Imported Upstream version 8.0pl1upstream/8.0pl1

202 files changed, 55869 insertions, 0 deletions

diff --git a/theories7/Arith/Arith.v b/theories7/Arith/Arith.v
new file mode 100755
index 00000000..181fadbc
--- /dev/null
+++ b/theories7/Arith/Arith.v
@@ -0,0 +1,21 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Arith.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
+
+Require Export Le.
+Require Export Lt.
+Require Export Plus.
+Require Export Gt.
+Require Export Minus.
+Require Export Mult.
+Require Export Between.
+Require Export Minus.
+Require Export Peano_dec.
+Require Export Compare_dec.
+Require Export Factorial.
diff --git a/theories7/Arith/Between.v b/theories7/Arith/Between.v
new file mode 100755
index 00000000..b3fef325
--- /dev/null
+++ b/theories7/Arith/Between.v
@@ -0,0 +1,185 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Between.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
+
+Require Le.
+Require Lt.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type k,l,p,q,r:nat.
+
+Section Between.
+Variables P,Q : nat -> Prop.
+
+Inductive between [k:nat] : nat -> Prop
+ := bet_emp : (between k k)
+ | bet_S : (l:nat)(between k l)->(P l)->(between k (S l)).
+
+Hint constr_between : arith v62 := Constructors between.
+
+Lemma bet_eq : (k,l:nat)(l=k)->(between k l).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Hints Resolve bet_eq : arith v62.
+
+Lemma between_le : (k,l:nat)(between k l)->(le k l).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+Hints Immediate between_le : arith v62.
+
+Lemma between_Sk_l : (k,l:nat)(between k l)->(le (S k) l)->(between (S k) l).
+Proof.
+NewInduction 1.
+Intros; Absurd (le (S k) k); Auto with arith.
+NewDestruct H; Auto with arith.
+Qed.
+Hints Resolve between_Sk_l : arith v62.
+
+Lemma between_restr : 
+  (k,l,m:nat)(le k l)->(le l m)->(between k m)->(between l m).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Inductive exists [k:nat] : nat -> Prop
+ := exists_S : (l:nat)(exists k l)->(exists k (S l))
+ | exists_le: (l:nat)(le k l)->(Q l)->(exists k (S l)).
+
+Hint constr_exists : arith v62 := Constructors exists.
+
+Lemma exists_le_S : (k,l:nat)(exists k l)->(le (S k) l).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Lemma exists_lt : (k,l:nat)(exists k l)->(lt k l).
+Proof exists_le_S.
+Hints Immediate exists_le_S exists_lt : arith v62.
+
+Lemma exists_S_le : (k,l:nat)(exists k (S l))->(le k l).
+Proof.
+Intros; Apply le_S_n; Auto with arith.
+Qed.
+Hints Immediate exists_S_le : arith v62.
+
+Definition in_int := [p,q,r:nat](le p r)/\(lt r q).
+
+Lemma in_int_intro : (p,q,r:nat)(le p r)->(lt r q)->(in_int p q r).
+Proof.
+Red; Auto with arith.
+Qed.
+Hints Resolve in_int_intro : arith v62.
+
+Lemma in_int_lt : (p,q,r:nat)(in_int p q r)->(lt p q).
+Proof.
+NewInduction 1; Intros.
+Apply le_lt_trans with r; Auto with arith.
+Qed.
+
+Lemma in_int_p_Sq : 
+  (p,q,r:nat)(in_int p (S q) r)->((in_int p q r) \/ <nat>r=q).
+Proof.
+NewInduction 1; Intros.
+Elim (le_lt_or_eq r q); Auto with arith.
+Qed.
+
+Lemma in_int_S : (p,q,r:nat)(in_int p q r)->(in_int p (S q) r).
+Proof.
+NewInduction 1;Auto with arith.
+Qed.
+Hints Resolve in_int_S : arith v62.
+
+Lemma in_int_Sp_q : (p,q,r:nat)(in_int (S p) q r)->(in_int p q r).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+Hints Immediate in_int_Sp_q : arith v62.
+
+Lemma between_in_int : (k,l:nat)(between k l)->(r:nat)(in_int k l r)->(P r).
+Proof.
+NewInduction 1; Intros.
+Absurd (lt k k); Auto with arith.
+Apply in_int_lt with r; Auto with arith.
+Elim (in_int_p_Sq k l r); Intros; Auto with arith.
+Rewrite H2; Trivial with arith.
+Qed.
+
+Lemma in_int_between : 
+  (k,l:nat)(le k l)->((r:nat)(in_int k l r)->(P r))->(between k l).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Lemma exists_in_int : 
+  (k,l:nat)(exists k l)->(EX m:nat | (in_int k l m) & (Q m)).
+Proof.
+NewInduction 1.
+Case IHexists; Intros p inp Qp; Exists p; Auto with arith.
+Exists l; Auto with arith.
+Qed.
+
+Lemma in_int_exists : (k,l,r:nat)(in_int k l r)->(Q r)->(exists k l).
+Proof.
+NewDestruct 1; Intros.
+Elim H0; Auto with arith.
+Qed.
+
+Lemma between_or_exists : 
+  (k,l:nat)(le k l)->((n:nat)(in_int k l n)->((P n)\/(Q n)))
+     ->((between k l)\/(exists k l)).
+Proof.
+NewInduction 1; Intros; Auto with arith.
+Elim IHle; Intro; Auto with arith.
+Elim (H0 m); Auto with arith.
+Qed.
+
+Lemma between_not_exists : (k,l:nat)(between k l)->
+     ((n:nat)(in_int k l n) -> (P n) -> ~(Q n))
+     -> ~(exists k l).
+Proof.
+NewInduction 1; Red; Intros.
+Absurd (lt 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'.
+Replace l with l'; Auto with arith.
+Elim inl'; Intros.
+Elim (le_lt_or_eq l' l); Auto with arith; Intros.
+Absurd (exists k l); Auto with arith.
+Apply in_int_exists with l'; Auto with arith.
+Qed.
+
+Inductive P_nth [init:nat] : nat->nat->Prop
+  := nth_O : (P_nth init init O)
+  | nth_S : (k,l:nat)(n:nat)(P_nth init k n)->(between (S k) l)
+                        ->(Q l)->(P_nth init l (S n)).
+
+Lemma nth_le : (init,l,n:nat)(P_nth init l n)->(le init l).
+Proof.
+NewInduction 1; Intros; Auto with arith.
+Apply le_trans with (S k); Auto with arith.
+Qed.
+
+Definition eventually := [n:nat](EX k:nat | (le k n) & (Q k)).
+
+Lemma event_O : (eventually O)->(Q O).
+Proof.
+NewInduction 1; Intros.
+Replace O with x; Auto with arith.
+Qed.
+
+End Between.
+
+Hints Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le 
+ in_int_S in_int_intro : arith v62. 
+Hints Immediate in_int_Sp_q exists_le_S exists_S_le : arith v62.
diff --git a/theories7/Arith/Bool_nat.v b/theories7/Arith/Bool_nat.v
new file mode 100644
index 00000000..c36f8f15
--- /dev/null
+++ b/theories7/Arith/Bool_nat.v
@@ -0,0 +1,43 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: Bool_nat.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ *)
+
+Require Export Compare_dec.
+Require Export Peano_dec.
+Require Sumbool.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,x,y:nat.
+
+(** The decidability of equality and order relations over
+    type [nat] give some boolean functions with the adequate specification. *)
+
+Definition notzerop := [n:nat] (sumbool_not ? ? (zerop n)).
+Definition lt_ge_dec : (x,y:nat){(lt x y)}+{(ge x y)} := 
+  [n,m:nat] (sumbool_not ? ? (le_lt_dec m n)).
+
+Definition nat_lt_ge_bool := 
+  [x,y:nat](bool_of_sumbool (lt_ge_dec x y)).
+Definition nat_ge_lt_bool := 
+  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (lt_ge_dec x y))).
+
+Definition nat_le_gt_bool := 
+  [x,y:nat](bool_of_sumbool (le_gt_dec x y)).
+Definition nat_gt_le_bool := 
+  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (le_gt_dec x y))).
+
+Definition nat_eq_bool :=
+  [x,y:nat](bool_of_sumbool (eq_nat_dec x y)).
+Definition nat_noteq_bool := 
+  [x,y:nat](bool_of_sumbool (sumbool_not ? ? (eq_nat_dec x y))).
+
+Definition zerop_bool := [x:nat](bool_of_sumbool (zerop x)).
+Definition notzerop_bool := [x:nat](bool_of_sumbool (notzerop x)).
diff --git a/theories7/Arith/Compare.v b/theories7/Arith/Compare.v
new file mode 100755
index 00000000..1bca3fbe
--- /dev/null
+++ b/theories7/Arith/Compare.v
@@ -0,0 +1,60 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Compare.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
+
+(** Equality is decidable on [nat] *)
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+(*
+Lemma not_eq_sym : (A:Set)(p,q:A)(~p=q) -> ~(q=p).
+Proof sym_not_eq.
+Hints Immediate not_eq_sym : arith.
+*)
+Notation not_eq_sym := sym_not_eq.
+
+Implicit Variables Type m,n,p,q:nat.
+
+Require Arith.
+Require Peano_dec.
+Require Compare_dec.
+
+Definition le_or_le_S := le_le_S_dec.
+
+Definition compare := gt_eq_gt_dec.
+
+Lemma le_dec : (n,m:nat) {le n m} + {le m n}.
+Proof le_ge_dec.
+
+Definition lt_or_eq := [n,m:nat]{(gt m n)}+{n=m}.
+
+Lemma le_decide : (n,m:nat)(le n m)->(lt_or_eq n m).
+Proof le_lt_eq_dec.
+
+Lemma le_le_S_eq : (p,q:nat)(le p q)->((le (S p) q)\/(p=q)).
+Proof le_lt_or_eq.
+
+(* By special request of G. Kahn - Used in Group Theory *)
+Lemma discrete_nat : (m, n: nat) (lt m n) ->
+   (S m) = n \/ (EX r: nat | n = (S (S (plus m r)))).
+Proof.
+Intros m n H.
+LApply (lt_le_S m n); Auto with arith.
+Intro H'; LApply (le_lt_or_eq (S m) n); Auto with arith.
+NewInduction 1; Auto with arith.
+Right; Exists (minus n (S (S m))); Simpl.
+Rewrite (plus_sym m (minus n (S (S m)))).
+Rewrite (plus_n_Sm (minus n (S (S m))) m).
+Rewrite (plus_n_Sm (minus n (S (S m))) (S m)).
+Rewrite (plus_sym (minus n (S (S m))) (S (S m))); Auto with arith.
+Qed.
+
+Require Export Wf_nat.
+
+Require Export Min.
diff --git a/theories7/Arith/Compare_dec.v b/theories7/Arith/Compare_dec.v
new file mode 100755
index 00000000..504c0562
--- /dev/null
+++ b/theories7/Arith/Compare_dec.v
@@ -0,0 +1,109 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Compare_dec.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
+
+Require Le.
+Require Lt.
+Require Gt.
+Require Decidable.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,x,y:nat.
+
+Definition zerop : (n:nat){n=O}+{lt O n}.
+NewDestruct n; Auto with arith.
+Defined.
+
+Definition lt_eq_lt_dec : (n,m:nat){(lt n m)}+{n=m}+{(lt m n)}.
+Proof.
+NewInduction n; Destruct m; Auto with arith.
+Intros m0; Elim (IHn m0); Auto with arith.
+NewInduction 1; Auto with arith.
+Defined.
+
+Lemma gt_eq_gt_dec : (n,m:nat)({(gt m n)}+{n=m})+{(gt n m)}.
+Proof lt_eq_lt_dec.
+
+Lemma le_lt_dec : (n,m:nat) {le n m} + {lt m n}.
+Proof.
+NewInduction n.
+Auto with arith.
+NewInduction m.
+Auto with arith.
+Elim (IHn m); Auto with arith.
+Defined.
+
+Definition le_le_S_dec : (n,m:nat) {le n m} + {le (S m) n}.
+Proof.
+Exact le_lt_dec.
+Defined.
+
+Definition le_ge_dec : (n,m:nat) {le n m} + {ge n m}.
+Proof.
+Intros; Elim (le_lt_dec n m); Auto with arith.
+Defined.
+
+Definition le_gt_dec : (n,m:nat){(le n m)}+{(gt n m)}.
+Proof.
+Exact le_lt_dec.
+Defined.
+
+Definition le_lt_eq_dec : (n,m:nat)(le n m)->({(lt n m)}+{n=m}).
+Proof.
+Intros; Elim (lt_eq_lt_dec n m); Auto with arith.
+Intros; Absurd (lt m n); Auto with arith.
+Defined.
+
+(** Proofs of decidability *)
+
+Theorem dec_le:(x,y:nat)(decidable (le x y)).
+Intros x y; Unfold decidable ; Elim (le_gt_dec x y); [
+  Auto with arith
+| Intro; Right; Apply gt_not_le; Assumption].
+Qed.
+
+Theorem dec_lt:(x,y:nat)(decidable (lt x y)).
+Intros x y; Unfold lt; Apply dec_le.
+Qed.
+
+Theorem dec_gt:(x,y:nat)(decidable (gt x y)).
+Intros x y; Unfold gt; Apply dec_lt.
+Qed.
+
+Theorem dec_ge:(x,y:nat)(decidable (ge x y)).
+Intros x y; Unfold ge; Apply dec_le.
+Qed.
+
+Theorem not_eq : (x,y:nat) ~ x=y -> (lt x y) \/ (lt y x).
+Intros x y H; Elim (lt_eq_lt_dec x y); [
+  Intros H1; Elim H1; [ Auto with arith | Intros H2; Absurd x=y; Assumption]
+| Auto with arith].
+Qed.
+
+
+Theorem not_le : (x,y:nat) ~(le x y) -> (gt x y).
+Intros x y H; Elim (le_gt_dec x y);
+  [ Intros H1; Absurd (le x y); Assumption | Trivial with arith ].
+Qed.
+
+Theorem not_gt : (x,y:nat) ~(gt x y) -> (le x y).
+Intros x y H; Elim (le_gt_dec x y);
+  [ Trivial with arith | Intros H1; Absurd (gt x y); Assumption].
+Qed.
+
+Theorem not_ge : (x,y:nat) ~(ge x y) -> (lt x y).
+Intros x y H; Exact (not_le y x H).
+Qed.
+
+Theorem not_lt : (x,y:nat) ~(lt x y) -> (ge x y).
+Intros x y H; Exact (not_gt y x H). 
+Qed.
+
diff --git a/theories7/Arith/Div.v b/theories7/Arith/Div.v
new file mode 100755
index 00000000..59694628
--- /dev/null
+++ b/theories7/Arith/Div.v
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Div.v,v 1.1.2.1 2004/07/16 19:31:23 herbelin Exp $ i*)
+
+(** Euclidean division *)
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Require Le.
+Require Euclid_def.
+Require Compare_dec.
+
+Implicit Variables Type n,a,b,q,r:nat.
+
+Fixpoint inf_dec [n:nat] : nat->bool :=
+      [m:nat] Cases n m of
+                  O     _     => true
+              | (S n')  O     => false
+              | (S n') (S m') => (inf_dec n' m')
+             end.
+
+Theorem div1 : (b:nat)(gt b O)->(a:nat)(diveucl a b).
+Realizer Fix div1 {div1/2: nat->nat->diveucl :=
+  [b,a]Cases a of
+         O     => (O,O)
+       | (S n) =>
+           let (q,r) = (div1 b n) in
+             if (le_gt_dec b (S r)) then ((S q),O)
+	     else (q,(S r))
+       end}.
+Program_all.
+Rewrite e.
+Replace b with (S r).
+Simpl.
+Elim plus_n_O; Auto with arith.
+Apply le_antisym; Auto with arith.
+Elim plus_n_Sm; Auto with arith.
+Qed.
+
+Theorem div2 : (b:nat)(gt b O)->(a:nat)(diveucl a b).
+Realizer Fix div1 {div1/2: nat->nat->diveucl :=
+  [b,a]Cases a of
+         O     => (O,O)
+       | (S n) =>
+           let (q,r) = (div1 b n) in
+             if (inf_dec b (S r)) :: :: { {(le b (S r))}+{(gt b (S r))} }
+             then ((S q),O)
+	     else (q,(S r))
+       end}.
+Program_all.
+Rewrite e.
+Replace b with (S r).
+Simpl.
+Elim plus_n_O; Auto with arith.
+Apply le_antisym; Auto with arith.
+Elim plus_n_Sm; Auto with arith.
+Qed.
diff --git a/theories7/Arith/Div2.v b/theories7/Arith/Div2.v
new file mode 100644
index 00000000..8bd0160f
--- /dev/null
+++ b/theories7/Arith/Div2.v
@@ -0,0 +1,174 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Div2.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Lt.
+Require Plus.
+Require Compare_dec.
+Require Even.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type n:nat.
+
+(** Here we define [n/2] and prove some of its properties *)
+
+Fixpoint div2 [n:nat] : nat :=
+  Cases n of
+    O => O
+  | (S O) => O
+  | (S (S n')) => (S (div2 n'))
+  end.
+
+(** Since [div2] is recursively defined on [0], [1] and [(S (S n))], it is
+    useful to prove the corresponding induction principle *)
+
+Lemma ind_0_1_SS : (P:nat->Prop)
+  (P O) -> (P (S O)) -> ((n:nat)(P n)->(P (S (S n)))) -> (n:nat)(P n).
+Proof.
+Intros.
+Cut (n:nat)(P n)/\(P (S n)).
+Intros. Elim (H2 n). Auto with arith.
+
+NewInduction n0. Auto with arith.
+Intros. Elim IHn0; Auto with arith.
+Qed.
+
+(** [0 <n  =>  n/2 < n] *)
+
+Lemma lt_div2 : (n:nat) (lt O n) -> (lt (div2 n) n).
+Proof.
+Intro n. Pattern n. Apply ind_0_1_SS.
+Intro. Inversion H.
+Auto with arith.
+Intros. Simpl.
+Case (zerop n0).
+Intro. Rewrite e. Auto with arith.
+Auto with arith.
+Qed.
+
+Hints Resolve lt_div2 : arith.
+
+(** Properties related to the parity *)
+
+Lemma even_odd_div2 : (n:nat) 
+  ((even n)<->(div2 n)=(div2 (S n))) /\ ((odd n)<->(S (div2 n))=(div2 (S n))).
+Proof.
+Intro n. Pattern n. Apply ind_0_1_SS.
+(* n  = 0 *)
+Split. Split; Auto with arith. 
+Split. Intro H. Inversion H.
+Intro H.  Absurd (S (div2 O))=(div2 (S O)); Auto with arith.
+(* n = 1 *)
+Split. Split. Intro. Inversion H. Inversion H1.
+Intro H.  Absurd (div2 (S O))=(div2 (S (S O))).
+Simpl. Discriminate. Assumption.
+Split; Auto with arith.
+(* n = (S (S n')) *)
+Intros. Decompose [and] H. Unfold iff in H0 H1.
+Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
+Split; Split; Auto with arith.
+Intro H. Inversion H. Inversion H1.
+Change (S (div2 n0))=(S (div2 (S n0))). Auto with arith.
+Intro H. Inversion H. Inversion H1.
+Change (S (S (div2 n0)))=(S (div2 (S n0))). Auto with arith.
+Qed.
+
+(** Specializations *)
+
+Lemma even_div2 : (n:nat) (even n) -> (div2 n)=(div2 (S n)).
+Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_div2 n))).
+
+Lemma div2_even : (n:nat) (div2 n)=(div2 (S n)) -> (even n).
+Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_div2 n))).
+
+Lemma odd_div2 : (n:nat) (odd n) -> (S (div2 n))=(div2 (S n)).
+Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_div2 n))).
+
+Lemma div2_odd : (n:nat) (S (div2 n))=(div2 (S n)) -> (odd n).
+Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_div2 n))).
+
+Hints Resolve even_div2 div2_even odd_div2 div2_odd : arith.
+
+(** Properties related to the double ([2n]) *)
+
+Definition double := [n:nat](plus n n).
+
+Hints Unfold double : arith.
+
+Lemma double_S : (n:nat) (double (S n))=(S (S (double n))).
+Proof.
+Intro. Unfold double. Simpl. Auto with arith.
+Qed.
+
+Lemma double_plus : (m,n:nat) (double (plus m n))=(plus (double m) (double n)).
+Proof.
+Intros m n. Unfold double.
+Do 2 Rewrite -> plus_assoc_r. Rewrite -> (plus_permute n).
+Reflexivity.
+Qed.
+
+Hints Resolve double_S : arith.
+
+Lemma even_odd_double : (n:nat) 
+  ((even n)<->n=(double (div2 n))) /\ ((odd n)<->n=(S (double (div2 n)))).
+Proof.
+Intro n. Pattern n. Apply ind_0_1_SS.
+(* n = 0 *)
+Split; Split; Auto with arith.
+Intro H. Inversion H.
+(* n = 1 *)
+Split; Split; Auto with arith.
+Intro H. Inversion H. Inversion H1.
+(* n = (S (S n')) *)
+Intros. Decompose [and] H. Unfold iff in H0 H1.
+Decompose [and] H0. Decompose [and] H1. Clear H H0 H1.
+Split; Split.
+Intro H. Inversion H. Inversion H1.
+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. Rewrite (double_S (div2 n0)). Auto with arith.
+Simpl. Rewrite (double_S (div2 n0)). Intro H. Injection H. Auto with arith.
+Qed.
+
+
+(** Specializations *)
+
+Lemma even_double : (n:nat) (even n) -> n=(double (div2 n)).
+Proof [n:nat](proj1 ? ? (proj1 ? ? (even_odd_double n))).
+
+Lemma double_even : (n:nat) n=(double (div2 n)) -> (even n).
+Proof [n:nat](proj2 ? ? (proj1 ? ? (even_odd_double n))).
+
+Lemma odd_double : (n:nat) (odd n) -> n=(S (double (div2 n))).
+Proof [n:nat](proj1 ? ? (proj2 ? ? (even_odd_double n))).
+
+Lemma double_odd : (n:nat) n=(S (double (div2 n))) -> (odd n).
+Proof [n:nat](proj2 ? ? (proj2 ? ? (even_odd_double n))).
+
+Hints Resolve even_double double_even odd_double double_odd : arith.
+
+(** Application: 
+    - if [n] is even then there is a [p] such that [n = 2p]
+    - if [n] is odd  then there is a [p] such that [n = 2p+1]
+
+    (Immediate: it is [n/2]) *)
+
+Lemma even_2n : (n:nat) (even n) -> { p:nat | n=(double p) }.
+Proof.
+Intros n H. Exists (div2 n). Auto with arith.
+Qed.
+
+Lemma odd_S2n : (n:nat) (odd n) -> { p:nat | n=(S (double p)) }.
+Proof.
+Intros n H. Exists (div2 n). Auto with arith.
+Qed.
+
diff --git a/theories7/Arith/EqNat.v b/theories7/Arith/EqNat.v
new file mode 100755
index 00000000..9f5ee7ee
--- /dev/null
+++ b/theories7/Arith/EqNat.v
@@ -0,0 +1,78 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: EqNat.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+(** Equality on natural numbers *)
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,x,y:nat.
+
+Fixpoint  eq_nat [n:nat] : nat -> Prop :=
+  [m:nat]Cases n m of 
+                O      O     => True
+             |  O     (S _)  => False
+             | (S _)   O     => False
+             | (S n1) (S m1) => (eq_nat n1 m1)
+          end.
+
+Theorem eq_nat_refl : (n:nat)(eq_nat n n).
+NewInduction n; Simpl; Auto.
+Qed.
+Hints Resolve eq_nat_refl : arith v62.
+
+Theorem eq_eq_nat : (n,m:nat)(n=m)->(eq_nat n m).
+NewInduction 1; Trivial with arith.
+Qed.
+Hints Immediate eq_eq_nat : arith v62.
+
+Theorem eq_nat_eq : (n,m:nat)(eq_nat n m)->(n=m).
+NewInduction n; NewInduction m; Simpl; Contradiction Orelse Auto with arith.
+Qed.
+Hints Immediate eq_nat_eq : arith v62.
+
+Theorem eq_nat_elim : (n:nat)(P:nat->Prop)(P n)->(m:nat)(eq_nat n m)->(P m).
+Intros; Replace m with n; Auto with arith.
+Qed.
+
+Theorem eq_nat_decide : (n,m:nat){(eq_nat n m)}+{~(eq_nat n m)}.
+NewInduction n.
+NewDestruct m.
+Auto with arith.
+Intros; Right; Red; Trivial with arith.
+NewDestruct m.
+Right; Red; Auto with arith.
+Intros.
+Simpl.
+Apply IHn.
+Defined.
+
+Fixpoint  beq_nat [n:nat] : nat -> bool :=
+  [m:nat]Cases n m of 
+                O      O     => true
+             |  O     (S _)  => false
+             | (S _)   O     => false
+             | (S n1) (S m1) => (beq_nat n1 m1)
+          end.
+
+Lemma beq_nat_refl : (x:nat)true=(beq_nat x x).
+Proof.
+  Intro x; NewInduction x; Simpl; Auto.
+Qed.
+
+Definition beq_nat_eq : (x,y:nat)true=(beq_nat x y)->x=y.
+Proof.
+  Double Induction x y; Simpl.
+    Reflexivity.
+    Intros; Discriminate H0.
+    Intros; Discriminate H0.
+    Intros; Case (H0 ? H1); Reflexivity.
+Defined.
+
diff --git a/theories7/Arith/Euclid.v b/theories7/Arith/Euclid.v
new file mode 100644
index 00000000..adeaf713
--- /dev/null
+++ b/theories7/Arith/Euclid.v
@@ -0,0 +1,65 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Euclid.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Mult.
+Require Compare_dec.
+Require Wf_nat.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type a,b,n,q,r:nat.
+
+Inductive diveucl [a,b:nat] : Set 
+      := divex : (q,r:nat)(gt b r)->(a=(plus (mult q b) r))->(diveucl a b).
+
+
+Lemma eucl_dev : (b:nat)(gt b O)->(a:nat)(diveucl a b).
+Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
+Elim (le_gt_dec b n).
+Intro lebn.
+Elim (H0 (minus n b)); Auto with arith.
+Intros q r g e.
+Apply divex with (S q) r; Simpl; Auto with arith.
+Elim plus_assoc_l.
+Elim e; Auto with arith.
+Intros gtbn.
+Apply divex with O n; Simpl; Auto with arith.
+Qed.
+
+Lemma quotient : (b:nat)(gt b O)->
+     (a:nat){q:nat|(EX r:nat | (a=(plus (mult q b) r))/\(gt b r))}.
+Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
+Elim (le_gt_dec b n).
+Intro lebn.
+Elim (H0 (minus n b)); Auto with arith.
+Intros q Hq; Exists (S q).
+Elim Hq; Intros r Hr.
+Exists r; Simpl; Elim Hr; Intros.
+Elim plus_assoc_l.
+Elim H1; Auto with arith.
+Intros gtbn.
+Exists O; Exists n; Simpl; Auto with arith.
+Qed.
+
+Lemma modulo : (b:nat)(gt b O)->
+     (a:nat){r:nat|(EX q:nat | (a=(plus (mult q b) r))/\(gt b r))}.
+Intros b H a; Pattern a; Apply gt_wf_rec; Intros n H0.
+Elim (le_gt_dec b n).
+Intro lebn.
+Elim (H0 (minus n b)); Auto with arith.
+Intros r Hr; Exists r.
+Elim Hr; Intros q Hq.
+Elim Hq; Intros; Exists (S q); Simpl.
+Elim plus_assoc_l.
+Elim H1; Auto with arith.
+Intros gtbn.
+Exists n; Exists O; Simpl; Auto with arith.
+Qed.
diff --git a/theories7/Arith/Even.v b/theories7/Arith/Even.v
new file mode 100644
index 00000000..bcc413f5
--- /dev/null
+++ b/theories7/Arith/Even.v
@@ -0,0 +1,310 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Even.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ 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. *)
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n:nat.
+
+Inductive even : nat->Prop :=
+    even_O : (even O)
+  | even_S : (n:nat)(odd n)->(even (S n))
+with odd : nat->Prop :=
+    odd_S : (n:nat)(even n)->(odd (S n)).
+
+Hint constr_even : arith := Constructors even.
+Hint constr_odd : arith := Constructors odd.
+
+Lemma even_or_odd : (n:nat) (even n)\/(odd n).
+Proof.
+NewInduction n.
+Auto with arith.
+Elim IHn; Auto with arith.
+Qed.
+
+Lemma even_odd_dec : (n:nat) { (even n) }+{ (odd n) }.
+Proof.
+NewInduction n.
+Auto with arith.
+Elim IHn; Auto with arith.
+Qed.
+
+Lemma not_even_and_odd : (n:nat) (even n) -> (odd n) -> False.
+Proof.
+NewInduction n.
+Intros. Inversion H0.
+Intros. Inversion H. Inversion H0. Auto with arith.
+Qed.
+
+Lemma even_plus_aux:
+  (n,m:nat)
+   (iff (odd (plus n m)) (odd n) /\ (even m) \/ (even n) /\ (odd m)) /\
+   (iff (even (plus n m)) (even n) /\ (even m) \/ (odd n) /\ (odd m)).
+Proof.
+Intros n; Elim n; Simpl; Auto with arith.
+Intros m; Split; Auto.
+Split.
+Intros H; Right; Split; Auto with arith.
+Intros H'; Case H'; Auto with arith.
+Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
+Intros H; Elim H; Auto.
+Split; Auto with arith.
+Intros H'; Elim H'; Auto with arith.
+Intros H; Elim H; Auto.
+Intros H'0; Elim H'0; Intros H'1 H'2; Inversion H'1.
+Intros n0 H' m; Elim (H' m); Intros H'1 H'2; Elim H'1; Intros E1 E2; Elim H'2;
+ Intros E3 E4; Clear H'1 H'2.
+Split; Split.
+Intros H'0; Case E3.
+Inversion H'0; Auto.
+Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
+Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
+Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
+Apply odd_S.
+Apply E4; Left; Split; Auto with arith.
+Inversion C1; Auto.
+Apply odd_S.
+Apply E4; Right; Split; Auto with arith.
+Inversion C1; Auto.
+Intros H'0.
+Case E1.
+Inversion H'0; Auto.
+Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
+Intros H; Elim H; Intros H0 H1; Clear H; Auto with arith.
+Intros H'0; Case H'0; Intros C0; Case C0; Intros C1 C2.
+Apply even_S.
+Apply E2; Left; Split; Auto with arith.
+Inversion C1; Auto.
+Apply even_S.
+Apply E2; Right; Split; Auto with arith.
+Inversion C1; Auto.
+Qed.
+ 
+Lemma even_even_plus : (n,m:nat) (even n) -> (even m) -> (even (plus n m)).
+Proof.
+Intros n m; Case (even_plus_aux n m).
+Intros H H0; Case H0; Auto.
+Qed.
+ 
+Lemma odd_even_plus : (n,m:nat) (odd n) -> (odd m) -> (even (plus n m)).
+Proof.
+Intros n m; Case (even_plus_aux n m).
+Intros H H0; Case H0; Auto.
+Qed.
+ 
+Lemma even_plus_even_inv_r :
+  (n,m:nat) (even (plus n m)) -> (even n) -> (even m).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'0.
+Intros H'1; Case H'1; Auto.
+Intros H0; Elim H0; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
+Case H0; Auto.
+Qed.
+ 
+Lemma even_plus_even_inv_l :
+  (n,m:nat) (even (plus n m)) -> (even m) -> (even n).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'0.
+Intros H'1; Case H'1; Auto.
+Intros H0; Elim H0; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
+Case H0; Auto.
+Qed.
+ 
+Lemma even_plus_odd_inv_r : (n,m:nat) (even (plus n m)) -> (odd n) -> (odd m).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'0.
+Intros H'1; Case H'1; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
+Case H0; Auto.
+Intros H0; Case H0; Auto.
+Qed.
+ 
+Lemma even_plus_odd_inv_l : (n,m:nat) (even (plus n m)) -> (odd m) -> (odd n).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'0.
+Intros H'1; Case H'1; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
+Case H0; Auto.
+Intros H0; Case H0; Auto.
+Qed.
+Hints Resolve even_even_plus odd_even_plus :arith.
+ 
+Lemma odd_plus_l : (n,m:nat) (odd n) -> (even m) -> (odd (plus n m)).
+Proof.
+Intros n m; Case (even_plus_aux n m).
+Intros H; Case H; Auto.
+Qed.
+ 
+Lemma odd_plus_r : (n,m:nat) (even n) -> (odd m) -> (odd (plus n m)).
+Proof.
+Intros n m; Case (even_plus_aux n m).
+Intros H; Case H; Auto.
+Qed.
+ 
+Lemma odd_plus_even_inv_l : (n,m:nat) (odd (plus n m)) -> (odd m) -> (even n).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'.
+Intros H'1; Case H'1; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
+Case H0; Auto.
+Intros H0; Case H0; Auto.
+Qed.
+ 
+Lemma odd_plus_even_inv_r : (n,m:nat) (odd (plus n m)) -> (odd n) -> (even m).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'.
+Intros H'1; Case H'1; Auto.
+Intros H0; Case H0; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
+Case H0; Auto.
+Qed.
+ 
+Lemma odd_plus_odd_inv_l : (n,m:nat) (odd (plus n m)) -> (even m) -> (odd n).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'.
+Intros H'1; Case H'1; Auto.
+Intros H0; Case H0; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd m); Auto.
+Case H0; Auto.
+Qed.
+ 
+Lemma odd_plus_odd_inv_r : (n,m:nat) (odd (plus n m)) -> (even n) -> (odd m).
+Proof.
+Intros n m H; Case (even_plus_aux n m).
+Intros H' H'0; Elim H'.
+Intros H'1; Case H'1; Auto.
+Intros H0 H1 H2; Case (not_even_and_odd n); Auto.
+Case H0; Auto.
+Intros H0; Case H0; Auto.
+Qed.
+Hints Resolve odd_plus_l odd_plus_r :arith.
+ 
+Lemma even_mult_aux :
+  (n,m:nat)
+   (iff (odd (mult n m)) (odd n) /\ (odd m)) /\
+   (iff (even (mult n m)) (even n) \/ (even m)).
+Proof.
+Intros n; Elim n; Simpl; Auto with arith.
+Intros m; Split; Split; Auto with arith.
+Intros H'; Inversion H'.
+Intros H'; Elim H'; Auto.
+Intros n0 H' m; Split; Split; Auto with arith.
+Intros H'0.
+Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'3; Intros H'1 H'2;
+ Case H'1; Auto.
+Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
+Split; Auto with arith.
+Case (H' m).
+Intros H'8 H'9; Case H'9.
+Intros H'10; Case H'10; Auto with arith.
+Intros H'11 H'12; Case (not_even_and_odd m); Auto with arith.
+Intros H'5; Elim H'5; Intros H'6 H'7; Case (not_even_and_odd (mult n0 m)); Auto.
+Case (H' m).
+Intros H'8 H'9; Case H'9; Auto.
+Intros H'0; Elim H'0; Intros H'1 H'2; Clear H'0.
+Elim (even_plus_aux m (mult n0 m)); Auto.
+Intros H'0 H'3.
+Elim H'0.
+Intros H'4 H'5; Apply H'5; Auto.
+Left; Split; Auto with arith.
+Case (H' m).
+Intros H'6 H'7; Elim H'7.
+Intros H'8 H'9; Apply H'9.
+Left.
+Inversion H'1; Auto.
+Intros H'0.
+Elim (even_plus_aux m (mult n0 m)); Intros H'3 H'4; Case H'4.
+Intros H'1 H'2.
+Elim H'1; Auto.
+Intros H; Case H; Auto.
+Intros H'5; Elim H'5; Intros H'6 H'7; Auto with arith.
+Left.
+Case (H' m).
+Intros H'8; Elim H'8.
+Intros H'9; Elim H'9; Auto with arith.
+Intros H'0; Elim H'0; Intros H'1.
+Case (even_or_odd m); Intros H'2.
+Apply even_even_plus; Auto.
+Case (H' m).
+Intros H H0; Case H0; Auto.
+Apply odd_even_plus; Auto.
+Inversion H'1; Case (H' m); Auto.
+Intros H1; Case H1; Auto.
+Apply even_even_plus; Auto.
+Case (H' m).
+Intros H H0; Case H0; Auto.
+Qed.
+ 
+Lemma even_mult_l : (n,m:nat) (even n) -> (even (mult n m)).
+Proof.
+Intros n m; Case (even_mult_aux n m); Auto.
+Intros H H0; Case H0; Auto.
+Qed.
+ 
+Lemma even_mult_r: (n,m:nat) (even m) -> (even (mult n m)).
+Proof.
+Intros n m; Case (even_mult_aux n m); Auto.
+Intros H H0; Case H0; Auto.
+Qed.
+Hints Resolve even_mult_l even_mult_r :arith.
+ 
+Lemma even_mult_inv_r: (n,m:nat) (even (mult n m)) -> (odd n) -> (even m).
+Proof.
+Intros n m H' H'0.
+Case (even_mult_aux n m).
+Intros H'1 H'2; Elim H'2.
+Intros H'3; Elim H'3; Auto.
+Intros H; Case (not_even_and_odd n); Auto.
+Qed.
+ 
+Lemma even_mult_inv_l : (n,m:nat) (even (mult n m)) -> (odd m) -> (even n).
+Proof.
+Intros n m H' H'0.
+Case (even_mult_aux n m).
+Intros H'1 H'2; Elim H'2.
+Intros H'3; Elim H'3; Auto.
+Intros H; Case (not_even_and_odd m); Auto.
+Qed.
+ 
+Lemma odd_mult : (n,m:nat) (odd n) -> (odd m) -> (odd (mult n m)).
+Proof.
+Intros n m; Case (even_mult_aux n m); Intros H; Case H; Auto.
+Qed.
+Hints Resolve even_mult_l even_mult_r odd_mult :arith.
+ 
+Lemma odd_mult_inv_l : (n,m:nat) (odd (mult n m)) -> (odd n).
+Proof.
+Intros n m H'.
+Case (even_mult_aux n m).
+Intros H'1 H'2; Elim H'1.
+Intros H'3; Elim H'3; Auto.
+Qed.
+ 
+Lemma odd_mult_inv_r : (n,m:nat) (odd (mult n m)) -> (odd m).
+Proof.
+Intros n m H'.
+Case (even_mult_aux n m).
+Intros H'1 H'2; Elim H'1.
+Intros H'3; Elim H'3; Auto.
+Qed.
+
diff --git a/theories7/Arith/Factorial.v b/theories7/Arith/Factorial.v
new file mode 100644
index 00000000..a8a60c98
--- /dev/null
+++ b/theories7/Arith/Factorial.v
@@ -0,0 +1,51 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Factorial.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Plus.
+Require Mult.
+Require Lt.
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+(** Factorial *)
+
+Fixpoint fact [n:nat]:nat:=
+  Cases n of
+     O     => (S O)
+    |(S n) => (mult (S n) (fact n))
+  end.
+
+Arguments Scope fact [ nat_scope ].
+
+Lemma lt_O_fact : (n:nat)(lt O (fact n)).
+Proof.
+Induction n; Unfold lt; Simpl; Auto with arith.
+Qed.
+
+Lemma fact_neq_0:(n:nat)~(fact n)=O.
+Proof.
+Intro.
+Apply sym_not_eq.
+Apply lt_O_neq.
+Apply lt_O_fact.
+Qed.
+
+Lemma fact_growing : (n,m:nat) (le n m) -> (le (fact n) (fact m)).
+Proof.
+NewInduction 1.
+Apply le_n.
+Assert (le (mult (S O) (fact n)) (mult (S m) (fact m))).
+Apply le_mult_mult.
+Apply lt_le_S; Apply lt_O_Sn.
+Assumption.
+Simpl (mult (S O) (fact n)) in H0.
+Rewrite <- plus_n_O in H0.
+Assumption.
+Qed.
diff --git a/theories7/Arith/Gt.v b/theories7/Arith/Gt.v
new file mode 100755
index 00000000..16b6f203
--- /dev/null
+++ b/theories7/Arith/Gt.v
@@ -0,0 +1,149 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Gt.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Le.
+Require Lt.
+Require Plus.
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+(** Order and successor *)
+
+Theorem gt_Sn_O : (n:nat)(gt (S n) O).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve gt_Sn_O : arith v62.
+
+Theorem gt_Sn_n : (n:nat)(gt (S n) n).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve gt_Sn_n : arith v62.
+
+Theorem gt_n_S : (n,m:nat)(gt n m)->(gt (S n) (S m)).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve gt_n_S : arith v62.
+
+Lemma gt_S_n : (n,p:nat)(gt (S p) (S n))->(gt p n).
+Proof.
+  Auto with arith.
+Qed.
+Hints Immediate gt_S_n : arith v62.
+
+Theorem gt_S : (n,m:nat)(gt (S n) m)->((gt n m)\/(m=n)).
+Proof.
+  Intros n m H; Unfold gt; Apply le_lt_or_eq; Auto with arith.
+Qed.
+
+Lemma gt_pred : (n,p:nat)(gt p (S n))->(gt (pred p) n).
+Proof.
+  Auto with arith.
+Qed.
+Hints Immediate gt_pred : arith v62.
+
+(** Irreflexivity *)
+
+Lemma gt_antirefl : (n:nat)~(gt n n).
+Proof lt_n_n.
+Hints Resolve gt_antirefl : arith v62.
+
+(** Asymmetry *)
+
+Lemma gt_not_sym : (n,m:nat)(gt n m) -> ~(gt m n).
+Proof [n,m:nat](lt_not_sym m n).
+
+Hints Resolve gt_not_sym : arith v62.
+
+(** Relating strict and large orders *)
+
+Lemma le_not_gt : (n,m:nat)(le n m) -> ~(gt n m).
+Proof le_not_lt.
+Hints Resolve le_not_gt : arith v62.
+
+Lemma gt_not_le : (n,m:nat)(gt n m) -> ~(le n m).
+Proof.
+Auto with arith.
+Qed.
+
+Hints Resolve gt_not_le : arith v62.
+
+Theorem le_S_gt : (n,m:nat)(le (S n) m)->(gt m n).
+Proof.
+  Auto with arith.
+Qed.
+Hints Immediate le_S_gt : arith v62.
+
+Lemma gt_S_le : (n,p:nat)(gt (S p) n)->(le n p).
+Proof.
+  Intros n p; Exact (lt_n_Sm_le n p).
+Qed.
+Hints Immediate gt_S_le : arith v62.
+
+Lemma gt_le_S : (n,p:nat)(gt p n)->(le (S n) p).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve gt_le_S : arith v62.
+
+Lemma le_gt_S : (n,p:nat)(le n p)->(gt (S p) n).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve le_gt_S : arith v62.
+
+(** Transitivity *)
+
+Theorem le_gt_trans : (n,m,p:nat)(le m n)->(gt m p)->(gt n p).
+Proof.
+  Red; Intros; Apply lt_le_trans with m; Auto with arith.
+Qed.
+
+Theorem gt_le_trans : (n,m,p:nat)(gt n m)->(le p m)->(gt n p).
+Proof.
+  Red; Intros; Apply le_lt_trans with m; Auto with arith.
+Qed.
+
+Lemma gt_trans : (n,m,p:nat)(gt n m)->(gt m p)->(gt n p).
+Proof.
+  Red; Intros n m p H1 H2.
+  Apply lt_trans with m; Auto with arith.
+Qed.
+
+Theorem gt_trans_S : (n,m,p:nat)(gt (S n) m)->(gt m p)->(gt n p).
+Proof.
+  Red; Intros; Apply lt_le_trans with m; Auto with arith.
+Qed.
+
+Hints Resolve gt_trans_S le_gt_trans gt_le_trans : arith v62.
+
+(** Comparison to 0 *)
+
+Theorem gt_O_eq : (n:nat)((gt n O)\/(O=n)).
+Proof.
+  Intro n ; Apply gt_S ; Auto with arith.
+Qed.
+
+(** Simplification and compatibility *)
+
+Lemma simpl_gt_plus_l : (n,m,p:nat)(gt (plus p n) (plus p m))->(gt n m).
+Proof.
+  Red; Intros n m p H; Apply simpl_lt_plus_l with p; Auto with arith.
+Qed.
+
+Lemma gt_reg_l : (n,m,p:nat)(gt n m)->(gt (plus p n) (plus p m)).
+Proof.
+  Auto with arith.
+Qed.
+Hints Resolve gt_reg_l : arith v62.
diff --git a/theories7/Arith/Le.v b/theories7/Arith/Le.v
new file mode 100755
index 00000000..cdb98645
--- /dev/null
+++ b/theories7/Arith/Le.v
@@ -0,0 +1,122 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Le.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+(** Order on natural numbers *)
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+(** Reflexivity *)
+
+Theorem le_refl : (n:nat)(le n n).
+Proof.
+Exact le_n.
+Qed.
+
+(** Transitivity *)
+
+Theorem le_trans : (n,m,p:nat)(le n m)->(le m p)->(le n p).
+Proof.
+  NewInduction 2; Auto.
+Qed.
+Hints Resolve le_trans : arith v62.
+
+(** Order, successor and predecessor *)
+
+Theorem le_n_S : (n,m:nat)(le n m)->(le (S n) (S m)).
+Proof.
+  NewInduction 1; Auto.
+Qed.
+
+Theorem le_n_Sn : (n:nat)(le n (S n)).
+Proof.
+  Auto.
+Qed.
+
+Theorem le_O_n : (n:nat)(le O n).
+Proof.
+  NewInduction n ; Auto.
+Qed.
+
+Hints Resolve le_n_S le_n_Sn le_O_n le_n_S : arith v62.
+
+Theorem le_pred_n : (n:nat)(le (pred n) n).
+Proof.
+NewInduction n ; Auto with arith.
+Qed.
+Hints Resolve le_pred_n : arith v62.
+
+Theorem le_trans_S : (n,m:nat)(le (S n) m)->(le n m).
+Proof.
+Intros n m H ; Apply le_trans with (S n); Auto with arith.
+Qed.
+Hints Immediate le_trans_S : arith v62.
+
+Theorem le_S_n : (n,m:nat)(le (S n) (S m))->(le n m).
+Proof.
+Intros n m H ; Change (le (pred (S n)) (pred (S m))).
+Elim H ; Simpl ; Auto with arith.
+Qed.
+Hints Immediate le_S_n : arith v62.
+
+Theorem le_pred : (n,m:nat)(le n m)->(le (pred n) (pred m)).
+Proof.
+NewInduction n as [|n IHn]. Simpl. Auto with arith.
+NewDestruct m as [|m]. Simpl. Intro H. Inversion H.
+Simpl. Auto with arith.
+Qed.
+
+(** Comparison to 0 *)
+
+Theorem le_Sn_O : (n:nat)~(le (S n) O).
+Proof.
+Red ; Intros n H.
+Change (IsSucc O) ; Elim H ; Simpl ; Auto with arith.
+Qed.
+Hints Resolve le_Sn_O : arith v62.
+
+Theorem le_n_O_eq : (n:nat)(le n O)->(O=n).
+Proof.
+NewInduction n; Auto with arith.
+Intro; Contradiction le_Sn_O with n.
+Qed.
+Hints Immediate le_n_O_eq : arith v62.
+
+(** Negative properties *)
+
+Theorem le_Sn_n : (n:nat)~(le (S n) n).
+Proof.
+NewInduction n; Auto with arith.
+Qed.
+Hints Resolve le_Sn_n : arith v62.
+
+(** Antisymmetry *)
+
+Theorem le_antisym : (n,m:nat)(le n m)->(le m n)->(n=m).
+Proof.
+Intros n m h ; NewDestruct h as [|m0]; Auto with arith.
+Intros H1.
+Absurd (le (S m0) m0) ; Auto with arith.
+Apply le_trans with n ; Auto with arith.
+Qed.
+Hints Immediate le_antisym : arith v62.
+
+(** A different elimination principle for the order on natural numbers *)
+
+Lemma le_elim_rel : (P:nat->nat->Prop)
+     ((p:nat)(P O p))->
+     ((p,q:nat)(le p q)->(P p q)->(P (S p) (S q)))->
+     (n,m:nat)(le n m)->(P n m).
+Proof.
+NewInduction n; Auto with arith.
+Intros m Le.
+Elim Le; Auto with arith.
+Qed.
diff --git a/theories7/Arith/Lt.v b/theories7/Arith/Lt.v
new file mode 100755
index 00000000..9bb1d564
--- /dev/null
+++ b/theories7/Arith/Lt.v
@@ -0,0 +1,176 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Lt.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Le.
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+(** Irreflexivity *)
+
+Theorem lt_n_n : (n:nat)~(lt n n).
+Proof le_Sn_n.
+Hints Resolve lt_n_n : arith v62.
+
+(** Relationship between [le] and [lt] *) 
+
+Theorem lt_le_S : (n,p:nat)(lt n p)->(le (S n) p).
+Proof.
+Auto with arith.
+Qed.
+Hints Immediate lt_le_S : arith v62.
+
+Theorem lt_n_Sm_le : (n,m:nat)(lt n (S m))->(le n m).
+Proof.
+Auto with arith.
+Qed.
+Hints Immediate lt_n_Sm_le : arith v62.
+
+Theorem le_lt_n_Sm : (n,m:nat)(le n m)->(lt n (S m)).
+Proof.
+Auto with arith.
+Qed.
+Hints Immediate le_lt_n_Sm : arith v62.
+
+Theorem le_not_lt : (n,m:nat)(le n m) -> ~(lt m n).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Theorem lt_not_le : (n,m:nat)(lt n m) -> ~(le m n).
+Proof.
+Red; Intros n m Lt Le; Exact (le_not_lt m n Le Lt).
+Qed.
+Hints Immediate le_not_lt lt_not_le : arith v62.
+
+(** Asymmetry *)
+
+Theorem lt_not_sym : (n,m:nat)(lt n m) -> ~(lt m n).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+(** Order and successor *)
+
+Theorem lt_n_Sn : (n:nat)(lt n (S n)).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve lt_n_Sn : arith v62.
+
+Theorem lt_S : (n,m:nat)(lt n m)->(lt n (S m)).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve lt_S : arith v62.
+
+Theorem lt_n_S : (n,m:nat)(lt n m)->(lt (S n) (S m)).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve lt_n_S : arith v62.
+
+Theorem lt_S_n : (n,m:nat)(lt (S n) (S m))->(lt n m).
+Proof.
+Auto with arith.
+Qed.
+Hints Immediate lt_S_n : arith v62.
+
+Theorem lt_O_Sn : (n:nat)(lt O (S n)).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve lt_O_Sn : arith v62.
+
+Theorem lt_n_O : (n:nat)~(lt n O).
+Proof le_Sn_O.
+Hints Resolve lt_n_O : arith v62.
+
+(** Predecessor *)
+
+Lemma S_pred : (n,m:nat)(lt m n)->n=(S (pred n)).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Lemma lt_pred : (n,p:nat)(lt (S n) p)->(lt n (pred p)).
+Proof.
+NewInduction 1; Simpl; Auto with arith.
+Qed.
+Hints Immediate lt_pred : arith v62.
+
+Lemma lt_pred_n_n : (n:nat)(lt O n)->(lt (pred n) n).
+NewDestruct 1; Simpl; Auto with arith.
+Qed.
+Hints Resolve lt_pred_n_n : arith v62.
+
+(** Transitivity properties *)
+
+Theorem lt_trans : (n,m,p:nat)(lt n m)->(lt m p)->(lt n p).
+Proof.
+NewInduction 2; Auto with arith.
+Qed.
+
+Theorem lt_le_trans : (n,m,p:nat)(lt n m)->(le m p)->(lt n p).
+Proof.
+NewInduction 2; Auto with arith.
+Qed.
+
+Theorem le_lt_trans : (n,m,p:nat)(le n m)->(lt m p)->(lt n p).
+Proof.
+NewInduction 2; Auto with arith.
+Qed.
+
+Hints Resolve lt_trans lt_le_trans le_lt_trans : arith v62.
+
+(** Large = strict or equal *)
+
+Theorem le_lt_or_eq : (n,m:nat)(le n m)->((lt n m) \/ n=m).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+
+Theorem lt_le_weak : (n,m:nat)(lt n m)->(le n m).
+Proof.
+Auto with arith.
+Qed.
+Hints Immediate lt_le_weak : arith v62.
+
+(** Dichotomy *)
+
+Theorem le_or_lt : (n,m:nat)((le n m)\/(lt m n)).
+Proof.
+Intros n m; Pattern n m; Apply nat_double_ind; Auto with arith.
+NewInduction 1; Auto with arith.
+Qed.
+
+Theorem nat_total_order: (m,n: nat) ~ m = n -> (lt m n) \/ (lt n m).
+Proof.
+Intros m n diff.
+Elim (le_or_lt n m); [Intro H'0 | Auto with arith].
+Elim (le_lt_or_eq n m); Auto with arith.
+Intro H'; Elim diff; Auto with arith.
+Qed.
+
+(** Comparison to 0 *)
+
+Theorem neq_O_lt : (n:nat)(~O=n)->(lt O n).
+Proof.
+NewInduction n; Auto with arith.
+Intros; Absurd O=O; Trivial with arith.
+Qed.
+Hints Immediate neq_O_lt : arith v62.
+
+Theorem lt_O_neq : (n:nat)(lt O n)->(~O=n).
+Proof.
+NewInduction 1; Auto with arith.
+Qed.
+Hints Immediate lt_O_neq : arith v62.
diff --git a/theories7/Arith/Max.v b/theories7/Arith/Max.v
new file mode 100755
index 00000000..aea389d1
--- /dev/null
+++ b/theories7/Arith/Max.v
@@ -0,0 +1,87 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Max.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Arith.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n:nat.
+
+(** maximum of two natural numbers *)
+
+Fixpoint max [n:nat] : nat -> nat :=  
+[m:nat]Cases n m of
+          O      _     => m
+       | (S n')  O     => n
+       | (S n') (S m') => (S (max n' m'))
+       end.
+
+(** Simplifications of [max] *)
+
+Lemma max_SS : (n,m:nat)((S (max n m))=(max (S n) (S m))).
+Proof.
+Auto with arith.
+Qed.
+
+Lemma max_sym : (n,m:nat)(max n m)=(max m n).
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+(** [max] and [le] *)
+
+Lemma max_l : (n,m:nat)(le m n)->(max n m)=n.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+Lemma max_r : (n,m:nat)(le n m)->(max n m)=m.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+Lemma le_max_l : (n,m:nat)(le n (max n m)).
+Proof.
+NewInduction n; Intros; Simpl; Auto with arith.
+Elim m; Intros; Simpl; Auto with arith.
+Qed.
+
+Lemma le_max_r : (n,m:nat)(le m (max n m)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Simpl; Auto with arith.
+Qed.
+Hints Resolve max_r max_l le_max_l le_max_r: arith v62.
+
+
+(** [max n m] is equal to [n] or [m] *)
+
+Lemma max_dec : (n,m:nat){(max n m)=n}+{(max n m)=m}.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Elim (IHn m);Intro H;Elim H;Auto.
+Qed.
+
+Lemma max_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (max n m)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Intros; Simpl; Auto with arith.
+Pattern (max n m); Apply IHn ; Auto with arith.
+Qed.
+
+Lemma max_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (max n m)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Intros; Simpl; Auto with arith.
+Pattern (max n m); Apply IHn ; Auto with arith.
+Qed.
+
+
diff --git a/theories7/Arith/Min.v b/theories7/Arith/Min.v
new file mode 100755
index 00000000..fd5da61a
--- /dev/null
+++ b/theories7/Arith/Min.v
@@ -0,0 +1,84 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Min.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+Require Arith.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n:nat.
+
+(** minimum of two natural numbers *)
+
+Fixpoint min [n:nat] : nat -> nat :=  
+[m:nat]Cases n m of
+          O      _     => O
+       | (S n')  O     => O
+       | (S n') (S m') => (S (min n' m'))
+       end.
+
+(** Simplifications of [min] *)
+
+Lemma min_SS : (n,m:nat)((S (min n m))=(min (S n) (S m))).
+Proof.
+Auto with arith.
+Qed.
+
+Lemma min_sym : (n,m:nat)(min n m)=(min m n).
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+(** [min] and [le] *)
+
+Lemma min_l : (n,m:nat)(le n m)->(min n m)=n.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+Lemma min_r : (n,m:nat)(le m n)->(min n m)=m.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Qed.
+
+Lemma le_min_l : (n,m:nat)(le (min n m) n).
+Proof.
+NewInduction n; Intros; Simpl; Auto with arith.
+Elim m; Intros; Simpl; Auto with arith.
+Qed.
+
+Lemma le_min_r : (n,m:nat)(le (min n m) m).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Simpl; Auto with arith.
+Qed.
+Hints Resolve min_l min_r le_min_l le_min_r : arith v62.
+
+(** [min n m] is equal to [n] or [m] *)
+
+Lemma min_dec : (n,m:nat){(min n m)=n}+{(min n m)=m}.
+Proof.
+NewInduction n;NewInduction m;Simpl;Auto with arith.
+Elim (IHn m);Intro H;Elim H;Auto.
+Qed.
+
+Lemma min_case : (n,m:nat)(P:nat->Set)(P n)->(P m)->(P (min n m)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Intros; Simpl; Auto with arith.
+Pattern (min n m); Apply IHn ; Auto with arith.
+Qed.
+
+Lemma min_case2 : (n,m:nat)(P:nat->Prop)(P n)->(P m)->(P (min n m)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+NewInduction m; Intros; Simpl; Auto with arith.
+Pattern (min n m); Apply IHn ; Auto with arith.
+Qed.
diff --git a/theories7/Arith/Minus.v b/theories7/Arith/Minus.v
new file mode 100755
index 00000000..709d5f0b
--- /dev/null
+++ b/theories7/Arith/Minus.v
@@ -0,0 +1,120 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Minus.v,v 1.1.2.1 2004/07/16 19:31:24 herbelin Exp $ i*)
+
+(** Subtraction (difference between two natural numbers) *)
+
+Require Lt.
+Require Le.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+(** 0 is right neutral *)
+
+Lemma minus_n_O : (n:nat)(n=(minus n O)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+Qed.
+Hints Resolve minus_n_O : arith v62.
+
+(** Permutation with successor *)
+
+Lemma minus_Sn_m : (n,m:nat)(le m n)->((S (minus n m))=(minus (S n) m)).
+Proof.
+Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
+Qed.
+Hints Resolve minus_Sn_m : arith v62.
+
+Theorem pred_of_minus : (x:nat)(pred x)=(minus x (S O)).
+Intro x; NewInduction x; Simpl; Auto with arith.
+Qed.
+
+(** Diagonal *)
+
+Lemma minus_n_n : (n:nat)(O=(minus n n)).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+Qed.
+Hints Resolve minus_n_n : arith v62.
+
+(** Simplification *)
+
+Lemma minus_plus_simpl : 
+	(n,m,p:nat)((minus n m)=(minus (plus p n) (plus p m))).
+Proof.
+  NewInduction p; Simpl; Auto with arith.
+Qed.
+Hints Resolve minus_plus_simpl : arith v62.
+
+(** Relation with plus *)
+
+Lemma plus_minus : (n,m,p:nat)(n=(plus m p))->(p=(minus n m)).
+Proof.
+Intros n m p; Pattern m n; Apply nat_double_ind; Simpl; Intros.
+Replace (minus n0 O) with n0; Auto with arith.
+Absurd O=(S (plus n0 p)); Auto with arith.
+Auto with arith.
+Qed.
+Hints Immediate plus_minus : arith v62.
+
+Lemma minus_plus : (n,m:nat)(minus (plus n m) n)=m.
+Symmetry; Auto with arith.
+Qed.
+Hints Resolve minus_plus : arith v62.
+
+Lemma le_plus_minus : (n,m:nat)(le n m)->(m=(plus n (minus m n))).
+Proof.
+Intros n m Le; Pattern n m; Apply le_elim_rel; Simpl; Auto with arith.
+Qed.
+Hints Resolve le_plus_minus : arith v62.
+
+Lemma le_plus_minus_r : (n,m:nat)(le n m)->(plus n (minus m n))=m.
+Proof.
+Symmetry; Auto with arith.
+Qed.
+Hints Resolve le_plus_minus_r : arith v62.
+
+(** Relation with order *)
+
+Theorem le_minus: (i,h:nat) (le (minus i h) i).
+Proof.
+Intros i h;Pattern i h; Apply nat_double_ind; [
+  Auto
+| Auto
+| Intros m n H; Simpl; Apply le_trans with m:=m; Auto ].
+Qed.
+
+Lemma lt_minus : (n,m:nat)(le m n)->(lt O m)->(lt (minus n m) n).
+Proof.
+Intros n m Le; Pattern m n; Apply le_elim_rel; Simpl; Auto with arith.
+Intros; Absurd (lt O O); Auto with arith.
+Intros p q lepq Hp gtp.
+Elim (le_lt_or_eq O p); Auto with arith.
+Auto with arith.
+NewInduction 1; Elim minus_n_O; Auto with arith.
+Qed.
+Hints Resolve lt_minus : arith v62.
+
+Lemma lt_O_minus_lt : (n,m:nat)(lt O (minus n m))->(lt m n).
+Proof.
+Intros n m; Pattern n m; Apply nat_double_ind; Simpl; Auto with arith.
+Intros; Absurd (lt O O); Trivial with arith.
+Qed.
+Hints Immediate lt_O_minus_lt : arith v62.
+
+Theorem inj_minus_aux: (x,y:nat) ~(le y x) -> (minus x y) = O.
+Intros y x; Pattern y x ; Apply nat_double_ind; [
+  Simpl; Trivial with arith
+| Intros n H; Absurd (le O (S n)); [ Assumption | Apply le_O_n]
+| Simpl; Intros n m H1 H2; Apply H1;
+  Unfold not ; Intros H3; Apply H2; Apply le_n_S; Assumption].
+Qed.
diff --git a/theories7/Arith/Mult.v b/theories7/Arith/Mult.v
new file mode 100755
index 00000000..9bd4aaf9
--- /dev/null
+++ b/theories7/Arith/Mult.v
@@ -0,0 +1,224 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Mult.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+Require Export Plus.
+Require Export Minus.
+Require Export Lt.
+Require Export Le.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+(** Zero property *)
+
+Lemma mult_0_r : (n:nat) (mult n O)=O.
+Proof.
+Intro; Symmetry; Apply mult_n_O.
+Qed.
+
+Lemma mult_0_l : (n:nat) (mult O n)=O.
+Proof.
+Reflexivity.
+Qed.
+
+(** Distributivity *)
+
+Lemma mult_plus_distr : 
+      (n,m,p:nat)((mult (plus n m) p)=(plus (mult n p) (mult m p))).
+Proof.
+Intros; Elim n; Simpl; Intros; Auto with arith.
+Elim plus_assoc_l; Elim H; Auto with arith.
+Qed.
+Hints Resolve mult_plus_distr : arith v62.
+
+Lemma mult_plus_distr_r : (n,m,p:nat) (mult n (plus m p))=(plus (mult n m) (mult n p)).
+Proof.
+  NewInduction n. Trivial.
+  Intros. Simpl. Rewrite (IHn m p). Apply sym_eq. Apply plus_permute_2_in_4.
+Qed.
+
+Lemma mult_minus_distr : (n,m,p:nat)((mult (minus n m) p)=(minus (mult n p) (mult m p))).
+Proof.
+Intros; Pattern n m; Apply nat_double_ind; Simpl; Intros; Auto with arith.
+Elim minus_plus_simpl; Auto with arith.
+Qed.
+Hints Resolve mult_minus_distr : arith v62.
+
+(** Associativity *)
+
+Lemma mult_assoc_r : (n,m,p:nat)((mult (mult n m) p) = (mult n (mult m p))).
+Proof.
+Intros; Elim n; Intros; Simpl; Auto with arith.
+Rewrite mult_plus_distr.
+Elim H; Auto with arith.
+Qed.
+Hints Resolve mult_assoc_r : arith v62.
+
+Lemma mult_assoc_l : (n,m,p:nat)(mult n (mult m p)) = (mult (mult n m) p).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve mult_assoc_l : arith v62.
+
+(** Commutativity *)
+
+Lemma mult_sym : (n,m:nat)(mult n m)=(mult m n).
+Proof.
+Intros; Elim n; Intros; Simpl; Auto with arith.
+Elim mult_n_Sm.
+Elim H; Apply plus_sym.
+Qed.
+Hints Resolve mult_sym : arith v62.
+
+(** 1 is neutral *)
+
+Lemma mult_1_n : (n:nat)(mult (S O) n)=n.
+Proof.
+Simpl; Auto with arith.
+Qed.
+Hints Resolve mult_1_n : arith v62.
+
+Lemma mult_n_1 : (n:nat)(mult n (S O))=n.
+Proof.
+Intro; Elim mult_sym; Auto with arith.
+Qed.
+Hints Resolve mult_n_1 : arith v62.
+
+(** Compatibility with orders *)
+
+Lemma mult_O_le : (n,m:nat)(m=O)\/(le n (mult m n)).
+Proof.
+NewInduction m; Simpl; Auto with arith.
+Qed.
+Hints Resolve mult_O_le : arith v62.
+
+Lemma mult_le_compat_l : (n,m,p:nat) (le n m) -> (le (mult p n) (mult p m)).
+Proof.
+  NewInduction p as [|p IHp]. Intros. Simpl. Apply le_n.
+  Intros. Simpl. Apply le_plus_plus. Assumption.
+  Apply IHp. Assumption.
+Qed.
+Hints Resolve mult_le_compat_l : arith.
+V7only [
+Notation mult_le := [m,n,p:nat](mult_le_compat_l p n m).
+].
+
+
+Lemma le_mult_right : (m,n,p:nat)(le m n)->(le (mult m p) (mult n p)).
+Intros m n p H.
+Rewrite mult_sym. Rewrite (mult_sym n).
+Auto with arith.
+Qed.
+
+Lemma le_mult_mult :
+  (m,n,p,q:nat)(le m n)->(le p q)->(le (mult m p) (mult n q)).
+Proof.
+Intros m n p q Hmn Hpq; NewInduction Hmn.
+NewInduction Hpq.
+(* m*p<=m*p *)
+Apply le_n.
+(* m*p<=m*m0 -> m*p<=m*(S m0) *)
+Rewrite <- mult_n_Sm; Apply le_trans with (mult m m0).
+Assumption.
+Apply le_plus_l.
+(* m*p<=m0*q -> m*p<=(S m0)*q *)
+Simpl; Apply le_trans with (mult m0 q).
+Assumption.
+Apply le_plus_r.
+Qed.
+
+Lemma mult_lt : (m,n,p:nat) (lt n p) -> (lt (mult (S m) n) (mult (S m) p)).
+Proof.
+  Intro m; NewInduction m. Intros. Simpl. Rewrite <- plus_n_O. Rewrite <- plus_n_O. Assumption.
+  Intros. Exact (lt_plus_plus ? ? ? ? H (IHm ? ? H)).
+Qed.
+
+Hints Resolve mult_lt : arith.
+V7only [
+Notation lt_mult_left := mult_lt.
+(* Theorem lt_mult_left :
+   (x,y,z:nat) (lt x y) -> (lt (mult (S z) x) (mult (S z) y)).
+*)
+].
+
+Lemma lt_mult_right :
+  (m,n,p:nat) (lt m n) -> (lt (0) p) -> (lt (mult m p) (mult n p)).
+Intros m n p H H0.
+NewInduction p.
+Elim (lt_n_n ? H0).
+Rewrite mult_sym.
+Replace (mult n (S p)) with (mult (S p) n); Auto with arith.
+Qed.
+
+Lemma mult_le_conv_1 : (m,n,p:nat) (le (mult (S m) n) (mult (S m) p)) -> (le n p).
+Proof.
+  Intros m n p H. Elim (le_or_lt n p). Trivial.
+  Intro H0. Cut (lt (mult (S m) n) (mult (S m) n)). Intro. Elim (lt_n_n ? H1).
+  Apply le_lt_trans with m:=(mult (S m) p). Assumption.
+  Apply mult_lt. Assumption.
+Qed.
+
+(** n|->2*n and n|->2n+1 have disjoint image *)
+
+V7only [ (* From Zdivides *) ].
+Theorem odd_even_lem:
+  (p, q : ?)  ~ (plus (mult (2) p) (1)) = (mult (2) q).
+Intros p; Elim p; Auto.
+Intros q; Case q; Simpl.
+Red; Intros; Discriminate.
+Intros q'; Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Red; Intros;
+ Discriminate.
+Intros p' H q; Case q.
+Simpl; Red; Intros; Discriminate.
+Intros q'; Red; Intros H0; Case (H q').
+Replace (mult (S (S O)) q') with (minus (mult (S (S O)) (S q')) (2)).
+Rewrite <- H0; Simpl; Auto.
+Repeat Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Auto.
+Simpl; Repeat Rewrite [x, y : ?]  (plus_sym x (S y)); Simpl; Auto.
+Case q'; Simpl; Auto.
+Qed.
+
+
+(** Tail-recursive mult *)
+
+(** [tail_mult] is an alternative definition for [mult] which is 
+    tail-recursive, whereas [mult] is not. This can be useful 
+    when extracting programs. *)
+
+Fixpoint mult_acc [s,m,n:nat] : nat := 
+   Cases n of 
+      O => s
+      | (S p) => (mult_acc (tail_plus m s) m p)
+    end.
+
+Lemma mult_acc_aux : (n,s,m:nat)(plus s (mult n m))= (mult_acc s m n).
+Proof.
+NewInduction n as [|p IHp]; Simpl;Auto.
+Intros s m; Rewrite <- plus_tail_plus; Rewrite <- IHp.
+Rewrite <- plus_assoc_r; Apply (f_equal2 nat nat);Auto.
+Rewrite plus_sym;Auto.
+Qed.
+
+Definition tail_mult := [n,m:nat](mult_acc O m n).
+
+Lemma mult_tail_mult : (n,m:nat)(mult n m)=(tail_mult n m).
+Proof.
+Intros; Unfold tail_mult; Rewrite <- mult_acc_aux;Auto.
+Qed.
+
+(** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] 
+    and [mult] and simplify *)
+
+Tactic Definition TailSimpl := 
+   Repeat Rewrite <- plus_tail_plus; 
+   Repeat Rewrite <- mult_tail_mult; 
+   Simpl. 
diff --git a/theories7/Arith/Peano_dec.v b/theories7/Arith/Peano_dec.v
new file mode 100755
index 00000000..6646545a
--- /dev/null
+++ b/theories7/Arith/Peano_dec.v
@@ -0,0 +1,36 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Peano_dec.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+Require Decidable.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,x,y:nat.
+
+Theorem O_or_S : (n:nat)({m:nat|(S m)=n})+{O=n}.
+Proof.
+NewInduction n.
+Auto.
+Left; Exists n; Auto.
+Defined.
+
+Theorem eq_nat_dec : (n,m:nat){n=m}+{~(n=m)}.
+Proof.
+NewInduction n; NewInduction m; Auto.
+Elim (IHn m); Auto.
+Defined.
+
+Hints Resolve O_or_S eq_nat_dec : arith.
+
+Theorem dec_eq_nat:(x,y:nat)(decidable (x=y)).
+Intros x y; Unfold decidable; Elim (eq_nat_dec x y); Auto with arith.
+Defined.
+
diff --git a/theories7/Arith/Plus.v b/theories7/Arith/Plus.v
new file mode 100755
index 00000000..23488b4c
--- /dev/null
+++ b/theories7/Arith/Plus.v
@@ -0,0 +1,223 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Plus.v,v 1.5.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+(** Properties of addition *)
+
+Require Le.
+Require Lt.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p,q:nat.
+
+(** Zero is neutral *)
+
+Lemma plus_0_l : (n:nat) (O+n)=n.
+Proof.
+Reflexivity.
+Qed.
+
+Lemma plus_0_r : (n:nat) (n+O)=n.
+Proof.
+Intro; Symmetry; Apply plus_n_O.
+Qed.
+
+(** Commutativity *)
+
+Lemma plus_sym : (n,m:nat)(n+m)=(m+n).
+Proof.
+Intros n m ; Elim n ; Simpl ; Auto with arith.
+Intros y H ; Elim (plus_n_Sm m y) ; Auto with arith.
+Qed.
+Hints Immediate plus_sym : arith v62.
+
+(** Associativity *)
+
+Lemma plus_Snm_nSm : (n,m:nat)((S n)+m)=(n+(S m)).
+Intros.
+Simpl.
+Rewrite -> (plus_sym n m).
+Rewrite -> (plus_sym n (S m)).
+Trivial with arith.
+Qed.
+
+Lemma plus_assoc_l : (n,m,p:nat)((n+(m+p))=((n+m)+p)).
+Proof.
+Intros n m p; Elim n; Simpl; Auto with arith.
+Qed.
+Hints Resolve plus_assoc_l : arith v62.
+
+Lemma plus_permute : (n,m,p:nat) ((n+(m+p))=(m+(n+p))).
+Proof. 
+Intros; Rewrite (plus_assoc_l m n p); Rewrite (plus_sym m n); Auto with arith.
+Qed.
+
+Lemma plus_assoc_r : (n,m,p:nat)(((n+m)+p)=(n+(m+p))).
+Proof.
+Auto with arith.
+Qed.
+Hints Resolve plus_assoc_r : arith v62.
+
+(** Simplification *)
+
+Lemma plus_reg_l : (m,p,n:nat)((n+m)=(n+p))->(m=p).
+Proof.
+Intros m p n; NewInduction n ; Simpl ; Auto with arith.
+Qed.
+V7only [
+(* Compatibility order of arguments *)
+Notation "'simpl_plus_l' c" := [a,b:nat](plus_reg_l a b c)
+  (at level 10, c at next level).
+Notation "'simpl_plus_l' c a" := [b:nat](plus_reg_l a b c)
+  (at level 10, a, c at next level).
+Notation "'simpl_plus_l' c a b" := (plus_reg_l a b c)
+  (at level 10, a, b, c at next level).
+Notation simpl_plus_l := plus_reg_l.
+].
+
+Lemma plus_le_reg_l : (n,m,p:nat)((p+n)<=(p+m))->(n<=m).
+Proof.
+NewInduction p; Simpl; Auto with arith.
+Qed.
+V7only [
+(* Compatibility order of arguments *)
+Notation "'simpl_le_plus_l' c" := [a,b:nat](plus_le_reg_l a b c)
+  (at level 10, c at next level).
+Notation "'simpl_le_plus_l' c a" := [b:nat](plus_le_reg_l a b c)
+  (at level 10, a, c at next level).
+Notation "'simpl_le_plus_l' c a b" := (plus_le_reg_l a b c)
+  (at level 10, a, b, c at next level).
+Notation simpl_le_plus_l := [p,n,m:nat](plus_le_reg_l n m p).
+].
+
+Lemma simpl_lt_plus_l : (n,m,p:nat) (p+n)<(p+m) -> n<m.
+Proof.
+NewInduction p; Simpl; Auto with arith.
+Qed.
+
+(** Compatibility with order *)
+
+Lemma le_reg_l : (n,m,p:nat) n<=m -> (p+n)<=(p+m).
+Proof.
+NewInduction p; Simpl; Auto with arith.
+Qed.
+Hints Resolve le_reg_l : arith v62.
+
+Lemma le_reg_r : (a,b,c:nat) a<=b -> (a+c)<=(b+c).
+Proof.
+NewInduction 1 ; Simpl; Auto with arith.
+Qed.
+Hints Resolve le_reg_r : arith v62.
+
+Lemma le_plus_l : (n,m:nat) n<=(n+m).
+Proof.
+NewInduction n; Simpl; Auto with arith.
+Qed.
+Hints Resolve le_plus_l : arith v62.
+
+Lemma le_plus_r : (n,m:nat) m<=(n+m).
+Proof.
+Intros n m; Elim n; Simpl; Auto with arith.
+Qed.
+Hints Resolve le_plus_r : arith v62.
+
+Theorem le_plus_trans : (n,m,p:nat) n<=m -> n<=(m+p).
+Proof.
+Intros; Apply le_trans with m:=m; Auto with arith.
+Qed.
+Hints Resolve le_plus_trans : arith v62.
+
+Theorem lt_plus_trans : (n,m,p:nat) n<m -> n<(m+p).
+Proof.
+Intros; Apply lt_le_trans with m:=m; Auto with arith.
+Qed.
+Hints Immediate lt_plus_trans : arith v62.
+
+Lemma lt_reg_l : (n,m,p:nat) n<m -> (p+n)<(p+m).
+Proof.
+NewInduction p; Simpl; Auto with arith.
+Qed.
+Hints Resolve lt_reg_l : arith v62.
+
+Lemma lt_reg_r : (n,m,p:nat) n<m -> (n+p)<(m+p).
+Proof.
+Intros n m p H ; Rewrite (plus_sym n p) ; Rewrite (plus_sym m p).
+Elim p; Auto with arith.
+Qed.
+Hints Resolve lt_reg_r : arith v62.
+
+Lemma le_plus_plus : (n,m,p,q:nat)  n<=m -> p<=q -> (n+p)<=(m+q).
+Proof.
+Intros n m p q H H0.
+Elim H; Simpl; Auto with arith.
+Qed.
+
+Lemma le_lt_plus_plus : (n,m,p,q:nat)  n<=m -> p<q -> (n+p)<(m+q).
+Proof.
+  Unfold lt. Intros. Change ((S n)+p)<=(m+q). Rewrite plus_Snm_nSm.
+  Apply le_plus_plus; Assumption.
+Qed.
+
+Lemma lt_le_plus_plus : (n,m,p,q:nat) n<m -> p<=q -> (n+p)<(m+q).
+Proof.
+  Unfold lt. Intros. Change ((S n)+p)<=(m+q). Apply le_plus_plus; Assumption.
+Qed.
+
+Lemma lt_plus_plus : (n,m,p,q:nat) n<m -> p<q -> (n+p)<(m+q).
+Proof.
+  Intros. Apply lt_le_plus_plus. Assumption.
+  Apply lt_le_weak. Assumption.
+Qed.
+
+(** Inversion lemmas *)
+
+Lemma plus_is_O : (m,n:nat) (m+n)=O -> m=O /\ n=O.
+Proof.
+  Intro m; NewDestruct m; Auto.
+  Intros. Discriminate H.
+Qed.
+
+Definition plus_is_one : 
+      (m,n:nat) (m+n)=(S O) -> {m=O /\ n=(S O)}+{m=(S O) /\ n=O}.
+Proof.
+  Intro m; NewDestruct m; Auto.
+  NewDestruct n; Auto.
+  Intros. 
+  Simpl in H. Discriminate H.
+Defined.
+
+(** Derived properties *)
+
+Lemma plus_permute_2_in_4 : (m,n,p,q:nat) ((m+n)+(p+q))=((m+p)+(n+q)).
+Proof.
+  Intros m n p q. 
+  Rewrite <- (plus_assoc_l m n (p+q)). Rewrite (plus_assoc_l n p q).
+  Rewrite (plus_sym n p). Rewrite <- (plus_assoc_l p n q). Apply plus_assoc_l.
+Qed.
+
+(** Tail-recursive plus *)
+
+(** [tail_plus] is an alternative definition for [plus] which is 
+    tail-recursive, whereas [plus] is not. This can be useful
+    when extracting programs. *)
+
+Fixpoint plus_acc [q,n:nat] : nat := 
+   Cases n of 
+      O => q
+      | (S p) => (plus_acc (S q) p)
+    end.
+
+Definition tail_plus := [n,m:nat](plus_acc m n).
+
+Lemma plus_tail_plus : (n,m:nat)(n+m)=(tail_plus n m).
+Unfold tail_plus; NewInduction n as [|n IHn]; Simpl; Auto.
+Intro m; Rewrite <- IHn; Simpl; Auto.
+Qed.
diff --git a/theories7/Arith/Wf_nat.v b/theories7/Arith/Wf_nat.v
new file mode 100755
index 00000000..be1003ce
--- /dev/null
+++ b/theories7/Arith/Wf_nat.v
@@ -0,0 +1,200 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Wf_nat.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+(** Well-founded relations and natural numbers *)
+
+Require Lt.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Implicit Variables Type m,n,p:nat.
+
+Chapter  Well_founded_Nat.
+
+Variable A : Set.
+
+Variable f : A -> nat.
+Definition ltof := [a,b:A](lt (f a) (f b)).
+Definition gtof := [a,b:A](gt (f b) (f a)).
+
+Theorem well_founded_ltof : (well_founded A ltof).
+Proof.
+Red.
+Cut (n:nat)(a:A)(lt (f a) n)->(Acc A ltof a).
+Intros H a;  Apply (H (S (f a))); Auto with arith.
+NewInduction n.
+Intros; Absurd (lt (f a) O); Auto with arith.
+Intros a ltSma.
+Apply Acc_intro.
+Unfold ltof; Intros b ltfafb.
+Apply IHn.
+Apply lt_le_trans with (f a); Auto with arith.
+Qed.
+
+Theorem  well_founded_gtof : (well_founded A gtof).
+Proof well_founded_ltof.
+
+(** It is possible to directly prove the induction principle going
+   back to primitive recursion on natural numbers ([induction_ltof1])
+   or to use the previous lemmas to extract a program with a fixpoint
+   ([induction_ltof2]) 
+
+the ML-like program for [induction_ltof1] is : [[
+   let induction_ltof1 F a = indrec ((f a)+1) a 
+   where rec indrec = 
+        function 0    -> (function a -> error)
+               |(S m) -> (function a -> (F a (function y -> indrec y m)));;
+]]
+
+the ML-like program for [induction_ltof2] is : [[
+   let induction_ltof2 F a = indrec a
+   where rec indrec a = F a indrec;;
+]] *)
+
+Theorem induction_ltof1 
+  : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
+Proof.
+Intros P F; Cut (n:nat)(a:A)(lt (f a) n)->(P a).
+Intros H a;  Apply (H (S (f a))); Auto with arith.
+NewInduction n.
+Intros; Absurd (lt (f a) O); Auto with arith.
+Intros a ltSma.
+Apply F.
+Unfold ltof; Intros b ltfafb.
+Apply IHn.
+Apply lt_le_trans with (f a); Auto with arith.
+Defined. 
+
+Theorem induction_gtof1 
+  : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
+Proof.
+Exact induction_ltof1.
+Defined.
+
+Theorem induction_ltof2 
+  : (P:A->Set)((x:A)((y:A)(ltof y x)->(P y))->(P x))->(a:A)(P a).
+Proof.
+Exact (well_founded_induction A ltof well_founded_ltof).
+Defined.
+
+Theorem induction_gtof2 
+  : (P:A->Set)((x:A)((y:A)(gtof y x)->(P y))->(P x))->(a:A)(P a).
+Proof.
+Exact induction_ltof2.
+Defined.
+
+(** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)]
+    then [R] is well-founded. *)
+
+Variable R : A->A->Prop.
+
+Hypothesis H_compat : (x,y:A) (R x y) -> (lt (f x) (f y)).
+
+Theorem well_founded_lt_compat : (well_founded A R).
+Proof.
+Red.
+Cut (n:nat)(a:A)(lt (f a) n)->(Acc A R a).
+Intros H a; Apply (H (S (f a))); Auto with arith.
+NewInduction n.
+Intros; Absurd (lt (f a) O); Auto with arith.
+Intros a ltSma.
+Apply Acc_intro.
+Intros b ltfafb.
+Apply IHn.
+Apply lt_le_trans with (f a); Auto with arith.
+Qed.
+
+End Well_founded_Nat.
+
+Lemma lt_wf : (well_founded nat lt).
+Proof (well_founded_ltof nat [m:nat]m).
+
+Lemma lt_wf_rec1 : (p:nat)(P:nat->Set)
+              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
+Proof.
+Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
+     (induction_ltof1 nat [m:nat]m P F p).
+Defined.
+
+Lemma lt_wf_rec : (p:nat)(P:nat->Set)
+              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
+Proof.
+Exact [p:nat][P:nat->Set][F:(n:nat)((m:nat)(lt m n)->(P m))->(P n)]
+     (induction_ltof2 nat [m:nat]m P F p).
+Defined.
+
+Lemma lt_wf_ind : (p:nat)(P:nat->Prop)
+              ((n:nat)((m:nat)(lt m n)->(P m))->(P n)) -> (P p).
+Intro p; Intros; Elim (lt_wf p); Auto with arith.
+Qed.
+
+Lemma gt_wf_rec : (p:nat)(P:nat->Set)
+              ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
+Proof.
+Exact lt_wf_rec.
+Defined.
+
+Lemma gt_wf_ind : (p:nat)(P:nat->Prop)
+              ((n:nat)((m:nat)(gt n m)->(P m))->(P n)) -> (P p).
+Proof lt_wf_ind.
+
+Lemma lt_wf_double_rec : 
+  (P:nat->nat->Set)
+  ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
+   -> (p,q:nat)(P p q).
+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 : 
+  (P:nat->nat->Prop)
+  ((n,m:nat)((p,q:nat)(lt p n)->(P p q))->((p:nat)(lt p m)->(P n p))->(P n m))
+   -> (p,q:nat)(P p q).
+Intros P Hrec p; Pattern p; Apply lt_wf_ind.
+Intros n H q; Pattern q; Apply lt_wf_ind; Auto with arith.
+Qed.
+
+Hints Resolve lt_wf : arith.
+Hints Resolve well_founded_lt_compat : arith.
+
+Section LT_WF_REL.
+Variable A :Set.
+Variable R:A->A->Prop.
+
+(* Relational form of inversion *)
+Variable F : A -> nat -> Prop.
+Definition inv_lt_rel 
+ [x,y]:=(EX n | (F x n) & (m:nat)(F y m)->(lt n m)).
+
+Hypothesis F_compat : (x,y:A) (R x y) -> (inv_lt_rel x y).
+Remark acc_lt_rel : 
+  (x:A)(EX n | (F x n))->(Acc A R x).
+Intros x (n,fxn); Generalize x fxn; Clear x fxn.
+Pattern n; Apply lt_wf_ind; Intros.
+Constructor; Intros.
+Case (F_compat y x); Trivial; Intros.
+Apply (H x0); Auto.
+Save.
+
+Theorem well_founded_inv_lt_rel_compat : (well_founded A R).
+Constructor; Intros.
+Case (F_compat y a); Trivial; Intros.
+Apply acc_lt_rel; Trivial.
+Exists x; Trivial.
+Save.
+
+
+End LT_WF_REL.
+
+Lemma well_founded_inv_rel_inv_lt_rel 
+  : (A:Set)(F:A->nat->Prop)(well_founded A (inv_lt_rel A F)).
+Intros; Apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); Trivial.
+Save.
diff --git a/theories7/Bool/Bool.v b/theories7/Bool/Bool.v
new file mode 100755
index 00000000..cd75cf30
--- /dev/null
+++ b/theories7/Bool/Bool.v
@@ -0,0 +1,544 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Bool.v,v 1.2.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+(** Booleans  *)
+
+(** The type [bool] is defined in the prelude as
+    [Inductive bool : Set := true : bool | false : bool] *)
+
+(** Interpretation of booleans as Proposition *)
+Definition Is_true := [b:bool](Cases b of
+                                 true  => True
+                               | false => False
+                               end).
+Hints Unfold Is_true : bool.
+
+Lemma Is_true_eq_left : (x:bool)x=true -> (Is_true x).
+Proof.
+  Intros; Rewrite H; Auto with bool.
+Qed.
+
+Lemma Is_true_eq_right : (x:bool)true=x -> (Is_true x).
+Proof.
+  Intros; Rewrite <- H; Auto with bool.
+Qed.
+
+Hints Immediate Is_true_eq_right Is_true_eq_left : bool.
+
+(*******************)
+(** Discrimination *)
+(*******************)
+
+Lemma diff_true_false : ~true=false.
+Proof.
+Unfold not; Intro contr; Change (Is_true false).
+Elim contr; Simpl; Trivial with bool.
+Qed.
+Hints Resolve diff_true_false : bool v62.
+
+Lemma diff_false_true : ~false=true.
+Proof.
+Red; Intros H; Apply diff_true_false.
+Symmetry.
+Assumption.
+Qed.
+Hints Resolve diff_false_true : bool v62.
+
+Lemma eq_true_false_abs : (b:bool)(b=true)->(b=false)->False.
+Intros b H; Rewrite H; Auto with bool.
+Qed.
+Hints Resolve eq_true_false_abs : bool.
+
+Lemma not_true_is_false : (b:bool)~b=true->b=false.
+NewDestruct b.
+Intros.
+Red in H; Elim H.
+Reflexivity.
+Intros abs.
+Reflexivity.
+Qed.
+
+Lemma not_false_is_true : (b:bool)~b=false->b=true.
+NewDestruct b.
+Intros.
+Reflexivity.
+Intro H; Red in H; Elim H.
+Reflexivity.
+Qed.
+
+(**********************)
+(** Order on booleans *)
+(**********************)
+
+Definition leb := [b1,b2:bool]
+  Cases b1 of 
+  | true => b2=true
+  | false => True 
+  end.
+Hints Unfold leb : bool v62.
+
+(*************)
+(** Equality *)
+(*************)
+
+Definition eqb : bool->bool->bool :=
+ [b1,b2:bool]
+    Cases b1 b2 of
+      true  true  => true
+    | true  false => false
+    | false true  => false
+    | false false => true
+    end.
+
+Lemma eqb_refl : (x:bool)(Is_true (eqb x x)).
+NewDestruct x; Simpl; Auto with bool.
+Qed.
+
+Lemma eqb_eq : (x,y:bool)(Is_true (eqb x y))->x=y.
+NewDestruct x; NewDestruct y; Simpl; Tauto.
+Qed.
+
+Lemma Is_true_eq_true : (x:bool) (Is_true x) -> x=true.
+NewDestruct x; Simpl; Tauto.
+Qed.
+ 
+Lemma Is_true_eq_true2 : (x:bool)  x=true -> (Is_true x).
+NewDestruct x; Simpl; Auto with bool.
+Qed.
+
+Lemma eqb_subst : 
+  (P:bool->Prop)(b1,b2:bool)(eqb b1 b2)=true->(P b1)->(P b2).
+Unfold eqb .
+Intros P b1.
+Intros b2.
+Case b1.
+Case b2.
+Trivial with bool.
+Intros H.
+Inversion_clear H.
+Case b2.
+Intros H.
+Inversion_clear H.
+Trivial with bool.
+Qed.
+
+Lemma eqb_reflx : (b:bool)(eqb b b)=true.
+Intro b.
+Case b.
+Trivial with bool.
+Trivial with bool.
+Qed.
+
+Lemma eqb_prop : (a,b:bool)(eqb a b)=true -> a=b.
+NewDestruct a; NewDestruct b; Simpl; Intro;
+  Discriminate H Orelse Reflexivity.
+Qed.
+
+
+(************************)
+(** Logical combinators *)
+(************************)
+ 
+Definition ifb : bool -> bool -> bool -> bool
+     := [b1,b2,b3:bool](Cases b1 of true => b2 | false => b3 end).
+
+Definition andb : bool -> bool -> bool
+     := [b1,b2:bool](ifb b1 b2 false).
+
+Definition orb : bool -> bool -> bool
+     := [b1,b2:bool](ifb b1 true b2).
+
+Definition implb : bool -> bool -> bool
+     := [b1,b2:bool](ifb b1 b2 true).
+
+Definition xorb :  bool -> bool -> bool
+     := [b1,b2:bool]
+    Cases b1 b2 of
+      true  true  => false
+    | true  false => true
+    | false true  => true
+    | false false => false
+    end.
+
+Definition negb := [b:bool]Cases b of
+                             true  => false
+                           | false => true
+                           end.
+
+Infix "||" orb  (at level 4, left associativity) : bool_scope.
+Infix "&&" andb (at level 3, no associativity) : bool_scope
+  V8only (at level 40, left associativity).
+
+Open Scope bool_scope.
+
+Delimits Scope bool_scope with bool.
+
+Bind Scope bool_scope with bool.
+
+(**************************)
+(** Lemmas about [negb]   *)
+(**************************)
+
+Lemma negb_intro : (b:bool)b=(negb (negb b)).
+Proof.
+NewDestruct b; Reflexivity.
+Qed.
+
+Lemma negb_elim : (b:bool)(negb (negb b))=b.
+Proof.
+NewDestruct b; Reflexivity.
+Qed.
+       
+Lemma negb_orb : (b1,b2:bool)
+  (negb (orb b1 b2)) = (andb (negb b1) (negb b2)).
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+Qed.
+
+Lemma negb_andb : (b1,b2:bool)
+  (negb (andb b1 b2)) = (orb (negb b1) (negb b2)).
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+Qed.
+
+Lemma negb_sym : (b,b':bool)(b'=(negb b))->(b=(negb b')).
+Proof.
+NewDestruct b; NewDestruct b'; Intros; Simpl; Trivial with bool.
+Qed.
+
+Lemma no_fixpoint_negb : (b:bool)~(negb b)=b.
+Proof.
+NewDestruct b; Simpl; Intro; Apply diff_true_false; Auto with bool.
+Qed.
+
+Lemma eqb_negb1 : (b:bool)(eqb (negb b) b)=false.
+NewDestruct b.
+Trivial with bool.
+Trivial with bool.
+Qed.
+ 
+Lemma eqb_negb2 : (b:bool)(eqb b (negb b))=false.
+NewDestruct b.
+Trivial with bool.
+Trivial with bool.
+Qed.
+
+
+Lemma if_negb : (A:Set) (b:bool) (x,y:A) (if (negb b) then x else y)=(if b then y else x).
+Proof.
+  NewDestruct b;Trivial.
+Qed.
+
+
+(****************************)
+(** A few lemmas about [or] *)
+(****************************)
+
+Lemma orb_prop : 
+  (a,b:bool)(orb a b)=true -> (a = true)\/(b = true).
+NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
+Qed.
+
+Lemma orb_prop2 : 
+  (a,b:bool)(Is_true (orb a b)) -> (Is_true a)\/(Is_true b).
+NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H); Auto with bool.
+Qed.
+
+Lemma orb_true_intro 
+    : (b1,b2:bool)(b1=true)\/(b2=true)->(orb b1 b2)=true.
+NewDestruct b1; Auto with bool.
+NewDestruct 1; Intros.
+Elim diff_true_false; Auto with bool.
+Rewrite H; Trivial with bool.
+Qed.
+Hints Resolve orb_true_intro : bool v62.
+
+Lemma orb_b_true : (b:bool)(orb b true)=true.
+Auto with bool.
+Qed.
+Hints Resolve orb_b_true : bool v62.
+
+Lemma orb_true_b : (b:bool)(orb true b)=true.
+Trivial with bool.
+Qed.
+
+Definition orb_true_elim : (b1,b2:bool)(orb b1 b2)=true -> {b1=true}+{b2=true}.
+NewDestruct b1; Simpl; Auto with bool.
+Defined.
+
+Lemma orb_false_intro 
+    : (b1,b2:bool)(b1=false)->(b2=false)->(orb b1 b2)=false.
+Intros b1 b2 H1 H2; Rewrite H1; Rewrite H2; Trivial with bool.
+Qed.
+Hints Resolve orb_false_intro : bool v62.
+
+Lemma orb_b_false : (b:bool)(orb b false)=b.
+Proof.
+  NewDestruct b; Trivial with bool.
+Qed.
+Hints Resolve orb_b_false : bool v62.
+
+Lemma orb_false_b : (b:bool)(orb false b)=b.
+Proof.
+  NewDestruct b; Trivial with bool.
+Qed.
+Hints Resolve orb_false_b : bool v62.
+
+Lemma orb_false_elim : 
+    (b1,b2:bool)(orb b1 b2)=false -> (b1=false)/\(b2=false).
+Proof.
+  NewDestruct b1.
+  Intros; Elim diff_true_false; Auto with bool.
+  NewDestruct b2.
+  Intros; Elim diff_true_false; Auto with bool.
+  Auto with bool.
+Qed.
+
+Lemma orb_neg_b :
+  (b:bool)(orb b (negb b))=true.
+Proof.
+  NewDestruct b; Reflexivity.
+Qed.
+Hints Resolve orb_neg_b : bool v62.
+
+Lemma orb_sym : (b1,b2:bool)(orb b1 b2)=(orb b2 b1).
+NewDestruct b1; NewDestruct b2; Reflexivity.
+Qed.
+
+Lemma orb_assoc : (b1,b2,b3:bool)(orb b1 (orb b2 b3))=(orb (orb b1 b2) b3).
+Proof.
+  NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Hints Resolve orb_sym orb_assoc orb_b_false orb_false_b : bool v62.
+
+(*****************************)
+(** A few lemmas about [and] *)
+(*****************************)
+
+Lemma andb_prop : 
+  (a,b:bool)(andb a b) = true -> (a = true)/\(b = true).
+
+Proof.
+  NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
+  Auto with bool.
+Qed.
+Hints Resolve andb_prop : bool v62.
+
+Definition andb_true_eq : (a,b:bool) true = (andb a b) -> true = a /\ true = b.
+Proof.
+  NewDestruct a; NewDestruct b; Auto.
+Defined.
+
+Lemma andb_prop2 : 
+  (a,b:bool)(Is_true (andb a b)) -> (Is_true a)/\(Is_true b).
+Proof.
+  NewDestruct a; NewDestruct b; Simpl; Try (Intro H;Discriminate H);
+  Auto with bool.
+Qed.
+Hints Resolve andb_prop2 : bool v62.
+
+Lemma andb_true_intro : (b1,b2:bool)(b1=true)/\(b2=true)->(andb b1 b2)=true.
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+Qed.
+Hints Resolve andb_true_intro : bool v62.
+
+Lemma andb_true_intro2 : 
+  (b1,b2:bool)(Is_true b1)->(Is_true b2)->(Is_true (andb b1 b2)).
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Tauto.
+Qed.
+Hints Resolve andb_true_intro2 : bool v62.
+
+Lemma andb_false_intro1 
+    : (b1,b2:bool)(b1=false)->(andb b1 b2)=false.
+NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+Qed.
+
+Lemma andb_false_intro2 
+    : (b1,b2:bool)(b2=false)->(andb b1 b2)=false.
+NewDestruct b1; NewDestruct b2; Simpl; Tauto Orelse Auto with bool.
+Qed.
+
+Lemma andb_b_false : (b:bool)(andb b false)=false.
+NewDestruct b; Auto with bool.
+Qed.
+
+Lemma andb_false_b : (b:bool)(andb false b)=false.
+Trivial with bool.
+Qed.
+
+Lemma andb_b_true : (b:bool)(andb b true)=b.
+NewDestruct b; Auto with bool.
+Qed.
+
+Lemma andb_true_b : (b:bool)(andb true b)=b.
+Trivial with bool.
+Qed.
+
+Definition andb_false_elim : 
+    (b1,b2:bool)(andb b1 b2)=false -> {b1=false}+{b2=false}.
+NewDestruct b1; Simpl; Auto with bool.
+Defined.
+Hints Resolve andb_false_elim : bool v62.
+
+Lemma andb_neg_b :
+   (b:bool)(andb b (negb b))=false.
+NewDestruct b; Reflexivity.
+Qed.   
+Hints Resolve andb_neg_b : bool v62.
+
+Lemma andb_sym : (b1,b2:bool)(andb b1 b2)=(andb b2 b1).
+NewDestruct b1; NewDestruct b2; Reflexivity.
+Qed.
+
+Lemma andb_assoc : (b1,b2,b3:bool)(andb b1 (andb b2 b3))=(andb (andb b1 b2) b3).
+NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Hints Resolve andb_sym andb_assoc : bool v62.
+
+(*******************************)
+(** Properties of [xorb]       *)
+(*******************************)
+
+Lemma xorb_false : (b:bool) (xorb b false)=b.
+Proof.
+  NewDestruct b; Trivial.
+Qed.
+
+Lemma false_xorb : (b:bool) (xorb false b)=b.
+Proof.
+  NewDestruct b; Trivial.
+Qed.
+
+Lemma xorb_true : (b:bool) (xorb b true)=(negb b).
+Proof.
+  Trivial.
+Qed.
+
+Lemma true_xorb : (b:bool) (xorb true b)=(negb b).
+Proof.
+  NewDestruct b; Trivial.
+Qed.
+
+Lemma xorb_nilpotent : (b:bool) (xorb b b)=false.
+Proof.
+  NewDestruct b; Trivial.
+Qed.
+
+Lemma xorb_comm : (b,b':bool) (xorb b b')=(xorb b' b).
+Proof.
+  NewDestruct b; NewDestruct b'; Trivial.
+Qed.
+
+Lemma xorb_assoc : (b,b',b'':bool) (xorb (xorb b b') b'')=(xorb b (xorb b' b'')).
+Proof.
+  NewDestruct b; NewDestruct b'; NewDestruct b''; Trivial.
+Qed.
+
+Lemma xorb_eq : (b,b':bool) (xorb b b')=false -> b=b'.
+Proof.
+  NewDestruct b; NewDestruct b'; Trivial.
+  Unfold xorb. Intros. Rewrite H. Reflexivity.
+Qed.
+
+Lemma xorb_move_l_r_1 : (b,b',b'':bool) (xorb b b')=b'' -> b'=(xorb b b'').
+Proof.
+  Intros. Rewrite <- (false_xorb b'). Rewrite <- (xorb_nilpotent b). Rewrite xorb_assoc.
+  Rewrite H. Reflexivity.
+Qed.
+
+Lemma xorb_move_l_r_2 : (b,b',b'':bool) (xorb b b')=b'' -> b=(xorb b'' b').
+Proof.
+  Intros. Rewrite xorb_comm in H. Rewrite (xorb_move_l_r_1 b' b b'' H). Apply xorb_comm.
+Qed.
+
+Lemma xorb_move_r_l_1 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b' b)=b''.
+Proof.
+  Intros. Rewrite H. Rewrite <- xorb_assoc. Rewrite xorb_nilpotent. Apply false_xorb.
+Qed.
+
+Lemma xorb_move_r_l_2 : (b,b',b'':bool) b=(xorb b' b'') -> (xorb b b'')=b'.
+Proof.
+  Intros. Rewrite H. Rewrite xorb_assoc. Rewrite xorb_nilpotent. Apply xorb_false.
+Qed.
+
+(*******************************)
+(** De Morgan's law            *)
+(*******************************)
+
+Lemma demorgan1 : (b1,b2,b3:bool)
+  (andb b1 (orb b2 b3)) = (orb (andb b1 b2) (andb b1 b3)).
+NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Lemma demorgan2 : (b1,b2,b3:bool)
+  (andb (orb b1 b2) b3) = (orb (andb b1 b3) (andb b2 b3)).
+NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Lemma demorgan3 : (b1,b2,b3:bool)
+  (orb b1 (andb b2 b3)) = (andb (orb b1 b2) (orb b1 b3)).
+NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Lemma demorgan4 : (b1,b2,b3:bool)
+  (orb (andb b1 b2) b3) = (andb (orb b1 b3) (orb b2 b3)).
+NewDestruct b1; NewDestruct b2; NewDestruct b3; Reflexivity.
+Qed.
+
+Lemma absoption_andb : (b1,b2:bool)
+  (andb b1 (orb b1 b2)) = b1.
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+Qed.
+
+Lemma absoption_orb : (b1,b2:bool)
+  (orb b1 (andb b1 b2)) = b1.
+Proof.
+  NewDestruct b1; NewDestruct b2; Simpl; Reflexivity.
+Qed.
+
+
+(** Misc. equalities between booleans (to be used by Auto) *)
+
+Lemma bool_1 : (b1,b2:bool)(b1=true <-> b2=true) -> b1=b2. 
+Proof. 
+ Intros b1 b2; Case b1; Case b2; Intuition.
+Qed.
+
+Lemma bool_2 : (b1,b2:bool)b1=b2 -> b1=true -> b2=true.
+Proof. 
+ Intros b1 b2; Case b1; Case b2; Intuition.
+Qed. 
+
+Lemma bool_3 : (b:bool) ~(negb b)=true -> b=true.
+Proof.
+  NewDestruct b; Intuition.
+Qed.
+
+Lemma bool_4 : (b:bool) b=true -> ~(negb b)=true.  
+Proof.
+  NewDestruct b; Intuition.
+Qed.
+
+Lemma bool_5 : (b:bool) (negb b)=true -> ~b=true.
+Proof.
+  NewDestruct b; Intuition.
+Qed.
+
+Lemma bool_6 : (b:bool) ~b=true -> (negb b)=true.  
+Proof.
+  NewDestruct b; Intuition.
+Qed.
+
+Hints Resolve bool_1 bool_2 bool_3 bool_4 bool_5 bool_6.
diff --git a/theories7/Bool/BoolEq.v b/theories7/Bool/BoolEq.v
new file mode 100644
index 00000000..b670dbdd
--- /dev/null
+++ b/theories7/Bool/BoolEq.v
@@ -0,0 +1,72 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: BoolEq.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+(* Cuihtlauac Alvarado - octobre 2000 *)
+
+(** Properties of a boolean equality   *)
+
+
+Require Export Bool.
+
+Section Bool_eq_dec.
+
+  Variable A : Set.
+
+  Variable beq : A -> A -> bool.
+
+  Variable beq_refl : (x:A)true=(beq x x).
+
+  Variable beq_eq : (x,y:A)true=(beq x y)->x=y.
+
+  Definition beq_eq_true : (x,y:A)x=y->true=(beq x y).
+  Proof.
+    Intros x y H.
+    Case H.
+    Apply beq_refl.
+  Defined.
+
+  Definition beq_eq_not_false : (x,y:A)x=y->~false=(beq x y).
+  Proof.
+    Intros x y e.
+    Rewrite <- beq_eq_true; Trivial; Discriminate.
+  Defined.
+
+  Definition beq_false_not_eq : (x,y:A)false=(beq x y)->~x=y.
+  Proof.
+    Exact [x,y:A; H:(false=(beq x y)); e:(x=y)](beq_eq_not_false x y e H).
+  Defined.
+
+  Definition exists_beq_eq : (x,y:A){b:bool | b=(beq x y)}.
+  Proof.
+    Intros.
+    Exists (beq x y).
+    Constructor.
+  Defined.
+
+  Definition not_eq_false_beq : (x,y:A)~x=y->false=(beq x y).
+  Proof.
+    Intros x y H.
+    Symmetry.
+    Apply not_true_is_false.
+    Intro.
+    Apply H.
+    Apply beq_eq.
+    Symmetry.
+    Assumption.
+  Defined.
+
+  Definition eq_dec : (x,y:A){x=y}+{~x=y}.
+  Proof.
+    Intros x y; Case (exists_beq_eq x y).
+    Intros b; Case b; Intro H.
+      Left; Apply beq_eq; Assumption.
+      Right; Apply beq_false_not_eq; Assumption.
+  Defined.
+
+End Bool_eq_dec.
diff --git a/theories7/Bool/Bvector.v b/theories7/Bool/Bvector.v
new file mode 100644
index 00000000..e6545381
--- /dev/null
+++ b/theories7/Bool/Bvector.v
@@ -0,0 +1,266 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Bvector.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+(** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
+
+Require Export Bool.
+Require Export Sumbool.
+Require Arith.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+(*  
+On s'inspire de PolyList pour fabriquer les vecteurs de bits.
+La dimension du vecteur est un paramètre trop important pour
+se contenter de la fonction "length".
+La première idée est de faire un record avec la liste et la longueur.
+Malheureusement, cette verification a posteriori amene a faire
+de nombreux lemmes pour gerer les longueurs.
+La seconde idée est de faire un type dépendant dans lequel la
+longueur est un paramètre de construction. Cela complique un
+peu les inductions structurelles, la solution qui a ma préférence
+est alors d'utiliser un terme de preuve comme définition.
+
+(En effet une définition comme :
+Fixpoint Vunaire [n:nat; v:(vector n)]: (vector n) :=
+Cases v of
+	| Vnil => Vnil
+	| (Vcons a p v') => (Vcons (f a) p (Vunaire p v'))
+end.
+provoque ce message d'erreur :
+Coq < Error: Inference of annotation not yet implemented in this case).
+
+
+	Inductive list [A : Set]  : Set :=
+		nil : (list A) | cons : A->(list A)->(list A).
+	head = [A:Set; l:(list A)] Cases l of
+			| nil => Error
+ 			| (cons x _) => (Value x)
+ 			end
+     		: (A:Set)(list A)->(option A).
+	tail = [A:Set; l:(list A)]Cases l of
+                   			| nil => (nil A)
+                   			| (cons _ m) => m
+                   			end
+     		: (A:Set)(list A)->(list A).
+	length = [A:Set] Fix length {length [l:(list A)] : nat :=
+      		Cases l of
+       			| nil => O
+      			| (cons _ m) => (S (length m))
+      		end}
+     		: (A:Set)(list A)->nat.
+	map = [A,B:Set; f:(A->B)] Fix map {map [l:(list A)] : (list B) :=
+		Cases l of
+			| nil => (nil B)
+			| (cons a t) => (cons (f a) (map t))
+		end}
+		: (A,B:Set)(A->B)->(list A)->(list B)
+*)
+
+Section VECTORS.
+
+(* 
+Un vecteur est une liste de taille n d'éléments d'un ensemble A.
+Si la taille est non nulle, on peut extraire la première composante et 
+le reste du vecteur, la dernière composante ou rajouter ou enlever 
+une composante (carry) ou repeter la dernière composante en fin de vecteur.
+On peut aussi tronquer le vecteur de ses p dernières composantes ou
+au contraire l'étendre (concaténer) d'un vecteur de longueur p.
+Une fonction unaire sur A génère une fonction des vecteurs de taille n
+dans les vecteurs de taille n en appliquant f terme à terme.
+Une fonction binaire sur A génère une fonction des couple de vecteurs 
+de taille n dans les vecteurs de taille n en appliquant f terme à terme.
+*)
+
+Variable A : Set.
+
+Inductive vector: nat -> Set :=
+	| Vnil : (vector O)
+	| Vcons  : (a:A) (n:nat) (vector n) -> (vector (S n)).
+
+Definition Vhead : (n:nat) (vector (S n)) -> A.
+Proof.
+	Intros n v; Inversion v; Exact a.
+Defined.
+
+Definition Vtail : (n:nat) (vector (S n)) -> (vector n).
+Proof.
+	Intros n v; Inversion v; Exact H0.
+Defined.
+
+Definition Vlast : (n:nat) (vector (S n)) -> A.
+Proof.
+	NewInduction n as [|n f]; Intro v.
+	Inversion v.
+	Exact a.
+
+	Inversion v.
+	Exact (f H0).
+Defined.
+
+Definition Vconst : (a:A) (n:nat) (vector n).
+Proof.
+	NewInduction n as [|n v].
+	Exact Vnil.
+
+	Exact (Vcons a n v).
+Defined.
+
+Lemma Vshiftout : (n:nat) (vector (S n)) -> (vector n).
+Proof.
+	NewInduction n as [|n f]; Intro v.
+	Exact Vnil.
+
+	Inversion v.
+	Exact (Vcons a n (f H0)).
+Defined.
+
+Lemma Vshiftin : (n:nat) A -> (vector n) -> (vector (S n)).
+Proof.
+	NewInduction n as [|n f]; Intros a v.
+	Exact (Vcons a O v).
+
+	Inversion v.
+	Exact (Vcons a (S n) (f a H0)).
+Defined.
+
+Lemma Vshiftrepeat : (n:nat) (vector (S n)) -> (vector (S (S n))).
+Proof.
+	NewInduction n as [|n f]; Intro v.
+	Inversion v.
+	Exact (Vcons a (1) v).
+
+	Inversion v.
+	Exact (Vcons a (S (S n)) (f H0)).
+Defined.
+
+(*
+Lemma S_minus_S : (n,p:nat) (gt n (S p)) -> (S (minus n (S p)))=(minus n p).
+Proof.
+  Intros.
+Save.
+*)
+
+Lemma Vtrunc : (n,p:nat) (gt n p) ->  (vector n) -> (vector (minus n p)).
+Proof.
+	NewInduction p as [|p f]; Intros H v.
+	Rewrite <- minus_n_O.
+	Exact v.
+
+	Apply (Vshiftout (minus n (S p))).
+
+Rewrite minus_Sn_m.
+Apply f.
+Auto with *.
+Exact v.
+Auto with *.
+Defined.
+
+Lemma Vextend : (n,p:nat) (vector n) ->  (vector p) -> (vector (plus n p)).
+Proof.
+	NewInduction n as [|n f]; Intros p v v0.
+	Simpl; Exact v0.
+
+	Inversion v.
+	Simpl; Exact (Vcons a (plus n p) (f p H0 v0)).
+Defined.
+
+Variable f : A -> A.
+
+Lemma Vunary : (n:nat)(vector n)->(vector n).
+Proof.
+	NewInduction n as [|n g]; Intro v.
+	Exact Vnil.
+
+	Inversion v.
+	Exact (Vcons (f a) n (g H0)).
+Defined.
+
+Variable g : A -> A -> A.
+
+Lemma Vbinary : (n:nat)(vector n)->(vector n)->(vector n).
+Proof.
+	NewInduction n as [|n h]; Intros v v0.
+	Exact Vnil.
+
+	Inversion v; Inversion v0.
+	Exact (Vcons (g a a0) n (h H0 H2)).
+Defined.
+
+End VECTORS.
+
+Section BOOLEAN_VECTORS.
+
+(* 
+Un vecteur de bits est un vecteur sur l'ensemble des booléens de longueur fixe. 
+ATTENTION : le stockage s'effectue poids FAIBLE en tête.
+On en extrait le bit  de poids faible (head) et la fin du vecteur (tail).
+On calcule la négation d'un vecteur, le et, le ou et le xor bit à bit de 2 vecteurs.
+On calcule les décalages d'une position vers la gauche (vers les poids forts, on
+utilise donc Vshiftout, vers la droite (vers les poids faibles, on utilise Vshiftin) en 
+insérant un bit 'carry' (logique) ou en répétant le bit de poids fort (arithmétique).
+ATTENTION : Tous les décalages prennent la taille moins un comme paramètre
+(ils ne travaillent que sur des vecteurs au moins de longueur un).
+*)
+
+Definition Bvector := (vector bool).
+
+Definition Bnil := (Vnil bool).
+
+Definition Bcons := (Vcons bool).
+
+Definition Bvect_true := (Vconst bool true).
+
+Definition Bvect_false := (Vconst bool false).
+
+Definition Blow := (Vhead bool).
+
+Definition Bhigh := (Vtail bool).
+
+Definition Bsign := (Vlast bool).
+
+Definition Bneg := (Vunary bool negb).
+
+Definition BVand := (Vbinary bool andb).
+
+Definition BVor := (Vbinary bool orb).
+
+Definition BVxor := (Vbinary bool xorb).
+
+Definition BshiftL := [n:nat; bv : (Bvector (S n)); carry:bool] 
+	(Bcons carry n (Vshiftout bool n bv)).
+
+Definition BshiftRl := [n:nat; bv : (Bvector (S n)); carry:bool] 
+	(Bhigh (S n) (Vshiftin bool (S n) carry bv)).
+
+Definition BshiftRa := [n:nat; bv : (Bvector (S n))] 
+	(Bhigh (S n) (Vshiftrepeat bool n bv)).
+
+Fixpoint BshiftL_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
+Cases p of
+	| O => bv
+	| (S p') => (BshiftL n (BshiftL_iter n bv p') false)
+end.
+
+Fixpoint BshiftRl_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
+Cases p of
+	| O => bv
+	| (S p') => (BshiftRl n (BshiftRl_iter n bv p') false)
+end.
+
+Fixpoint BshiftRa_iter [n:nat; bv:(Bvector (S n)); p:nat]:(Bvector (S n)) :=
+Cases p of
+	| O => bv
+	| (S p') => (BshiftRa n (BshiftRa_iter n bv p'))
+end.
+
+End BOOLEAN_VECTORS.
+
diff --git a/theories7/Bool/DecBool.v b/theories7/Bool/DecBool.v
new file mode 100755
index 00000000..c22cd032
--- /dev/null
+++ b/theories7/Bool/DecBool.v
@@ -0,0 +1,27 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: DecBool.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+Set Implicit Arguments.
+
+Definition ifdec : (A,B:Prop)(C:Set)({A}+{B})->C->C->C
+   := [A,B,C,H,x,y]if H then [_]x else [_]y.
+
+
+Theorem ifdec_left : (A,B:Prop)(C:Set)(H:{A}+{B})~B->(x,y:C)(ifdec H x y)=x.
+Intros; Case H; Auto.
+Intro; Absurd B; Trivial.
+Qed.
+
+Theorem ifdec_right : (A,B:Prop)(C:Set)(H:{A}+{B})~A->(x,y:C)(ifdec H x y)=y.
+Intros; Case H; Auto.
+Intro; Absurd A; Trivial.
+Qed.
+
+Unset Implicit Arguments.
diff --git a/theories7/Bool/IfProp.v b/theories7/Bool/IfProp.v
new file mode 100755
index 00000000..bcfa4be3
--- /dev/null
+++ b/theories7/Bool/IfProp.v
@@ -0,0 +1,49 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: IfProp.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+Require Bool.
+
+Inductive IfProp [A,B:Prop] : bool-> Prop 
+  := Iftrue  : A -> (IfProp A B true)
+  |  Iffalse : B -> (IfProp A B false).
+
+Hints Resolve Iftrue Iffalse : bool v62.
+
+Lemma Iftrue_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=true -> A.
+NewDestruct 1; Intros; Auto with bool.
+Case diff_true_false; Auto with bool.
+Qed.
+
+Lemma Iffalse_inv : (A,B:Prop)(b:bool) (IfProp A B b) -> b=false -> B.
+NewDestruct 1; Intros; Auto with bool.
+Case diff_true_false; Trivial with bool.
+Qed.
+
+Lemma IfProp_true : (A,B:Prop)(IfProp A B true) -> A.
+Intros.
+Inversion H.
+Assumption.
+Qed.
+
+Lemma IfProp_false : (A,B:Prop)(IfProp A B false) -> B.
+Intros.
+Inversion H.
+Assumption.
+Qed.
+
+Lemma IfProp_or : (A,B:Prop)(b:bool)(IfProp A B b) -> A\/B.
+NewDestruct 1; Auto with bool.
+Qed.
+
+Lemma IfProp_sum : (A,B:Prop)(b:bool)(IfProp A B b) -> {A}+{B}.
+NewDestruct b; Intro H.
+Left; Inversion H; Auto with bool.
+Right; Inversion H; Auto with bool.
+Qed.
diff --git a/theories7/Bool/Sumbool.v b/theories7/Bool/Sumbool.v
new file mode 100644
index 00000000..8d55cbb6
--- /dev/null
+++ b/theories7/Bool/Sumbool.v
@@ -0,0 +1,77 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Sumbool.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ 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.
+   Its extraction is isomorphic to the type of booleans. *)
+
+(** A boolean is either [true] or [false], and this is decidable *)
+
+Definition sumbool_of_bool : (b:bool) {b=true}+{b=false}.
+Proof.
+  NewDestruct b; Auto.
+Defined.
+
+Hints Resolve sumbool_of_bool : bool.
+
+Definition bool_eq_rec : (b:bool)(P:bool->Set)
+                    ((b=true)->(P true))->((b=false)->(P false))->(P b).
+NewDestruct b; Auto.
+Defined.
+
+Definition bool_eq_ind : (b:bool)(P:bool->Prop)
+                    ((b=true)->(P true))->((b=false)->(P false))->(P b).
+NewDestruct b; Auto.
+Defined.
+
+
+(*i pourquoi ce machin-la est dans BOOL et pas dans LOGIC ?  Papageno i*)
+
+(** Logic connectives on type [sumbool] *)
+
+Section connectives.
+
+Variables A,B,C,D : Prop.
+
+Hypothesis H1 : {A}+{B}.
+Hypothesis H2 : {C}+{D}.
+
+Definition sumbool_and : {A/\C}+{B\/D}.
+Proof.
+Case H1; Case H2; Auto.
+Defined.
+
+Definition sumbool_or : {A\/C}+{B/\D}.
+Proof.
+Case H1; Case H2; Auto.
+Defined.
+
+Definition sumbool_not : {B}+{A}.
+Proof.
+Case H1; Auto.
+Defined.
+
+End connectives.
+
+Hints Resolve sumbool_and sumbool_or sumbool_not : core.
+
+
+(** Any decidability function in type [sumbool] can be turned into a function
+    returning a boolean with the corresponding specification: *)
+
+Definition bool_of_sumbool : 
+  (A,B:Prop) {A}+{B} -> { b:bool | if b then A else B }.
+Proof.
+Intros A B H.
+Elim H; [ Intro; Exists true; Assumption
+        | Intro; Exists false; Assumption ].
+Defined.
+Implicits bool_of_sumbool.
diff --git a/theories7/Bool/Zerob.v b/theories7/Bool/Zerob.v
new file mode 100755
index 00000000..24e48c28
--- /dev/null
+++ b/theories7/Bool/Zerob.v
@@ -0,0 +1,36 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zerob.v,v 1.1.2.1 2004/07/16 19:31:25 herbelin Exp $ i*)
+
+Require Arith.
+Require Bool.
+
+V7only [Import nat_scope.].
+Open Local Scope nat_scope.
+
+Definition zerob : nat->bool 
+      := [n:nat]Cases n of O => true | (S _) => false end.
+
+Lemma zerob_true_intro : (n:nat)(n=O)->(zerob n)=true.
+NewDestruct n; [Trivial with bool | Inversion 1].
+Qed.
+Hints Resolve zerob_true_intro : bool.
+
+Lemma zerob_true_elim : (n:nat)(zerob n)=true->(n=O).
+NewDestruct n; [Trivial with bool | Inversion 1].
+Qed.
+
+Lemma zerob_false_intro : (n:nat)~(n=O)->(zerob n)=false.
+NewDestruct n; [NewDestruct 1; Auto with bool | Trivial with bool].
+Qed.
+Hints Resolve zerob_false_intro : bool.
+
+Lemma zerob_false_elim : (n:nat)(zerob n)=false -> ~(n=O).
+NewDestruct n; [Intro H; Inversion H | Auto with bool].
+Qed.
diff --git a/theories7/Init/Datatypes.v b/theories7/Init/Datatypes.v
new file mode 100755
index 00000000..006ec08e
--- /dev/null
+++ b/theories7/Init/Datatypes.v
@@ -0,0 +1,125 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Datatypes.v,v 1.3.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+Require Notations.
+Require Logic.
+
+Set Implicit Arguments.
+V7only [Unset Implicit Arguments.].
+
+(** [unit] is a singleton datatype with sole inhabitant [tt] *)
+
+Inductive unit : Set := tt : unit.
+
+(** [bool] is the datatype of the booleans values [true] and [false] *)
+
+Inductive bool : Set := true : bool 
+                      | false : bool.
+
+Add Printing If bool.
+
+(** [nat] is the datatype of natural numbers built from [O] and successor [S];
+    note that zero is the letter O, not the numeral 0 *)
+
+Inductive nat : Set := O : nat 
+                     | S : nat->nat.
+
+Delimits Scope nat_scope with nat.
+Bind Scope nat_scope with nat.
+Arguments Scope S [ nat_scope ].
+
+(** [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->Set :=
+     refl_identity: (identity A a a).
+Hints Resolve refl_identity : core v62.
+
+Implicits identity_ind [1].
+Implicits identity_rec [1].
+Implicits identity_rect [1].
+V7only [
+Implicits identity_ind [].
+Implicits identity_rec [].
+Implicits identity_rect [].
+].
+
+(** [option A] is the extension of A with a dummy element None *)
+
+Inductive option [A:Set] : Set := Some : A -> (option A) | None : (option A).
+
+Implicits None [1].
+V7only [Implicits None [].].
+
+(** [sum A B], equivalently [A + B], is the disjoint sum of [A] and [B] *)
+(* Syntax defined in Specif.v *)
+Inductive sum [A,B:Set] : Set
+    := inl : A -> (sum A B)
+     | inr : B -> (sum A B).
+
+Notation "x + y" := (sum x y) : type_scope.
+
+(** [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)] *)
+
+Inductive prod [A,B:Set] : Set := pair : A -> B -> (prod A B).
+Add Printing Let prod.
+
+Notation "x * y" := (prod x y) : type_scope.
+V7only [Notation "( x , y )" := (pair ? ? x y) : core_scope.].
+V8Notation "( x , y , .. , z )" := (pair ? ? .. (pair ? ? x y) .. z) : core_scope.
+
+Section projections.
+   Variables A,B:Set.
+   Definition fst := [p:(prod A B)]Cases p of (pair x y) => x end.
+   Definition snd := [p:(prod A B)]Cases p of (pair x y) => y end.
+End projections. 
+
+V7only [
+Notation Fst := (fst ? ?).
+Notation Snd := (snd ? ?).
+].
+Hints Resolve pair inl inr : core v62.
+
+Lemma surjective_pairing : (A,B:Set;p:A*B)p=(pair A B (Fst p) (Snd p)).
+Proof.
+NewDestruct p; Reflexivity.
+Qed.
+
+Lemma injective_projections : 
+ (A,B:Set;p1,p2:A*B)(Fst p1)=(Fst p2)->(Snd p1)=(Snd p2)->p1=p2.
+Proof.
+NewDestruct p1; NewDestruct p2; Simpl; Intros Hfst Hsnd.
+Rewrite Hfst; Rewrite Hsnd; Reflexivity. 
+Qed.
+
+V7only[
+(** Parsing only of things in [Datatypes.v] *)
+Notation "< A , B > ( x , y )" := (pair A B x y) (at level 1, only parsing, A annot).
+Notation "< A , B > 'Fst' ( p )" := (fst A B p) (at level 1, only parsing, A annot).
+Notation "< A , B > 'Snd' ( p )" := (snd A B p) (at level 1, only parsing, A annot).
+].
+
+(** Comparison *)
+
+Inductive relation : Set := 
+  EGAL :relation | INFERIEUR : relation | SUPERIEUR : relation.
+
+Definition Op := [r:relation]
+  Cases r of
+    EGAL => EGAL
+  | INFERIEUR => SUPERIEUR
+  | SUPERIEUR => INFERIEUR
+  end.
diff --git a/theories7/Init/Logic.v b/theories7/Init/Logic.v
new file mode 100755
index 00000000..6ba9c7a1
--- /dev/null
+++ b/theories7/Init/Logic.v
@@ -0,0 +1,306 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Logic.v,v 1.6.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+Set Implicit Arguments.
+V7only [Unset Implicit Arguments.].
+
+Require Notations.
+
+(** [True] is the always true proposition *)
+Inductive True : Prop := I : True. 
+
+(** [False] is the always false proposition *)
+Inductive False : Prop := . 
+
+(** [not A], written [~A], is the negation of [A] *)
+Definition not := [A:Prop]A->False.
+
+Notation "~ x" := (not x) : type_scope.
+
+Hints Unfold not : core.
+
+Inductive and [A,B:Prop] : Prop := conj : A -> B -> A /\ B
+
+where "A /\ B" := (and A B) : type_scope.
+
+V7only[
+Notation "< P , Q > { p , q }" := (conj P Q p q) (P annot, at level 1).
+].
+
+Section Conjunction.
+
+  (** [and A B], written [A /\ B], is the conjunction of [A] and [B]
+
+      [conj A B p q], written [<p,q>] is a proof of [A /\ B] as soon as 
+      [p] is a proof of [A] and [q] a proof of [B]
+
+      [proj1] and [proj2] are first and second projections of a conjunction *)
+
+  Variables A,B : Prop.
+
+  Theorem proj1 : (and A B) -> A.
+  Proof.
+  NewDestruct 1; Trivial.
+  Qed.
+
+  Theorem proj2 : (and A B) -> B.
+  Proof.
+  NewDestruct 1; Trivial.
+  Qed.
+
+End Conjunction.
+
+(** [or A B], written [A \/ B], is the disjunction of [A] and [B] *)
+
+Inductive or [A,B:Prop] : Prop :=
+     or_introl : A -> A \/ B 
+   | or_intror : B -> A \/ B
+
+where "A \/ B" := (or A B) : type_scope.
+
+(** [iff A B], written [A <-> B], expresses the equivalence of [A] and [B] *)
+
+Definition iff := [A,B:Prop] (and (A->B) (B->A)).
+
+Notation "A <-> B" := (iff A B) : type_scope.
+
+Section Equivalence.
+
+Theorem iff_refl : (A:Prop) (iff A A).
+  Proof.
+    Split; Auto.
+  Qed.
+
+Theorem iff_trans : (a,b,c:Prop) (iff a b) -> (iff b c) -> (iff a c).
+  Proof.
+    Intros A B C (H1,H2) (H3,H4); Split; Auto.
+  Qed.
+
+Theorem iff_sym : (A,B:Prop) (iff A B) -> (iff B A).
+  Proof.
+    Intros A B (H1,H2); Split; Auto.
+  Qed.
+
+End Equivalence.
+
+(** [(IF P Q R)], or more suggestively [(either P and_then Q or_else R)],
+    denotes either [P] and [Q], or [~P] and [Q] *)
+Definition IF_then_else := [P,Q,R:Prop] (or (and P Q) (and (not P) R)).
+V7only [Notation IF:=IF_then_else.].
+
+Notation "'IF' c1 'then' c2 'else' c3" := (IF c1 c2 c3)
+  (at level 1, c1, c2, c3 at level 8) : type_scope
+  V8only (at level 200).
+
+(** First-order quantifiers *)
+
+  (** [ex A P], or simply [exists x, P x], expresses the existence of an 
+      [x] of type [A] which satisfies the predicate [P] ([A] is of type 
+      [Set]). This is existential quantification. *)
+
+  (** [ex2 A P Q], or simply [exists2 x, P x & Q x], expresses the
+      existence of an [x] of type [A] which satisfies both the predicates
+      [P] and [Q] *)
+
+  (** Universal quantification (especially first-order one) is normally 
+      written [forall x:A, P x]. For duality with existential quantification, 
+      the construction [all P] is provided too *)
+
+Inductive ex [A:Type;P:A->Prop] : Prop 
+    := ex_intro : (x:A)(P x)->(ex A P).
+
+Inductive ex2 [A:Type;P,Q:A->Prop] : Prop
+    := ex_intro2 : (x:A)(P x)->(Q x)->(ex2 A P Q).
+
+Definition all := [A:Type][P:A->Prop](x:A)(P x). 
+
+(* Rule order is important to give printing priority to fully typed exists *)
+
+V7only [ Notation Ex  := (ex ?). ].
+Notation "'EX' x | p"      := (ex ? [x]p)
+  (at level 10, p at level 8) : type_scope
+  V8only "'exists' x , p" (at level 200, x ident, p at level 99).
+Notation "'EX' x : t | p"  := (ex ? [x:t]p)
+  (at level 10, p at level 8) : type_scope
+  V8only "'exists' x : t , p" (at level 200, x ident, p at level 99, format
+  "'exists'  '/  ' x  :  t ,  '/  ' p").
+
+V7only [ Notation Ex2 := (ex2 ?). ].
+Notation "'EX' x | p & q"       := (ex2 ? [x]p [x]q)
+  (at level 10, p, q at level 8) : type_scope
+  V8only "'exists2' x , p & q" (at level 200, x ident, p, q at level 99).
+Notation "'EX' x : t | p & q"   := (ex2 ? [x:t]p [x:t]q)
+  (at level 10, p, q at level 8) : type_scope
+  V8only "'exists2' x : t , p & q"
+    (at level 200, x ident, t at level 200, p, q at level 99, format
+    "'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']'").
+
+V7only [Notation All := (all ?).
+Notation "'ALL' x | p"     := (all ? [x]p)
+  (at level 10, p at level 8) : type_scope
+  V8only (at level 200, x ident, p at level 200).
+Notation "'ALL' x : t | p" := (all ? [x:t]p)
+  (at level 10, p at level 8) : type_scope
+  V8only (at level 200, x ident, t, p at level 200).
+].
+
+(** Universal quantification *)
+
+Section universal_quantification.
+
+  Variable A : Type.
+  Variable P : A->Prop.
+
+  Theorem inst : (x:A)(all ? [x](P x))->(P x).
+  Proof.
+  Unfold all; Auto.
+  Qed.
+
+  Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(all A P).
+  Proof.
+  Red; Auto.
+  Qed.
+
+  End universal_quantification.
+
+(** Equality *)
+
+(** [eq A x y], or simply [x=y], expresses the (Leibniz') equality
+    of [x] and [y]. Both [x] and [y] must belong to the same type [A].
+    The definition is inductive and states the reflexivity of the equality.
+    The others properties (symmetry, transitivity, replacement of 
+    equals) are proved below *)
+
+Inductive eq [A:Type;x:A] : A->Prop
+       := refl_equal : x = x :> A
+
+where "x = y :> A" := (!eq A x y) : type_scope.
+
+Notation "x = y" := (eq ? x y) : type_scope.
+Notation "x <> y  :> T" := ~ (!eq T x y) : type_scope.
+Notation "x <> y" := ~ x=y : type_scope.
+
+Implicits eq_ind [1].
+Implicits eq_rec [1].
+Implicits eq_rect [1].
+V7only [
+Implicits eq_ind [].
+Implicits eq_rec [].
+Implicits eq_rect [].
+].
+
+Hints Resolve I conj or_introl or_intror refl_equal : core v62.
+Hints Resolve ex_intro ex_intro2 : core v62.
+
+Section Logic_lemmas.
+
+  Theorem absurd : (A:Prop)(C:Prop) A -> (not A) -> C.
+  Proof.
+    Unfold not; Intros A C h1 h2.
+    NewDestruct (h2 h1).
+  Qed.
+
+  Section equality.
+    Variable A,B : Type.
+    Variable f   : A->B.
+    Variable x,y,z : A.
+
+    Theorem sym_eq : (eq ? x y) -> (eq ? y x).
+    Proof.
+     NewDestruct 1; Trivial.
+    Defined.
+    Opaque sym_eq.
+
+    Theorem trans_eq : (eq ? x y) -> (eq ? y z) -> (eq ? x z).
+    Proof.
+     NewDestruct 2; Trivial.
+    Defined.
+    Opaque trans_eq.
+
+    Theorem f_equal : (eq ? x y) -> (eq ? (f x) (f y)).
+    Proof.
+     NewDestruct 1; Trivial.
+    Defined.
+    Opaque f_equal.
+
+    Theorem sym_not_eq : (not (eq ? x y)) -> (not (eq ? y x)).
+    Proof.
+     Red; Intros h1 h2; Apply h1; NewDestruct h2; Trivial.
+    Qed.
+
+    Definition sym_equal     := sym_eq.
+    Definition sym_not_equal := sym_not_eq.
+    Definition trans_equal   := trans_eq.
+
+  End equality.
+
+(* Is now a primitive principle 
+  Theorem eq_rect: (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? x y)->(P y).
+  Proof.
+   Intros.
+   Cut (identity A x y).
+   NewDestruct 1; Auto.
+   NewDestruct H; Auto.
+  Qed.
+*)
+
+  Definition eq_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eq ? y x)->(P y).
+   Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+  Defined.
+
+  Definition eq_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eq ? y x)->(P y).
+    Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+  Defined.
+
+  Definition eq_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eq ? y x)->(P y).
+    Intros A x P H y H0; Elim sym_eq with 1:= H0; Assumption.
+  Defined.
+End Logic_lemmas.
+
+Theorem f_equal2 : (A1,A2,B:Type)(f:A1->A2->B)(x1,y1:A1)(x2,y2:A2)
+  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? (f x1 x2) (f y1 y2)).
+Proof.
+  NewDestruct 1; NewDestruct 1; Reflexivity.
+Qed.
+
+Theorem f_equal3 : (A1,A2,A3,B:Type)(f:A1->A2->A3->B)(x1,y1:A1)(x2,y2:A2)
+  (x3,y3:A3)(eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) 
+   -> (eq ? (f x1 x2 x3) (f y1 y2 y3)).
+Proof.
+  NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
+Qed.
+
+Theorem f_equal4 : (A1,A2,A3,A4,B:Type)(f:A1->A2->A3->A4->B)
+  (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)
+  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4)
+   -> (eq ? (f x1 x2 x3 x4) (f y1 y2 y3 y4)).
+Proof.
+  NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; Reflexivity.
+Qed.
+
+Theorem f_equal5 : (A1,A2,A3,A4,A5,B:Type)(f:A1->A2->A3->A4->A5->B)
+  (x1,y1:A1)(x2,y2:A2)(x3,y3:A3)(x4,y4:A4)(x5,y5:A5)
+  (eq ? x1 y1) -> (eq ? x2 y2) -> (eq ? x3 y3) -> (eq ? x4 y4) -> (eq ? x5 y5)
+    -> (eq ? (f x1 x2 x3 x4 x5) (f y1 y2 y3 y4 y5)).
+Proof.
+  NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1; NewDestruct 1;
+  Reflexivity.
+Qed.
+
+Hints Immediate sym_eq sym_not_eq : core v62.
+
+V7only[
+(** Parsing only of things in [Logic.v] *)
+Notation "< A > 'All' ( P )" :=(all A P) (A annot, at level 1, only parsing).
+Notation "< A > x = y" := (eq A x y)
+ (A annot, at level 1, x at level 0, only parsing).
+Notation "< A > x <> y" := ~(eq A x y)
+  (A annot, at level 1, x at level 0, only parsing).
+].
diff --git a/theories7/Init/Logic_Type.v b/theories7/Init/Logic_Type.v
new file mode 100755
index 00000000..793b671c
--- /dev/null
+++ b/theories7/Init/Logic_Type.v
@@ -0,0 +1,304 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Logic_Type.v,v 1.3.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+Set Implicit Arguments.
+V7only [Unset Implicit Arguments.].
+
+(** This module defines quantification on the world [Type]
+    ([Logic.v] was defining it on the world [Set]) *)
+
+Require Datatypes.
+Require Export Logic.
+
+V7only [
+(*
+(** [allT A P], or simply [(ALLT x | P(x))], stands for [(x:A)(P x)]
+   when [A] is of type [Type] *)
+
+Definition allT := [A:Type][P:A->Prop](x:A)(P x). 
+*)
+
+Notation allT := all (only parsing).
+Notation inst := Logic.inst (only parsing).
+Notation gen := Logic.gen (only parsing).
+
+(* Order is important to give printing priority to fully typed ALL and EX *)
+
+Notation AllT := (all ?).
+Notation "'ALLT' x | p"     := (all ? [x]p)   (at level 10, p at level 8).
+Notation "'ALLT' x : t | p" := (all ? [x:t]p) (at level 10, p at level 8).
+
+(*
+Section universal_quantification.
+
+Variable A : Type.
+Variable P : A->Prop.
+
+Theorem inst :  (x:A)(allT ? [x](P x))->(P x).
+Proof.
+Unfold all; Auto.
+Qed.
+
+Theorem gen : (B:Prop)(f:(y:A)B->(P y))B->(allT A P).
+Proof.
+Red; Auto.
+Qed.
+
+End universal_quantification.
+*)
+
+(*
+(** * Existential Quantification *)
+
+(** [exT A P], or simply [(EXT x | P(x))], stands for the existential 
+    quantification on the predicate [P] when [A] is of type [Type] *)
+
+(** [exT2 A P Q], or simply [(EXT x | P(x) & Q(x))], stands for the
+    existential quantification on both [P] and [Q] when [A] is of
+    type [Type] *)
+Inductive  exT [A:Type;P:A->Prop] : Prop
+    := exT_intro : (x:A)(P x)->(exT A P).
+*)
+
+Notation exT := ex (only parsing).
+Notation exT_intro := ex_intro (only parsing).
+Notation exT_ind  := ex_ind (only parsing).
+
+Notation ExT  := (ex ?).
+Notation "'EXT' x | p"      := (ex ? [x]p)
+  (at level 10, p at level 8, only parsing).
+Notation "'EXT' x : t | p"  := (ex ? [x:t]p)
+  (at level 10, p at level 8, only parsing).
+
+(*
+Inductive exT2 [A:Type;P,Q:A->Prop] : Prop
+    := exT_intro2 : (x:A)(P x)->(Q x)->(exT2 A P Q).
+*)
+
+Notation exT2 := ex2 (only parsing).
+Notation exT_intro2 := ex_intro2 (only parsing).
+Notation exT2_ind  := ex2_ind (only parsing).
+
+Notation ExT2 := (ex2 ?).
+Notation "'EXT' x | p & q"     := (ex2 ? [x]p [x]q)
+  (at level 10, p, q at level 8).
+Notation "'EXT' x : t | p & q" := (ex2 ? [x:t]p [x:t]q)
+  (at level 10, p, q at level 8).
+
+(*
+(** Leibniz equality : [A:Type][x,y:A] (P:A->Prop)(P x)->(P y)
+
+   [eqT A x y], or simply [x==y], is Leibniz' equality when [A] is of 
+   type [Type]. This equality satisfies reflexivity (by definition), 
+   symmetry, transitivity and stability by congruence *)
+
+
+Inductive eqT [A:Type;x:A] : A -> Prop
+                       := refl_eqT : (eqT A x x).
+
+Hints Resolve refl_eqT (* exT_intro2 exT_intro *) : core v62.
+*)
+
+Notation eqT      := eq (only parsing).
+Notation refl_eqT := refl_equal (only parsing).
+Notation eqT_ind  := eq_ind (only parsing).
+Notation eqT_rect := eq_rect (only parsing).
+Notation eqT_rec  := eq_rec (only parsing).
+
+Notation "x == y"  := (eq ? x y) (at level 5, no associativity, only parsing).
+
+(** Parsing only of things in [Logic_type.v] *)
+
+Notation "< A > x == y"  := (eq A x y)
+   (A annot, at level 1, x at level 0, only parsing).
+
+(*
+Section Equality_is_a_congruence.
+
+ Variables A,B : Type.
+ Variable  f : A->B.
+
+ Variable x,y,z : A.
+ 
+ Lemma sym_eqT : (eqT ? x y) -> (eqT ? y x).
+ Proof.
+  NewDestruct 1; Trivial.
+ Qed.
+
+ Lemma trans_eqT : (eqT ? x y) -> (eqT ? y z) -> (eqT ? x z).
+ Proof.
+  NewDestruct 2; Trivial.
+ Qed.
+
+ Lemma congr_eqT : (eqT ? x y)->(eqT ? (f x) (f y)).
+ Proof.
+  NewDestruct 1; Trivial.
+ Qed.
+
+ Lemma sym_not_eqT : ~(eqT ? x y) -> ~(eqT ? y x).
+ Proof.
+  Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
+ Qed.
+
+End Equality_is_a_congruence.
+*)
+
+Notation sym_eqT  := sym_eq (only parsing).
+Notation trans_eqT  := trans_eq (only parsing).
+Notation congr_eqT  := f_equal (only parsing).
+Notation sym_not_eqT  := sym_not_eq (only parsing).
+
+(*
+Hints Immediate sym_eqT sym_not_eqT : core v62.
+*)
+
+(** This states the replacement of equals by equals *)
+
+(*
+Definition eqT_ind_r : (A:Type)(x:A)(P:A->Prop)(P x)->(y:A)(eqT ? y x)->(P y).
+Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
+Defined.
+
+Definition eqT_rec_r : (A:Type)(x:A)(P:A->Set)(P x)->(y:A)(eqT ? y x)->(P y).
+Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
+Defined.
+
+Definition eqT_rect_r : (A:Type)(x:A)(P:A->Type)(P x)->(y:A)(eqT ? y x)->(P y).
+Intros A x P H y H0; Case sym_eqT with 1:=H0; Trivial.
+Defined.
+*)
+
+Notation eqT_ind_r  := eq_ind_r (only parsing).
+Notation eqT_rec_r  := eq_rec_r (only parsing).
+Notation eqT_rect_r  := eq_rect_r (only parsing).
+
+(** Some datatypes at the [Type] level *)
+(*
+Inductive EmptyT: Type :=.
+Inductive UnitT : Type := IT : UnitT.
+*)
+
+Notation EmptyT := False (only parsing).
+Notation UnitT := unit (only parsing).
+Notation IT := tt.
+].
+Definition notT := [A:Type] A->EmptyT.
+
+V7only [
+(** Have you an idea of what means [identityT A a b]? No matter! *)
+
+(*
+Inductive identityT [A:Type; a:A] : A -> Type :=
+     refl_identityT : (identityT A a a).
+*)
+
+Notation identityT := identity (only parsing).
+Notation refl_identityT := refl_identity (only parsing).
+
+Notation "< A > x === y" := (!identityT A x y)
+   (A annot, at level 1, x at level 0, only parsing) : type_scope.
+
+Notation "x === y" := (identityT ? x y)
+  (at level 5, no associativity, only parsing) : type_scope.
+
+(*
+Hints Resolve refl_identityT : core v62.
+*)
+].
+Section identity_is_a_congruence.
+
+ Variables A,B : Type.
+ Variable  f : A->B.
+
+ Variable x,y,z : A.
+ 
+ Lemma sym_id : (identityT ? x y) -> (identityT ? y x).
+ Proof.
+  NewDestruct 1; Trivial.
+ Qed.
+
+ Lemma trans_id : (identityT ? x y) -> (identityT ? y z) -> (identityT ? x z).
+ Proof.
+  NewDestruct 2; Trivial.
+ Qed.
+
+ Lemma congr_id : (identityT ? x y)->(identityT ? (f x) (f y)).
+ Proof.
+  NewDestruct 1; Trivial.
+ Qed.
+
+ Lemma sym_not_id : (notT (identityT ? x y)) -> (notT (identityT ? y x)).
+ Proof.
+  Red; Intros H H'; Apply H; NewDestruct H'; Trivial.
+ Qed.
+
+End identity_is_a_congruence.
+
+Definition identity_ind_r :
+     (A:Type)
+        (a:A)
+         (P:A->Prop)
+          (P a)->(y:A)(identityT ? y a)->(P y).
+ Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+Defined.
+
+Definition identity_rec_r :      
+     (A:Type)
+        (a:A)
+         (P:A->Set)
+          (P a)->(y:A)(identityT ? y a)->(P y).
+ Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+Defined.
+
+Definition identity_rect_r :      
+     (A:Type)
+        (a:A)
+         (P:A->Type)
+          (P a)->(y:A)(identityT ? y a)->(P y).
+ Intros A x P H y H0; Case sym_id with 1:= H0; Trivial.
+Defined.
+
+V7only [
+Notation sym_idT  := sym_id (only parsing).
+Notation trans_idT  := trans_id (only parsing).
+Notation congr_idT  := congr_id (only parsing).
+Notation sym_not_idT  := sym_not_id (only parsing).
+Notation identityT_ind_r := identity_ind_r (only parsing).
+Notation identityT_rec_r  := identity_rec_r (only parsing).
+Notation identityT_rect_r := identity_rect_r (only parsing).
+].
+Inductive prodT [A,B:Type] : Type := pairT : A -> B -> (prodT A B).
+
+Section prodT_proj.
+
+  Variables A, B : Type.
+
+  Definition fstT := [H:(prodT A B)]Cases H of (pairT x _) => x end.
+  Definition sndT := [H:(prodT A B)]Cases H of (pairT _ y) => y end.
+
+End prodT_proj.
+
+Definition prodT_uncurry : (A,B,C:Type)((prodT A B)->C)->A->B->C :=
+  [A,B,C:Type; f:((prodT A B)->C); x:A; y:B]
+  (f (pairT A B x y)).
+
+Definition prodT_curry : (A,B,C:Type)(A->B->C)->(prodT A B)->C :=
+  [A,B,C:Type; f:(A->B->C); p:(prodT A B)]
+  Cases p of
+  | (pairT x y) => (f x y)
+  end.
+
+Hints Immediate sym_id sym_not_id : core v62.
+
+V7only [
+Implicits fstT [1 2].
+Implicits sndT [1 2].
+Implicits pairT [1 2].
+].
diff --git a/theories7/Init/Notations.v b/theories7/Init/Notations.v
new file mode 100644
index 00000000..34bfcbfa
--- /dev/null
+++ b/theories7/Init/Notations.v
@@ -0,0 +1,94 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Notations.v,v 1.5.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+(** These are the notations whose level and associativity is imposed by Coq *)
+
+(** Notations for logical connectives *)
+
+Uninterpreted Notation "x <-> y" (at level 8, right associativity)
+  V8only (at level 95, no associativity).
+Uninterpreted Notation "x /\ y" (at level 6, right associativity) 
+  V8only (at level 80, right associativity).
+Uninterpreted Notation "x \/ y" (at level 7, right associativity)
+  V8only (at level 85, right associativity).
+Uninterpreted Notation "~ x" (at level 5, right associativity)
+  V8only (at level 75, right associativity).
+
+(** Notations for equality and inequalities *)
+
+Uninterpreted Notation "x = y  :> T" 
+  (at level 5, y at next level, no associativity).
+Uninterpreted Notation "x = y"
+  (at level 5, no associativity).
+Uninterpreted Notation "x = y = z"
+  (at level 5, no associativity, y at next level).
+
+Uninterpreted Notation "x <> y  :> T" 
+  (at level 5, y at next level, no associativity).
+Uninterpreted Notation "x <> y"
+  (at level 5, no associativity).
+
+Uninterpreted V8Notation "x <= y" (at level 70, no associativity).
+Uninterpreted V8Notation "x < y" (at level 70, no associativity).
+Uninterpreted V8Notation "x >= y" (at level 70, no associativity).
+Uninterpreted V8Notation "x > y" (at level 70, no associativity).
+
+Uninterpreted V8Notation "x <= y <= z" (at level 70, y at next level).
+Uninterpreted V8Notation "x <= y < z"  (at level 70, y at next level).
+Uninterpreted V8Notation "x < y < z"   (at level 70, y at next level).
+Uninterpreted V8Notation "x < y <= z"  (at level 70, y at next level).
+
+(** Arithmetical notations (also used for type constructors) *)
+
+Uninterpreted Notation "x + y" (at level 4, left associativity).
+Uninterpreted V8Notation "x - y" (at level 50, left associativity).
+Uninterpreted Notation "x * y" (at level 3, right associativity)
+  V8only (at level 40, left associativity).
+Uninterpreted V8Notation "x / y" (at level 40, left associativity).
+Uninterpreted V8Notation "- x" (at level 35, right associativity).
+Uninterpreted V8Notation "/ x" (at level 35, right associativity).
+Uninterpreted V8Notation "x ^ y" (at level 30, right associativity).
+
+(** Notations for pairs *)
+
+V7only [Uninterpreted Notation "( x , y )" (at level 0) V8only.].
+Uninterpreted V8Notation "( x , y , .. , z )" (at level 0).
+
+(** Notation "{ x }" is reserved and has a special status as component
+    of other notations; it is at level 1 to factor with {x:A|P} etc *)
+
+Uninterpreted Notation "{ x }" (at level 1)
+  V8only (at level 0, x at level 99).
+
+(** Notations for sum-types *)
+
+Uninterpreted Notation "{ A }  + { B }" (at level 4, left associativity)
+  V8only (at level 50, left associativity).
+
+Uninterpreted Notation "A + { B }" (at level 4, left associativity)
+  V8only (at level 50, left associativity).
+
+(** Notations for sigma-types or subsets *)
+
+Uninterpreted Notation "{ x : A  |  P }" (at level 1)
+  V8only (at level 0, x at level 99).
+Uninterpreted Notation "{ x : A  |  P  &  Q }" (at level 1)
+  V8only (at level 0, x at level 99).
+
+Uninterpreted Notation "{ x : A  &  P }" (at level 1)
+  V8only (at level 0, x at level 99).
+Uninterpreted Notation "{ x : A  &  P  &  Q }" (at level 1)
+  V8only (at level 0, x at level 99).
+
+Delimits Scope type_scope with type.
+Delimits Scope core_scope with core.
+
+Open Scope core_scope.
+Open Scope type_scope.
diff --git a/theories7/Init/Peano.v b/theories7/Init/Peano.v
new file mode 100755
index 00000000..72d19399
--- /dev/null
+++ b/theories7/Init/Peano.v
@@ -0,0 +1,218 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Peano.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+(** Natural numbers [nat] built from [O] and [S] are defined in Datatypes.v *)
+
+(** This module defines the following operations on natural numbers :
+    - predecessor [pred]
+    - addition [plus]
+    - multiplication [mult]
+    - less or equal order [le]
+    - less [lt]
+    - greater or equal [ge]
+    - greater [gt]
+
+   This module states various lemmas and theorems about natural numbers,
+   including Peano's axioms of arithmetic (in Coq, these are in fact provable)
+   Case analysis on [nat] and induction on [nat * nat] are provided too *)
+
+Require Notations.
+Require Datatypes.
+Require Logic.
+
+Open Scope nat_scope.
+
+Definition eq_S := (f_equal nat nat S).
+
+Hint eq_S : v62 := Resolve (f_equal nat nat S).
+Hint eq_nat_unary : core := Resolve (f_equal nat).
+
+(** The predecessor function *)
+
+Definition pred : nat->nat := [n:nat](Cases n of O => O | (S u) => u end).
+Hint eq_pred : v62 := Resolve (f_equal nat nat pred).
+
+Theorem pred_Sn : (m:nat) m=(pred (S m)).
+Proof.
+  Auto.
+Qed.
+
+Theorem eq_add_S : (n,m:nat) (S n)=(S m) -> n=m.
+Proof.
+  Intros n m H ; Change (pred (S n))=(pred (S m)); Auto.
+Qed.
+
+Hints Immediate eq_add_S : core v62.
+
+(** A consequence of the previous axioms *)
+
+Theorem not_eq_S : (n,m:nat) ~(n=m) -> ~((S n)=(S m)).
+Proof.
+  Red; Auto.
+Qed.
+Hints Resolve not_eq_S : core v62.
+
+Definition IsSucc : nat->Prop
+  := [n:nat]Cases n of O => False | (S p) => True end.
+
+
+Theorem O_S : (n:nat)~(O=(S n)).
+Proof.
+  Red;Intros n H.
+  Change (IsSucc O).
+  Rewrite <- (sym_eq nat O (S n));[Exact I | Assumption].
+Qed.
+Hints Resolve O_S : core v62.
+
+Theorem n_Sn : (n:nat) ~(n=(S n)).
+Proof.
+  NewInduction n ; Auto.
+Qed.
+Hints Resolve n_Sn : core v62.
+
+(** Addition *)
+
+Fixpoint plus [n:nat] : nat -> nat := 
+   [m:nat]Cases n of 
+      O   => m 
+  | (S p) => (S (plus p m)) end.
+Hint eq_plus : v62 := Resolve (f_equal2 nat nat nat plus).
+Hint eq_nat_binary : core := Resolve (f_equal2 nat nat).
+
+V8Infix "+" plus : nat_scope.
+
+Lemma plus_n_O : (n:nat) n=(plus n O).
+Proof.
+  NewInduction n ; Simpl ; Auto.
+Qed.
+Hints Resolve plus_n_O : core v62.
+
+Lemma plus_O_n : (n:nat) (plus O n)=n.
+Proof.
+  Auto.
+Qed.
+
+Lemma plus_n_Sm : (n,m:nat) (S (plus n m))=(plus n (S m)).
+Proof.
+  Intros n m; NewInduction n; Simpl; Auto.
+Qed.
+Hints Resolve plus_n_Sm : core v62.
+
+Lemma plus_Sn_m : (n,m:nat)(plus (S n) m)=(S (plus n m)).
+Proof.
+  Auto.
+Qed.
+
+(** Multiplication *)
+
+Fixpoint  mult [n:nat] : nat -> nat := 
+   [m:nat]Cases n of O => O 
+               | (S p) => (plus m (mult p m)) end.
+Hint eq_mult : core v62 := Resolve (f_equal2 nat nat nat mult).
+
+V8Infix "*" mult : nat_scope.
+
+Lemma mult_n_O : (n:nat) O=(mult n O).
+Proof.
+  NewInduction n; Simpl; Auto.
+Qed.
+Hints Resolve mult_n_O : core v62.
+
+Lemma mult_n_Sm : (n,m:nat) (plus (mult n m) n)=(mult n (S m)).
+Proof.
+  Intros; NewInduction n as [|p H]; Simpl; Auto.
+  NewDestruct H; Rewrite <- plus_n_Sm; Apply (f_equal nat nat S).
+  Pattern 1 3 m; Elim m; Simpl; Auto.
+Qed.
+Hints Resolve mult_n_Sm : core v62.
+
+(** Definition of subtraction on [nat] : [m-n] is [0] if [n>=m] *)
+
+Fixpoint minus [n:nat] : nat -> nat := 
+  [m:nat]Cases n m of
+            O    _     =>  O
+         | (S k) O     => (S k)
+         | (S k) (S l) => (minus k l)
+        end. 
+
+V8Infix "-" minus : nat_scope.
+
+(** Definition of the usual orders, the basic properties of [le] and [lt] 
+    can be found in files Le and Lt *)
+
+(** An inductive definition to define the order *)
+
+Inductive le [n:nat] : nat -> Prop
+    := le_n : (le n n)
+     | le_S : (m:nat)(le n m)->(le n (S m)).
+
+V8Infix "<=" le : nat_scope.
+
+Hint constr_le : core v62 := Constructors le.
+(*i equivalent to : "Hints Resolve le_n le_S : core v62." i*)
+
+Definition lt := [n,m:nat](le (S n) m).
+Hints Unfold lt : core v62.
+
+V8Infix "<" lt : nat_scope.
+
+Definition ge := [n,m:nat](le m n).
+Hints Unfold ge : core v62.
+
+V8Infix ">=" ge : nat_scope.
+
+Definition gt := [n,m:nat](lt m n).
+Hints Unfold gt : core v62.
+
+V8Infix ">" gt : nat_scope.
+
+V8Notation "x <= y <= z" := (le x y)/\(le y z) : nat_scope.
+V8Notation "x <= y < z"  := (le x y)/\(lt y z) : nat_scope.
+V8Notation "x < y < z"   := (lt x y)/\(lt y z) : nat_scope.
+V8Notation "x < y <= z"  := (lt x y)/\(le y z) : nat_scope.
+
+(** Pattern-Matching on natural numbers *)
+
+Theorem nat_case : (n:nat)(P:nat->Prop)(P O)->((m:nat)(P (S m)))->(P n).
+Proof.
+  NewInduction n ; Auto.
+Qed.
+
+(** Principle of double induction *)
+
+Theorem nat_double_ind : (R:nat->nat->Prop)
+     ((n:nat)(R O n)) -> ((n:nat)(R (S n) O))
+     -> ((n,m:nat)(R n m)->(R (S n) (S m)))
+     -> (n,m:nat)(R n m).
+Proof.
+  NewInduction n; Auto.
+  NewDestruct m; Auto.
+Qed.
+
+(** Notations *)
+V7only[
+Syntax constr
+  level 0:
+    S [ (S $p) ] -> [$p:"nat_printer":9]
+  | O [ O ]      -> ["(0)"].
+].
+
+V7only [
+(* For parsing/printing based on scopes *)
+Module nat_scope.
+Infix 4 "+" plus : nat_scope.
+Infix 3 "*" mult : nat_scope.
+Infix 4 "-" minus : nat_scope.
+Infix NONA 5 "<=" le : nat_scope.
+Infix NONA 5 "<" lt : nat_scope.
+Infix NONA 5 ">=" ge : nat_scope.
+Infix NONA 5 ">" gt : nat_scope.
+End nat_scope.
+].
diff --git a/theories7/Init/Prelude.v b/theories7/Init/Prelude.v
new file mode 100755
index 00000000..2752f462
--- /dev/null
+++ b/theories7/Init/Prelude.v
@@ -0,0 +1,16 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Prelude.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+Require Export Notations.
+Require Export Logic.
+Require Export Datatypes.
+Require Export Specif.
+Require Export Peano.
+Require Export Wf.
diff --git a/theories7/Init/Specif.v b/theories7/Init/Specif.v
new file mode 100755
index 00000000..c39e5ed8
--- /dev/null
+++ b/theories7/Init/Specif.v
@@ -0,0 +1,204 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Specif.v,v 1.2.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+Set Implicit Arguments.
+V7only [Unset Implicit Arguments.].
+
+(** Basic specifications : Sets containing logical information *)
+
+Require Notations.
+Require Datatypes.
+Require Logic.
+
+(** Subsets *)
+
+(** [(sig A P)], or more suggestively [{x:A | (P x)}], denotes the subset 
+    of elements of the Set [A] which satisfy the predicate [P].
+    Similarly [(sig2 A P Q)], or [{x:A | (P x) & (Q x)}], denotes the subset 
+    of elements of the Set [A] which satisfy both [P] and [Q]. *)
+
+Inductive sig [A:Set;P:A->Prop] : Set
+    := exist : (x:A)(P x) -> (sig A P).
+
+Inductive sig2 [A:Set;P,Q:A->Prop] : Set
+    := exist2 : (x:A)(P x) -> (Q x) -> (sig2 A P Q).
+
+(** [(sigS A P)], or more suggestively [{x:A & (P x)}], is a subtle variant
+    of subset where [P] is now of type [Set].
+    Similarly for [(sigS2 A P Q)], also written [{x:A & (P x) & (Q x)}]. *)
+     
+Inductive sigS [A:Set;P:A->Set] : Set
+    := existS : (x:A)(P x) -> (sigS A P).
+
+Inductive sigS2 [A:Set;P,Q:A->Set] : Set
+    := existS2 : (x:A)(P x) -> (Q x) -> (sigS2 A P Q).
+
+Arguments Scope sig [type_scope type_scope].
+Arguments Scope sig2 [type_scope type_scope type_scope].
+Arguments Scope sigS [type_scope type_scope].
+Arguments Scope sigS2 [type_scope type_scope type_scope].
+
+Notation "{ x : A  |  P }" := (sig A [x:A]P) : type_scope.
+Notation "{ x : A  |  P  &  Q }" := (sig2 A [x:A]P [x:A]Q) : type_scope.
+Notation "{ x : A  &  P }" := (sigS A [x:A]P) : type_scope.
+Notation "{ x : A  &  P  &  Q }" := (sigS2 A [x:A]P [x:A]Q) : type_scope.
+
+Add Printing Let sig.
+Add Printing Let sig2.
+Add Printing Let sigS.
+Add Printing Let sigS2.
+
+
+(** Projections of sig *)
+
+Section Subset_projections.
+
+  Variable A:Set.
+  Variable P:A->Prop.
+
+  Definition proj1_sig :=
+   [e:(sig A P)]Cases e of (exist a b) => a  end.
+
+  Definition proj2_sig :=
+   [e:(sig A P)]
+     <[e:(sig A P)](P (proj1_sig e))>Cases e of (exist a b) => b  end.
+
+End Subset_projections.
+
+
+(** Projections of sigS *)
+
+Section Projections.
+
+  Variable A:Set.
+  Variable P:A->Set.
+
+ (** 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 [(projS1 y)] is the witness [a]
+     and [(projS2 y)] is the proof of [(P a)] *)
+
+  Definition projS1 : (sigS A P) -> A
+           := [x:(sigS A P)]Cases x of (existS a _) => a end.
+  Definition projS2 : (x:(sigS A P))(P (projS1 x))
+           := [x:(sigS A P)]<[x:(sigS A P)](P (projS1 x))> 
+                  Cases x of (existS _ h) => h end.
+
+End Projections.
+
+
+(** Extended_booleans *)
+
+Inductive sumbool [A,B:Prop] : Set
+    := left  : A -> {A}+{B}
+     | right : B -> {A}+{B}
+
+where "{ A } + { B }" := (sumbool A B) : type_scope.
+
+Inductive sumor [A:Set;B:Prop] : Set
+    := inleft  : A -> A+{B}
+     | inright : B -> A+{B}
+
+where "A + { B }" := (sumor A B) : type_scope.
+
+(** Choice *)
+
+Section Choice_lemmas.
+
+  (** The following lemmas state various forms of the axiom of choice *)
+
+  Variables S,S':Set.
+  Variable R:S->S'->Prop.
+  Variable R':S->S'->Set.
+  Variables R1,R2 :S->Prop.
+
+  Lemma Choice : ((x:S)(sig ? [y:S'](R x y))) ->
+                     (sig ? [f:S->S'](z:S)(R z (f z))).
+  Proof.
+   Intro H.
+   Exists [z:S]Cases (H z) of (exist y _) => y end.
+   Intro z; NewDestruct (H z); Trivial.
+  Qed.
+
+  Lemma Choice2 : ((x:S)(sigS ? [y:S'](R' x y))) ->
+                     (sigS ? [f:S->S'](z:S)(R' z (f z))).
+  Proof.
+    Intro H.
+    Exists [z:S]Cases (H z) of (existS y _) => y end.
+    Intro z; NewDestruct (H z); Trivial.
+  Qed.
+
+  Lemma bool_choice : 
+    ((x:S)(sumbool (R1 x) (R2 x))) ->
+    (sig ? [f:S->bool] (x:S)( ((f x)=true  /\ (R1 x)) 
+                           \/ ((f x)=false /\ (R2 x)))).
+  Proof.
+    Intro H.
+    Exists [z:S]Cases (H z) of (left _) => true | (right _) => false end.
+    Intro z; NewDestruct (H z); Auto.
+  Qed.
+
+End Choice_lemmas.
+
+ (** A result of type [(Exc A)] is either a normal value of type [A] or 
+     an [error] :
+     [Inductive Exc [A:Set] : Set := value : A->(Exc A) | error : (Exc A)]
+     it is implemented using the option type. *) 
+
+Definition Exc := option.
+Definition value := Some.
+Definition error := !None.
+
+Implicits error [1].
+
+Definition except := False_rec. (* for compatibility with previous versions *)
+
+Implicits except [1].
+
+V7only [
+Notation Except := (!except ?) (only parsing).
+Notation Error := (!error ?) (only parsing).
+V7only [Implicits error [].].
+V7only [Implicits except [].].
+].
+Theorem absurd_set : (A:Prop)(C:Set)A->(~A)->C.
+Proof.
+  Intros A C h1 h2.
+  Apply False_rec.
+  Apply (h2 h1).
+Qed.
+
+Hints Resolve left right inleft inright : core v62.
+
+(** Sigma Type at Type level [sigT] *)
+
+Inductive sigT [A:Type;P:A->Type] : Type
+    := existT : (x:A)(P x) -> (sigT A P).
+
+Section projections_sigT.
+
+  Variable A:Type.
+  Variable P:A->Type.
+
+  Definition projT1 : (sigT A P) -> A
+              := [H:(sigT A P)]Cases H of (existT x _) => x end.
+   
+  Definition projT2 : (x:(sigT A P))(P (projT1 x))
+              := [H:(sigT A P)]<[H:(sigT A P)](P (projT1 H))> 
+                     Cases H of (existT x h) => h end.
+
+End projections_sigT.
+
+V7only [
+Notation ProjS1 := (projS1 ? ?).
+Notation ProjS2 := (projS2 ? ?).
+Notation Value := (value ?).
+].
+
diff --git a/theories7/Init/Wf.v b/theories7/Init/Wf.v
new file mode 100755
index 00000000..b65057eb
--- /dev/null
+++ b/theories7/Init/Wf.v
@@ -0,0 +1,158 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+Set Implicit Arguments.
+V7only [Unset Implicit Arguments.].
+
+(*i $Id: Wf.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $ i*)
+
+(** This module proves the validity of
+    - well-founded recursion (also called course of values)
+    - well-founded induction
+
+   from a well-founded ordering on a given set *)
+
+Require Notations.
+Require Logic.
+Require Datatypes.
+
+(** Well-founded induction principle on Prop *)
+
+Chapter Well_founded.
+
+ Variable A : Set.
+ Variable R : A -> A -> Prop.
+
+ (** The accessibility predicate is defined to be non-informative *)
+
+ Inductive  Acc : A -> Prop 
+    := Acc_intro : (x:A)((y:A)(R y x)->(Acc y))->(Acc x).
+
+ Lemma Acc_inv : (x:A)(Acc x) -> (y:A)(R y x) -> (Acc y).
+  NewDestruct 1; Trivial.
+ Defined.
+
+  (** the informative elimination :
+     [let Acc_rec F = let rec wf x = F x wf in wf] *)
+
+ Section AccRecType.
+  Variable P : A -> Type.
+  Variable F : (x:A)((y:A)(R y x)->(Acc y))->((y:A)(R y x)->(P y))->(P x).
+
+  Fixpoint Acc_rect [x:A;a:(Acc x)] : (P x)
+     := (F x (Acc_inv x a) ([y:A][h:(R y x)](Acc_rect y (Acc_inv x a y h)))).
+
+ End AccRecType.
+
+ Definition Acc_rec [P:A->Set] := (Acc_rect P).
+
+ (** A simplified version of Acc_rec(t) *)
+
+ Section AccIter.
+  Variable P : A -> Type. 
+  Variable F : (x:A)((y:A)(R y x)-> (P y))->(P x).
+
+  Fixpoint Acc_iter [x:A;a:(Acc x)] : (P x)
+     := (F x ([y:A][h:(R y x)](Acc_iter y (Acc_inv x a y h)))).
+
+ End AccIter.
+
+ (** A relation is well-founded if every element is accessible *)
+
+ Definition well_founded := (a:A)(Acc a).
+
+ (** well-founded induction on Set and Prop *)
+
+ Hypothesis Rwf : well_founded.
+
+ Theorem well_founded_induction_type : 
+        (P:A->Type)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ Proof.
+  Intros; Apply (Acc_iter P); Auto.
+ Defined.
+
+ Theorem well_founded_induction :
+        (P:A->Set)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ Proof.
+  Exact [P:A->Set](well_founded_induction_type P).
+ Defined.
+
+ Theorem well_founded_ind : 
+         (P:A->Prop)((x:A)((y:A)(R y x)->(P y))->(P x))->(a:A)(P a).
+ Proof.
+  Exact [P:A->Prop](well_founded_induction_type P).
+ Defined.
+
+(** Building fixpoints  *) 
+
+Section FixPoint.
+
+Variable P : A -> Set.
+Variable F : (x:A)((y:A)(R y x)->(P y))->(P x).
+
+Fixpoint Fix_F [x:A;r:(Acc x)] : (P x) := 
+         (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p))).
+
+Definition fix := [x:A](Fix_F x (Rwf x)).
+
+(** Proof that [well_founded_induction] satisfies the fixpoint equation. 
+    It requires an extra property of the functional *)
+
+Hypothesis F_ext : 
+  (x:A)(f,g:(y:A)(R y x)->(P y))
+  ((y:A)(p:(R y x))((f y p)=(g y p)))->(F x f)=(F x g).
+
+Scheme Acc_inv_dep := Induction for Acc Sort Prop.
+
+Lemma Fix_F_eq
+  : (x:A)(r:(Acc x))
+    (F x [y:A][p:(R y x)](Fix_F y (Acc_inv x r y p)))=(Fix_F x r).
+NewDestruct r using  Acc_inv_dep; Auto.
+Qed.
+
+Lemma Fix_F_inv : (x:A)(r,s:(Acc x))(Fix_F x r)=(Fix_F x s).
+Intro x; NewInduction (Rwf x); Intros.
+Rewrite <- (Fix_F_eq x r); Rewrite <- (Fix_F_eq x s); Intros.
+Apply F_ext; Auto.
+Qed.
+
+
+Lemma Fix_eq : (x:A)(fix x)=(F x [y:A][p:(R y x)](fix y)).
+Intro x; Unfold fix.
+Rewrite <- (Fix_F_eq x).
+Apply F_ext; Intros.
+Apply Fix_F_inv.
+Qed.
+
+End FixPoint.
+
+End Well_founded. 
+
+(** A recursor over pairs *)
+
+Chapter Well_founded_2.
+
+  Variable A,B : Set.
+  Variable R : A * B -> A * B -> Prop.
+
+  Variable P : A -> B -> Type. 
+  Variable F : (x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))-> (P y y'))->(P x x').
+
+  Fixpoint Acc_iter_2 [x:A;x':B;a:(Acc ? R (x,x'))] : (P x x')
+     := (F x x' ([y:A][y':B][h:(R (y,y') (x,x'))](Acc_iter_2 y y' (Acc_inv ? ? (x,x') a (y,y') h)))).
+
+  Hypothesis Rwf : (well_founded ? R).
+
+  Theorem well_founded_induction_type_2 : 
+     ((x:A)(x':B)((y:A)(y':B)(R (y,y') (x,x'))->(P y y'))->(P x x'))->(a:A)(b:B)(P a b).
+  Proof.
+   Intros; Apply Acc_iter_2; Auto.
+  Defined.
+
+End Well_founded_2.
+
diff --git a/theories7/IntMap/Adalloc.v b/theories7/IntMap/Adalloc.v
new file mode 100644
index 00000000..9e8dd1b3
--- /dev/null
+++ b/theories7/IntMap/Adalloc.v
@@ -0,0 +1,339 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Adalloc.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Arith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Fset.
+
+Section AdAlloc.
+
+  Variable A : Set.
+
+  Definition nat_of_ad := [a:ad] Cases a of
+                                     ad_z => O
+				   | (ad_x p) => (convert p)
+			         end.
+
+  Fixpoint nat_le [m:nat] : nat -> bool :=
+    Cases m of
+        O => [_:nat] true
+      | (S m') => [n:nat] Cases n of
+                              O => false
+			    | (S n') => (nat_le m' n')
+			  end
+    end.
+
+  Lemma nat_le_correct : (m,n:nat) (le m n) -> (nat_le m n)=true.
+  Proof.
+    NewInduction m as [|m IHm]. Trivial.
+    NewDestruct n. Intro H. Elim (le_Sn_O ? H).
+    Intros. Simpl. Apply IHm. Apply le_S_n. Assumption.
+  Qed.
+
+  Lemma nat_le_complete : (m,n:nat) (nat_le m n)=true -> (le m n).
+  Proof.
+    NewInduction m. Trivial with arith.
+    NewDestruct n. Intro H. Discriminate H.
+    Auto with arith.
+  Qed.
+
+  Lemma nat_le_correct_conv : (m,n:nat) (lt m n) -> (nat_le n m)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (nat_le n m)). Intro H0.
+    Elim (lt_n_n ? (lt_le_trans ? ? ? H (nat_le_complete ? ? H0))).
+    Trivial.
+  Qed.
+
+  Lemma nat_le_complete_conv : (m,n:nat) (nat_le n m)=false -> (lt m n).
+  Proof.
+    Intros. Elim (le_or_lt n m). Intro. Conditional Trivial Rewrite nat_le_correct in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Definition ad_of_nat := [n:nat] Cases n of
+                                      O => ad_z
+				    | (S n') => (ad_x (anti_convert n'))
+				  end.
+
+  Lemma ad_of_nat_of_ad : (a:ad) (ad_of_nat (nat_of_ad a))=a.
+  Proof.
+    NewDestruct a as [|p]. Reflexivity.
+    Simpl. Elim (ZL4 p). Intros n H. Rewrite H. Simpl. Rewrite <- bij1 in H.
+    Rewrite convert_intro with 1:=H. Reflexivity.
+  Qed.
+
+  Lemma nat_of_ad_of_nat : (n:nat) (nat_of_ad (ad_of_nat n))=n.
+  Proof.
+    NewInduction n. Trivial.
+    Intros. Simpl. Apply bij1.
+  Qed.
+
+  Definition ad_le := [a,b:ad] (nat_le (nat_of_ad a) (nat_of_ad b)).
+
+  Lemma ad_le_refl : (a:ad) (ad_le a a)=true.
+  Proof.
+    Intro. Unfold ad_le. Apply nat_le_correct. Apply le_n.
+  Qed.
+
+  Lemma ad_le_antisym : (a,b:ad) (ad_le a b)=true -> (ad_le b a)=true -> a=b.
+  Proof.
+    Unfold ad_le. Intros. Rewrite <- (ad_of_nat_of_ad a). Rewrite <- (ad_of_nat_of_ad b).
+    Rewrite (le_antisym ? ? (nat_le_complete ? ? H) (nat_le_complete ? ? H0)). Reflexivity.
+  Qed.
+
+  Lemma ad_le_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le b c)=true -> 
+      (ad_le a c)=true.
+  Proof.
+    Unfold ad_le. Intros. Apply nat_le_correct. Apply le_trans with m:=(nat_of_ad b).
+    Apply nat_le_complete. Assumption.
+    Apply nat_le_complete. Assumption.
+  Qed.
+
+  Lemma ad_le_lt_trans : (a,b,c:ad) (ad_le a b)=true -> (ad_le c b)=false -> 
+      (ad_le c a)=false.
+  Proof.
+    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply le_lt_trans with m:=(nat_of_ad b).
+    Apply nat_le_complete. Assumption.
+    Apply nat_le_complete_conv. Assumption.
+  Qed.
+
+  Lemma ad_lt_le_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le b c)=true -> 
+      (ad_le c a)=false.
+  Proof.
+    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_le_trans with m:=(nat_of_ad b).
+    Apply nat_le_complete_conv. Assumption.
+    Apply nat_le_complete. Assumption.
+  Qed.
+
+  Lemma ad_lt_trans : (a,b,c:ad) (ad_le b a)=false -> (ad_le c b)=false -> 
+      (ad_le c a)=false.
+  Proof.
+    Unfold ad_le. Intros. Apply nat_le_correct_conv. Apply lt_trans with m:=(nat_of_ad b).
+    Apply nat_le_complete_conv. Assumption.
+    Apply nat_le_complete_conv. Assumption.
+  Qed.
+
+  Lemma ad_lt_le_weak : (a,b:ad) (ad_le b a)=false -> (ad_le a b)=true.
+  Proof.
+    Unfold ad_le. Intros. Apply nat_le_correct. Apply lt_le_weak.
+    Apply nat_le_complete_conv. Assumption.
+  Qed.
+
+  Definition ad_min := [a,b:ad] if (ad_le a b) then a else b.
+
+  Lemma ad_min_choice : (a,b:ad) {(ad_min a b)=a}+{(ad_min a b)=b}.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Left . Rewrite H.
+    Reflexivity.
+    Intro H. Right . Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma ad_min_le_1 : (a,b:ad) (ad_le (ad_min a b) a)=true.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H.
+    Apply ad_le_refl.
+    Intro H. Rewrite H. Apply ad_lt_le_weak. Assumption.
+  Qed.
+
+  Lemma ad_min_le_2 : (a,b:ad) (ad_le (ad_min a b) b)=true.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H. Rewrite H. Assumption.
+    Intro H. Rewrite H. Apply ad_le_refl.
+  Qed.
+
+  Lemma ad_min_le_3 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a b)=true.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
+    Assumption.
+    Intro H0. Rewrite H0 in H. Apply ad_lt_le_weak. Apply ad_le_lt_trans with b:=c; Assumption.
+  Qed.
+
+  Lemma ad_min_le_4 : (a,b,c:ad) (ad_le a (ad_min b c))=true -> (ad_le a c)=true.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
+    Apply ad_le_trans with b:=b; Assumption.
+    Intro H0. Rewrite H0 in H. Assumption.
+  Qed.
+
+  Lemma ad_min_le_5 : (a,b,c:ad) (ad_le a b)=true -> (ad_le a c)=true ->
+      (ad_le a (ad_min b c))=true.
+  Proof.
+    Intros. Elim (ad_min_choice b c). Intro H1. Rewrite H1. Assumption.
+    Intro H1. Rewrite H1. Assumption.
+  Qed.
+
+  Lemma ad_min_lt_3 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le b a)=false.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
+    Assumption.
+    Intro H0. Rewrite H0 in H. Apply ad_lt_trans with b:=c; Assumption.
+  Qed.
+
+  Lemma ad_min_lt_4 : (a,b,c:ad) (ad_le (ad_min b c) a)=false -> (ad_le c a)=false.
+  Proof.
+    Unfold ad_min. Intros. Elim (sumbool_of_bool (ad_le b c)). Intro H0. Rewrite H0 in H.
+    Apply ad_lt_le_trans with b:=b; Assumption.
+    Intro H0. Rewrite H0 in H. Assumption.
+  Qed.
+
+  (** Allocator: returns an address not in the domain of [m].
+  This allocator is optimal in that it returns the lowest possible address,
+  in the usual ordering on integers. It is not the most efficient, however. *)
+  Fixpoint ad_alloc_opt [m:(Map A)] : ad :=
+    Cases m of
+        M0 => ad_z
+      | (M1 a _) => if (ad_eq a ad_z)
+                    then (ad_x xH)
+		    else ad_z
+      | (M2 m1 m2) => (ad_min (ad_double (ad_alloc_opt m1))
+                              (ad_double_plus_un (ad_alloc_opt m2)))
+    end.
+
+  Lemma ad_alloc_opt_allocates_1 : (m:(Map A)) (MapGet A m (ad_alloc_opt m))=(NONE A).
+  Proof.
+    NewInduction m as [|a|m0 H m1 H0]. Reflexivity.
+    Simpl. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H. Rewrite H.
+    Rewrite (ad_eq_complete ? ? H). Reflexivity.
+    Intro H. Rewrite H. Rewrite H. Reflexivity.
+    Intros. Change (ad_alloc_opt (M2 A m0 m1)) with
+         (ad_min (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
+    Elim (ad_min_choice (ad_double (ad_alloc_opt m0)) (ad_double_plus_un (ad_alloc_opt m1))).
+    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
+    Apply ad_double_bit_0.
+    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
+    Apply ad_double_plus_un_bit_0.
+  Qed.
+
+  Lemma ad_alloc_opt_allocates : (m:(Map A)) (in_dom A (ad_alloc_opt m) m)=false.
+  Proof.
+    Unfold in_dom. Intro. Rewrite (ad_alloc_opt_allocates_1 m). Reflexivity.
+  Qed.
+
+  (** Moreover, this is optimal: all addresses below [(ad_alloc_opt m)]
+      are in [dom m]: *)
+
+  Lemma nat_of_ad_double : (a:ad) (nat_of_ad (ad_double a))=(mult (2) (nat_of_ad a)).
+  Proof.
+    NewDestruct a as [|p]. Trivial.
+    Exact (convert_xO p).
+  Qed.
+
+  Lemma nat_of_ad_double_plus_un : (a:ad)
+      (nat_of_ad (ad_double_plus_un a))=(S (mult (2) (nat_of_ad a))).
+  Proof.
+    NewDestruct a as [|p]. Trivial.
+    Exact (convert_xI p).
+  Qed.
+
+  Lemma ad_le_double_mono : (a,b:ad) (ad_le a b)=true -> 
+      (ad_le (ad_double a) (ad_double b))=true.
+  Proof.
+    Unfold ad_le. Intros. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Apply nat_le_correct.
+    Simpl. Apply le_plus_plus. Apply nat_le_complete. Assumption.
+    Apply le_plus_plus. Apply nat_le_complete. Assumption.
+    Apply le_n.
+  Qed.
+
+  Lemma ad_le_double_plus_un_mono : (a,b:ad) (ad_le a b)=true ->
+      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true.
+  Proof.
+    Unfold ad_le. Intros. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
+    Apply nat_le_correct. Apply le_n_S. Simpl. Apply le_plus_plus. Apply nat_le_complete.
+    Assumption.
+    Apply le_plus_plus. Apply nat_le_complete. Assumption.
+    Apply le_n.
+  Qed.
+
+  Lemma ad_le_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=true ->
+      (ad_le a b)=true.
+  Proof.
+    Unfold ad_le. Intros a b. Rewrite nat_of_ad_double. Rewrite nat_of_ad_double. Intro.
+    Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply nat_le_complete. Assumption.
+  Qed.
+
+  Lemma ad_le_double_plus_un_mono_conv : (a,b:ad)
+      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=true -> (ad_le a b)=true.
+  Proof.
+    Unfold ad_le. Intros a b. Rewrite nat_of_ad_double_plus_un. Rewrite nat_of_ad_double_plus_un.
+    Intro. Apply nat_le_correct. Apply (mult_le_conv_1 (1)). Apply le_S_n. Apply nat_le_complete.
+    Assumption.
+  Qed.
+
+  Lemma ad_lt_double_mono : (a,b:ad) (ad_le a b)=false ->
+      (ad_le (ad_double a) (ad_double b))=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_le (ad_double a) (ad_double b))). Intro H0.
+    Rewrite (ad_le_double_mono_conv ? ? H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_lt_double_plus_un_mono : (a,b:ad) (ad_le a b)=false ->
+      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_le (ad_double_plus_un a) (ad_double_plus_un b))). Intro H0.
+    Rewrite (ad_le_double_plus_un_mono_conv ? ? H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_lt_double_mono_conv : (a,b:ad) (ad_le (ad_double a) (ad_double b))=false ->
+      (ad_le a b)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0. Rewrite (ad_le_double_mono ? ? H0) in H.
+    Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_lt_double_plus_un_mono_conv : (a,b:ad)
+      (ad_le (ad_double_plus_un a) (ad_double_plus_un b))=false -> (ad_le a b)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_le a b)). Intro H0.
+    Rewrite (ad_le_double_plus_un_mono ? ? H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_alloc_opt_optimal_1 : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
+      {y:A | (MapGet A m a)=(SOME A y)}.
+  Proof.
+    NewInduction m as [|a y|m0 H m1 H0]. Simpl. Unfold ad_le. Simpl. Intros. Discriminate H.
+    Simpl. Intros b H. Elim (sumbool_of_bool (ad_eq a ad_z)). Intro H0. Rewrite H0 in H.
+    Unfold ad_le in H. Cut ad_z=b. Intro. Split with y. Rewrite <- H1. Rewrite H0. Reflexivity.
+    Rewrite <- (ad_of_nat_of_ad b).
+    Rewrite <- (le_n_O_eq ? (le_S_n ? ? (nat_le_complete_conv ? ? H))). Reflexivity.
+    Intro H0. Rewrite H0 in H. Discriminate H.
+    Intros. Simpl in H1. Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3.
+    Rewrite H3 in H1. Elim (H ? (ad_lt_double_mono_conv ? ? (ad_min_lt_3 ? ? ? H1))). Intros y H4.
+    Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
+    Apply ad_double_bit_0.
+    Intro H2. Elim H2. Intros a0 H3. Rewrite H3 in H1.
+    Elim (H0 ? (ad_lt_double_plus_un_mono_conv ? ? (ad_min_lt_4 ? ? ? H1))). Intros y H4.
+    Split with y. Rewrite H3. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2.
+    Assumption.
+    Apply ad_double_plus_un_bit_0.
+  Qed.
+
+  Lemma ad_alloc_opt_optimal : (m:(Map A)) (a:ad) (ad_le (ad_alloc_opt m) a)=false ->
+      (in_dom A a m)=true.
+  Proof.
+    Intros. Unfold in_dom. Elim (ad_alloc_opt_optimal_1 m a H). Intros y H0. Rewrite H0.
+    Reflexivity.
+  Qed.
+
+End AdAlloc.
+
+V7only [
+(* Moved to NArith *)
+Notation positive_to_nat_2 := positive_to_nat_2.
+Notation positive_to_nat_4 := positive_to_nat_4.
+].
diff --git a/theories7/IntMap/Addec.v b/theories7/IntMap/Addec.v
new file mode 100644
index 00000000..50dc1480
--- /dev/null
+++ b/theories7/IntMap/Addec.v
@@ -0,0 +1,179 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Addec.v,v 1.1.2.1 2004/07/16 19:31:26 herbelin Exp $	 i*)
+
+(** Equality on adresses *)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+
+Fixpoint ad_eq_1 [p1,p2:positive] : bool :=
+  Cases p1 p2 of
+      xH xH => true
+    | (xO p'1) (xO p'2) => (ad_eq_1 p'1 p'2)
+    | (xI p'1) (xI p'2) => (ad_eq_1 p'1 p'2)
+    | _ _ => false
+  end.
+
+Definition ad_eq := [a,a':ad]
+  Cases a a' of
+      ad_z ad_z => true
+    | (ad_x p) (ad_x p') => (ad_eq_1 p p')
+    | _ _ => false
+  end.
+
+Lemma ad_eq_correct : (a:ad) (ad_eq a a)=true.
+Proof.
+  NewDestruct a; Trivial.
+  NewInduction p; Trivial.
+Qed.
+
+Lemma ad_eq_complete : (a,a':ad) (ad_eq a a')=true -> a=a'.
+Proof.
+  NewDestruct a. NewDestruct a'; Trivial. NewDestruct p.
+  Discriminate 1.
+  Discriminate 1.
+  Discriminate 1.
+  NewDestruct a'. Intros. Discriminate H.
+  Unfold ad_eq. Intros. Cut p=p0. Intros. Rewrite H0. Reflexivity.
+  Generalize Dependent p0.
+  NewInduction p as [p IHp|p IHp|]. NewDestruct p0; Intro H.
+  Rewrite (IHp p0). Reflexivity.
+  Exact H.
+  Discriminate H.
+  Discriminate H.
+  NewDestruct p0; Intro H. Discriminate H.
+  Rewrite (IHp p0 H). Reflexivity.
+  Discriminate H.
+  NewDestruct p0; Intro H. Discriminate H.
+  Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_eq_comm : (a,a':ad) (ad_eq a a')=(ad_eq a' a).
+Proof.
+  Intros. Cut (b,b':bool)(ad_eq a a')=b->(ad_eq a' a)=b'->b=b'.
+  Intros. Apply H. Reflexivity.
+  Reflexivity.
+  NewDestruct b. Intros. Cut a=a'.
+  Intro. Rewrite H1 in H0. Rewrite (ad_eq_correct a') in H0. Exact H0.
+  Apply ad_eq_complete. Exact H.
+  NewDestruct b'. Intros. Cut a'=a.
+  Intro. Rewrite H1 in H. Rewrite H1 in H0. Rewrite <- H. Exact H0.
+  Apply ad_eq_complete. Exact H0.
+  Trivial.
+Qed.
+
+Lemma ad_xor_eq_true : (a,a':ad) (ad_xor a a')=ad_z -> (ad_eq a a')=true.
+Proof.
+  Intros. Rewrite (ad_xor_eq a a' H). Apply ad_eq_correct.
+Qed.
+
+Lemma ad_xor_eq_false :
+    (a,a':ad) (p:positive) (ad_xor a a')=(ad_x p) -> (ad_eq a a')=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
+  Rewrite (ad_eq_complete a a' H0) in H. Rewrite (ad_xor_nilpotent a') in H. Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_bit_0_1_not_double : (a:ad) (ad_bit_0 a)=true ->
+      (a0:ad) (ad_eq (ad_double a0) a)=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
+  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_bit_0 a0) in H. Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_not_div_2_not_double : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
+      (ad_eq a (ad_double a0))=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq (ad_double a0) a)). Intro H0.
+  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_div_2 a0) in H.
+  Rewrite (ad_eq_correct a0) in H. Discriminate H.
+  Intro. Rewrite ad_eq_comm. Assumption.
+Qed.
+
+Lemma ad_bit_0_0_not_double_plus_un : (a:ad) (ad_bit_0 a)=false ->
+      (a0:ad) (ad_eq (ad_double_plus_un a0) a)=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq (ad_double_plus_un a0) a)). Intro H0.
+  Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_bit_0 a0) in H.
+  Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_not_div_2_not_double_plus_un : (a,a0:ad) (ad_eq (ad_div_2 a) a0)=false ->
+      (ad_eq (ad_double_plus_un a0) a)=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq a (ad_double_plus_un a0))). Intro H0.
+  Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_double_plus_un_div_2 a0) in H.
+  Rewrite (ad_eq_correct a0) in H. Discriminate H.
+  Intro H0. Rewrite ad_eq_comm. Assumption.
+Qed.
+
+Lemma ad_bit_0_neq :
+    (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> (ad_eq a a')=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H1. Rewrite (ad_eq_complete ? ? H1) in H.
+  Rewrite H in H0. Discriminate H0.
+  Trivial.
+Qed.
+
+Lemma ad_div_eq :
+    (a,a':ad) (ad_eq a a')=true -> (ad_eq (ad_div_2 a) (ad_div_2 a'))=true.
+Proof.
+  Intros. Cut a=a'. Intros. Rewrite H0. Apply ad_eq_correct.
+  Apply ad_eq_complete. Exact H.
+Qed.
+
+Lemma ad_div_neq : (a,a':ad) (ad_eq (ad_div_2 a) (ad_div_2 a'))=false -> 
+    (ad_eq a a')=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq a a')). Intro H0.
+  Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_eq_correct (ad_div_2 a')) in H. Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_div_bit_eq : (a,a':ad) (ad_bit_0 a)=(ad_bit_0 a') ->
+    (ad_div_2 a)=(ad_div_2 a') -> a=a'.
+Proof.
+  Intros. Apply ad_faithful. Unfold eqf. NewDestruct n.
+  Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Assumption.
+  Rewrite <- ad_div_2_correct. Rewrite <- ad_div_2_correct.
+  Rewrite H0. Reflexivity.
+Qed.
+
+Lemma ad_div_bit_neq : (a,a':ad) (ad_eq a a')=false -> (ad_bit_0 a)=(ad_bit_0 a') ->
+    (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
+Proof.
+  Intros. Elim (sumbool_of_bool (ad_eq (ad_div_2 a) (ad_div_2 a'))). Intro H1.
+  Rewrite (ad_div_bit_eq ? ? H0 (ad_eq_complete ? ? H1)) in H.
+  Rewrite (ad_eq_correct a') in H. Discriminate H.
+  Trivial.
+Qed.
+
+Lemma ad_neq : (a,a':ad) (ad_eq a a')=false ->
+    (ad_bit_0 a)=(negb (ad_bit_0 a')) \/ (ad_eq (ad_div_2 a) (ad_div_2 a'))=false.
+Proof.
+  Intros. Cut (ad_bit_0 a)=(ad_bit_0 a')\/(ad_bit_0 a)=(negb (ad_bit_0 a')).
+  Intros. Elim H0. Intro. Right . Apply ad_div_bit_neq. Assumption.
+  Assumption.
+  Intro. Left . Assumption.
+  Case (ad_bit_0 a); Case (ad_bit_0 a'); Auto.
+Qed.
+
+Lemma ad_double_or_double_plus_un : (a:ad)
+    {a0:ad | a=(ad_double a0)}+{a1:ad | a=(ad_double_plus_un a1)}.
+Proof.
+  Intro. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Right . Split with (ad_div_2 a).
+  Rewrite (ad_div_2_double_plus_un a H). Reflexivity.
+  Intro H. Left . Split with (ad_div_2 a). Rewrite (ad_div_2_double a H). Reflexivity.
+Qed.
diff --git a/theories7/IntMap/Addr.v b/theories7/IntMap/Addr.v
new file mode 100644
index 00000000..9f362772
--- /dev/null
+++ b/theories7/IntMap/Addr.v
@@ -0,0 +1,456 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Addr.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
+
+(** Representation of adresses by the [positive] type of binary numbers *)
+
+Require Bool.
+Require ZArith.
+
+Inductive ad : Set :=
+    ad_z : ad
+  | ad_x : positive -> ad.
+
+Lemma ad_sum : (a:ad) {p:positive | a=(ad_x p)}+{a=ad_z}.
+Proof.
+  NewDestruct a; Auto.
+  Left; Exists p; Trivial.
+Qed.
+
+Fixpoint p_xor [p:positive] : positive -> ad :=
+  [p2] Cases p of
+      xH => Cases p2 of
+	        xH => ad_z
+	      | (xO p'2) => (ad_x (xI p'2))
+	      | (xI p'2) => (ad_x (xO p'2))
+	    end
+    | (xO p') => Cases p2 of
+                     xH => (ad_x (xI p'))
+		   | (xO p'2) => Cases (p_xor p' p'2) of
+		                     ad_z => ad_z
+				   | (ad_x p'') => (ad_x (xO p''))
+				 end
+		   | (xI p'2) => Cases (p_xor p' p'2) of
+		                     ad_z => (ad_x xH)
+				   | (ad_x p'') => (ad_x (xI p''))
+				 end
+                 end
+    | (xI p') => Cases p2 of
+		     xH => (ad_x (xO p'))
+		   | (xO p'2) => Cases (p_xor p' p'2) of
+		                     ad_z => (ad_x xH)
+				   | (ad_x p'') => (ad_x (xI p''))
+				 end
+		   | (xI p'2) => Cases (p_xor p' p'2) of
+		                     ad_z => ad_z
+				   | (ad_x p'') => (ad_x (xO p''))
+				 end
+                 end
+  end.
+
+Definition ad_xor := [a,a':ad]
+  Cases a of
+      ad_z => a'
+    | (ad_x p) => Cases a' of
+                      ad_z => a
+	            | (ad_x p') => (p_xor p p')
+                  end
+  end.
+
+Lemma ad_xor_neutral_left : (a:ad) (ad_xor ad_z a)=a.
+Proof.
+  Trivial.
+Qed.
+
+Lemma ad_xor_neutral_right : (a:ad) (ad_xor a ad_z)=a.
+Proof.
+  NewDestruct a; Trivial.
+Qed.
+
+Lemma ad_xor_comm : (a,a':ad) (ad_xor a a')=(ad_xor a' a).
+Proof.
+  NewDestruct a; NewDestruct a'; Simpl; Auto.
+  Generalize p0; Clear p0; NewInduction p as [p Hrecp|p Hrecp|]; Simpl; Auto.
+  NewDestruct p0; Simpl; Trivial; Intros.
+  Rewrite Hrecp; Trivial.
+  Rewrite Hrecp; Trivial.
+  NewDestruct p0; Simpl; Trivial; Intros.
+  Rewrite Hrecp; Trivial.
+  Rewrite Hrecp; Trivial.
+  NewDestruct p0; Simpl; Auto.
+Qed.
+
+Lemma ad_xor_nilpotent : (a:ad) (ad_xor a a)=ad_z.
+Proof.
+  NewDestruct a; Trivial.
+  Simpl. NewInduction p as [p IHp|p IHp|]; Trivial.
+  Simpl. Rewrite IHp; Reflexivity.
+  Simpl. Rewrite IHp; Reflexivity.
+Qed.
+
+Fixpoint ad_bit_1 [p:positive] : nat -> bool :=
+  Cases p of
+      xH => [n:nat] Cases n of
+                        O => true
+		      | (S _) => false
+		    end
+    | (xO p) => [n:nat] Cases n of
+                            O => false
+			  | (S n') => (ad_bit_1 p n')
+		        end
+    | (xI p) => [n:nat] Cases n of
+                            O => true
+			  | (S n') => (ad_bit_1 p n')
+		        end
+  end.
+
+Definition ad_bit := [a:ad]
+  Cases a of
+      ad_z => [_:nat] false
+    | (ad_x p) => (ad_bit_1 p)
+  end.
+
+Definition eqf := [f,g:nat->bool] (n:nat) (f n)=(g n).
+
+Lemma ad_faithful_1 : (a:ad) (eqf (ad_bit ad_z) (ad_bit a)) -> ad_z=a.
+Proof.
+  NewDestruct a. Trivial.
+  NewInduction p as [p IHp|p IHp|];Intro H. Absurd ad_z=(ad_x p). Discriminate.
+  Exact (IHp [n:nat](H (S n))).
+  Absurd ad_z=(ad_x p). Discriminate.
+  Exact (IHp [n:nat](H (S n))).
+  Absurd false=true. Discriminate.
+  Exact (H O).
+Qed.
+
+Lemma ad_faithful_2 : (a:ad) (eqf (ad_bit (ad_x xH)) (ad_bit a)) -> (ad_x xH)=a.
+Proof.
+  NewDestruct a. Intros. Absurd true=false. Discriminate.
+  Exact (H O).
+  NewDestruct p. Intro H. Absurd ad_z=(ad_x p). Discriminate.
+  Exact (ad_faithful_1 (ad_x p) [n:nat](H (S n))).
+  Intros. Absurd true=false. Discriminate.
+  Exact (H O).
+  Trivial.
+Qed.
+
+Lemma ad_faithful_3 :
+    (a:ad) (p:positive)
+      ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
+        (eqf (ad_bit (ad_x (xO p))) (ad_bit a)) ->
+          (ad_x (xO p))=a.
+Proof.
+  NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xO p)))).
+  Intro. Rewrite (ad_faithful_1 (ad_x (xO p)) H1). Reflexivity.
+  Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
+  Case p. Intros. Absurd false=true. Discriminate.
+  Exact (H0 O).
+  Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
+  Intros. Absurd false=true. Discriminate.
+  Exact (H0 O).
+Qed.
+
+Lemma ad_faithful_4 :
+    (a:ad) (p:positive)
+      ((p':positive) (eqf (ad_bit (ad_x p)) (ad_bit (ad_x p'))) -> p=p') ->
+        (eqf (ad_bit (ad_x (xI p))) (ad_bit a)) ->
+          (ad_x (xI p))=a.
+Proof.
+  NewDestruct a. Intros. Cut (eqf (ad_bit ad_z) (ad_bit (ad_x (xI p)))).
+  Intro. Rewrite (ad_faithful_1 (ad_x (xI p)) H1). Reflexivity.
+  Unfold eqf. Intro. Unfold eqf in H0. Rewrite H0. Reflexivity.
+  Case p. Intros. Rewrite (H p0 [n:nat](H0 (S n))). Reflexivity.
+  Intros. Absurd true=false. Discriminate.
+  Exact (H0 O).
+  Intros. Absurd ad_z=(ad_x p0). Discriminate.
+  Cut (eqf (ad_bit (ad_x xH)) (ad_bit (ad_x (xI p0)))).
+  Intro. Exact (ad_faithful_1 (ad_x p0) [n:nat](H1 (S n))).
+  Unfold eqf. Unfold eqf in H0. Intro. Rewrite H0. Reflexivity.
+Qed.
+
+Lemma ad_faithful : (a,a':ad) (eqf (ad_bit a) (ad_bit a')) -> a=a'.
+Proof.
+  NewDestruct a. Exact ad_faithful_1.
+  NewInduction p. Intros a' H. Apply ad_faithful_4. Intros. Cut (ad_x p)=(ad_x p').
+  Intro. Inversion H1. Reflexivity.
+  Exact (IHp (ad_x p') H0).
+  Assumption.
+  Intros. Apply ad_faithful_3. Intros. Cut (ad_x p)=(ad_x p'). Intro. Inversion H1. Reflexivity.
+  Exact (IHp (ad_x p') H0).
+  Assumption.
+  Exact ad_faithful_2.
+Qed.
+
+Definition adf_xor := [f,g:nat->bool; n:nat] (xorb (f n) (g n)).
+
+Lemma ad_xor_sem_1 : (a':ad) (ad_bit (ad_xor ad_z a') O)=(ad_bit a' O).
+Proof.
+  Trivial.
+Qed.
+
+Lemma ad_xor_sem_2 : (a':ad) (ad_bit (ad_xor (ad_x xH) a') O)=(negb (ad_bit a' O)).
+Proof.
+  Intro. Case a'. Trivial.
+  Simpl. Intro. 
+  Case p; Trivial.
+Qed.
+
+Lemma ad_xor_sem_3 :
+    (p:positive) (a':ad) (ad_bit (ad_xor (ad_x (xO p)) a') O)=(ad_bit a' O).
+Proof.
+  Intros. Case a'. Trivial.
+  Simpl. Intro. 
+  Case p0; Trivial. Intro. 
+  Case (p_xor p p1); Trivial.
+  Intro. Case (p_xor p p1); Trivial.
+Qed.
+
+Lemma ad_xor_sem_4 : (p:positive) (a':ad)
+    (ad_bit (ad_xor (ad_x (xI p)) a') O)=(negb (ad_bit a' O)).
+Proof.
+  Intros. Case a'. Trivial.
+  Simpl. Intro. Case p0; Trivial. Intro. 
+  Case (p_xor p p1); Trivial.
+  Intro. 
+  Case (p_xor p p1); Trivial.
+Qed.
+
+Lemma ad_xor_sem_5 :
+    (a,a':ad) (ad_bit (ad_xor a a') O)=(adf_xor (ad_bit a) (ad_bit a') O).
+Proof.
+  NewDestruct a. Intro. Change (ad_bit a' O)=(xorb false (ad_bit a' O)). Rewrite false_xorb. Trivial.
+  Case p. Exact ad_xor_sem_4.
+  Intros. Change (ad_bit (ad_xor (ad_x (xO p0)) a') O)=(xorb false (ad_bit a' O)).
+  Rewrite false_xorb. Apply ad_xor_sem_3. Exact ad_xor_sem_2.
+Qed.
+
+Lemma ad_xor_sem_6 : (n:nat)
+    ((a,a':ad) (ad_bit (ad_xor a a') n)=(adf_xor (ad_bit a) (ad_bit a') n)) ->
+      (a,a':ad) (ad_bit (ad_xor a a') (S n))=(adf_xor (ad_bit a) (ad_bit a') (S n)).
+Proof.
+  Intros. Case a. Unfold adf_xor. Unfold 2 ad_bit. Rewrite false_xorb. Reflexivity.
+  Case a'. Unfold adf_xor. Unfold 3 ad_bit. Intro. Rewrite xorb_false. Reflexivity.
+  Intros. Case p0. Case p. Intros.
+  Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xI p1))) (S n))
+        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
+  Rewrite <- H. Simpl. 
+  Case (p_xor p2 p1); Trivial.
+  Intros.
+  Change (ad_bit (ad_xor (ad_x (xI p2)) (ad_x (xO p1))) (S n))
+        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
+  Rewrite <- H. Simpl. 
+  Case (p_xor p2 p1); Trivial.
+  Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
+  Case p. Intros.
+  Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xI p1))) (S n))
+        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
+  Rewrite <- H. Simpl. 
+  Case (p_xor p2 p1); Trivial.
+  Intros.
+  Change (ad_bit (ad_xor (ad_x (xO p2)) (ad_x (xO p1))) (S n))
+        =(adf_xor (ad_bit (ad_x p2)) (ad_bit (ad_x p1)) n).
+  Rewrite <- H. Simpl. 
+  Case (p_xor p2 p1); Trivial.
+  Intro. Unfold adf_xor. Unfold 3 ad_bit. Unfold ad_bit_1. Rewrite xorb_false. Reflexivity.
+  Unfold adf_xor. Unfold 2 ad_bit. Unfold ad_bit_1. Rewrite false_xorb. Simpl.   Case p; Trivial.
+Qed.
+
+Lemma ad_xor_semantics :
+    (a,a':ad) (eqf (ad_bit (ad_xor a a')) (adf_xor (ad_bit a) (ad_bit a'))).
+Proof.
+  Unfold eqf. Intros. Generalize a a'. Elim n. Exact ad_xor_sem_5.
+  Exact ad_xor_sem_6.
+Qed.
+
+Lemma eqf_sym : (f,f':nat->bool) (eqf f f') -> (eqf f' f).
+Proof.
+  Unfold eqf. Intros. Rewrite H. Reflexivity.
+Qed.
+
+Lemma eqf_refl :  (f:nat->bool) (eqf f f).
+Proof.
+  Unfold eqf. Trivial.
+Qed.
+
+Lemma eqf_trans : (f,f',f'':nat->bool) (eqf f f') -> (eqf f' f'') -> (eqf f f'').
+Proof.
+  Unfold eqf. Intros. Rewrite H. Exact (H0 n).
+Qed.
+
+Lemma adf_xor_eq : (f,f':nat->bool) (eqf (adf_xor f f') [n:nat] false) -> (eqf f f').
+Proof.
+  Unfold eqf. Unfold adf_xor. Intros. Apply xorb_eq. Apply H.
+Qed.
+
+Lemma ad_xor_eq : (a,a':ad) (ad_xor a a')=ad_z -> a=a'.
+Proof.
+  Intros. Apply ad_faithful. Apply adf_xor_eq. Apply eqf_trans with f':=(ad_bit (ad_xor a a')).
+  Apply eqf_sym. Apply ad_xor_semantics.
+  Rewrite H. Unfold eqf. Trivial.
+Qed.
+
+Lemma adf_xor_assoc : (f,f',f'':nat->bool)
+    (eqf (adf_xor (adf_xor f f') f'') (adf_xor f (adf_xor f' f''))).
+Proof.
+  Unfold eqf. Unfold adf_xor. Intros. Apply xorb_assoc.
+Qed.
+
+Lemma eqf_xor_1 : (f,f',f'',f''':nat->bool) (eqf f f') -> (eqf f'' f''') ->
+    (eqf (adf_xor f f'') (adf_xor f' f''')).
+Proof.
+  Unfold eqf. Intros. Unfold adf_xor. Rewrite H. Rewrite H0. Reflexivity.
+Qed.
+
+Lemma ad_xor_assoc :
+    (a,a',a'':ad) (ad_xor (ad_xor a a') a'')=(ad_xor a (ad_xor a' a'')).
+Proof.
+  Intros. Apply ad_faithful.
+  Apply eqf_trans with f':=(adf_xor (adf_xor (ad_bit a) (ad_bit a')) (ad_bit a'')).
+  Apply eqf_trans with f':=(adf_xor (ad_bit (ad_xor a a')) (ad_bit a'')).
+  Apply ad_xor_semantics.
+  Apply eqf_xor_1. Apply ad_xor_semantics.
+  Apply eqf_refl.
+  Apply eqf_trans with f':=(adf_xor (ad_bit a) (adf_xor (ad_bit a') (ad_bit a''))).
+  Apply adf_xor_assoc.
+  Apply eqf_trans with f':=(adf_xor (ad_bit a) (ad_bit (ad_xor a' a''))).
+  Apply eqf_xor_1. Apply eqf_refl.
+  Apply eqf_sym. Apply ad_xor_semantics.
+  Apply eqf_sym. Apply ad_xor_semantics.
+Qed.
+
+Definition ad_double := [a:ad]
+  Cases a of
+      ad_z => ad_z
+    | (ad_x p) => (ad_x (xO p))
+  end.
+
+Definition ad_double_plus_un := [a:ad]
+  Cases a of
+      ad_z => (ad_x xH)
+    | (ad_x p) => (ad_x (xI p))
+  end.
+
+Definition ad_div_2 := [a:ad]
+  Cases a of
+      ad_z => ad_z
+    | (ad_x xH) => ad_z
+    | (ad_x (xO p)) => (ad_x p)
+    | (ad_x (xI p)) => (ad_x p)
+  end.
+
+Lemma ad_double_div_2 : (a:ad) (ad_div_2 (ad_double a))=a.
+Proof.
+  NewDestruct a; Trivial.
+Qed.
+
+Lemma ad_double_plus_un_div_2 : (a:ad) (ad_div_2 (ad_double_plus_un a))=a.
+Proof.
+  NewDestruct a; Trivial.
+Qed.
+
+Lemma ad_double_inj : (a0,a1:ad) (ad_double a0)=(ad_double a1) -> a0=a1.
+Proof.
+  Intros. Rewrite <- (ad_double_div_2 a0). Rewrite H. Apply ad_double_div_2.
+Qed.
+
+Lemma ad_double_plus_un_inj :
+    (a0,a1:ad) (ad_double_plus_un a0)=(ad_double_plus_un a1) -> a0=a1.
+Proof.
+  Intros. Rewrite <- (ad_double_plus_un_div_2 a0). Rewrite H. Apply ad_double_plus_un_div_2.
+Qed.
+
+Definition ad_bit_0 := [a:ad]
+  Cases a of
+      ad_z => false
+    | (ad_x (xO _)) => false
+    | _ => true
+  end.
+
+Lemma ad_double_bit_0 : (a:ad) (ad_bit_0 (ad_double a))=false.
+Proof.
+  NewDestruct a; Trivial.
+Qed.
+
+Lemma ad_double_plus_un_bit_0 : (a:ad) (ad_bit_0 (ad_double_plus_un a))=true.
+Proof.
+  NewDestruct a; Trivial.
+Qed.
+
+Lemma ad_div_2_double : (a:ad) (ad_bit_0 a)=false -> (ad_double (ad_div_2 a))=a.
+Proof.
+  NewDestruct a. Trivial. NewDestruct p. Intro H. Discriminate H.
+  Intros. Reflexivity.
+  Intro H. Discriminate H.
+Qed.
+
+Lemma ad_div_2_double_plus_un :
+    (a:ad) (ad_bit_0 a)=true -> (ad_double_plus_un (ad_div_2 a))=a.
+Proof.
+  NewDestruct a. Intro. Discriminate H.
+  NewDestruct p. Intros. Reflexivity.
+  Intro H. Discriminate H.
+  Intro. Reflexivity.
+Qed.
+
+Lemma ad_bit_0_correct : (a:ad) (ad_bit a O)=(ad_bit_0 a).
+Proof.
+  NewDestruct a; Trivial.
+  NewDestruct p; Trivial.
+Qed.
+
+Lemma ad_div_2_correct : (a:ad) (n:nat) (ad_bit (ad_div_2 a) n)=(ad_bit a (S n)).
+Proof.
+  NewDestruct a; Trivial.
+  NewDestruct p; Trivial.
+Qed.
+
+Lemma ad_xor_bit_0 :
+    (a,a':ad) (ad_bit_0 (ad_xor a a'))=(xorb (ad_bit_0 a) (ad_bit_0 a')).
+Proof.
+  Intros. Rewrite <- ad_bit_0_correct. Rewrite (ad_xor_semantics a a' O).
+  Unfold adf_xor. Rewrite ad_bit_0_correct. Rewrite ad_bit_0_correct. Reflexivity.
+Qed.
+
+Lemma ad_xor_div_2 :
+    (a,a':ad) (ad_div_2 (ad_xor a a'))=(ad_xor (ad_div_2 a) (ad_div_2 a')).
+Proof.
+  Intros. Apply ad_faithful. Unfold eqf. Intro.
+  Rewrite (ad_xor_semantics (ad_div_2 a) (ad_div_2 a') n).
+  Rewrite ad_div_2_correct.
+  Rewrite (ad_xor_semantics a a' (S n)).
+  Unfold adf_xor. Rewrite ad_div_2_correct. Rewrite ad_div_2_correct.
+  Reflexivity.
+Qed.
+
+Lemma ad_neg_bit_0 : (a,a':ad) (ad_bit_0 (ad_xor a a'))=true ->
+    (ad_bit_0 a)=(negb (ad_bit_0 a')).
+Proof.
+  Intros. Rewrite <- true_xorb. Rewrite <- H. Rewrite ad_xor_bit_0.
+  Rewrite xorb_assoc. Rewrite xorb_nilpotent. Rewrite xorb_false. Reflexivity.
+Qed.
+
+Lemma ad_neg_bit_0_1 :
+    (a,a':ad) (ad_xor a a')=(ad_x xH) -> (ad_bit_0 a)=(negb (ad_bit_0 a')).
+Proof.
+  Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
+Qed.
+
+Lemma ad_neg_bit_0_2 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xI p)) ->
+    (ad_bit_0 a)=(negb (ad_bit_0 a')).
+Proof.
+  Intros. Apply ad_neg_bit_0. Rewrite H. Reflexivity.
+Qed.
+
+Lemma ad_same_bit_0 : (a,a':ad) (p:positive) (ad_xor a a')=(ad_x (xO p)) ->
+    (ad_bit_0 a)=(ad_bit_0 a').
+Proof.
+  Intros. Rewrite <- (xorb_false (ad_bit_0 a)). Cut (ad_bit_0 (ad_x (xO p)))=false.
+  Intro. Rewrite <- H0. Rewrite <- H. Rewrite ad_xor_bit_0. Rewrite <- xorb_assoc.
+  Rewrite xorb_nilpotent. Rewrite false_xorb. Reflexivity.
+  Reflexivity.
+Qed.
diff --git a/theories7/IntMap/Adist.v b/theories7/IntMap/Adist.v
new file mode 100644
index 00000000..a7948c72
--- /dev/null
+++ b/theories7/IntMap/Adist.v
@@ -0,0 +1,321 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	     $Id: Adist.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	      i*)
+
+Require Bool.
+Require ZArith.
+Require Arith.
+Require Min.
+Require Addr.
+
+Fixpoint ad_plength_1 [p:positive] : nat :=
+  Cases p of
+      xH => O
+    | (xI _) => O
+    | (xO p') => (S (ad_plength_1 p'))
+  end.
+
+Inductive natinf : Set :=
+    infty : natinf
+  | ni : nat -> natinf.
+
+Definition ad_plength := [a:ad]
+  Cases a of
+      ad_z => infty
+    | (ad_x p) => (ni (ad_plength_1 p))
+  end.
+
+Lemma ad_plength_infty : (a:ad) (ad_plength a)=infty -> a=ad_z.
+Proof.
+  Induction a; Trivial. 
+  Unfold ad_plength; Intros; Discriminate H.
+Qed.
+
+Lemma ad_plength_zeros : (a:ad) (n:nat) (ad_plength a)=(ni n) ->
+    (k:nat) (lt k n) -> (ad_bit a k)=false.
+Proof.
+  Induction a; Trivial. 
+  Induction p. Induction n. Intros. Inversion H1.
+  Induction k. Simpl in H1. Discriminate H1.
+  Intros. Simpl in H1. Discriminate H1.
+  Induction k. Trivial.
+  Generalize H0. Case n. Intros. Inversion H3.
+  Intros. Simpl. Unfold ad_bit in H. Apply (H n0). Simpl in H1. Inversion H1. Reflexivity.
+  Exact (lt_S_n n1 n0 H3).
+  Simpl. Intros n H. Inversion H. Intros. Inversion H0.
+Qed.
+
+Lemma ad_plength_one : (a:ad) (n:nat) (ad_plength a)=(ni n) -> (ad_bit a n)=true.
+Proof.
+  Induction a. Intros. Inversion H.
+  Induction p. Intros. Simpl in H0. Inversion H0. Reflexivity.
+  Intros. Simpl in H0. Inversion H0. Simpl. Unfold ad_bit in H. Apply H. Reflexivity.
+  Intros. Simpl in H. Inversion H. Reflexivity.
+Qed.
+
+Lemma ad_plength_first_one : (a:ad) (n:nat)
+    ((k:nat) (lt k n) -> (ad_bit a k)=false) -> (ad_bit a n)=true ->
+      (ad_plength a)=(ni n).
+Proof.
+  Induction a. Intros. Simpl in H0. Discriminate H0.
+  Induction p. Intros. Generalize H0. Case n. Intros. Reflexivity.
+  Intros. Absurd (ad_bit (ad_x (xI p0)) O)=false. Trivial with bool.
+  Auto with bool arith.
+  Intros. Generalize H0 H1. Case n. Intros. Simpl in H3. Discriminate H3.
+  Intros. Simpl. Unfold ad_plength in H.
+  Cut (ni (ad_plength_1 p0))=(ni n0). Intro. Inversion H4. Reflexivity.
+  Apply H. Intros. Change (ad_bit (ad_x (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.
+Qed.
+
+Definition ni_min := [d,d':natinf]
+  Cases d of
+      infty => d'
+    | (ni n) => Cases d' of
+                    infty => d
+		  | (ni n') => (ni (min n n'))
+		end
+  end.
+
+Lemma ni_min_idemp : (d:natinf) (ni_min d d)=d.
+Proof.
+  Induction d; Trivial.
+  Unfold ni_min.
+  Induction n; Trivial.
+  Intros.
+  Simpl.
+  Inversion H.
+  Rewrite H1.
+  Rewrite H1.
+  Reflexivity.
+Qed.
+
+Lemma ni_min_comm : (d,d':natinf) (ni_min d d')=(ni_min d' d).
+Proof.
+  Induction d. Induction d'; Trivial.
+  Induction d'; Trivial. Elim n. Induction n0; Trivial.
+  Intros. Elim n1; Trivial. Intros. Unfold ni_min in H. Cut (min n0 n2)=(min n2 n0).
+  Intro. Unfold ni_min. Simpl. Rewrite H1. Reflexivity.
+  Cut (ni (min n0 n2))=(ni (min n2 n0)). Intros.
+  Inversion H1; Trivial.
+  Exact (H n2).
+Qed.
+
+Lemma ni_min_assoc : (d,d',d'':natinf) (ni_min (ni_min d d') d'')=(ni_min d (ni_min d' d'')).
+Proof.
+  Induction d; Trivial. Induction d'; Trivial. 
+  Induction d''; Trivial.
+  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. 
+  Induction n3; Trivial. Induction n5; Trivial.
+  Intros. Simpl. Auto.
+Qed.
+
+Lemma ni_min_O_l : (d:natinf) (ni_min (ni O) d)=(ni O).
+Proof.
+  Induction d; Trivial.
+Qed.
+
+Lemma ni_min_O_r : (d:natinf) (ni_min d (ni O))=(ni O).
+Proof.
+  Intros. Rewrite ni_min_comm. Apply ni_min_O_l.
+Qed.
+
+Lemma ni_min_inf_l : (d:natinf) (ni_min infty d)=d.
+Proof.
+  Trivial.
+Qed.
+
+Lemma ni_min_inf_r : (d:natinf) (ni_min d infty)=d.
+Proof.
+  Induction d; Trivial.
+Qed.
+
+Definition ni_le := [d,d':natinf] (ni_min d d')=d.
+
+Lemma ni_le_refl : (d:natinf) (ni_le d d).
+Proof.
+  Exact ni_min_idemp.
+Qed.
+
+Lemma ni_le_antisym : (d,d':natinf) (ni_le d d') -> (ni_le d' d) -> d=d'.
+Proof.
+  Unfold ni_le. Intros d d'. Rewrite ni_min_comm. Intro H. Rewrite H. Trivial.
+Qed.
+
+Lemma ni_le_trans : (d,d',d'':natinf) (ni_le d d') -> (ni_le d' d'') -> (ni_le d d'').
+Proof.
+  Unfold ni_le. Intros. Rewrite <- H. Rewrite ni_min_assoc. Rewrite H0. Reflexivity.
+Qed.
+
+Lemma ni_le_min_1 : (d,d':natinf) (ni_le (ni_min d d') d).
+Proof.
+  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 : (d,d':natinf) (ni_le (ni_min d d') d').
+Proof.
+  Unfold ni_le. Intros. Rewrite ni_min_assoc. Rewrite ni_min_idemp. Reflexivity.
+Qed.
+
+Lemma ni_min_case : (d,d':natinf) (ni_min d d')=d \/ (ni_min d d')=d'.
+Proof.
+  Induction d. Intro. Right . Exact (ni_min_inf_l d').
+  Induction d'. Left . Exact (ni_min_inf_r (ni n)).
+  Unfold ni_min. Cut (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.
+  Induction n1. Right . Reflexivity.
+  Intros. Case (H n2). Intro. Left . Simpl. Rewrite H1. Reflexivity.
+  Intro. Right . Simpl. Rewrite H1. Reflexivity.
+Qed.
+
+Lemma ni_le_total : (d,d':natinf) (ni_le d d') \/ (ni_le d' d).
+Proof.
+  Unfold ni_le. Intros. Rewrite (ni_min_comm d' d). Apply ni_min_case.
+Qed.
+
+Lemma ni_le_min_induc : (d,d',dm:natinf) (ni_le dm d) -> (ni_le dm d') ->
+    ((d'':natinf) (ni_le d'' d) -> (ni_le d'' d') -> (ni_le d'' dm)) ->
+      (ni_min d d')=dm.
+Proof.
+  Intros. Case (ni_min_case d d'). Intro. Rewrite H2.
+  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. Rewrite ni_min_comm. Exact H2.
+  Apply ni_le_refl.
+  Exact H0.
+Qed.
+
+Lemma le_ni_le : (m,n:nat) (le m n) -> (ni_le (ni m) (ni n)).
+Proof.
+  Cut (m,n:nat)(le m n)->(min m n)=m.
+  Intros. Unfold ni_le ni_min. Rewrite (H m n H0). Reflexivity.
+  Induction m. Trivial.
+  Induction n0. Intro. Inversion H0.
+  Intros. Simpl. Rewrite (H n1 (le_S_n n n1 H1)). Reflexivity.
+Qed.
+
+Lemma ni_le_le : (m,n:nat) (ni_le (ni m) (ni n)) -> (le m n).
+Proof.
+  Unfold ni_le. Unfold ni_min. Intros. Inversion H. Apply le_min_r.
+Qed.
+
+Lemma ad_plength_lb : (a:ad) (n:nat) ((k:nat) (lt k n) -> (ad_bit a k)=false) ->
+    (ni_le (ni n) (ad_plength a)).
+Proof.
+  Induction a. Intros. Exact (ni_min_inf_r (ni n)).
+  Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt n (ad_plength_1 p)). Trivial.
+  Intro. Absurd (ad_bit (ad_x p) (ad_plength_1 p))=false.
+  Rewrite (ad_plength_one (ad_x p) (ad_plength_1 p)
+          (refl_equal natinf (ad_plength (ad_x p)))).
+  Discriminate.
+  Apply H. Exact H0.
+Qed.
+
+Lemma ad_plength_ub : (a:ad) (n:nat) (ad_bit a n)=true ->
+    (ni_le (ad_plength a) (ni n)).
+Proof.
+  Induction a. Intros. Discriminate H.
+  Intros. Unfold ad_plength. Apply le_ni_le. Case (le_or_lt (ad_plength_1 p) n). Trivial.
+  Intro. Absurd (ad_bit (ad_x p) n)=true.
+  Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
+          (refl_equal natinf (ad_plength (ad_x p))) n H0).
+  Discriminate.
+  Exact H.
+Qed.
+
+
+(** We define an ultrametric distance between addresses: 
+    $d(a,a')=1/2^pd(a,a')$, 
+    where $pd(a,a')$ is the number of identical bits at the beginning 
+    of $a$ and $a'$ (infinity if $a=a'$).  
+    Instead of working with $d$, we work with $pd$, namely
+    [ad_pdist]: *)
+
+Definition ad_pdist := [a,a':ad] (ad_plength (ad_xor 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 ad_pdist_eq_1 : (a:ad) (ad_pdist a a)=infty.
+Proof.
+  Intros. Unfold ad_pdist. Rewrite ad_xor_nilpotent. Reflexivity.
+Qed.
+
+Lemma ad_pdist_eq_2 : (a,a':ad) (ad_pdist a a')=infty -> a=a'.
+Proof.
+  Intros. Apply ad_xor_eq. Apply ad_plength_infty. Exact H.
+Qed.
+
+(** $d$ is a distance, so $d(a,a')=d(a',a)$: *)
+
+Lemma ad_pdist_comm : (a,a':ad) (ad_pdist a a')=(ad_pdist a' a).
+Proof.
+  Unfold ad_pdist. Intros. Rewrite ad_xor_comm. Reflexivity.
+Qed.
+
+(** $d$ is an ultrametric distance, that is, not only $d(a,a')\leq
+    d(a,a'')+d(a'',a')$,
+  but in fact $d(a,a')\leq max(d(a,a''),d(a'',a'))$.
+  This means that $min(pd(a,a''),pd(a'',a'))<=pd(a,a')$ (lemma [ad_pdist_ultra] below).
+  This follows from the fact that $a ~Ra~|a| = 1/2^{\texttt{ad\_plength}}(a))$
+  is an ultrametric norm, i.e. that $|a-a'| \leq max (|a-a''|, |a''-a'|)$,
+  or equivalently that $|a+b|<=max(|a|,|b|)$, i.e. that
+  min $(\texttt{ad\_plength}(a), \texttt{ad\_plength}(b)) \leq 
+  \texttt{ad\_plength} (a~\texttt{xor}~ b)$
+  (lemma [ad_plength_ultra]).
+*)
+
+Lemma ad_plength_ultra_1 : (a,a':ad)
+    (ni_le (ad_plength a) (ad_plength a')) ->
+      (ni_le (ad_plength a) (ad_plength (ad_xor a a'))).
+Proof.
+  Induction a. Intros. Unfold ni_le in H. Unfold 1 3 ad_plength in H.
+  Rewrite (ni_min_inf_l (ad_plength a')) in H.
+  Rewrite (ad_plength_infty a' H). Simpl. Apply ni_le_refl.
+  Intros. Unfold 1 ad_plength. Apply ad_plength_lb. Intros.
+  Cut (a'':ad)(ad_xor (ad_x p) a')=a''->(ad_bit a'' k)=false.
+  Intros. Apply H1. Reflexivity.
+  Intro a''. Case a''. Intro. Reflexivity.
+  Intros. Rewrite <- H1. Rewrite (ad_xor_semantics (ad_x p) a' k). Unfold adf_xor.
+  Rewrite (ad_plength_zeros (ad_x p) (ad_plength_1 p)
+          (refl_equal natinf (ad_plength (ad_x p))) k H0).
+  Generalize H. Case a'. Trivial.
+  Intros. Cut (ad_bit (ad_x p1) k)=false. Intros. Rewrite H3. Reflexivity.
+  Apply ad_plength_zeros with n:=(ad_plength_1 p1). Reflexivity.
+  Apply (lt_le_trans k (ad_plength_1 p) (ad_plength_1 p1)). Exact H0.
+  Apply ni_le_le. Exact H2.
+Qed.
+
+Lemma ad_plength_ultra : (a,a':ad)
+    (ni_le (ni_min (ad_plength a) (ad_plength a')) (ad_plength (ad_xor a a'))).
+Proof.
+  Intros. Case (ni_le_total (ad_plength a) (ad_plength a')). Intro.
+  Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a).
+  Intro. Rewrite H0. Apply ad_plength_ultra_1. Exact H.
+  Exact H.
+  Intro. Cut (ni_min (ad_plength a) (ad_plength a'))=(ad_plength a').
+  Intro. Rewrite H0. Rewrite ad_xor_comm. Apply ad_plength_ultra_1. Exact H.
+  Rewrite ni_min_comm. Exact H.
+Qed.
+
+Lemma ad_pdist_ultra : (a,a',a'':ad)
+    (ni_le (ni_min (ad_pdist a a'') (ad_pdist a'' a')) (ad_pdist a a')).
+Proof.
+  Intros. Unfold ad_pdist. Cut (ad_xor (ad_xor a a'') (ad_xor a'' a'))=(ad_xor a a').
+  Intro. Rewrite <- H. Apply ad_plength_ultra.
+  Rewrite ad_xor_assoc. Rewrite <- (ad_xor_assoc a'' a'' a'). Rewrite ad_xor_nilpotent.
+  Rewrite ad_xor_neutral_left. Reflexivity.
+Qed.
diff --git a/theories7/IntMap/Allmaps.v b/theories7/IntMap/Allmaps.v
new file mode 100644
index 00000000..e76e210f
--- /dev/null
+++ b/theories7/IntMap/Allmaps.v
@@ -0,0 +1,26 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Allmaps.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
+
+Require Export Addr.
+Require Export Adist.
+Require Export Addec.
+Require Export Map.
+
+Require Export Fset.
+Require Export Mapaxioms.
+Require Export Mapiter.
+
+Require Export Mapsubset.
+Require Export Lsort.
+Require Export Mapfold.
+Require Export Mapcard.
+Require Export Mapcanon.
+Require Export Mapc.
+Require Export Maplists.
+Require Export Adalloc.
diff --git a/theories7/IntMap/Fset.v b/theories7/IntMap/Fset.v
new file mode 100644
index 00000000..545c1716
--- /dev/null
+++ b/theories7/IntMap/Fset.v
@@ -0,0 +1,338 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Fset.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
+
+(*s Sets operations on maps *)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+
+Section Dom.
+
+  Variable A, B : Set.
+
+  Fixpoint MapDomRestrTo [m:(Map A)] : (Map B) -> (Map A) :=
+    Cases m of
+        M0 => [_:(Map B)] (M0 A)
+      | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
+                                 NONE => (M0 A)
+			       | _ => m
+			     end
+      | (M2 m1 m2) => [m':(Map B)] Cases m' of
+                                   M0 => (M0 A)
+				 | (M1 a' y') => Cases (MapGet A m a') of
+				                     NONE => (M0 A)
+						   | (SOME y) => (M1 A a' y)
+						 end
+				 | (M2 m'1 m'2) => (makeM2 A (MapDomRestrTo m1 m'1)
+				                             (MapDomRestrTo m2 m'2))
+			       end
+    end.
+
+  Lemma MapDomRestrTo_semantics : (m:(Map A)) (m':(Map B))
+      (eqm A (MapGet A (MapDomRestrTo m m'))
+             [a0:ad] Cases (MapGet B m' a0) of
+	               NONE => (NONE A)
+		     | _ => (MapGet A m a0)
+		   end).
+  Proof.
+    Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
+    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
+    Rewrite <- (ad_eq_complete ? ? H). Case (MapGet B m' a). Reflexivity.
+    Intro. Apply M1_semantics_1.
+    Intro H. Rewrite H. Case (MapGet B m' a). 
+    Case (MapGet B m' a1); Reflexivity.
+    Case (MapGet B m' a1); Intros; Exact (M1_semantics_2 A a a1 a0 H).
+    Induction m'. Trivial.
+    Unfold MapDomRestrTo. Intros. Elim (sumbool_of_bool (ad_eq a a1)).
+    Intro H1.
+    Rewrite (ad_eq_complete ? ? H1). Rewrite (M1_semantics_1 B a1 a0).
+    Case (MapGet A (M2 A m0 m1) a1). Reflexivity.
+    Intro. Apply M1_semantics_1.
+    Intro H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Case (MapGet A (M2 A m0 m1) a). Reflexivity.
+    Intro. Exact (M1_semantics_2 A a a1 a2 H1).
+    Intros. Change (MapGet A (makeM2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3)) a)
+        =(Cases (MapGet B (M2 B m2 m3) a) of
+            NONE => (NONE A)
+          | (SOME _) => (MapGet A (M2 A m0 m1) a)
+          end).
+    Rewrite (makeM2_M2 A (MapDomRestrTo m0 m2) (MapDomRestrTo m1 m3) a).
+    Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
+    Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+    Case (ad_bit_0 a); Reflexivity.
+  Qed.
+
+  Fixpoint MapDomRestrBy [m:(Map A)] : (Map B) -> (Map A) :=
+    Cases m of
+        M0 => [_:(Map B)] (M0 A)
+      | (M1 a y) => [m':(Map B)] Cases (MapGet B m' a) of
+                                 NONE => m
+			       | _ => (M0 A)
+			     end
+      | (M2 m1 m2) => [m':(Map B)] Cases m' of
+                                   M0 => m
+				 | (M1 a' y') => (MapRemove A m a')
+				 | (M2 m'1 m'2) => (makeM2 A (MapDomRestrBy m1 m'1)
+				                             (MapDomRestrBy m2 m'2))
+			       end
+    end.
+
+  Lemma MapDomRestrBy_semantics : (m:(Map A)) (m':(Map B))
+      (eqm A (MapGet A (MapDomRestrBy m m'))
+             [a0:ad] Cases (MapGet B m' a0) of
+	               NONE => (MapGet A m a0)
+		     | _ => (NONE A)
+		   end).
+  Proof.
+    Unfold eqm. Induction m. Simpl. Intros. Case (MapGet B m' a); Trivial.
+    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a a1)). Intro H. Rewrite H.
+    Rewrite (ad_eq_complete ? ? H). Case (MapGet B m' a1). Apply M1_semantics_1.
+    Trivial.
+    Intro H. Rewrite H. Case (MapGet B m' a). Rewrite (M1_semantics_2 A a a1 a0 H).
+    Case (MapGet B m' a1); Trivial.
+    Case (MapGet B m' a1); Trivial.
+    Induction m'. Trivial.
+    Unfold MapDomRestrBy. Intros. Rewrite (MapRemove_semantics A (M2 A m0 m1) a a1).
+    Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
+    Rewrite (M1_semantics_1 B a1 a0). Reflexivity.
+    Intro H1. Rewrite H1. Rewrite (M1_semantics_2 B a a1 a0 H1). Reflexivity.
+    Intros. Change (MapGet A (makeM2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3)) a)
+        =(Cases (MapGet B (M2 B m2 m3) a) of
+            NONE => (MapGet A (M2 A m0 m1) a)
+          | (SOME _) => (NONE A)
+          end).
+    Rewrite (makeM2_M2 A (MapDomRestrBy m0 m2) (MapDomRestrBy m1 m3) a).
+    Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)).
+    Rewrite (MapGet_M2_bit_0_if B m2 m3 a). Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+    Case (ad_bit_0 a); Reflexivity.
+  Qed.
+
+  Definition in_dom := [a:ad; m:(Map A)]
+    Cases (MapGet A m a) of
+        NONE => false
+      | _ => true
+    end.
+
+  Lemma in_dom_M0 : (a:ad) (in_dom a (M0 A))=false.
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma in_dom_M1 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=(ad_eq a a0).
+  Proof.
+    Unfold in_dom. Intros. Simpl. Case (ad_eq a a0); Reflexivity.
+  Qed.
+
+  Lemma in_dom_M1_1 : (a:ad) (y:A) (in_dom a (M1 A a y))=true.
+  Proof.
+    Intros. Rewrite in_dom_M1. Apply ad_eq_correct.
+  Qed.
+
+  Lemma in_dom_M1_2 : (a,a0:ad) (y:A) (in_dom a0 (M1 A a y))=true -> a=a0.
+  Proof.
+    Intros. Apply (ad_eq_complete a a0). Rewrite (in_dom_M1 a a0 y) in H. Assumption.
+  Qed.
+
+  Lemma in_dom_some : (m:(Map A)) (a:ad) (in_dom a m)=true ->
+      {y:A | (MapGet A m a)=(SOME A y)}.
+  Proof.
+    Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Trivial.
+    Intro H0. Rewrite H0 in H. Discriminate H.
+  Qed.
+
+  Lemma in_dom_none : (m:(Map A)) (a:ad) (in_dom a m)=false ->
+      (MapGet A m a)=(NONE A).
+  Proof.
+    Unfold in_dom. Intros. Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0.
+    Intros y H1. Rewrite H1 in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma in_dom_put : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
+      (in_dom a (MapPut A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapPut_semantics A m a0 y0 a).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
+    Rewrite H. Rewrite orb_true_b. Reflexivity.
+    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Rewrite orb_false_b.
+    Reflexivity.
+  Qed.
+
+  Lemma in_dom_put_behind : (m:(Map A)) (a0:ad) (y0:A) (a:ad)
+      (in_dom a (MapPut_behind A m a0 y0))=(orb (ad_eq a a0) (in_dom a m)).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapPut_behind_semantics A m a0 y0 a).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
+    Rewrite H. Case (MapGet A m a); Reflexivity.
+    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H. Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma in_dom_remove : (m:(Map A)) (a0:ad) (a:ad)
+      (in_dom a (MapRemove A m a0))=(andb (negb (ad_eq a a0)) (in_dom a m)).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapRemove_semantics A m a0 a).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H.
+    Rewrite H. Reflexivity.
+    Intro H. Rewrite H. Rewrite (ad_eq_comm a a0) in H. Rewrite H.
+    Case (MapGet A m a); Reflexivity.
+  Qed.
+
+  Lemma in_dom_merge : (m,m':(Map A)) (a:ad)
+      (in_dom a (MapMerge A m m'))=(orb (in_dom a m) (in_dom a m')).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapMerge_semantics A m m' a).
+    Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
+    Case (MapGet A m a); Reflexivity.
+    Intro H. Rewrite H. Rewrite orb_b_false. Reflexivity.
+  Qed.
+
+  Lemma in_dom_delta : (m,m':(Map A)) (a:ad)
+      (in_dom a (MapDelta A m m'))=(xorb (in_dom a m) (in_dom a m')).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapDelta_semantics A m m' a).
+    Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
+    Case (MapGet A m a); Reflexivity.
+    Intro H. Rewrite H. Case (MapGet A m a); Reflexivity.
+  Qed.
+
+End Dom.
+
+Section InDom.
+
+  Variable A, B : Set.
+
+  Lemma in_dom_restrto : (m:(Map A)) (m':(Map B)) (a:ad)
+    (in_dom A a (MapDomRestrTo A B m m'))=(andb (in_dom A a m) (in_dom B a m')).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
+    Rewrite andb_b_true. Reflexivity.
+    Intro H. Rewrite H. Rewrite andb_b_false. Reflexivity.
+  Qed.
+
+  Lemma in_dom_restrby : (m:(Map A)) (m':(Map B)) (a:ad)
+    (in_dom A a (MapDomRestrBy A B m m'))=(andb (in_dom A a m) (negb (in_dom B a m'))).
+  Proof.
+    Unfold in_dom. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y H0. Rewrite H0.
+    Unfold negb. Rewrite andb_b_false. Reflexivity.
+    Intro H. Rewrite H. Unfold negb. Rewrite andb_b_true. Reflexivity.
+  Qed.
+
+End InDom.
+
+Definition FSet := (Map unit).
+
+Section FSetDefs.
+
+  Variable A : Set.
+
+  Definition in_FSet : ad -> FSet -> bool := (in_dom unit).
+
+  Fixpoint MapDom [m:(Map A)] : FSet :=
+    Cases m of
+      	M0 => (M0 unit)
+      | (M1 a _) => (M1 unit a tt)
+      | (M2 m m') => (M2 unit (MapDom m) (MapDom m'))
+    end.
+
+  Lemma MapDom_semantics_1 : (m:(Map A)) (a:ad) 
+      (y:A) (MapGet A m a)=(SOME A y) -> (in_FSet a (MapDom m))=true.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0 y0.
+    Case (ad_eq a a0). Trivial.
+    Intro. Discriminate H.
+    Intros m0 H m1 H0 a y. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
+    Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
+    Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0 with y:=y. Assumption.
+    Unfold in_FSet in_dom in H. Intro. Apply H with y:=y. Assumption.
+  Qed.
+
+  Lemma MapDom_semantics_2 : (m:(Map A)) (a:ad) 
+      (in_FSet a (MapDom m))=true -> {y:A | (MapGet A m a)=(SOME A y)}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Unfold MapDom. Unfold in_FSet. Unfold in_dom. Unfold MapGet. Intros a y a0. Case (ad_eq a a0).
+    Intro. Split with y. Reflexivity.
+    Intro. Discriminate H.
+    Intros m0 H m1 H0 a. Rewrite (MapGet_M2_bit_0_if A m0 m1 a). Simpl. Unfold in_FSet.
+    Unfold in_dom. Rewrite (MapGet_M2_bit_0_if unit (MapDom m0) (MapDom m1) a).
+    Case (ad_bit_0 a). Unfold in_FSet in_dom in H0. Intro. Apply H0. Assumption.
+    Unfold in_FSet in_dom in H. Intro. Apply H. Assumption.
+  Qed.
+
+  Lemma MapDom_semantics_3 : (m:(Map A)) (a:ad) 
+      (MapGet A m a)=(NONE A) -> (in_FSet a (MapDom m))=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H0.
+    Elim (MapDom_semantics_2 m a H0). Intros y H1. Rewrite H in H1. Discriminate H1.
+    Trivial.
+  Qed.
+
+  Lemma MapDom_semantics_4 : (m:(Map A)) (a:ad) 
+      (in_FSet a (MapDom m))=false -> (MapGet A m a)=(NONE A).
+  Proof.
+    Intros. Elim (option_sum A (MapGet A m a)). Intro H0. Elim H0. Intros y H1.
+    Rewrite (MapDom_semantics_1 m a y H1) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma MapDom_Dom : (m:(Map A)) (a:ad) (in_dom A a m)=(in_FSet a (MapDom m)).
+  Proof.
+    Intros. Elim (sumbool_of_bool (in_FSet a (MapDom m))). Intro H.
+    Elim (MapDom_semantics_2 m a H). Intros y H0. Rewrite H. Unfold in_dom. Rewrite H0.
+    Reflexivity.
+    Intro H. Rewrite H. Unfold in_dom. Rewrite (MapDom_semantics_4 m a H). Reflexivity.
+  Qed.
+
+  Definition FSetUnion : FSet -> FSet -> FSet := [s,s':FSet] (MapMerge unit s s').
+
+  Lemma in_FSet_union : (s,s':FSet) (a:ad)
+      (in_FSet a (FSetUnion s s'))=(orb (in_FSet a s) (in_FSet a s')).
+  Proof.
+    Exact (in_dom_merge unit).
+  Qed.
+
+  Definition FSetInter : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrTo unit unit s s').
+
+  Lemma in_FSet_inter : (s,s':FSet) (a:ad)
+      (in_FSet a (FSetInter s s'))=(andb (in_FSet a s) (in_FSet a s')).
+  Proof.
+    Exact (in_dom_restrto unit unit).
+  Qed.
+
+  Definition FSetDiff : FSet -> FSet -> FSet := [s,s':FSet] (MapDomRestrBy unit unit s s').
+
+  Lemma in_FSet_diff : (s,s':FSet) (a:ad)
+      (in_FSet a (FSetDiff s s'))=(andb (in_FSet a s) (negb (in_FSet a s'))).
+  Proof.
+    Exact (in_dom_restrby unit unit).
+  Qed.
+
+  Definition FSetDelta : FSet -> FSet -> FSet := [s,s':FSet] (MapDelta unit s s').
+
+  Lemma in_FSet_delta : (s,s':FSet) (a:ad)
+      (in_FSet a (FSetDelta s s'))=(xorb (in_FSet a s) (in_FSet a s')).
+  Proof.
+    Exact (in_dom_delta unit).
+  Qed.
+
+End FSetDefs.
+
+Lemma FSet_Dom : (s:FSet) (MapDom unit s)=s.
+Proof.
+  Induction s. Trivial.
+  Simpl. Intros a t. Elim t. Reflexivity.
+  Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+Qed.
diff --git a/theories7/IntMap/Lsort.v b/theories7/IntMap/Lsort.v
new file mode 100644
index 00000000..31b71c62
--- /dev/null
+++ b/theories7/IntMap/Lsort.v
@@ -0,0 +1,537 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Lsort.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require Arith.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require PolyList.
+Require Mapiter.
+
+Section LSort.
+
+  Variable A : Set.
+
+  Fixpoint ad_less_1 [a,a':ad; p:positive] : bool :=
+    Cases p of
+        (xO p') => (ad_less_1 (ad_div_2 a) (ad_div_2 a') p')
+      | _ => (andb (negb (ad_bit_0 a)) (ad_bit_0 a'))
+    end.
+
+  Definition ad_less := [a,a':ad] Cases (ad_xor a a') of
+      	                              ad_z => false
+				    | (ad_x p) => (ad_less_1 a a' p)
+				  end.
+
+  Lemma ad_bit_0_less : (a,a':ad) (ad_bit_0 a)=false -> (ad_bit_0 a')=true -> 
+      (ad_less a a')=true.
+  Proof.
+    Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
+    Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+    Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
+    Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
+    Rewrite H4. Reflexivity.
+    Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+    Intro H1. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H2.
+    Rewrite H in H2. Rewrite H0 in H2. Discriminate H2.
+    Rewrite H1. Reflexivity.
+  Qed.
+
+  Lemma ad_bit_0_gt : (a,a':ad) (ad_bit_0 a)=true -> (ad_bit_0 a')=false -> 
+      (ad_less a a')=false.
+  Proof.
+    Intros. Elim (ad_sum (ad_xor a a')). Intro H1. Elim H1. Intros p H2. Unfold ad_less.
+    Rewrite H2. Generalize H2. Elim p. Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+    Intros. Cut (ad_bit_0 (ad_xor a a'))=false. Intro. Rewrite (ad_xor_bit_0 a a') in H5.
+    Rewrite H in H5. Rewrite H0 in H5. Discriminate H5.
+    Rewrite H4. Reflexivity.
+    Intro. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+    Intro H1. Unfold ad_less. Rewrite H1. Reflexivity.
+  Qed.
+
+  Lemma ad_less_not_refl : (a:ad) (ad_less a a)=false.
+  Proof.
+    Intro. Unfold ad_less. Rewrite (ad_xor_nilpotent a). Reflexivity.
+  Qed.
+
+  Lemma ad_ind_double : 
+      (a:ad)(P:ad->Prop) (P ad_z) ->
+      	((a:ad) (P a) -> (P (ad_double a))) ->
+      	((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
+  Proof.
+    Intros; Elim a. Trivial.
+    Induction p. Intros. 
+    Apply (H1 (ad_x p0)); Trivial.
+    Intros; Apply (H0 (ad_x p0)); Trivial.
+    Intros; Apply (H1 ad_z); Assumption.
+  Qed.
+
+  Lemma ad_rec_double : 
+      (a:ad)(P:ad->Set) (P ad_z) ->
+      	((a:ad) (P a) -> (P (ad_double a))) ->
+      	((a:ad) (P a) -> (P (ad_double_plus_un a))) -> (P a).
+  Proof.
+    Intros; Elim a. Trivial.
+    Induction p. Intros. 
+    Apply (H1 (ad_x p0)); Trivial.
+    Intros; Apply (H0 (ad_x p0)); Trivial.
+    Intros; Apply (H1 ad_z); Assumption.
+  Qed.
+
+  Lemma ad_less_def_1 : (a,a':ad) (ad_less (ad_double a) (ad_double a'))=(ad_less a a').
+  Proof.
+    Induction a. Induction a'. Reflexivity.
+    Trivial.
+    Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
+    Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
+    Trivial.
+  Qed.
+
+  Lemma ad_less_def_2 : (a,a':ad)
+      (ad_less (ad_double_plus_un a) (ad_double_plus_un a'))=(ad_less a a').
+  Proof.
+    Induction a. Induction a'. Reflexivity.
+    Trivial.
+    Induction a'. Unfold ad_less. Simpl. (Elim p; Trivial).
+    Unfold ad_less. Simpl. Intro. Case (p_xor p p0). Reflexivity.
+    Trivial.
+  Qed.
+
+  Lemma ad_less_def_3 : (a,a':ad) (ad_less (ad_double a) (ad_double_plus_un a'))=true.
+  Proof.
+    Intros. Apply ad_bit_0_less. Apply ad_double_bit_0.
+    Apply ad_double_plus_un_bit_0.
+  Qed.
+
+  Lemma ad_less_def_4 : (a,a':ad) (ad_less (ad_double_plus_un a) (ad_double a'))=false.
+  Proof.
+    Intros. Apply ad_bit_0_gt. Apply ad_double_plus_un_bit_0.
+    Apply ad_double_bit_0.
+  Qed.
+
+  Lemma ad_less_z : (a:ad) (ad_less a ad_z)=false.
+  Proof.
+    Induction a. Reflexivity.
+    Unfold ad_less. Intro. Rewrite (ad_xor_neutral_right (ad_x p)). (Elim p; Trivial).
+  Qed.
+
+  Lemma ad_z_less_1 : (a:ad) (ad_less ad_z a)=true -> {p:positive | a=(ad_x p)}.
+  Proof.
+    Induction a. Intro. Discriminate H.
+    Intros. Split with p. Reflexivity.
+  Qed.
+
+  Lemma ad_z_less_2 : (a:ad) (ad_less ad_z a)=false -> a=ad_z.
+  Proof.
+    Induction a. Trivial.
+    Unfold ad_less. Simpl. Cut (p:positive)(ad_less_1 ad_z (ad_x p) p)=false->False.
+    Intros. Elim (H p H0).
+    Induction p. Intros. Discriminate H0.
+    Intros. Exact (H H0).
+    Intro. Discriminate H.
+  Qed.
+
+  Lemma ad_less_trans : (a,a',a'':ad)
+      (ad_less a a')=true -> (ad_less a' a'')=true -> (ad_less a a'')=true.
+  Proof.
+    Intro a. Apply ad_ind_double with P:=[a:ad]
+          (a',a'':ad)
+           (ad_less a a')=true
+            ->(ad_less a' a'')=true->(ad_less a a'')=true.
+    Intros. Elim (sumbool_of_bool (ad_less ad_z a'')). Trivial.
+    Intro H1. Rewrite (ad_z_less_2 a'' H1) in H0. Rewrite (ad_less_z a') in H0. Discriminate H0.
+    Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
+          (a'':ad)
+           (ad_less (ad_double a0) a')=true
+            ->(ad_less a' a'')=true->(ad_less (ad_double a0) a'')=true.
+    Intros. Rewrite (ad_less_z (ad_double a0)) in H0. Discriminate H0.
+    Intros a1 H0 a'' H1. Rewrite (ad_less_def_1 a0 a1) in H1.
+    Apply ad_ind_double with P:=[a'':ad]
+          (ad_less (ad_double a1) a'')=true
+           ->(ad_less (ad_double a0) a'')=true.
+    Intro. Rewrite (ad_less_z (ad_double a1)) in H2. Discriminate H2.
+    Intros. Rewrite (ad_less_def_1 a1 a2) in H3. Rewrite (ad_less_def_1 a0 a2).
+    Exact (H a1 a2 H1 H3).
+    Intros. Apply ad_less_def_3.
+    Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
+          (ad_less (ad_double_plus_un a1) a'')=true
+           ->(ad_less (ad_double a0) a'')=true.
+    Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
+    Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
+    Intros. Apply ad_less_def_3.
+    Intros a0 H a'. Apply ad_ind_double with P:=[a':ad]
+          (a'':ad)
+           (ad_less (ad_double_plus_un a0) a')=true
+            ->(ad_less a' a'')=true
+               ->(ad_less (ad_double_plus_un a0) a'')=true.
+    Intros. Rewrite (ad_less_z (ad_double_plus_un a0)) in H0. Discriminate H0.
+    Intros. Rewrite (ad_less_def_4 a0 a1) in H1. Discriminate H1.
+    Intros a1 H0 a'' H1. Apply ad_ind_double with P:=[a'':ad]
+          (ad_less (ad_double_plus_un a1) a'')=true
+           ->(ad_less (ad_double_plus_un a0) a'')=true.
+    Intro. Rewrite (ad_less_z (ad_double_plus_un a1)) in H2. Discriminate H2.
+    Intros. Rewrite (ad_less_def_4 a1 a2) in H3. Discriminate H3.
+    Rewrite (ad_less_def_2 a0 a1) in H1. Intros. Rewrite (ad_less_def_2 a1 a2) in H3.
+    Rewrite (ad_less_def_2 a0 a2). Exact (H a1 a2 H1 H3).
+  Qed.
+
+  Fixpoint alist_sorted [l:(alist A)] : bool :=
+    Cases l of
+      	nil => true
+      | (cons (a, _) l') => Cases l' of
+                                nil => true
+			      | (cons (a', y') l'') => (andb (ad_less a a')
+			                                     (alist_sorted l'))
+			    end
+    end.
+
+  Fixpoint alist_nth_ad [n:nat; l:(alist A)] : ad :=
+    Cases l of
+      	nil => ad_z (* dummy *)
+      | (cons (a, y) l') => Cases n of
+                                O => a
+			      | (S n') => (alist_nth_ad n' l')
+			    end
+    end.
+
+  Definition alist_sorted_1 := [l:(alist A)]
+      (n:nat) (le (S (S n)) (length l)) ->
+      	(ad_less (alist_nth_ad n l) (alist_nth_ad (S n) l))=true.
+
+  Lemma alist_sorted_imp_1 : (l:(alist A)) (alist_sorted l)=true -> (alist_sorted_1 l).
+  Proof.
+    Unfold alist_sorted_1. Induction l. Intros. Elim (le_Sn_O (S n) H0).
+    Intro r. Elim r. Intros a y. Induction l0. Intros. Simpl in H1.
+    Elim (le_Sn_O n (le_S_n (S n) O H1)).
+    Intro r0. Elim r0. Intros a0 y0. Induction n. Intros. Simpl. Simpl in H1.
+    Exact (proj1 ? ? (andb_prop ? ? H1)).
+    Intros. Change (ad_less (alist_nth_ad n0 (cons (a0,y0) l1))
+      	                    (alist_nth_ad (S n0) (cons (a0,y0) l1)))=true.
+    Apply H0. Exact (proj2 ? ? (andb_prop ? ? H1)).
+    Apply le_S_n. Exact H3.
+  Qed.
+
+  Definition alist_sorted_2 := [l:(alist A)]
+    (m,n:nat) (lt m n) -> (le (S n) (length l)) ->
+      	(ad_less (alist_nth_ad m l) (alist_nth_ad n l))=true.
+
+  Lemma alist_sorted_1_imp_2 : (l:(alist A)) (alist_sorted_1 l) -> (alist_sorted_2 l).
+  Proof.
+    Unfold alist_sorted_1 alist_sorted_2 lt. Intros l H m n H0. Elim H0. Exact (H m).
+    Intros. Apply ad_less_trans with a':=(alist_nth_ad m0 l). Apply H2. Apply le_trans_S.
+    Assumption.
+    Apply H. Assumption.
+  Qed.
+
+  Lemma alist_sorted_2_imp : (l:(alist A)) (alist_sorted_2 l) -> (alist_sorted l)=true.
+  Proof.
+    Unfold alist_sorted_2 lt. Induction l. Trivial.
+    Intro r. Elim r. Intros a y. Induction l0. Trivial.
+    Intro r0. Elim r0. Intros a0 y0. Intros.
+    Change (andb (ad_less a a0) (alist_sorted (cons (a0,y0) l1)))=true.
+    Apply andb_true_intro. Split. Apply (H1 (0) (1)). Apply le_n.
+    Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
+    Apply H0. Intros. Apply (H1 (S m) (S n)). Apply le_n_S. Assumption.
+    Exact (le_n_S ? ? H3).
+  Qed.
+
+  Lemma app_length : (C:Set) (l,l':(list C)) (length (app l l'))=(plus (length l) (length l')).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (H l'). Reflexivity.
+  Qed.
+
+  Lemma aapp_length : (l,l':(alist A)) (length (aapp A l l'))=(plus (length l) (length l')).
+  Proof.
+    Exact (app_length ad*A).
+  Qed.
+
+  Lemma alist_nth_ad_aapp_1 : (l,l':(alist A)) (n:nat)
+      (le (S n) (length l)) -> (alist_nth_ad n (aapp A l l'))=(alist_nth_ad n l).
+  Proof.
+    Induction l. Intros. Elim (le_Sn_O n H).
+    Intro r. Elim r. Intros a y l' H l''. Induction n. Trivial.
+    Intros. Simpl. Apply H. Apply le_S_n. Exact H1.
+  Qed.
+
+  Lemma alist_nth_ad_aapp_2 : (l,l':(alist A)) (n:nat)
+      (le (S n) (length l')) ->
+      	(alist_nth_ad (plus (length l) n) (aapp A l l'))=(alist_nth_ad n l').
+  Proof.
+    Induction l. Trivial.
+    Intro r. Elim r. Intros a y l' H l'' n H0. Simpl. Apply H. Exact H0.
+  Qed.
+
+  Lemma interval_split : (p,q,n:nat) (le (S n) (plus p q)) ->
+      {n' : nat | (le (S n') q) /\ n=(plus p n')}+{(le (S n) p)}.
+  Proof.
+    Induction p. Simpl. Intros. Left . Split with n. (Split; [ Assumption | Reflexivity ]).
+    Intros p' H q. Induction n. Intros. Right . Apply le_n_S. Apply le_O_n.
+    Intros. Elim (H ? ? (le_S_n ? ? H1)). Intro H2. Left . Elim H2. Intros n' H3.
+    Elim H3. Intros H4 H5. Split with n'. (Split; [ Assumption | Rewrite H5; Reflexivity ]).
+    Intro H2. Right . Apply le_n_S. Assumption.
+  Qed.
+
+  Lemma alist_conc_sorted : (l,l':(alist A)) (alist_sorted_2 l) -> (alist_sorted_2 l') ->
+      ((n,n':nat) (le (S n) (length l)) -> (le (S n') (length l')) ->
+      	  (ad_less (alist_nth_ad n l) (alist_nth_ad n' l'))=true) ->
+      	(alist_sorted_2 (aapp A l l')).
+  Proof.
+    Unfold alist_sorted_2 lt. Intros. Rewrite (aapp_length l l') in H3.
+    Elim (interval_split (length l) (length l') m
+            (le_trans ? ? ? (le_n_S ? ? (lt_le_weak m n H2)) H3)).
+    Intro H4. Elim H4. Intros m' H5. Elim H5. Intros. Rewrite H7.
+    Rewrite (alist_nth_ad_aapp_2 l l' m' H6). Elim (interval_split (length l) (length l') n H3).
+    Intro H8. Elim H8. Intros n' H9. Elim H9. Intros. Rewrite H11.
+    Rewrite (alist_nth_ad_aapp_2 l l' n' H10). Apply H0. Rewrite H7 in H2. Rewrite H11 in H2.
+    Change (le (plus (S (length l)) m') (plus (length l) n')) in H2.
+    Rewrite (plus_Snm_nSm (length l) m') in H2. Exact (simpl_le_plus_l (length l) (S m') n' H2).
+    Exact H10.
+    Intro H8. Rewrite H7 in H2. Cut (le (S (length l)) (length l)). Intros. Elim (le_Sn_n ? H9).
+    Apply le_trans with m:=(S n). Apply le_n_S. Apply le_trans with m:=(S (plus (length l) m')).
+    Apply le_trans with m:=(plus (length l) m'). Apply le_plus_l.
+    Apply le_n_Sn.
+    Exact H2.
+    Exact H8.
+    Intro H4. Rewrite (alist_nth_ad_aapp_1 l l' m H4).
+    Elim (interval_split (length l) (length l') n H3). Intro H5. Elim H5. Intros n' H6. Elim H6.
+    Intros. Rewrite H8. Rewrite (alist_nth_ad_aapp_2 l l' n' H7). Exact (H1 m n' H4 H7).
+    Intro H5. Rewrite (alist_nth_ad_aapp_1 l l' n H5). Exact (H m n H2 H5).
+  Qed.
+
+  Lemma alist_nth_ad_semantics : (l:(alist A)) (n:nat) (le (S n) (length l)) ->
+      {y:A | (alist_semantics A l (alist_nth_ad n l))=(SOME A y)}.
+  Proof.
+    Induction l. Intros. Elim (le_Sn_O ? H).
+    Intro r. Elim r. Intros a y l0 H. Induction n. Simpl. Intro. Split with y.
+    Rewrite (ad_eq_correct a). Reflexivity.
+    Intros. Elim (H ? (le_S_n ? ? H1)). Intros y0 H2.
+    Elim (sumbool_of_bool (ad_eq a (alist_nth_ad n0 l0))). Intro H3. Split with y.
+    Rewrite (ad_eq_complete ? ? H3). Simpl. Rewrite (ad_eq_correct (alist_nth_ad n0 l0)).
+    Reflexivity.
+    Intro H3. Split with y0. Simpl. Rewrite H3. Assumption.
+  Qed.
+
+  Lemma alist_of_Map_nth_ad : (m:(Map A)) (pf:ad->ad)
+      (l:(alist A)) l=(MapFold1 A (alist A) (anil A) (aapp A)
+                                [a0:ad][y:A](acons A (a0,y) (anil A)) pf m) ->
+      	(n:nat) (le (S n) (length l)) -> {a':ad | (alist_nth_ad n l)=(pf a')}.
+  Proof.
+    Intros. Elim (alist_nth_ad_semantics l n H0). Intros y H1.
+    Apply (alist_of_Map_semantics_1_1 A m pf (alist_nth_ad n l) y).
+    Rewrite <- H. Assumption.
+  Qed.
+
+  Definition ad_monotonic := [pf:ad->ad] (a,a':ad)
+      (ad_less a a')=true -> (ad_less (pf a) (pf a'))=true.
+
+  Lemma ad_double_monotonic : (ad_monotonic ad_double).
+  Proof.
+    Unfold ad_monotonic. Intros. Rewrite ad_less_def_1. Assumption.
+  Qed.
+
+  Lemma ad_double_plus_un_monotonic : (ad_monotonic ad_double_plus_un).
+  Proof.
+    Unfold ad_monotonic. Intros. Rewrite ad_less_def_2. Assumption.
+  Qed.
+
+  Lemma ad_comp_monotonic : (pf,pf':ad->ad) (ad_monotonic pf) -> (ad_monotonic pf') ->
+      (ad_monotonic [a0:ad] (pf (pf' a0))).
+  Proof.
+    Unfold ad_monotonic. Intros. Apply H. Apply H0. Exact H1.
+  Qed.
+
+  Lemma ad_comp_double_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
+      (ad_monotonic [a0:ad] (pf (ad_double a0))).
+  Proof.
+    Intros. Apply ad_comp_monotonic. Assumption.
+    Exact ad_double_monotonic.
+  Qed.
+
+  Lemma ad_comp_double_plus_un_monotonic : (pf:ad->ad) (ad_monotonic pf) ->
+      (ad_monotonic [a0:ad] (pf (ad_double_plus_un a0))).
+  Proof.
+    Intros. Apply ad_comp_monotonic. Assumption.
+    Exact ad_double_plus_un_monotonic.
+  Qed.
+
+  Lemma alist_of_Map_sorts_1 : (m:(Map A)) (pf:ad->ad) (ad_monotonic pf) ->
+      (alist_sorted_2 (MapFold1 A (alist A) (anil A) (aapp A)
+                                [a:ad][y:A](acons A (a,y) (anil A)) pf m)).
+  Proof.
+    Induction m. Simpl. Intros. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
+    Intros. Simpl. Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1. Reflexivity.
+    Intros. Simpl. Apply alist_conc_sorted.
+    Exact (H [a0:ad](pf (ad_double a0)) (ad_comp_double_monotonic pf H1)).
+    Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_comp_double_plus_un_monotonic pf H1)).
+    Intros. Elim (alist_of_Map_nth_ad m0 [a0:ad](pf (ad_double a0))
+       (MapFold1 A (alist A) (anil A) (aapp A)
+         [a0:ad][y:A](acons A (a0,y) (anil A))
+         [a0:ad](pf (ad_double a0)) m0) (refl_equal ? ?) n H2).
+    Intros a H4. Rewrite H4. Elim (alist_of_Map_nth_ad m1 [a0:ad](pf (ad_double_plus_un a0))
+       (MapFold1 A (alist A) (anil A) (aapp A)
+         [a0:ad][y:A](acons A (a0,y) (anil A))
+         [a0:ad](pf (ad_double_plus_un a0)) m1) (refl_equal ? ?) n' H3).
+    Intros a' H5. Rewrite H5. Unfold ad_monotonic in H1. Apply H1. Apply ad_less_def_3.
+  Qed.
+
+  Lemma alist_of_Map_sorts : (m:(Map A)) (alist_sorted (alist_of_Map A m))=true.
+  Proof.
+    Intro. Apply alist_sorted_2_imp.
+    Exact (alist_of_Map_sorts_1 m [a0:ad]a0 [a,a':ad][p:(ad_less a a')=true]p).
+  Qed.
+
+  Lemma alist_of_Map_sorts1 : (m:(Map A)) (alist_sorted_1 (alist_of_Map A m)).
+  Proof.
+    Intro. Apply alist_sorted_imp_1. Apply alist_of_Map_sorts.
+  Qed.
+ 
+  Lemma alist_of_Map_sorts2 : (m:(Map A)) (alist_sorted_2 (alist_of_Map A m)).
+  Proof.
+    Intro. Apply alist_sorted_1_imp_2. Apply alist_of_Map_sorts1.
+  Qed.
+ 
+  Lemma ad_less_total : (a,a':ad) {(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}.
+  Proof.
+    Intro a. Refine (ad_rec_double a [a:ad] (a':ad){(ad_less a a')=true}+{(ad_less a' a)=true}+{a=a'}
+                            ? ? ?).
+    Intro. Elim (sumbool_of_bool (ad_less ad_z a')). Intro H. Left . Left . Assumption.
+    Intro H. Right . Rewrite (ad_z_less_2 a' H). Reflexivity.
+    Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double a0) a')=true}
+                                 +{(ad_less a' (ad_double a0))=true}+{(ad_double a0)=a'} ? ? ?).
+    Elim (sumbool_of_bool (ad_less ad_z (ad_double a0))). Intro H0. Left . Right . Assumption.
+    Intro H0. Right . Exact (ad_z_less_2 ? H0).
+    Intros a1 H0. Rewrite ad_less_def_1. Rewrite ad_less_def_1. Elim (H a1). Intro H1.
+    Left . Assumption.
+    Intro H1. Right . Rewrite H1. Reflexivity.
+    Intros a1 H0. Left . Left . Apply ad_less_def_3.
+    Intros a0 H a'. Refine (ad_rec_double a' [a':ad] {(ad_less (ad_double_plus_un a0) a')=true}
+                                 +{(ad_less a' (ad_double_plus_un a0))=true}
+                                 +{(ad_double_plus_un a0)=a'} ? ? ?).
+    Left . Right . (Case a0; Reflexivity).
+    Intros a1 H0. Left . Right . Apply ad_less_def_3.
+    Intros a1 H0. Rewrite ad_less_def_2. Rewrite ad_less_def_2. Elim (H a1). Intro H1.
+    Left . Assumption.
+    Intro H1. Right . Rewrite H1. Reflexivity.
+  Qed.
+
+  Lemma alist_too_low : (l:(alist A)) (a,a':ad) (y:A)
+      (ad_less a a')=true -> (alist_sorted_2 (cons (a',y) l)) ->
+      	(alist_semantics A (cons (a',y) l) a)=(NONE A).
+  Proof.
+    Induction l. Intros. Simpl. Elim (sumbool_of_bool (ad_eq a' a)). Intro H1.
+    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_less_not_refl a) in H. Discriminate H.
+    Intro H1. Rewrite H1. Reflexivity.
+    Intro r. Elim r. Intros a y l0 H a0 a1 y0 H0 H1.
+    Change (Case (ad_eq a1 a0) of
+               (SOME A y0)
+               (alist_semantics A (cons (a,y) l0) a0)
+               end)=(NONE A).
+    Elim (sumbool_of_bool (ad_eq a1 a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
+    Rewrite (ad_less_not_refl a0) in H0. Discriminate H0.
+    Intro H2. Rewrite H2. Apply H. Apply ad_less_trans with a':=a1. Assumption.
+    Unfold alist_sorted_2 in H1. Apply (H1 (0) (1)). Apply lt_n_Sn.
+    Simpl. Apply le_n_S. Apply le_n_S. Apply le_O_n.
+    Apply alist_sorted_1_imp_2. Apply alist_sorted_imp_1.
+    Cut (alist_sorted (cons (a1,y0) (cons (a,y) l0)))=true. Intro H3.
+    Exact (proj2 ? ? (andb_prop ? ? H3)).
+    Apply alist_sorted_2_imp. Assumption.
+  Qed.
+
+  Lemma alist_semantics_nth_ad : (l:(alist A)) (a:ad) (y:A)
+      (alist_semantics A l a)=(SOME A y) ->
+      	{n:nat | (le (S n) (length l)) /\ (alist_nth_ad n l)=a}.
+  Proof.
+    Induction l. Intros. Discriminate H.
+    Intro r. Elim r. Intros a y l0 H a0 y0 H0. Simpl in H0. Elim (sumbool_of_bool (ad_eq a a0)).
+    Intro H1. Rewrite H1 in H0. Split with O. Split. Simpl. Apply le_n_S. Apply le_O_n.
+    Simpl. Exact (ad_eq_complete ? ? H1).
+    Intro H1. Rewrite H1 in H0. Elim (H a0 y0 H0). Intros n' H2. Split with (S n'). Split.
+    Simpl. Apply le_n_S. Exact (proj1 ? ? H2).
+    Exact (proj2 ? ? H2).
+  Qed.
+
+  Lemma alist_semantics_tail : (l:(alist A)) (a:ad) (y:A)
+      (alist_sorted_2 (cons (a,y) l)) ->
+      	(eqm A (alist_semantics A l) [a0:ad] if (ad_eq a a0)
+                                             then (NONE A)
+					     else (alist_semantics A (cons (a,y) l) a0)).
+  Proof.
+    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
+    Rewrite <- (ad_eq_complete ? ? H0). Unfold alist_sorted_2 in H.
+    Elim (option_sum A (alist_semantics A l a)). Intro H1. Elim H1. Intros y0 H2.
+    Elim (alist_semantics_nth_ad l a y0 H2). Intros n H3. Elim H3. Intros.
+    Cut (ad_less (alist_nth_ad (0) (cons (a,y) l)) (alist_nth_ad (S n) (cons (a,y) l)))=true.
+    Intro. Simpl in H6. Rewrite H5 in H6. Rewrite (ad_less_not_refl a) in H6. Discriminate H6.
+    Apply H. Apply lt_O_Sn.
+    Simpl. Apply le_n_S. Assumption.
+    Trivial.
+    Intro H0. Simpl. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma alist_semantics_same_tail : (l,l':(alist A)) (a:ad) (y:A)
+      (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 (cons (a,y) l')) ->
+      	(eqm A (alist_semantics A (cons (a,y) l)) (alist_semantics A (cons (a,y) l'))) ->
+	  (eqm A (alist_semantics A l) (alist_semantics A l')).
+  Proof.
+    Unfold eqm. Intros. Rewrite (alist_semantics_tail ? ? ? H a0).
+    Rewrite (alist_semantics_tail ? ? ? H0 a0). Case (ad_eq a a0). Reflexivity.
+    Exact (H1 a0).
+  Qed.
+
+  Lemma alist_sorted_tail : (l:(alist A)) (a:ad) (y:A)
+      (alist_sorted_2 (cons (a,y) l)) -> (alist_sorted_2 l).
+  Proof.
+    Unfold alist_sorted_2. Intros. Apply (H (S m) (S n)). Apply lt_n_S. Assumption.
+    Simpl. Apply le_n_S. Assumption.
+  Qed.
+
+  Lemma alist_canonical : (l,l':(alist A))
+      (eqm A (alist_semantics A l) (alist_semantics A l')) ->
+      	(alist_sorted_2 l) -> (alist_sorted_2 l') -> l=l'.
+  Proof.
+    Unfold eqm. Induction l. Induction l'. Trivial.
+    Intro r. Elim r. Intros a y l0 H H0 H1 H2. Simpl in H0.
+    Cut (NONE A)=(Case (ad_eq a a) of (SOME A y)
+                           (alist_semantics A l0 a)
+                           end).
+    Rewrite (ad_eq_correct a). Intro. Discriminate H3.
+    Exact (H0 a).
+    Intro r. Elim r. Intros a y l0 H. Induction l'. Intros. Simpl in H0.
+    Cut (Case (ad_eq a a) of (SOME A y)
+                         (alist_semantics A l0 a)
+                         end)=(NONE A).
+    Rewrite (ad_eq_correct a). Intro. Discriminate H3.
+    Exact (H0 a).
+    Intro r'. Elim r'. Intros a' y' l'0 H0 H1 H2 H3. Elim (ad_less_total a a'). Intro H4.
+    Elim H4. Intro H5.
+    Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
+    Intro. Rewrite (alist_too_low l'0 a a' y' H5 H3) in H6. Simpl in H6.
+    Rewrite (ad_eq_correct a) in H6. Discriminate H6.
+    Exact (H1 a).
+    Intro H5. Cut (alist_semantics A (cons (a,y) l0) a')=(alist_semantics A (cons (a',y') l'0) a').
+    Intro. Rewrite (alist_too_low l0 a' a y H5 H2) in H6. Simpl in H6.
+    Rewrite (ad_eq_correct a') in H6. Discriminate H6.
+    Exact (H1 a').
+    Intro H4. Rewrite H4.
+    Cut (alist_semantics A (cons (a,y) l0) a)=(alist_semantics A (cons (a',y') l'0) a).
+    Intro. Simpl in H5. Rewrite H4 in H5. Rewrite (ad_eq_correct a') in H5. Inversion H5.
+    Rewrite H4 in H1. Rewrite H7 in H1. Cut l0=l'0. Intro. Rewrite H6. Reflexivity.
+    Apply H. Rewrite H4 in H2. Rewrite H7 in H2.
+    Exact (alist_semantics_same_tail l0 l'0 a' y' H2 H3 H1).
+    Exact (alist_sorted_tail ? ? ? H2).
+    Exact (alist_sorted_tail ? ? ? H3).
+    Exact (H1 a).
+  Qed.
+
+End LSort.
diff --git a/theories7/IntMap/Map.v b/theories7/IntMap/Map.v
new file mode 100644
index 00000000..00ba3f8a
--- /dev/null
+++ b/theories7/IntMap/Map.v
@@ -0,0 +1,786 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Map.v,v 1.1.2.1 2004/07/16 19:31:27 herbelin Exp $	 i*)
+
+(** Definition of finite sets as trees indexed by adresses *)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+
+
+Section MapDefs.
+
+(** We define maps from ad to A. *)
+  Variable A : Set.  
+
+  Inductive Map : Set :=
+      M0 : Map
+    | M1 : ad -> A -> Map
+    | M2 : Map -> Map -> Map.
+
+  Inductive option : Set :=
+      NONE : option
+    | SOME : A -> option.
+
+  Lemma option_sum : (o:option) {y:A | o=(SOME y)}+{o=NONE}.
+  Proof.
+    Induction o. Right . Reflexivity.
+    Left . Split with a. Reflexivity.
+  Qed.
+
+  (** The semantics of maps is given by the function [MapGet].
+      The semantics of a map [m] is a partial, finite function from
+      [ad] to [A]: *)
+
+  Fixpoint MapGet [m:Map] : ad -> option :=
+    Cases m of
+        M0 => [a:ad] NONE
+      | (M1 x y) => [a:ad]
+          if (ad_eq x a)
+	     then (SOME y)
+	  else NONE
+      | (M2 m1 m2) => [a:ad]
+          Cases a of
+	      ad_z => (MapGet m1 ad_z)
+	    | (ad_x xH) => (MapGet m2 ad_z)
+	    | (ad_x (xO p)) => (MapGet m1 (ad_x p))
+	    | (ad_x (xI p)) => (MapGet m2 (ad_x p))
+	  end
+    end.
+
+  Definition newMap := M0.
+
+  Definition MapSingleton := M1.
+
+  Definition eqm := [g,g':ad->option] (a:ad) (g a)=(g' a).
+
+  Lemma newMap_semantics : (eqm (MapGet newMap) [a:ad] NONE).
+  Proof.
+    Simpl. Unfold eqm. Trivial.
+  Qed.
+
+  Lemma MapSingleton_semantics : (a:ad) (y:A)
+      (eqm (MapGet (MapSingleton a y)) [a':ad] if (ad_eq a a') then (SOME y) else NONE).
+  Proof.
+    Simpl. Unfold eqm. Trivial.
+  Qed.
+
+  Lemma M1_semantics_1 : (a:ad) (y:A) (MapGet (M1 a y) a)=(SOME y).
+  Proof.
+    Unfold MapGet. Intros. Rewrite (ad_eq_correct a). Reflexivity.
+  Qed.
+
+  Lemma M1_semantics_2 :
+      (a,a':ad) (y:A) (ad_eq a a')=false -> (MapGet (M1 a y) a')=NONE.
+  Proof.
+    Intros. Simpl. Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma Map2_semantics_1 :
+      (m,m':Map) (eqm (MapGet m) [a:ad] (MapGet (M2 m m') (ad_double a))).
+  Proof.
+    Unfold eqm. Induction a; Trivial.
+  Qed.
+
+  Lemma Map2_semantics_1_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
+      -> (eqm (MapGet m) [a:ad] (f (ad_double a))).
+  Proof.
+    Unfold eqm.
+    Intros.
+    Rewrite <- (H (ad_double a)).
+    Exact (Map2_semantics_1 m m' a).
+  Qed.
+
+  Lemma Map2_semantics_2 :
+      (m,m':Map) (eqm (MapGet m') [a:ad] (MapGet (M2 m m') (ad_double_plus_un a))).
+  Proof.
+    Unfold eqm. Induction a; Trivial.
+  Qed.
+
+  Lemma Map2_semantics_2_eq : (m,m':Map) (f:ad->option) (eqm (MapGet (M2 m m')) f)
+      -> (eqm (MapGet m') [a:ad] (f (ad_double_plus_un a))).
+  Proof.
+    Unfold eqm.
+    Intros.
+    Rewrite <- (H (ad_double_plus_un a)).
+    Exact (Map2_semantics_2 m m' a).
+  Qed.
+
+  Lemma MapGet_M2_bit_0_0 : (a:ad) (ad_bit_0 a)=false
+      -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m (ad_div_2 a)).
+  Proof.
+    Induction a; Trivial. Induction p. Intros. Discriminate H0.
+    Trivial.
+    Intros. Discriminate H.
+  Qed.
+
+  Lemma MapGet_M2_bit_0_1 : (a:ad) (ad_bit_0 a)=true
+      -> (m,m':Map) (MapGet (M2 m m') a)=(MapGet m' (ad_div_2 a)).
+  Proof.
+    Induction a. Intros. Discriminate H.
+    Induction p. Trivial.
+    Intros. Discriminate H0.
+    Trivial.
+  Qed.
+
+  Lemma MapGet_M2_bit_0_if : (m,m':Map) (a:ad) (MapGet (M2 m m') a)=
+      (if (ad_bit_0 a) then (MapGet m' (ad_div_2 a)) else (MapGet m (ad_div_2 a))).
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
+    Apply MapGet_M2_bit_0_1; Assumption.
+    Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
+  Qed.
+
+  Lemma MapGet_M2_bit_0 : (m,m',m'':Map)
+      (a:ad) (if (ad_bit_0 a) then (MapGet (M2 m' m) a) else (MapGet (M2 m m'') a))=
+             (MapGet m (ad_div_2 a)).
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H. Rewrite H.
+    Apply MapGet_M2_bit_0_1; Assumption.
+    Intro H. Rewrite H. Apply MapGet_M2_bit_0_0; Assumption.
+  Qed.
+
+  Lemma Map2_semantics_3 : (m,m':Map) (eqm (MapGet (M2 m m'))
+      [a:ad] Cases (ad_bit_0 a) of
+                 false => (MapGet m (ad_div_2 a))
+	       | true => (MapGet m' (ad_div_2 a))
+	     end).
+  Proof.
+    Unfold eqm.
+    Induction a; Trivial.
+    Induction p; Trivial.
+  Qed.
+
+  Lemma Map2_semantics_3_eq : (m,m':Map) (f,f':ad->option)
+      (eqm (MapGet m) f) -> (eqm (MapGet m') f') -> (eqm (MapGet (M2 m m'))
+      [a:ad] Cases (ad_bit_0 a) of
+                 false => (f (ad_div_2 a))
+	       | true => (f' (ad_div_2 a))
+	     end).
+  Proof.
+    Unfold eqm.
+    Intros.
+    Rewrite <- (H (ad_div_2 a)).
+    Rewrite <- (H0 (ad_div_2 a)).
+    Exact (Map2_semantics_3 m m' a).
+  Qed.
+
+  Fixpoint MapPut1 [a:ad; y:A; a':ad; y':A; p:positive] : Map :=
+    Cases p of
+        (xO p') => let m = (MapPut1 (ad_div_2 a) y (ad_div_2 a') y' p') in
+      	           Cases (ad_bit_0 a) of
+      	               false => (M2 m M0)
+		     | true => (M2 M0 m)
+		   end
+      | _ => Cases (ad_bit_0 a) of
+                 false => (M2 (M1 (ad_div_2 a) y) (M1 (ad_div_2 a') y'))
+	       | true => (M2 (M1 (ad_div_2 a') y') (M1 (ad_div_2 a) y))
+	     end
+    end.
+
+  Lemma MapGet_if_commute : (b:bool) (m,m':Map) (a:ad)
+      (MapGet (if b then m else m') a)=(if b then (MapGet m a) else (MapGet m' a)).
+  Proof.
+    Intros. Case b; Trivial.
+  Qed.
+
+  (*i
+  Lemma MapGet_M2_bit_0_1' : (m,m',m'',m''':Map)
+      (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m'' m''')) a)=
+             (MapGet (if (ad_bit_0 a) then m' else m'') (ad_div_2 a)).
+  Proof.
+    Intros. Rewrite (MapGet_if_commute (ad_bit_0 a)). Rewrite (MapGet_if_commute (ad_bit_0 a)).
+    Cut (ad_bit_0 a)=false\/(ad_bit_0 a)=true. Intros. Elim H. Intros. Rewrite H0.
+    Apply MapGet_M2_bit_0_0. Assumption.
+    Intros. Rewrite H0. Apply MapGet_M2_bit_0_1. Assumption.
+    Case (ad_bit_0 a); Auto.
+  Qed.
+  i*)
+
+  Lemma MapGet_if_same : (m:Map) (b:bool) (a:ad) 
+      (MapGet (if b then m else m) a)=(MapGet m a).
+  Proof.
+    Induction b;Trivial.
+  Qed.
+
+  Lemma MapGet_M2_bit_0_2 : (m,m',m'':Map)
+      (a:ad) (MapGet (if (ad_bit_0 a) then (M2 m m') else (M2 m' m'')) a)=
+             (MapGet m' (ad_div_2 a)).
+  Proof.
+    Intros. Rewrite MapGet_if_commute. Apply MapGet_M2_bit_0.
+  Qed.
+
+  Lemma MapPut1_semantics_1 : (p:positive) (a,a':ad) (y,y':A)
+      (ad_xor a a')=(ad_x p)
+      	-> (MapGet (MapPut1 a y a' y' p) a)=(SOME y).
+  Proof.
+    Induction p. Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+    Intros. Simpl. Rewrite MapGet_M2_bit_0_2. Apply H. Rewrite <- ad_xor_div_2. Rewrite H0.
+    Reflexivity.
+    Intros. Unfold MapPut1. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+  Qed.
+
+  Lemma MapPut1_semantics_2 : (p:positive) (a,a':ad) (y,y':A)
+      (ad_xor a a')=(ad_x p)
+      	-> (MapGet (MapPut1 a y a' y' p) a')=(SOME y').
+  Proof.
+    Induction p. Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_2 a a' p0 H0).
+    Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+    Intros. Simpl. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite MapGet_M2_bit_0_2.
+    Apply H. Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
+    Intros. Unfold MapPut1. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite if_negb.
+    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_1.
+  Qed.
+
+  Lemma MapGet_M2_both_NONE : (m,m':Map) (a:ad)
+      (MapGet m (ad_div_2 a))=NONE -> (MapGet m' (ad_div_2 a))=NONE -> 
+        (MapGet (M2 m m') a)=NONE.
+  Proof.
+    Intros. Rewrite (Map2_semantics_3 m m' a). 
+    Case (ad_bit_0 a); Assumption.
+  Qed.
+ 
+  Lemma MapPut1_semantics_3 : (p:positive) (a,a',a0:ad) (y,y':A)
+      	(ad_xor a a')=(ad_x p) -> (ad_eq a a0)=false -> (ad_eq a' a0)=false ->
+	  (MapGet (MapPut1 a y a' y' p) a0)=NONE.
+  Proof.
+    Induction p. Intros. Unfold MapPut1. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
+    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
+    Rewrite (ad_neg_bit_0_2 a a' p0 H0) in H3. Rewrite (negb_intro (ad_bit_0 a')).
+    Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H3. Reflexivity.
+    Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_neg_bit_0_2 a a' p0 H0). Rewrite H4.
+    Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
+    Apply M1_semantics_2; Assumption.
+    Intro; Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; 
+	Apply M1_semantics_2; Assumption.
+    Intros. Simpl. Elim (ad_neq a a0 H1). Intro. Rewrite H3. Rewrite if_negb.
+    Rewrite MapGet_M2_bit_0_2. Reflexivity.
+    Intro. Elim (ad_neq a' a0 H2). Intro. Rewrite (ad_same_bit_0 a a' p0 H0). Rewrite H4.
+    Rewrite if_negb. Rewrite MapGet_M2_bit_0_2. Reflexivity.
+    Intro. Cut (ad_xor (ad_div_2 a) (ad_div_2 a'))=(ad_x p0). Intro.
+    Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Trivial; 
+	Apply H; Assumption.
+    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
+    Intros. Simpl. Elim (ad_neq a a0 H0). Intro. Rewrite H2. Rewrite if_negb.
+    Rewrite MapGet_M2_bit_0_2. Apply M1_semantics_2. Apply ad_div_bit_neq. Assumption.
+    Rewrite (ad_neg_bit_0_1 a a' H) in H2. Rewrite (negb_intro (ad_bit_0 a')).
+    Rewrite (negb_intro (ad_bit_0 a0)). Rewrite H2. Reflexivity.
+    Intro. Elim (ad_neq a' a0 H1). Intro. Rewrite (ad_neg_bit_0_1 a a' H). Rewrite H3.
+    Rewrite (negb_elim (ad_bit_0 a0)). Rewrite MapGet_M2_bit_0_2.
+    Apply M1_semantics_2; Assumption.
+    Intro. Case (ad_bit_0 a); Apply MapGet_M2_both_NONE; Apply M1_semantics_2; Assumption.
+  Qed.
+
+  Lemma MapPut1_semantics : (p:positive) (a,a':ad) (y,y':A)
+      (ad_xor a a')=(ad_x p)
+        -> (eqm (MapGet (MapPut1 a y a' y' p))
+	        [a0:ad] if (ad_eq a a0) then (SOME y)
+		        else if (ad_eq a' a0) then (SOME y') else NONE).
+  Proof.
+    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
+    Rewrite <- (ad_eq_complete ? ? H0). Exact (MapPut1_semantics_1 p a a' y y' H).
+    Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq a' a0)). Intro H1.
+    Rewrite <- (ad_eq_complete ? ? H1). Rewrite (ad_eq_correct a').
+    Exact (MapPut1_semantics_2 p a a' y y' H).
+    Intro H1. Rewrite H1. Exact (MapPut1_semantics_3 p a a' a0 y y' H H0 H1).
+  Qed.
+
+  Lemma MapPut1_semantics' : (p:positive) (a,a':ad) (y,y':A)
+      (ad_xor a a')=(ad_x p)
+        -> (eqm (MapGet (MapPut1 a y a' y' p))
+	        [a0:ad] if (ad_eq a' a0) then (SOME y')
+		        else if (ad_eq a a0) then (SOME y) else NONE).
+  Proof.
+    Unfold eqm. Intros. Rewrite (MapPut1_semantics p a a' y y' H a0).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0.
+    Rewrite <- (ad_eq_complete a a0 H0). Rewrite (ad_eq_comm a' a).
+    Rewrite (ad_xor_eq_false a a' p H). Reflexivity.
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Fixpoint MapPut [m:Map] : ad -> A -> Map :=
+    Cases m of
+        M0 => M1
+      | (M1 a y) => [a':ad; y':A]
+          Cases (ad_xor a a') of
+	      ad_z => (M1 a' y')
+	    | (ad_x p) => (MapPut1 a y a' y' p)
+          end
+      | (M2 m1 m2) => [a:ad; y:A]
+          Cases a of
+	      ad_z => (M2 (MapPut m1 ad_z y) m2)
+	    | (ad_x xH) => (M2 m1 (MapPut m2 ad_z y))
+	    | (ad_x (xO p)) => (M2 (MapPut m1 (ad_x p) y) m2)
+	    | (ad_x (xI p)) => (M2 m1 (MapPut m2 (ad_x p) y))
+	  end
+    end.
+
+  Lemma MapPut_semantics_1 : (a:ad) (y:A) (a0:ad)
+      (MapGet (MapPut M0 a y) a0)=(MapGet (M1 a y) a0).
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapPut_semantics_2_1 : (a:ad) (y,y':A) (a0:ad)
+      (MapGet (MapPut (M1 a y) a y') a0)=(if (ad_eq a a0) then (SOME y') else NONE).
+  Proof.
+    Simpl. Intros. Rewrite (ad_xor_nilpotent a). Trivial.
+  Qed.
+
+  Lemma MapPut_semantics_2_2 : (a,a':ad) (y,y':A) (a0:ad) (a'':ad) (ad_xor a a')=a'' ->
+      (MapGet (MapPut (M1 a y) a' y') a0)=
+      (if (ad_eq a' a0) then (SOME y') else
+       if (ad_eq a a0) then (SOME y) else NONE).
+  Proof.
+    Induction a''. Intro. Rewrite (ad_xor_eq ? ? H). Rewrite MapPut_semantics_2_1.
+    Case (ad_eq a' a0); Trivial.
+    Intros. Simpl. Rewrite H. Rewrite (MapPut1_semantics p a a' y y' H a0).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Rewrite H0. Rewrite <- (ad_eq_complete ? ? H0).
+    Rewrite (ad_eq_comm a' a). Rewrite (ad_xor_eq_false ? ? ? H). Reflexivity.
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapPut_semantics_2 : (a,a':ad) (y,y':A) (a0:ad)
+      (MapGet (MapPut (M1 a y) a' y') a0)=
+      (if (ad_eq a' a0) then (SOME y') else
+       if (ad_eq a a0) then (SOME y) else NONE).
+  Proof.
+    Intros. Apply MapPut_semantics_2_2 with a'':=(ad_xor a a'); Trivial.
+  Qed.
+
+  Lemma MapPut_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
+      (MapPut (M2 m m') a y)=(if (ad_bit_0 a) then (M2 m (MapPut m' (ad_div_2 a) y))
+                                              else (M2 (MapPut m (ad_div_2 a) y) m')).
+  Proof.
+    Induction a. Trivial.
+    Induction p; Trivial.
+  Qed.
+
+  Lemma MapPut_semantics : (m:Map) (a:ad) (y:A)
+      (eqm (MapGet (MapPut m a y)) [a':ad] if (ad_eq a a') then (SOME y) else (MapGet m a')).
+  Proof.
+    Unfold eqm. Induction m. Exact MapPut_semantics_1.
+    Intros. Unfold 2 MapGet. Apply MapPut_semantics_2; Assumption.
+    Intros. Rewrite MapPut_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a0).
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if.
+    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite H2.
+    Rewrite (H0 (ad_div_2 a) y (ad_div_2 a0)). Elim (sumbool_of_bool (ad_eq a a0)).
+    Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
+    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
+    Intro H2. Rewrite H2. Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq a0 a H2 H1).
+    Reflexivity.
+    Intro H1. Rewrite H1. Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)).
+    Intro H2. Rewrite H2. Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
+    Intro H2. Rewrite H2. Rewrite (H (ad_div_2 a) y (ad_div_2 a0)).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3.
+    Rewrite (ad_div_eq a a0 H3). Reflexivity.
+    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq a a0 H3 H1). Reflexivity.
+  Qed.
+
+  Fixpoint MapPut_behind [m:Map] : ad -> A -> Map :=
+    Cases m of
+        M0 => M1
+      | (M1 a y) => [a':ad; y':A]
+          Cases (ad_xor a a') of
+	      ad_z => m
+	    | (ad_x p) => (MapPut1 a y a' y' p)
+          end
+      | (M2 m1 m2) => [a:ad; y:A]
+          Cases a of
+	      ad_z => (M2 (MapPut_behind m1 ad_z y) m2)
+	    | (ad_x xH) => (M2 m1 (MapPut_behind m2 ad_z y))
+	    | (ad_x (xO p)) => (M2 (MapPut_behind m1 (ad_x p) y) m2)
+	    | (ad_x (xI p)) => (M2 m1 (MapPut_behind m2 (ad_x p) y))
+	  end
+    end.
+
+  Lemma MapPut_behind_semantics_3_1 : (m,m':Map) (a:ad) (y:A)
+      (MapPut_behind (M2 m m') a y)=
+      (if (ad_bit_0 a) then (M2 m (MapPut_behind m' (ad_div_2 a) y))
+                       else (M2 (MapPut_behind m (ad_div_2 a) y) m')).
+  Proof.
+    Induction a. Trivial.
+    Induction p; Trivial.
+  Qed.
+
+  Lemma MapPut_behind_as_before_1 : (a,a',a0:ad) (ad_eq a' a0)=false ->
+      (y,y':A) (MapGet (MapPut (M1 a y) a' y') a0)
+               =(MapGet (MapPut_behind (M1 a y) a' y') a0).
+  Proof.
+    Intros a a' a0. Simpl. Intros H y y'. Elim (ad_sum (ad_xor a a')). Intro H0. Elim H0.
+    Intros p H1. Rewrite H1. Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (ad_xor_eq ? ? H0). Rewrite (M1_semantics_2 a' a0 y H).
+    Exact (M1_semantics_2 a' a0 y' H).
+  Qed.
+
+  Lemma MapPut_behind_as_before : (m:Map) (a:ad) (y:A)
+      (a0:ad) (ad_eq a a0)=false ->
+         (MapGet (MapPut m a y) a0)=(MapGet (MapPut_behind m a y) a0).
+  Proof.
+    Induction m. Trivial.
+    Intros a y a' y' a0 H. Exact (MapPut_behind_as_before_1 a a' a0 H y y').
+    Intros. Rewrite MapPut_semantics_3_1. Rewrite MapPut_behind_semantics_3_1.
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if.
+    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3.
+    Rewrite H3. Apply H0. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
+    Intro H3. Rewrite H3. Reflexivity.
+    Intro H2. Rewrite H2. Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
+    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H3. Rewrite H3. Reflexivity.
+    Intro H3. Rewrite H3. Apply H. Rewrite <- H3 in H2. Exact (ad_div_bit_neq a a0 H1 H2).
+  Qed.
+
+  Lemma MapPut_behind_new : (m:Map) (a:ad) (y:A)
+      (MapGet (MapPut_behind m a y) a)=(Cases (MapGet m a) of
+                                            (SOME y') => (SOME y')
+					  | _ => (SOME y)
+				        end).
+  Proof.
+    Induction m. Simpl. Intros. Rewrite (ad_eq_correct a). Reflexivity.
+    Intros. Elim (ad_sum (ad_xor a a1)). Intro H. Elim H. Intros p H0. Simpl.
+    Rewrite H0. Rewrite (ad_xor_eq_false a a1 p). Exact (MapPut1_semantics_2 p a a1 a0 y H0).
+    Assumption.
+    Intro H. Simpl. Rewrite H. Rewrite <- (ad_xor_eq ? ? H). Rewrite (ad_eq_correct a).
+    Exact (M1_semantics_1 a a0).
+    Intros. Rewrite MapPut_behind_semantics_3_1. Rewrite (MapGet_M2_bit_0_if m0 m1 a).
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_1 a H1).
+    Exact (H0 (ad_div_2 a) y).
+    Intro H1. Rewrite H1. Rewrite (MapGet_M2_bit_0_0 a H1). Exact (H (ad_div_2 a) y).
+  Qed.
+
+  Lemma MapPut_behind_semantics : (m:Map) (a:ad) (y:A)
+      (eqm (MapGet (MapPut_behind m a y))
+           [a':ad] Cases (MapGet m a') of
+                       (SOME y') => (SOME y')
+		     | _ => if (ad_eq a a') then (SOME y) else NONE
+		   end).
+  Proof.
+    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H. Rewrite H.
+    Rewrite (ad_eq_complete ? ? H). Apply MapPut_behind_new.
+    Intro H. Rewrite H. Rewrite <- (MapPut_behind_as_before m a y a0 H).
+    Rewrite (MapPut_semantics m a y a0). Rewrite H. Case (MapGet m a0); Trivial.
+  Qed.
+
+  Definition makeM2 := [m,m':Map] Cases m m' of
+                                      M0 M0 => M0
+				    | M0 (M1 a y) => (M1 (ad_double_plus_un a) y)
+				    | (M1 a y) M0 => (M1 (ad_double a) y)
+				    | _ _ => (M2 m m')
+				  end.
+
+  Lemma makeM2_M2 : (m,m':Map) (eqm (MapGet (makeM2 m m')) (MapGet (M2 m m'))).
+  Proof.
+    Unfold eqm. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H.
+    Rewrite (MapGet_M2_bit_0_1 a H m m'). Case m'. Case m. Reflexivity.
+    Intros a0 y. Simpl. Rewrite (ad_bit_0_1_not_double a H a0). Reflexivity.
+    Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
+    Assumption.
+    Case m. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))).
+    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double_plus_un a H).
+    Rewrite (ad_eq_correct a). Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0.
+    Rewrite (ad_not_div_2_not_double_plus_un a a0 H0). Reflexivity.
+    Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
+    Assumption.
+    Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_1. Reflexivity.
+    Assumption.
+    Intros m1 m2. Unfold makeM2.
+    Cut (MapGet (M2 m (M2 m1 m2)) a)=(MapGet (M2 m1 m2) (ad_div_2 a)). 
+    Case m; Trivial.
+    Exact (MapGet_M2_bit_0_1 a H m (M2 m1 m2)).
+    Intro H. Rewrite (MapGet_M2_bit_0_0 a H m m'). Case m. Case m'. Reflexivity.
+    Intros a0 y. Simpl. Rewrite (ad_bit_0_0_not_double_plus_un a H a0). Reflexivity.
+    Intros m1 m2. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
+    Assumption.
+    Case m'. Intros a0 y. Simpl. Elim (sumbool_of_bool (ad_eq a0 (ad_div_2 a))). Intro H0.
+    Rewrite H0. Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_div_2_double a H).
+    Rewrite (ad_eq_correct a). Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (ad_eq_comm (ad_double a0) a).
+    Rewrite (ad_eq_comm a0 (ad_div_2 a)) in H0. Rewrite (ad_not_div_2_not_double a a0 H0).
+    Reflexivity.
+    Intros a0 y0 a1 y1. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
+    Assumption.
+    Intros m1 m2 a0 y. Unfold makeM2. Rewrite MapGet_M2_bit_0_0. Reflexivity.
+    Assumption.
+    Intros m1 m2. Unfold makeM2. Exact (MapGet_M2_bit_0_0 a H (M2 m1 m2) m').
+  Qed.
+
+  Fixpoint MapRemove [m:Map] : ad -> Map :=
+    Cases m of
+        M0 => [_:ad] M0
+      | (M1 a y) => [a':ad]
+          Cases (ad_eq a a') of
+	      true => M0
+	    | false => m
+          end
+      | (M2 m1 m2) => [a:ad]
+          if (ad_bit_0 a)
+	  then (makeM2 m1 (MapRemove m2 (ad_div_2 a)))
+	  else (makeM2 (MapRemove m1 (ad_div_2 a)) m2)
+    end.
+
+  Lemma MapRemove_semantics : (m:Map) (a:ad)
+      (eqm (MapGet (MapRemove m a)) [a':ad] if (ad_eq a a') then NONE else (MapGet m a')).
+  Proof.
+    Unfold eqm. Induction m. Simpl. Intros. Case (ad_eq a a0); Trivial.
+    Intros. Simpl. Elim (sumbool_of_bool (ad_eq a1 a2)). Intro H. Rewrite H.
+    Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H) in H0. Exact (M1_semantics_2 a a2 a0 H0).
+    Intro H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0. Rewrite H.
+    Rewrite <- (ad_eq_complete ? ? H0) in H. Rewrite H. Reflexivity.
+    Intro H0. Rewrite H0. Rewrite H. Reflexivity.
+    Intros. Change (MapGet (if (ad_bit_0 a)
+                            then (makeM2 m0 (MapRemove m1 (ad_div_2 a)))
+                            else (makeM2 (MapRemove m0 (ad_div_2 a)) m1))
+			   a0)
+                   =(if (ad_eq a a0) then NONE else (MapGet (M2 m0 m1) a0)).
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H1. Rewrite H1.
+    Rewrite (makeM2_M2 m0 (MapRemove m1 (ad_div_2 a)) a0). Elim (sumbool_of_bool (ad_bit_0 a0)).
+    Intro H2. Rewrite MapGet_M2_bit_0_1. Rewrite (H0 (ad_div_2 a) (ad_div_2 a0)).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H3. Rewrite H3. Rewrite (ad_div_eq ? ? H3).
+    Reflexivity.
+    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1).
+    Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Reflexivity.
+    Assumption.
+    Intro H2. Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 (MapRemove m1 (ad_div_2 a))).
+    Rewrite (ad_eq_comm a a0). Rewrite (ad_bit_0_neq ? ? H2 H1).
+    Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Reflexivity.
+    Intro H1. Rewrite H1. Rewrite (makeM2_M2 (MapRemove m0 (ad_div_2 a)) m1 a0).
+    Elim (sumbool_of_bool (ad_bit_0 a0)). Intro H2. Rewrite MapGet_M2_bit_0_1.
+    Rewrite (MapGet_M2_bit_0_1 a0 H2 m0 m1). Rewrite (ad_bit_0_neq a a0 H1 H2). Reflexivity.
+    Assumption.
+    Intro H2. Rewrite MapGet_M2_bit_0_0. Rewrite (H (ad_div_2 a) (ad_div_2 a0)).
+    Rewrite (MapGet_M2_bit_0_0 a0 H2 m0 m1). Elim (sumbool_of_bool (ad_eq a a0)). Intro H3.
+    Rewrite H3. Rewrite (ad_div_eq ? ? H3). Reflexivity.
+    Intro H3. Rewrite H3. Rewrite <- H2 in H1. Rewrite (ad_div_bit_neq ? ? H3 H1). Reflexivity.
+    Assumption.
+  Qed.
+
+  Fixpoint MapCard [m:Map] : nat :=
+    Cases m of
+        M0 => O
+      | (M1 _ _) => (S O)
+      | (M2 m m') => (plus (MapCard m) (MapCard m'))
+    end.
+
+  Fixpoint MapMerge [m:Map] : Map -> Map :=
+    Cases m of
+        M0 => [m':Map] m'
+      | (M1 a y) => [m':Map] (MapPut_behind m' a y)
+      | (M2 m1 m2) => [m':Map] Cases m' of
+      	                           M0 => m
+				 | (M1 a' y') => (MapPut m a' y')
+				 | (M2 m'1 m'2) => (M2 (MapMerge m1 m'1) 
+	                                               (MapMerge m2 m'2))
+			       end
+    end.
+
+  Lemma MapMerge_semantics : (m,m':Map)
+      (eqm (MapGet (MapMerge m m'))
+           [a0:ad] Cases (MapGet m' a0) of
+	               (SOME y') => (SOME y')
+		     | NONE => (MapGet m a0)
+                   end).
+  Proof.
+    Unfold eqm. Induction m. Intros. Simpl. Case (MapGet m' a); Trivial.
+    Intros. Simpl. Rewrite (MapPut_behind_semantics m' a a0 a1). Reflexivity.
+    Induction m'. Trivial.
+    Intros. Unfold MapMerge. Rewrite (MapPut_semantics (M2 m0 m1) a a0 a1).
+    Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Rewrite H1. Rewrite (ad_eq_complete ? ? H1).
+    Rewrite (M1_semantics_1 a1 a0). Reflexivity.
+    Intro H1. Rewrite H1. Rewrite (M1_semantics_2 a a1 a0 H1). Reflexivity.
+    Intros. Cut (MapMerge (M2 m0 m1) (M2 m2 m3))=(M2 (MapMerge m0 m2) (MapMerge m1 m3)).
+    Intro. Rewrite H3. Rewrite MapGet_M2_bit_0_if. Rewrite (H0 m3 (ad_div_2 a)).
+    Rewrite (H m2 (ad_div_2 a)). Rewrite (MapGet_M2_bit_0_if m2 m3 a).
+    Rewrite (MapGet_M2_bit_0_if m0 m1 a). Case (ad_bit_0 a); Trivial.
+    Reflexivity.
+  Qed.
+
+  (** [MapInter], [MapRngRestrTo], [MapRngRestrBy], [MapInverse] 
+      not implemented: need a decidable equality on [A]. *)
+
+  Fixpoint MapDelta [m:Map] : Map -> Map :=
+    Cases m of
+        M0 => [m':Map] m'
+      | (M1 a y) => [m':Map] Cases (MapGet m' a) of
+                                 NONE => (MapPut m' a y)
+			       | _ => (MapRemove m' a)
+			     end
+      | (M2 m1 m2) => [m':Map] Cases m' of
+                                   M0 => m
+				 | (M1 a' y') => Cases (MapGet m a') of
+				                     NONE => (MapPut m a' y')
+						   | _ => (MapRemove m a')
+						 end
+				 | (M2 m'1 m'2) => (makeM2 (MapDelta m1 m'1)
+				                           (MapDelta m2 m'2))
+			       end
+    end.
+
+  Lemma MapDelta_semantics_comm : (m,m':Map)
+      (eqm (MapGet (MapDelta m m')) (MapGet (MapDelta m' m))).
+  Proof.
+    Unfold eqm. Induction m. Induction m'; Reflexivity.
+    Induction m'. Reflexivity.
+    Unfold MapDelta. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H.
+    Rewrite <- (ad_eq_complete ? ? H). Rewrite (M1_semantics_1 a a2).
+    Rewrite (M1_semantics_1 a a0). Simpl. Rewrite (ad_eq_correct a). Reflexivity.
+    Intro H. Rewrite (M1_semantics_2 a a1 a0 H). Rewrite (ad_eq_comm a a1) in H.
+    Rewrite (M1_semantics_2 a1 a a2 H). Rewrite (MapPut_semantics (M1 a a0) a1 a2 a3).
+    Rewrite (MapPut_semantics (M1 a1 a2) a a0 a3). Elim (sumbool_of_bool (ad_eq a a3)).
+    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0) in H. Rewrite H.
+    Rewrite (ad_eq_complete ? ? H0). Rewrite (M1_semantics_1 a3 a0). Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (M1_semantics_2 a a3 a0 H0).
+    Elim (sumbool_of_bool (ad_eq a1 a3)). Intro H1. Rewrite H1.
+    Rewrite (ad_eq_complete ? ? H1). Exact (M1_semantics_1 a3 a2).
+    Intro H1. Rewrite H1. Exact (M1_semantics_2 a1 a3 a2 H1).
+    Intros. Reflexivity.
+    Induction m'. Reflexivity.
+    Reflexivity.
+    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+    Rewrite (makeM2_M2 (MapDelta m2 m0) (MapDelta m3 m1) a).
+    Rewrite (MapGet_M2_bit_0_if (MapDelta m0 m2) (MapDelta m1 m3) a).
+    Rewrite (MapGet_M2_bit_0_if (MapDelta m2 m0) (MapDelta m3 m1) a).
+    Rewrite (H0 m3 (ad_div_2 a)). Rewrite (H m2 (ad_div_2 a)). Reflexivity.
+  Qed.
+
+  Lemma MapDelta_semantics_1_1 : (a:ad) (y:A) (m':Map) (a0:ad)
+    (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=NONE -> 
+      (MapGet (MapDelta (M1 a y) m') a0)=NONE.
+  Proof.
+    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
+    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
+    Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
+    Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
+  Qed.
+
+  Lemma MapDelta_semantics_1 : (m,m':Map) (a:ad)
+    (MapGet m a)=NONE -> (MapGet m' a)=NONE -> 
+      (MapGet (MapDelta m m') a)=NONE.
+  Proof.
+    Induction m. Trivial.
+    Exact MapDelta_semantics_1_1.
+    Induction m'. Trivial.
+    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+    Apply MapDelta_semantics_1_1; Trivial.
+    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
+    Apply H0. Rewrite (MapGet_M2_bit_0_1 a H5 m0 m1) in H3. Exact H3.
+    Rewrite (MapGet_M2_bit_0_1 a H5 m2 m3) in H4. Exact H4.
+    Intro H5. Rewrite H5. Apply H. Rewrite (MapGet_M2_bit_0_0 a H5 m0 m1) in H3. Exact H3.
+    Rewrite (MapGet_M2_bit_0_0 a H5 m2 m3) in H4. Exact H4.
+  Qed.
+
+  Lemma MapDelta_semantics_2_1 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
+    (MapGet (M1 a y) a0)=NONE -> (MapGet m' a0)=(SOME y0) ->
+      (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
+  Proof.
+    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
+    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 a0 y) in H. Discriminate H.
+    Intro H1. Case (MapGet m' a). Rewrite (MapPut_semantics m' a y a0). Rewrite H1. Assumption.
+    Rewrite (MapRemove_semantics m' a a0). Rewrite H1. Trivial.
+  Qed.
+
+  Lemma MapDelta_semantics_2_2 : (a:ad) (y:A) (m':Map) (a0:ad) (y0:A)
+    (MapGet (M1 a y) a0)=(SOME y0) -> (MapGet m' a0)=NONE ->
+      (MapGet (MapDelta (M1 a y) m') a0)=(SOME y0).
+  Proof.
+    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1.
+    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (ad_eq_complete ? ? H1).
+    Rewrite H0. Rewrite (MapPut_semantics m' a0 y a0). Rewrite (ad_eq_correct a0).
+    Rewrite (M1_semantics_1 a0 y) in H. Simple Inversion H. Assumption.
+    Intro H1. Rewrite (M1_semantics_2 a a0 y H1) in H. Discriminate H.
+  Qed.
+
+  Lemma MapDelta_semantics_2 : (m,m':Map) (a:ad) (y:A)
+    (MapGet m a)=NONE -> (MapGet m' a)=(SOME y) -> 
+      (MapGet (MapDelta m m') a)=(SOME y).
+  Proof.
+    Induction m. Trivial.
+    Exact MapDelta_semantics_2_1.
+    Induction m'. Intros. Discriminate H2.
+    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+    Apply MapDelta_semantics_2_2; Assumption.
+    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
+    Apply H0. Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
+    Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
+    Intro H5. Rewrite H5. Apply H. Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
+    Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
+  Qed.
+
+  Lemma MapDelta_semantics_3_1 : (a0:ad) (y0:A) (m':Map) (a:ad) (y,y':A)
+    (MapGet (M1 a0 y0) a)=(SOME y) -> (MapGet m' a)=(SOME y') ->
+      (MapGet (MapDelta (M1 a0 y0) m') a)=NONE.
+  Proof.
+    Intros. Unfold MapDelta. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H1.
+    Rewrite (ad_eq_complete a0 a H1). Rewrite H0. Rewrite (MapRemove_semantics m' a a).
+    Rewrite (ad_eq_correct a). Reflexivity.
+    Intro H1. Rewrite (M1_semantics_2 a0 a y0 H1) in H. Discriminate H.
+  Qed.
+
+  Lemma MapDelta_semantics_3 : (m,m':Map) (a:ad) (y,y':A)
+    (MapGet m a)=(SOME y) -> (MapGet m' a)=(SOME y') -> 
+      (MapGet (MapDelta m m') a)=NONE.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Exact MapDelta_semantics_3_1.
+    Induction m'. Intros. Discriminate H2.
+    Intros. Rewrite (MapDelta_semantics_comm (M2 m0 m1) (M1 a a0) a1).
+    Exact (MapDelta_semantics_3_1 a a0 (M2 m0 m1) a1 y' y H2 H1).
+    Intros. Simpl. Rewrite (makeM2_M2 (MapDelta m0 m2) (MapDelta m1 m3) a).
+    Rewrite MapGet_M2_bit_0_if. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H5. Rewrite H5.
+    Apply (H0 m3 (ad_div_2 a) y y'). Rewrite <- (MapGet_M2_bit_0_1 a H5 m0 m1). Assumption.
+    Rewrite <- (MapGet_M2_bit_0_1 a H5 m2 m3). Assumption.
+    Intro H5. Rewrite H5. Apply (H m2 (ad_div_2 a) y y').
+    Rewrite <- (MapGet_M2_bit_0_0 a H5 m0 m1). Assumption.
+    Rewrite <- (MapGet_M2_bit_0_0 a H5 m2 m3). Assumption.
+  Qed.
+
+  Lemma MapDelta_semantics : (m,m':Map)
+      (eqm (MapGet (MapDelta m m'))
+           [a0:ad] Cases (MapGet m a0) (MapGet m' a0) of
+	               NONE (SOME y') => (SOME y')
+		     | (SOME y) NONE => (SOME y)
+		     | _ _ => NONE
+		   end).
+  Proof.
+    Unfold eqm. Intros. Elim (option_sum (MapGet m' a)). Intro H. Elim H. Intros a0 H0.
+    Rewrite H0. Elim (option_sum (MapGet m a)). Intro H1. Elim H1. Intros a1 H2. Rewrite H2.
+    Exact (MapDelta_semantics_3 m m' a a1 a0 H2 H0).
+    Intro H1. Rewrite H1. Exact (MapDelta_semantics_2 m m' a a0 H1 H0).
+    Intro H. Rewrite H. Elim (option_sum (MapGet m a)). Intro H0. Elim H0. Intros a0 H1.
+    Rewrite H1. Rewrite (MapDelta_semantics_comm m m' a).
+    Exact (MapDelta_semantics_2 m' m a a0 H H1).
+    Intro H0. Rewrite H0. Exact (MapDelta_semantics_1 m m' a H0 H).
+  Qed.
+
+  Definition MapEmptyp := [m:Map]
+    Cases m of
+      	M0 => true
+      | _ => false
+    end.
+
+  Lemma MapEmptyp_correct : (MapEmptyp M0)=true.
+  Proof.
+    Reflexivity.
+  Qed.
+
+  Lemma MapEmptyp_complete : (m:Map) (MapEmptyp m)=true -> m=M0.
+  Proof.
+    Induction m; Trivial. Intros. Discriminate H.
+    Intros. Discriminate H1.
+  Qed.
+
+  (** [MapSplit] not implemented: not the preferred way of recursing over Maps
+      (use [MapSweep], [MapCollect], or [MapFold] in Mapiter.v. *)
+
+End MapDefs.
diff --git a/theories7/IntMap/Mapaxioms.v b/theories7/IntMap/Mapaxioms.v
new file mode 100644
index 00000000..085afd69
--- /dev/null
+++ b/theories7/IntMap/Mapaxioms.v
@@ -0,0 +1,670 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapaxioms.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Fset.
+
+Section MapAxioms.
+
+  Variable A, B, C : Set.
+
+  Lemma eqm_sym : (f,f':ad->(option A)) (eqm A f f') -> (eqm A f' f).
+  Proof.
+    Unfold eqm. Intros. Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma eqm_refl :  (f:ad->(option A)) (eqm A f f).
+  Proof.
+    Unfold eqm. Trivial.
+  Qed.
+
+  Lemma eqm_trans : (f,f',f'':ad->(option A)) (eqm A f f') -> (eqm A f' f'') -> (eqm A f f'').
+  Proof.
+    Unfold eqm. Intros. Rewrite H. Exact (H0 a).
+  Qed.
+
+  Definition eqmap := [m,m':(Map A)] (eqm A (MapGet A m) (MapGet A m')).
+
+  Lemma eqmap_sym : (m,m':(Map A)) (eqmap m m') -> (eqmap m' m).
+  Proof.
+    Intros. Unfold eqmap. Apply eqm_sym. Assumption.
+  Qed.
+
+  Lemma eqmap_refl :  (m:(Map A)) (eqmap m m).
+  Proof.
+    Intros. Unfold eqmap. Apply eqm_refl.
+  Qed.
+
+  Lemma eqmap_trans : (m,m',m'':(Map A)) (eqmap m m') -> (eqmap m' m'') -> (eqmap m m'').
+  Proof.
+    Intros. Exact (eqm_trans (MapGet A m) (MapGet A m') (MapGet A m'') H H0).
+  Qed.
+
+  Lemma MapPut_as_Merge : (m:(Map A)) (a:ad) (y:A)
+      (eqmap (MapPut A m a y) (MapMerge A m (M1 A a y))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m a y a0).
+    Rewrite (MapMerge_semantics A m (M1 A a y) a0). Unfold 2 MapGet.
+    Elim (sumbool_of_bool (ad_eq a a0)); Intro H; Rewrite H; Reflexivity.
+  Qed.
+
+  Lemma MapPut_ext : (m,m':(Map A)) (eqmap m m') ->
+      (a:ad) (y:A) (eqmap (MapPut A m a y) (MapPut A m' a y)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapPut_semantics A m' a y a0).
+    Rewrite (MapPut_semantics A m a y a0). 
+    Case (ad_eq a a0); [ Reflexivity | Apply H ].
+  Qed.
+
+  Lemma MapPut_behind_as_Merge : (m:(Map A)) (a:ad) (y:A)
+      (eqmap (MapPut_behind A m a y) (MapMerge A (M1 A a y) m)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m a y a0).
+    Rewrite (MapMerge_semantics A (M1 A a y) m a0). Reflexivity.
+  Qed.
+
+  Lemma MapPut_behind_ext : (m,m':(Map A)) (eqmap m m') ->
+      (a:ad) (y:A) (eqmap (MapPut_behind A m a y) (MapPut_behind A m' a y)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapPut_behind_semantics A m' a y a0).
+    Rewrite (MapPut_behind_semantics A m a y a0). Rewrite (H a0). Reflexivity.
+  Qed.
+
+  Lemma MapMerge_empty_m_1 : (m:(Map A)) (MapMerge A (M0 A) m)=m.
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapMerge_empty_m : (m:(Map A)) (eqmap (MapMerge A (M0 A) m) m).
+  Proof.
+    Unfold eqmap eqm. Trivial.
+  Qed.
+
+  Lemma MapMerge_m_empty_1 : (m:(Map A)) (MapMerge A m (M0 A))=m.
+  Proof.
+    Induction m;Trivial.
+  Qed.
+
+  Lemma MapMerge_m_empty : (m:(Map A)) (eqmap (MapMerge A m (M0 A)) m).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite MapMerge_m_empty_1. Reflexivity.
+  Qed.
+
+  Lemma MapMerge_empty_l : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
+      (eqmap m (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
+    Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
+    Intros. Discriminate H0.
+    Exact (H a).
+  Qed.
+
+  Lemma MapMerge_empty_r : (m,m':(Map A)) (eqmap (MapMerge A m m') (M0 A)) ->
+      (eqmap m' (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Cut (MapGet A (MapMerge A m m') a)=(MapGet A (M0 A) a).
+    Rewrite (MapMerge_semantics A m m' a). Case (MapGet A m' a). Trivial.
+    Intros. Discriminate H0.
+    Exact (H a).
+  Qed.
+
+  Lemma MapMerge_assoc : (m,m',m'':(Map A)) (eqmap
+      (MapMerge A (MapMerge A m m') m'')
+      (MapMerge A m (MapMerge A m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapMerge A m m') m'' a).
+    Rewrite (MapMerge_semantics A m (MapMerge A m' m'') a). Rewrite (MapMerge_semantics A m m' a).
+    Rewrite (MapMerge_semantics A m' m'' a).
+    Case (MapGet A m'' a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapMerge_idempotent : (m:(Map A)) (eqmap (MapMerge A m m) m).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m m a).
+    Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma MapMerge_ext : (m1,m2,m'1,m'2:(Map A))
+      (eqmap m1 m'1) -> (eqmap m2 m'2) -> 
+        (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m'2)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A m1 m2 a).
+    Rewrite (MapMerge_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+  Qed.
+
+  Lemma MapMerge_ext_l : (m1,m'1,m2:(Map A))
+      (eqmap m1 m'1) -> (eqmap (MapMerge A m1 m2) (MapMerge A m'1 m2)).
+  Proof.
+    Intros. Apply MapMerge_ext. Assumption.
+    Apply eqmap_refl.
+  Qed.
+
+  Lemma MapMerge_ext_r : (m1,m2,m'2:(Map A))
+      (eqmap m2 m'2) -> (eqmap (MapMerge A m1 m2) (MapMerge A m1 m'2)).
+  Proof.
+    Intros. Apply MapMerge_ext. Apply eqmap_refl.
+    Assumption.
+  Qed.
+
+  Lemma MapMerge_RestrTo_l : (m,m',m'':(Map A))
+      (eqmap (MapMerge A (MapDomRestrTo A A m m') m'')
+             (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapMerge_semantics A (MapDomRestrTo A A m m') m'' a).
+    Rewrite (MapDomRestrTo_semantics A A m m' a).
+    Rewrite (MapDomRestrTo_semantics A A (MapMerge A m m'') (MapMerge A m' m'') a).
+    Rewrite (MapMerge_semantics A m' m'' a). Rewrite (MapMerge_semantics A m m'' a).
+    Case (MapGet A m'' a); Case (MapGet A m' a); Reflexivity.
+  Qed.
+
+  Lemma MapRemove_as_RestrBy : (m:(Map A)) (a:ad) (y:B)
+      (eqmap (MapRemove A m a) (MapDomRestrBy A B m (M1 B a y))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m a a0).
+    Rewrite (MapDomRestrBy_semantics A B m (M1 B a y) a0). Elim (sumbool_of_bool (ad_eq a a0)).
+    Intro H. Rewrite H. Rewrite (ad_eq_complete a a0 H). Rewrite (M1_semantics_1 B a0 y).
+    Reflexivity.
+    Intro H. Rewrite H. Rewrite (M1_semantics_2 B a a0 y H). Reflexivity.
+  Qed.
+
+  Lemma MapRemove_ext : (m,m':(Map A)) (eqmap m m') ->
+      (a:ad) (eqmap (MapRemove A m a) (MapRemove A m' a)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapRemove_semantics A m' a a0).
+    Rewrite (MapRemove_semantics A m a a0). 
+    Case (ad_eq a a0); [ Reflexivity | Apply H ].
+  Qed.
+
+  Lemma MapDomRestrTo_empty_m_1 : 
+      (m:(Map B)) (MapDomRestrTo A B (M0 A) m)=(M0 A).
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_empty_m : 
+      (m:(Map B)) (eqmap (MapDomRestrTo A B (M0 A) m) (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_m_empty_1 : 
+      (m:(Map A)) (MapDomRestrTo A B m (M0 B))=(M0 A).
+  Proof.
+    Induction m;Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_m_empty : 
+      (m:(Map A)) (eqmap (MapDomRestrTo A B m (M0 B)) (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_m_empty_1 m). Reflexivity.
+  Qed.
+
+  Lemma MapDomRestrTo_assoc : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
+             (MapDomRestrTo A B m (MapDomRestrTo B C m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrTo B C m' m'') a).
+    Rewrite (MapDomRestrTo_semantics B C m' m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_idempotent : (m:(Map A)) (eqmap (MapDomRestrTo A A m m) m).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A A m m a).
+    Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_Dom : (m:(Map A)) (m':(Map B))
+      (eqmap (MapDomRestrTo A B m m') (MapDomRestrTo A unit m (MapDom B m'))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A unit m (MapDom B m') a).
+    Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
+    Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0. Unfold in_FSet in_dom in H.
+    Generalize H. Case (MapGet unit (MapDom B m') a); Trivial. Intro H1. Discriminate H1.
+    Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
+    Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
+    Intros H0 H1. Discriminate H1.
+  Qed.
+
+  Lemma MapDomRestrBy_empty_m_1 : 
+      (m:(Map B)) (MapDomRestrBy A B (M0 A) m)=(M0 A).
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_empty_m : 
+      (m:(Map B)) (eqmap (MapDomRestrBy A B (M0 A) m) (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_m_empty_1 : (m:(Map A)) (MapDomRestrBy A B m (M0 B))=m.
+  Proof.
+    Induction m;Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_m_empty : (m:(Map A)) (eqmap (MapDomRestrBy A B m (M0 B)) m).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_m_empty_1 m). Reflexivity.
+  Qed.
+
+  Lemma MapDomRestrBy_Dom : (m:(Map A)) (m':(Map B))
+      (eqmap (MapDomRestrBy A B m m') (MapDomRestrBy A unit m (MapDom B m'))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrBy_semantics A unit m (MapDom B m') a).
+    Elim (sumbool_of_bool (in_FSet a (MapDom B m'))). Intro H.
+    Elim (MapDom_semantics_2 B m' a H). Intros y H0. Rewrite H0.
+    Unfold in_FSet in_dom in H. Generalize H. Case (MapGet unit (MapDom B m') a); Trivial.
+    Intro H1. Discriminate H1.
+    Intro H. Rewrite (MapDom_semantics_4 B m' a H). Unfold in_FSet in_dom in H.
+    Generalize H. Case (MapGet unit (MapDom B m') a). Trivial.
+    Intros H0 H1. Discriminate H1.
+  Qed.
+
+  Lemma MapDomRestrBy_m_m_1 : (m:(Map A)) (eqmap (MapDomRestrBy A A m m) (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A A m m a).
+    Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_By : (m:(Map A)) (m':(Map B)) (m'':(Map B))
+      (eqmap (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')
+             (MapDomRestrBy A B m (MapMerge B m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A B m m') m'' a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrBy_semantics A B m (MapMerge B m' m'') a).
+    Rewrite (MapMerge_semantics B m' m'' a).
+    Case (MapGet B m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')
+             (MapDomRestrBy A B (MapDomRestrBy A C m m'') m')).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrBy A B m m') m'' a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrBy A C m m'') m' a).
+    Rewrite (MapDomRestrBy_semantics A C m m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_To : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
+             (MapDomRestrTo A B m (MapDomRestrBy B C m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B m (MapDomRestrBy B C m' m'') a).
+    Rewrite (MapDomRestrBy_semantics B C m' m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrBy_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')
+             (MapDomRestrTo A B (MapDomRestrBy A C m m'') m')).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrBy_semantics A C (MapDomRestrTo A B m m') m'' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B (MapDomRestrBy A C m m'') m' a).
+    Rewrite (MapDomRestrBy_semantics A C m m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_By : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
+             (MapDomRestrTo A C m (MapDomRestrBy C B m'' m'))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A C m (MapDomRestrBy C B m'' m') a).
+    Rewrite (MapDomRestrBy_semantics C B m'' m' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_By_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')
+             (MapDomRestrBy A B (MapDomRestrTo A C m m'') m')).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrBy A B m m') m'' a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrBy_semantics A B (MapDomRestrTo A C m m'') m' a).
+    Rewrite (MapDomRestrTo_semantics A C m m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapDomRestrTo_To_comm : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (eqmap (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')
+             (MapDomRestrTo A B (MapDomRestrTo A C m m'') m')).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A C (MapDomRestrTo A B m m') m'' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B (MapDomRestrTo A C m m'') m' a).
+    Rewrite (MapDomRestrTo_semantics A C m m'' a).
+    Case (MapGet C m'' a); Case (MapGet B m' a); Trivial.
+  Qed.
+
+  Lemma MapMerge_DomRestrTo : (m,m':(Map A)) (m'':(Map B))
+      (eqmap (MapDomRestrTo A B (MapMerge A m m') m'')
+             (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A B (MapMerge A m m') m'' a).
+    Rewrite (MapMerge_semantics A m m' a).
+    Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'') a).
+    Rewrite (MapDomRestrTo_semantics A B m' m'' a).
+    Rewrite (MapDomRestrTo_semantics A B m m'' a).
+    Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapMerge_DomRestrBy : (m,m':(Map A)) (m'':(Map B))
+      (eqmap (MapDomRestrBy A B (MapMerge A m m') m'')
+             (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m''))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrBy_semantics A B (MapMerge A m m') m'' a).
+    Rewrite (MapMerge_semantics A m m' a).
+    Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'') a).
+    Rewrite (MapDomRestrBy_semantics A B m' m'' a).
+    Rewrite (MapDomRestrBy_semantics A B m m'' a).
+    Case (MapGet B m'' a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapDelta_empty_m_1 : (m:(Map A)) (MapDelta A (M0 A) m)=m.
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapDelta_empty_m : (m:(Map A)) (eqmap (MapDelta A (M0 A) m) m).
+  Proof.
+    Unfold eqmap eqm. Trivial.
+  Qed.
+
+  Lemma MapDelta_m_empty_1 : (m:(Map A)) (MapDelta A m (M0 A))=m.
+  Proof.
+    Induction m;Trivial.
+  Qed.
+
+  Lemma MapDelta_m_empty : (m:(Map A)) (eqmap (MapDelta A m (M0 A)) m).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite MapDelta_m_empty_1. Reflexivity.
+  Qed.
+
+  Lemma MapDelta_nilpotent : (m:(Map A)) (eqmap (MapDelta A m m) (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m a).
+    Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma MapDelta_as_Merge : (m,m':(Map A)) (eqmap (MapDelta A m m')
+      	(MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDelta_semantics A m m' a).
+    Rewrite (MapMerge_semantics A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m) a).
+    Rewrite (MapDomRestrBy_semantics A A m' m a).
+    Rewrite (MapDomRestrBy_semantics A A m m' a).
+    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapDelta_as_DomRestrBy : (m,m':(Map A)) (eqmap (MapDelta A m m')
+      	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m'))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
+    Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m m') a).
+    Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite (MapMerge_semantics A m m' a).
+    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapDelta_as_DomRestrBy_2 : (m,m':(Map A)) (eqmap (MapDelta A m m')
+      	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m))).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
+    Rewrite (MapDomRestrBy_semantics A A (MapMerge A m m') (MapDomRestrTo A A m' m) a).
+    Rewrite (MapDomRestrTo_semantics A A m' m a). Rewrite (MapMerge_semantics A m m' a).
+    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapDelta_sym : (m,m':(Map A)) (eqmap (MapDelta A m m') (MapDelta A m' m)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m m' a).
+    Rewrite (MapDelta_semantics A m' m a). 
+    Case (MapGet A m a); Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma MapDelta_ext : (m1,m2,m'1,m'2:(Map A))
+      (eqmap m1 m'1) -> (eqmap m2 m'2) -> 
+        (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m'2)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics A m1 m2 a).
+    Rewrite (MapDelta_semantics A m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+  Qed.
+
+  Lemma MapDelta_ext_l : (m1,m'1,m2:(Map A))
+      (eqmap m1 m'1) -> (eqmap (MapDelta A m1 m2) (MapDelta A m'1 m2)).
+  Proof.
+    Intros. Apply MapDelta_ext. Assumption.
+    Apply eqmap_refl.
+  Qed.
+
+  Lemma MapDelta_ext_r : (m1,m2,m'2:(Map A))
+      (eqmap m2 m'2) -> (eqmap (MapDelta A m1 m2) (MapDelta A m1 m'2)).
+  Proof.
+    Intros. Apply MapDelta_ext. Apply eqmap_refl.
+    Assumption.
+  Qed.
+
+  Lemma MapDom_Split_1 : (m:(Map A)) (m':(Map B))
+      (eqmap m (MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapMerge_semantics A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
+  Qed.
+ 
+  Lemma MapDom_Split_2 : (m:(Map A)) (m':(Map B))
+      (eqmap m (MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m'))).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapMerge_semantics A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m') a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
+  Qed.
+
+  Lemma MapDom_Split_3 : (m:(Map A)) (m':(Map B))
+      (eqmap (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')) 
+	(M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m') a).
+    Rewrite (MapDomRestrBy_semantics A B m m' a).
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Case (MapGet B m' a); Case (MapGet A m a); Trivial.
+  Qed.
+
+End MapAxioms.
+
+Lemma MapDomRestrTo_ext : (A,B:Set) 
+    (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
+      (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
+        (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m'2)).
+Proof.
+  Unfold eqmap eqm. Intros. Rewrite (MapDomRestrTo_semantics A B m1 m2 a).
+  Rewrite (MapDomRestrTo_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+Qed.
+
+Lemma MapDomRestrTo_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
+    (eqmap A m1 m'1) ->
+      (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m'1 m2)).
+Proof.
+  Intros. Apply MapDomRestrTo_ext; [ Assumption | Apply eqmap_refl ].
+Qed.
+
+Lemma MapDomRestrTo_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
+    (eqmap B m2 m'2) ->
+      (eqmap A (MapDomRestrTo A B m1 m2) (MapDomRestrTo A B m1 m'2)).
+Proof.
+  Intros. Apply MapDomRestrTo_ext; [ Apply eqmap_refl | Assumption ].
+Qed.
+
+Lemma MapDomRestrBy_ext : (A,B:Set) 
+    (m1:(Map A)) (m2:(Map B)) (m'1:(Map A)) (m'2:(Map B))
+      (eqmap A m1 m'1) -> (eqmap B m2 m'2) ->
+        (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m'2)).
+Proof.
+  Unfold eqmap eqm. Intros. Rewrite (MapDomRestrBy_semantics A B m1 m2 a).
+  Rewrite (MapDomRestrBy_semantics A B m'1 m'2 a). Rewrite (H a). Rewrite (H0 a). Reflexivity.
+Qed.
+
+Lemma MapDomRestrBy_ext_l : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'1:(Map A))
+    (eqmap A m1 m'1) ->
+      (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m'1 m2)).
+Proof.
+  Intros. Apply MapDomRestrBy_ext; [ Assumption | Apply eqmap_refl ].
+Qed.
+
+Lemma MapDomRestrBy_ext_r : (A,B:Set) (m1:(Map A)) (m2:(Map B)) (m'2:(Map B))
+    (eqmap B m2 m'2) ->
+      (eqmap A (MapDomRestrBy A B m1 m2) (MapDomRestrBy A B m1 m'2)).
+Proof.
+  Intros. Apply MapDomRestrBy_ext; [ Apply eqmap_refl | Assumption ].
+Qed.
+
+Lemma MapDomRestrBy_m_m : (A:Set) (m:(Map A))
+    (eqmap A (MapDomRestrBy A unit m (MapDom A m)) (M0 A)).
+Proof.
+  Intros. Apply eqmap_trans with m':=(MapDomRestrBy A A m m). Apply eqmap_sym.
+  Apply MapDomRestrBy_Dom.
+  Apply MapDomRestrBy_m_m_1.
+Qed.
+
+Lemma FSetDelta_assoc : (s,s',s'':FSet)
+    (eqmap unit (MapDelta ? (MapDelta ? s s') s'') (MapDelta ? s (MapDelta ? s' s''))).
+Proof.
+  Unfold eqmap eqm. Intros. Rewrite (MapDelta_semantics unit (MapDelta unit s s') s'' a).
+  Rewrite (MapDelta_semantics unit s s' a).
+  Rewrite (MapDelta_semantics unit s (MapDelta unit s' s'') a).
+  Rewrite (MapDelta_semantics unit s' s'' a).
+  Case (MapGet ? s a); Case (MapGet ? s' a); Case (MapGet ? s'' a); Trivial.
+  Intros. Elim u. Elim u1. Reflexivity.
+Qed.
+
+Lemma FSet_ext : (s,s':FSet) ((a:ad) (in_FSet a s)=(in_FSet a s')) -> (eqmap unit s s').
+Proof.
+  Unfold in_FSet eqmap eqm. Intros. Elim (sumbool_of_bool (in_dom ? a s)). Intro H0.
+  Elim (in_dom_some ? s a H0). Intros y H1. Rewrite (H a) in H0. Elim (in_dom_some ? s' a H0).
+  Intros y' H2. Rewrite H1. Rewrite H2. Elim y. Elim y'. Reflexivity.
+  Intro H0. Rewrite (in_dom_none ? s a H0). Rewrite (H a) in H0. Rewrite (in_dom_none ? s' a H0).
+  Reflexivity.
+Qed.
+
+Lemma FSetUnion_comm : (s,s':FSet) (eqmap unit (FSetUnion s s') (FSetUnion s' s)).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_union. Apply orb_sym.
+Qed.
+
+Lemma FSetUnion_assoc : (s,s',s'':FSet) (eqmap unit
+      (FSetUnion (FSetUnion s s') s'') (FSetUnion s (FSetUnion s' s''))).
+Proof.
+  Exact (MapMerge_assoc unit).
+Qed.
+
+Lemma FSetUnion_M0_s : (s:FSet) (eqmap unit (FSetUnion (M0 unit) s) s).
+Proof.
+  Exact (MapMerge_empty_m unit).
+Qed.
+
+Lemma FSetUnion_s_M0 : (s:FSet) (eqmap unit (FSetUnion s (M0 unit)) s).
+Proof.
+  Exact (MapMerge_m_empty unit).
+Qed.
+
+Lemma FSetUnion_idempotent : (s:FSet) (eqmap unit (FSetUnion s s) s).
+Proof.
+  Exact (MapMerge_idempotent unit).
+Qed.
+
+Lemma FSetInter_comm : (s,s':FSet) (eqmap unit (FSetInter s s') (FSetInter s' s)).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_inter. Apply andb_sym.
+Qed.
+
+Lemma FSetInter_assoc : (s,s',s'':FSet) (eqmap unit
+      (FSetInter (FSetInter s s') s'') (FSetInter s (FSetInter s' s''))).
+Proof.
+  Exact (MapDomRestrTo_assoc unit unit unit).
+Qed.
+
+Lemma FSetInter_M0_s : (s:FSet) (eqmap unit (FSetInter (M0 unit) s) (M0 unit)).
+Proof.
+  Exact (MapDomRestrTo_empty_m unit unit).
+Qed.
+
+Lemma FSetInter_s_M0 : (s:FSet) (eqmap unit (FSetInter s (M0 unit)) (M0 unit)).
+Proof.
+  Exact (MapDomRestrTo_m_empty unit unit).
+Qed.
+
+Lemma FSetInter_idempotent : (s:FSet) (eqmap unit (FSetInter s s) s).
+Proof.
+  Exact (MapDomRestrTo_idempotent unit).
+Qed.
+
+Lemma FSetUnion_Inter_l : (s,s',s'':FSet) (eqmap unit
+      (FSetUnion (FSetInter s s') s'') (FSetInter (FSetUnion s s'') (FSetUnion s' s''))).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
+  Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
+  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+Qed.
+
+Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (eqmap unit
+      (FSetUnion s (FSetInter s' s'')) (FSetInter (FSetUnion s s') (FSetUnion s s''))).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_union. Rewrite in_FSet_inter.
+  Rewrite in_FSet_inter. Rewrite in_FSet_union. Rewrite in_FSet_union.
+  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+Qed.
+
+Lemma FSetInter_Union_l : (s,s',s'':FSet) (eqmap unit
+      (FSetInter (FSetUnion s s') s'') (FSetUnion (FSetInter s s'') (FSetInter s' s''))).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
+  Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
+  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+Qed.
+
+Lemma FSetInter_Union_r : (s,s',s'':FSet) (eqmap unit
+      (FSetInter s (FSetUnion s' s'')) (FSetUnion (FSetInter s s') (FSetInter s s''))).
+Proof.
+  Intros. Apply FSet_ext. Intro. Rewrite in_FSet_inter. Rewrite in_FSet_union.
+  Rewrite in_FSet_union. Rewrite in_FSet_inter. Rewrite in_FSet_inter.
+  Case (in_FSet a s); Case (in_FSet a s'); Case (in_FSet a s''); Reflexivity.
+Qed.
diff --git a/theories7/IntMap/Mapc.v b/theories7/IntMap/Mapc.v
new file mode 100644
index 00000000..181050b1
--- /dev/null
+++ b/theories7/IntMap/Mapc.v
@@ -0,0 +1,457 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapc.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require Arith.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Mapaxioms.
+Require Fset.
+Require Mapiter.
+Require Mapsubset.
+Require PolyList.
+Require Lsort.
+Require Mapcard.
+Require Mapcanon.
+
+Section MapC.
+
+  Variable A, B, C : Set.
+
+  Lemma MapPut_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
+      (a:ad) (y:A) (MapPut A m a y)=(MapMerge A m (M1 A a y)).
+  Proof.
+    Intros. Apply mapcanon_unique. Exact (MapPut_canon A m H a y).
+    Apply MapMerge_canon. Assumption.
+    Apply M1_canon.
+    Apply MapPut_as_Merge.
+  Qed.
+
+  Lemma MapPut_behind_as_Merge_c : (m:(Map A)) (mapcanon A m) ->
+      (a:ad) (y:A) (MapPut_behind A m a y)=(MapMerge A (M1 A a y) m).
+  Proof.
+    Intros. Apply mapcanon_unique. Exact (MapPut_behind_canon A m H a y).
+    Apply MapMerge_canon. Apply M1_canon.
+    Assumption.
+    Apply MapPut_behind_as_Merge.
+  Qed.
+
+  Lemma MapMerge_empty_m_c : (m:(Map A)) (MapMerge A (M0 A) m)=m.
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapMerge_assoc_c : (m,m',m'':(Map A))
+      (mapcanon A m) -> (mapcanon A m') -> (mapcanon A m'') ->
+        (MapMerge A (MapMerge A m m') m'')=(MapMerge A m (MapMerge A m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique.
+    (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
+    (Apply MapMerge_canon; Try Assumption). (Apply MapMerge_canon; Try Assumption).
+    Apply MapMerge_assoc.
+  Qed.
+
+  Lemma MapMerge_idempotent_c : (m:(Map A)) (mapcanon A m) -> (MapMerge A m m)=m.
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapMerge_canon; Assumption).
+    Assumption.
+    Apply MapMerge_idempotent.
+  Qed.
+
+  Lemma MapMerge_RestrTo_l_c : (m,m',m'':(Map A)) 
+      (mapcanon A m) -> (mapcanon A m'') -> 
+        (MapMerge A (MapDomRestrTo A A m m') m'')=
+        (MapDomRestrTo A A (MapMerge A m m'') (MapMerge A m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
+    Assumption.
+    Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
+    Apply MapMerge_RestrTo_l.
+  Qed.
+
+  Lemma MapRemove_as_RestrBy_c : (m:(Map A)) (mapcanon A m) ->
+      (a:ad) (y:B) (MapRemove A m a)=(MapDomRestrBy A B m (M1 B a y)).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapRemove_canon; Assumption).
+    (Apply MapDomRestrBy_canon; Assumption).
+    Apply MapRemove_as_RestrBy.
+  Qed.
+
+  Lemma MapDomRestrTo_assoc_c : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (mapcanon A m) ->
+        (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
+        (MapDomRestrTo A B m (MapDomRestrTo B C m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Try Assumption).
+    (Apply MapDomRestrTo_canon; Try Assumption).
+    (Apply MapDomRestrTo_canon; Try Assumption).
+    Apply MapDomRestrTo_assoc.
+  Qed.
+
+  Lemma MapDomRestrTo_idempotent_c : (m:(Map A)) (mapcanon A m) -> 
+      (MapDomRestrTo A A m m)=m.
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
+    Assumption.
+    Apply MapDomRestrTo_idempotent.
+  Qed.
+
+  Lemma MapDomRestrTo_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
+      (MapDomRestrTo A B m m')=(MapDomRestrTo A unit m (MapDom B m')).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDomRestrTo_canon; Assumption).
+    (Apply MapDomRestrTo_canon; Assumption).
+    Apply MapDomRestrTo_Dom.
+  Qed.
+
+  Lemma MapDomRestrBy_Dom_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
+      (MapDomRestrBy A B m m')=(MapDomRestrBy A unit m (MapDom B m')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDomRestrBy_Dom.
+  Qed.
+
+  Lemma MapDomRestrBy_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map B)) 
+      (mapcanon A m) -> 
+        (MapDomRestrBy A B (MapDomRestrBy A B m m') m'')=
+        (MapDomRestrBy A B m (MapMerge B m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDomRestrBy_canon; Try Assumption).
+    (Apply MapDomRestrBy_canon; Try Assumption).
+    (Apply MapDomRestrBy_canon; Try Assumption).
+    Apply MapDomRestrBy_By.
+  Qed.
+
+  Lemma MapDomRestrBy_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrBy A C (MapDomRestrBy A B m m') m'')=
+        (MapDomRestrBy A B (MapDomRestrBy A C m m'') m').
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
+    (Apply MapDomRestrBy_canon; Assumption).
+    Apply MapDomRestrBy_canon. (Apply MapDomRestrBy_canon; Assumption).
+    Apply MapDomRestrBy_By_comm.
+  Qed.
+
+  Lemma MapDomRestrBy_To_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
+        (MapDomRestrTo A B m (MapDomRestrBy B C m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
+    (Apply MapDomRestrTo_canon; Assumption).
+    (Apply MapDomRestrTo_canon; Assumption).
+    Apply MapDomRestrBy_To.
+  Qed.
+
+  Lemma MapDomRestrBy_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrBy A C (MapDomRestrTo A B m m') m'')=
+        (MapDomRestrTo A B (MapDomRestrBy A C m m'') m').
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon.
+    Apply MapDomRestrTo_canon; Assumption.
+    Apply MapDomRestrTo_canon. Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDomRestrBy_To_comm.
+  Qed.
+
+  Lemma MapDomRestrTo_By_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
+        (MapDomRestrTo A C m (MapDomRestrBy C B m'' m')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
+    Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDomRestrTo_canon; Assumption.
+    Apply MapDomRestrTo_By.
+  Qed.
+
+  Lemma MapDomRestrTo_By_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrTo A C (MapDomRestrBy A B m m') m'')=
+        (MapDomRestrBy A B (MapDomRestrTo A C m m'') m').
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
+    (Apply MapDomRestrBy_canon; Assumption).
+    Apply MapDomRestrBy_canon. (Apply MapDomRestrTo_canon; Assumption).
+    Apply MapDomRestrTo_By_comm.
+  Qed.
+
+  Lemma MapDomRestrTo_To_comm_c : (m:(Map A)) (m':(Map B)) (m'':(Map C)) 
+      (mapcanon A m) ->
+        (MapDomRestrTo A C (MapDomRestrTo A B m m') m'')=
+        (MapDomRestrTo A B (MapDomRestrTo A C m m'') m').
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
+    Apply MapDomRestrTo_canon; Assumption.
+    Apply MapDomRestrTo_canon. Apply MapDomRestrTo_canon; Assumption.
+    Apply MapDomRestrTo_To_comm.
+  Qed.
+
+  Lemma MapMerge_DomRestrTo_c : (m,m':(Map A)) (m'':(Map B))
+      (mapcanon A m) -> (mapcanon A m') ->
+        (MapDomRestrTo A B (MapMerge A m m') m'')=
+        (MapMerge A (MapDomRestrTo A B m m'') (MapDomRestrTo A B m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
+    (Apply MapMerge_canon; Assumption).
+    Apply MapMerge_canon. (Apply MapDomRestrTo_canon; Assumption).
+    (Apply MapDomRestrTo_canon; Assumption).
+    Apply MapMerge_DomRestrTo.
+  Qed.
+
+  Lemma MapMerge_DomRestrBy_c : (m,m':(Map A)) (m'':(Map B))
+      (mapcanon A m) -> (mapcanon A m') ->
+        (MapDomRestrBy A B (MapMerge A m m') m'')=
+        (MapMerge A (MapDomRestrBy A B m m'') (MapDomRestrBy A B m' m'')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
+    Apply MapMerge_canon. Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDomRestrBy_canon; Assumption.
+    Apply MapMerge_DomRestrBy.
+  Qed.
+
+  Lemma MapDelta_nilpotent_c : (m:(Map A)) (mapcanon A m) -> 
+      (MapDelta A m m)=(M0 A).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
+    Apply M0_canon.
+    Apply MapDelta_nilpotent.
+  Qed.
+
+  Lemma MapDelta_as_Merge_c : (m,m':(Map A))
+      (mapcanon A m) -> (mapcanon A m') ->
+        (MapDelta A m m')=
+	(MapMerge A (MapDomRestrBy A A m m') (MapDomRestrBy A A m' m)).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
+    (Apply MapMerge_canon; Apply MapDomRestrBy_canon; Assumption).
+    Apply MapDelta_as_Merge.
+  Qed.
+
+  Lemma MapDelta_as_DomRestrBy_c : (m,m':(Map A))
+      (mapcanon A m) -> (mapcanon A m') ->
+        (MapDelta A m m')=
+	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDelta_canon; Assumption.
+    Apply MapDomRestrBy_canon. (Apply MapMerge_canon; Assumption).
+    Apply MapDelta_as_DomRestrBy.
+  Qed.
+
+  Lemma MapDelta_as_DomRestrBy_2_c : (m,m':(Map A))
+      (mapcanon A m) -> (mapcanon A m') ->
+        (MapDelta A m m')=
+	(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m' m)).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
+    Apply MapDomRestrBy_canon. Apply MapMerge_canon; Assumption.
+    Apply MapDelta_as_DomRestrBy_2.
+  Qed.
+
+  Lemma MapDelta_sym_c : (m,m':(Map A))
+      (mapcanon A m) -> (mapcanon A m') -> (MapDelta A m m')=(MapDelta A m' m).
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
+    (Apply MapDelta_canon; Assumption). Apply MapDelta_sym.
+  Qed.
+
+  Lemma MapDom_Split_1_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
+      m=(MapMerge A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m')).
+  Proof.
+    Intros. Apply mapcanon_unique. Assumption.
+    Apply MapMerge_canon. Apply MapDomRestrTo_canon; Assumption.
+    Apply MapDomRestrBy_canon; Assumption.
+    Apply MapDom_Split_1.
+  Qed.
+
+  Lemma MapDom_Split_2_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
+      m=(MapMerge A (MapDomRestrBy A B m m') (MapDomRestrTo A B m m')).
+  Proof.
+    Intros. Apply mapcanon_unique. Assumption.
+    Apply MapMerge_canon. (Apply MapDomRestrBy_canon; Assumption).
+    (Apply MapDomRestrTo_canon; Assumption).
+    Apply MapDom_Split_2.
+  Qed.
+
+  Lemma MapDom_Split_3_c : (m:(Map A)) (m':(Map B)) (mapcanon A m) ->
+      (MapDomRestrTo A A (MapDomRestrTo A B m m') (MapDomRestrBy A B m m'))=
+      (M0 A).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrTo_canon.
+    Apply MapDomRestrTo_canon; Assumption.
+    Apply M0_canon.
+    Apply MapDom_Split_3.
+  Qed.
+
+  Lemma Map_of_alist_of_Map_c : (m:(Map A)) (mapcanon A m) ->
+      (Map_of_alist A (alist_of_Map A m))=m.
+  Proof.
+    Intros. (Apply mapcanon_unique; Try Assumption). Apply Map_of_alist_canon.
+    Apply Map_of_alist_of_Map.
+  Qed.
+
+  Lemma alist_of_Map_of_alist_c : (l:(alist A)) (alist_sorted_2 A l) ->
+      (alist_of_Map A (Map_of_alist A l))=l.
+  Proof.
+    Intros. Apply alist_canonical. Apply alist_of_Map_of_alist.
+    Apply alist_of_Map_sorts2.
+    Assumption.
+  Qed.
+
+  Lemma MapSubset_antisym_c : (m:(Map A)) (m':(Map B))
+      (mapcanon A m) -> (mapcanon B m') ->
+      (MapSubset A B m m') -> (MapSubset B A m' m) -> (MapDom A m)=(MapDom B m').
+  Proof.
+    Intros. Apply (mapcanon_unique unit). (Apply MapDom_canon; Assumption).
+    (Apply MapDom_canon; Assumption).
+    (Apply MapSubset_antisym; Assumption).
+  Qed.
+
+  Lemma FSubset_antisym_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> s=s'.
+  Proof.
+    Intros. Apply (mapcanon_unique unit); Try Assumption. Apply FSubset_antisym; Assumption.
+  Qed.
+
+  Lemma MapDisjoint_empty_c : (m:(Map A)) (mapcanon A m) ->
+      (MapDisjoint A A m m) -> m=(M0 A).
+  Proof.
+    Intros. Apply mapcanon_unique; Try Assumption; Try Apply M0_canon.
+    Apply MapDisjoint_empty; Assumption.
+  Qed.
+
+  Lemma MapDelta_disjoint_c : (m,m':(Map A)) (mapcanon A m) -> (mapcanon A m') ->
+      (MapDisjoint A A m m') -> (MapDelta A m m')=(MapMerge A m m').
+  Proof.
+    Intros. Apply mapcanon_unique. (Apply MapDelta_canon; Assumption).
+    (Apply MapMerge_canon; Assumption). Apply MapDelta_disjoint; Assumption.
+  Qed.
+
+End MapC.
+
+Lemma FSetDelta_assoc_c : (s,s',s'':FSet)
+    (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
+      (MapDelta ? (MapDelta ? s s') s'')=(MapDelta ? s (MapDelta ? s' s'')).
+Proof.
+  Intros. Apply (mapcanon_unique unit). Apply MapDelta_canon. (Apply MapDelta_canon; Assumption).
+  Assumption.
+  Apply MapDelta_canon. Assumption.
+  (Apply MapDelta_canon; Assumption).
+  Apply FSetDelta_assoc; Assumption.
+Qed.
+
+Lemma FSet_ext_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      ((a:ad) (in_FSet a s)=(in_FSet a s')) -> s=s'.
+Proof.
+  Intros. (Apply (mapcanon_unique unit); Try Assumption). Apply FSet_ext. Assumption.
+Qed.
+
+Lemma FSetUnion_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (FSetUnion s s')=(FSetUnion s' s).
+Proof.
+  Intros.
+  Apply (mapcanon_unique unit); Try (Unfold FSetUnion; Apply MapMerge_canon; Assumption).
+  Apply FSetUnion_comm.
+Qed.
+
+Lemma FSetUnion_assoc_c : (s,s',s'':FSet)
+      (mapcanon unit s) -> (mapcanon unit s') -> (mapcanon unit s'') ->
+        (FSetUnion (FSetUnion s s') s'')=(FSetUnion s (FSetUnion s' s'')).
+Proof.
+  Exact (MapMerge_assoc_c unit).
+Qed.
+
+Lemma FSetUnion_M0_s_c : (s:FSet) (FSetUnion (M0 unit) s)=s.
+Proof.
+  Exact (MapMerge_empty_m_c unit).
+Qed.
+
+Lemma FSetUnion_s_M0_c : (s:FSet) (FSetUnion s (M0 unit))=s.
+Proof.
+  Exact (MapMerge_m_empty_1 unit).
+Qed.
+
+Lemma FSetUnion_idempotent : (s:FSet) (mapcanon unit s) -> (FSetUnion s s)=s.
+Proof.
+  Exact (MapMerge_idempotent_c unit).
+Qed.
+
+Lemma FSetInter_comm_c : (s,s':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (FSetInter s s')=(FSetInter s' s).
+Proof.
+  Intros.
+  Apply (mapcanon_unique unit); Try (Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption).
+  Apply FSetInter_comm.
+Qed.
+
+Lemma FSetInter_assoc_c : (s,s',s'':FSet)
+      (mapcanon unit s) ->
+        (FSetInter (FSetInter s s') s'')=(FSetInter s (FSetInter s' s'')).
+Proof.
+  Exact (MapDomRestrTo_assoc_c unit unit unit).
+Qed.
+
+Lemma FSetInter_M0_s_c : (s:FSet) (FSetInter (M0 unit) s)=(M0 unit).
+Proof.
+  Trivial.
+Qed.
+
+Lemma FSetInter_s_M0_c : (s:FSet) (FSetInter s (M0 unit))=(M0 unit).
+Proof.
+  Exact (MapDomRestrTo_m_empty_1 unit unit).
+Qed.
+
+Lemma FSetInter_idempotent : (s:FSet) (mapcanon unit s) -> (FSetInter s s)=s.
+Proof.
+  Exact (MapDomRestrTo_idempotent_c unit).
+Qed.
+
+Lemma FSetUnion_Inter_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s'') ->
+      (FSetUnion (FSetInter s s') s'')=(FSetInter (FSetUnion s s'') (FSetUnion s' s'')).
+Proof.
+  Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
+  Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
+  Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
+  Apply FSetUnion_Inter_l.
+Qed.
+
+Lemma FSetUnion_Inter_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (FSetUnion s (FSetInter s' s''))=(FSetInter (FSetUnion s s') (FSetUnion s s'')).
+Proof.
+  Intros. Apply (mapcanon_unique unit). Unfold FSetUnion. (Apply MapMerge_canon; Try Assumption).
+  Unfold FSetInter. (Apply MapDomRestrTo_canon; Assumption).
+  Unfold FSetInter; Unfold FSetUnion; Apply MapDomRestrTo_canon; Apply MapMerge_canon; Assumption.
+  Apply FSetUnion_Inter_r.
+Qed.
+
+Lemma FSetInter_Union_l_c : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (FSetInter (FSetUnion s s') s'')=(FSetUnion (FSetInter s s'') (FSetInter s' s'')).
+Proof.
+  Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
+  Apply MapDomRestrTo_canon; Try Assumption. Unfold FSetUnion.
+  Apply MapMerge_canon; Assumption.
+  Unfold FSetUnion; Unfold FSetInter; Apply MapMerge_canon; Apply MapDomRestrTo_canon;
+  Assumption.
+  Apply FSetInter_Union_l.
+Qed.
+
+Lemma FSetInter_Union_r : (s,s',s'':FSet) (mapcanon unit s) -> (mapcanon unit s') ->
+      (FSetInter s (FSetUnion s' s''))=(FSetUnion (FSetInter s s') (FSetInter s s'')).
+Proof.
+  Intros. Apply (mapcanon_unique unit). Unfold FSetInter.
+  Apply MapDomRestrTo_canon; Try Assumption.
+  Unfold FSetUnion. Apply MapMerge_canon; Unfold FSetInter; Apply MapDomRestrTo_canon; Assumption.
+  Apply FSetInter_Union_r.
+Qed.
diff --git a/theories7/IntMap/Mapcanon.v b/theories7/IntMap/Mapcanon.v
new file mode 100644
index 00000000..7beb1fd4
--- /dev/null
+++ b/theories7/IntMap/Mapcanon.v
@@ -0,0 +1,376 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapcanon.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require Arith.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Mapaxioms.
+Require Mapiter.
+Require Fset.
+Require PolyList.
+Require Lsort.
+Require Mapsubset.
+Require Mapcard.
+
+Section MapCanon.
+
+  Variable A : Set.
+
+  Inductive mapcanon : (Map A) -> Prop :=
+      M0_canon : (mapcanon (M0 A))
+    | M1_canon : (a:ad) (y:A) (mapcanon (M1 A a y))
+    | M2_canon : (m1,m2:(Map A)) (mapcanon m1) -> (mapcanon m2) ->
+        (le (2) (MapCard A (M2 A m1 m2))) -> (mapcanon (M2 A m1 m2)).
+
+  Lemma mapcanon_M2 : 
+      (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (le (2) (MapCard A (M2 A m1 m2))).
+  Proof.
+    Intros. Inversion H. Assumption.
+  Qed.
+
+  Lemma mapcanon_M2_1 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m1).
+  Proof.
+    Intros. Inversion H. Assumption.
+  Qed.
+
+  Lemma mapcanon_M2_2 : (m1,m2:(Map A)) (mapcanon (M2 A m1 m2)) -> (mapcanon m2).
+  Proof.
+    Intros. Inversion H. Assumption.
+  Qed.
+
+  Lemma M2_eqmap_1 : (m0,m1,m2,m3:(Map A)) 
+      (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m0 m2).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite <- (ad_double_div_2 a).
+    Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
+    Rewrite <- (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m2 m3).
+    Exact (H (ad_double a)).
+  Qed.
+
+  Lemma M2_eqmap_2 : (m0,m1,m2,m3:(Map A)) 
+      (eqmap A (M2 A m0 m1) (M2 A m2 m3)) -> (eqmap A m1 m3).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite <- (ad_double_plus_un_div_2 a).
+    Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
+    Rewrite <- (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m2 m3).
+    Exact (H (ad_double_plus_un a)).
+  Qed.
+
+  Lemma mapcanon_unique : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
+      (eqmap A m m') -> m=m'.
+  Proof.
+    Induction m. Induction m'. Trivial.
+    Intros a y H H0 H1. Cut (NONE A)=(MapGet A (M1 A a y) a). Simpl. Rewrite (ad_eq_correct a).
+    Intro. Discriminate H2.
+    Exact (H1 a).
+    Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
+    Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
+    Intros a y. Induction m'. Intros. Cut (MapGet A (M1 A a y) a)=(NONE A). Simpl.
+    Rewrite (ad_eq_correct a). Intro. Discriminate H2.
+    Exact (H1 a).
+    Intros a0 y0 H H0 H1. Cut (MapGet A (M1 A a y) a)=(MapGet A (M1 A a0 y0) a). Simpl.
+    Rewrite (ad_eq_correct a). Intro. Elim (sumbool_of_bool (ad_eq a0 a)). Intro H3.
+    Rewrite H3 in H2. Inversion H2. Rewrite (ad_eq_complete ? ? H3). Reflexivity.
+    Intro H3. Rewrite H3 in H2. Discriminate H2.
+    Exact (H1 a).
+    Intros. Cut (le (2) (MapCard A (M1 A a y))). Intro. Elim (le_Sn_O ? (le_S_n ? ? H4)).
+    Rewrite (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H2).
+    Induction m'. Intros. Cut (le (2) (MapCard A (M0 A))). Intro. Elim (le_Sn_O ? H4).
+    Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
+    Intros a y H1 H2 H3. Cut (le (2) (MapCard A (M1 A a y))). Intro.
+    Elim (le_Sn_O ? (le_S_n ? ? H4)).
+    Rewrite <- (MapCard_ext A ? ? H3). Exact (mapcanon_M2 ? ? H1).
+    Intros. Rewrite (H m2). Rewrite (H0 m3). Reflexivity.
+    Exact (mapcanon_M2_2 ? ? H3).
+    Exact (mapcanon_M2_2 ? ? H4).
+    Exact (M2_eqmap_2 ? ? ? ? H5).
+    Exact (mapcanon_M2_1 ? ? H3).
+    Exact (mapcanon_M2_1 ? ? H4).
+    Exact (M2_eqmap_1 ? ? ? ? H5).
+  Qed.
+
+  Lemma MapPut1_canon : 
+      (p:positive) (a,a':ad) (y,y':A) (mapcanon (MapPut1 A a y a' y' p)).
+  Proof.
+    Induction p. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
+    Apply M1_canon.
+    Apply le_n.
+    Apply M2_canon. Apply M1_canon.
+    Apply M1_canon.
+    Apply le_n.
+    Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M0_canon.
+    Apply H.
+    Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
+    Apply M2_canon. Apply H.
+    Apply M0_canon.
+    Simpl. Rewrite MapCard_Put1_equals_2. Apply le_n.
+    Simpl. Simpl. Intros. Case (ad_bit_0 a). Apply M2_canon. Apply M1_canon.
+    Apply M1_canon.
+    Simpl. Apply le_n.
+    Apply M2_canon. Apply M1_canon.
+    Apply M1_canon.
+    Simpl. Apply le_n.
+  Qed.
+
+  Lemma MapPut_canon : 
+      (m:(Map A)) (mapcanon m) -> (a:ad) (y:A) (mapcanon (MapPut A m a y)).
+  Proof.
+    Induction m. Intros. Simpl. Apply M1_canon.
+    Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
+    Intro. Apply MapPut1_canon.
+    Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
+    Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
+    Apply le_plus_plus. Exact (MapCard_Put_lb A m0 ad_z y).
+    Apply le_n.
+    Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
+    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_l. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
+    Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
+    Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_r. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
+    Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
+    Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_l. Exact (MapCard_Put_lb A m1 ad_z y).
+  Qed.
+
+  Lemma MapPut_behind_canon : (m:(Map A)) (mapcanon m) ->
+      (a:ad) (y:A) (mapcanon (MapPut_behind A m a y)).
+  Proof.
+    Induction m. Intros. Simpl. Apply M1_canon.
+    Intros a0 y0 H a y. Simpl. Case (ad_xor a0 a). Apply M1_canon.
+    Intro. Apply MapPut1_canon.
+    Intros. Simpl. Elim a. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
+    Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)). Exact (mapcanon_M2 ? ? H1).
+    Apply le_plus_plus. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 ad_z y).
+    Apply le_n.
+    Intro. Case p. Intro. Apply M2_canon. Exact (mapcanon_M2_1 m0 m1 H1).
+    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 (ad_x p0) y).
+    Intro. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
+    Exact (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_r. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m0 (ad_x p0) y).
+    Apply M2_canon. Apply (mapcanon_M2_1 m0 m1 H1).
+    Apply H0. Apply (mapcanon_M2_2 m0 m1 H1).
+    Simpl. Apply le_trans with m:=(plus (MapCard A m0) (MapCard A m1)).
+    Exact (mapcanon_M2 m0 m1 H1).
+    Apply le_reg_l. Rewrite MapCard_Put_behind_Put. Exact (MapCard_Put_lb A m1 ad_z y).
+  Qed.
+
+  Lemma makeM2_canon : 
+      (m,m':(Map A)) (mapcanon m) -> (mapcanon m') -> (mapcanon (makeM2 A m m')).
+  Proof.
+    Intro. Case m. Intro. Case m'. Intros. Exact M0_canon.
+    Intros a y H H0. Exact (M1_canon (ad_double_plus_un a) y).
+    Intros. Simpl. (Apply M2_canon; Try Assumption). Exact (mapcanon_M2 m0 m1 H0).
+    Intros a y m'. Case m'. Intros. Exact (M1_canon (ad_double a) y).
+    Intros a0 y0 H H0. Simpl. (Apply M2_canon; Try Assumption). Apply le_n.
+    Intros. Simpl. (Apply M2_canon; Try Assumption).
+    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H0).
+    Exact (le_plus_r (MapCard A (M1 A a y)) (MapCard A (M2 A m0 m1))).
+    Simpl. Intros. (Apply M2_canon; Try Assumption).
+    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H).
+    Exact (le_plus_l (MapCard A (M2 A m0 m1)) (MapCard A m')).
+  Qed.
+
+  Fixpoint MapCanonicalize [m:(Map A)] : (Map A) :=
+      Cases m of
+          (M2 m0 m1) => (makeM2 A (MapCanonicalize m0) (MapCanonicalize m1))
+	| _ => m
+      end.
+
+  Lemma mapcanon_exists_1 : (m:(Map A)) (eqmap A m (MapCanonicalize m)).
+  Proof.
+    Induction m. Apply eqmap_refl.
+    Intros. Apply eqmap_refl.
+    Intros. Simpl. Unfold eqmap eqm. Intro.
+    Rewrite (makeM2_M2 A (MapCanonicalize m0) (MapCanonicalize m1) a).
+    Rewrite MapGet_M2_bit_0_if. Rewrite MapGet_M2_bit_0_if.
+    Rewrite <- (H (ad_div_2 a)). Rewrite <- (H0 (ad_div_2 a)). Reflexivity.
+  Qed.
+
+  Lemma mapcanon_exists_2 : (m:(Map A)) (mapcanon (MapCanonicalize m)).
+  Proof.
+    Induction m. Apply M0_canon.
+    Intros. Simpl. Apply M1_canon.
+    Intros. Simpl. (Apply makeM2_canon; Assumption).
+  Qed.
+
+  Lemma mapcanon_exists : 
+      (m:(Map A)) {m':(Map A) | (eqmap A m m') /\ (mapcanon m')}.
+  Proof.
+    Intro. Split with (MapCanonicalize m). Split. Apply mapcanon_exists_1.
+    Apply mapcanon_exists_2.
+  Qed.
+
+  Lemma MapRemove_canon : 
+      (m:(Map A)) (mapcanon m) -> (a:ad) (mapcanon (MapRemove A m a)).
+  Proof.
+    Induction m. Intros. Exact M0_canon.
+    Intros a y H a0. Simpl. Case (ad_eq a a0). Exact M0_canon.
+    Assumption.
+    Intros. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
+    Apply H0. Exact (mapcanon_M2_2 ? ? H1).
+    Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
+    Exact (mapcanon_M2_2 ? ? H1).
+  Qed.
+
+  Lemma MapMerge_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
+      (mapcanon (MapMerge A m m')).
+  Proof.
+    Induction m. Intros. Exact H0.
+    Simpl. Intros a y m' H H0. Exact (MapPut_behind_canon m' H0 a y).
+    Induction m'. Intros. Exact H1.
+    Intros a y H1 H2. Unfold MapMerge. Exact (MapPut_canon ? H1 a y).
+    Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
+    Exact (mapcanon_M2_1 ? ? H4).
+    Apply H0. Exact (mapcanon_M2_2 ? ? H3).
+    Exact (mapcanon_M2_2 ? ? H4).
+    Change (le (2) (MapCard A (MapMerge A (M2 A m0 m1) (M2 A m2 m3)))).
+    Apply le_trans with m:=(MapCard A (M2 A m0 m1)). Exact (mapcanon_M2 ? ? H3).
+    Exact (MapMerge_Card_lb_l A (M2 A m0 m1) (M2 A m2 m3)).
+  Qed.
+
+  Lemma MapDelta_canon : (m,m':(Map A)) (mapcanon m) -> (mapcanon m') ->
+      (mapcanon (MapDelta A m m')).
+  Proof.
+    Induction m. Intros. Exact H0.
+    Simpl. Intros a y m' H H0. Case (MapGet A m' a). Exact (MapPut_canon m' H0 a y).
+    Intro. Exact (MapRemove_canon m' H0 a).
+    Induction m'. Intros. Exact H1.
+    Unfold MapDelta. Intros a y H1 H2. Case (MapGet A (M2 A m0 m1) a).
+    Exact (MapPut_canon ? H1 a y).
+    Intro. Exact (MapRemove_canon ? H1 a).
+    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H3).
+    Exact (mapcanon_M2_1 ? ? H4).
+    Apply H0. Exact (mapcanon_M2_2 ? ? H3).
+    Exact (mapcanon_M2_2 ? ? H4).
+  Qed.
+
+  Variable B : Set.
+
+  Lemma MapDomRestrTo_canon : (m:(Map A)) (mapcanon m) ->
+      (m':(Map B)) (mapcanon (MapDomRestrTo A B m m')).
+  Proof.
+    Induction m. Intros. Exact M0_canon.
+    Simpl. Intros a y H m'. Case (MapGet B m' a). Exact M0_canon.
+    Intro. Apply M1_canon.
+    Induction m'. Exact M0_canon.
+    Unfold MapDomRestrTo. Intros a y. Case (MapGet A (M2 A m0 m1) a). Exact M0_canon.
+    Intro. Apply M1_canon.
+    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 m0 m1 H1).
+    Apply H0. Exact (mapcanon_M2_2 m0 m1 H1).
+  Qed.
+
+  Lemma MapDomRestrBy_canon : (m:(Map A)) (mapcanon m) ->
+      (m':(Map B)) (mapcanon (MapDomRestrBy A B m m')).
+  Proof.
+    Induction m. Intros. Exact M0_canon.
+    Simpl. Intros a y H m'. Case (MapGet B m' a). Assumption.
+    Intro. Exact M0_canon.
+    Induction m'. Exact H1.
+    Intros a y. Simpl. Case (ad_bit_0 a). Apply makeM2_canon. Exact (mapcanon_M2_1 ? ? H1).
+    Apply MapRemove_canon. Exact (mapcanon_M2_2 ? ? H1).
+    Apply makeM2_canon. Apply MapRemove_canon. Exact (mapcanon_M2_1 ? ? H1).
+    Exact (mapcanon_M2_2 ? ? H1).
+    Intros. Simpl. Apply makeM2_canon. Apply H. Exact (mapcanon_M2_1 ? ? H1).
+    Apply H0. Exact (mapcanon_M2_2 ? ? H1).
+  Qed.
+
+  Lemma Map_of_alist_canon : (l:(alist A)) (mapcanon (Map_of_alist A l)).
+  Proof.
+    Induction l. Exact M0_canon.
+    Intro r. Elim r. Intros a y l0 H. Simpl. Apply MapPut_canon. Assumption.
+  Qed.
+
+  Lemma MapSubset_c_1 : (m:(Map A)) (m':(Map B)) (mapcanon m) ->
+      (MapSubset A B m m') -> (MapDomRestrBy A B m m')=(M0 A).
+  Proof.
+    Intros. Apply mapcanon_unique. Apply MapDomRestrBy_canon. Assumption.
+    Apply M0_canon.
+    Exact (MapSubset_imp_2 ? ? m m' H0).
+  Qed.
+
+  Lemma MapSubset_c_2 : (m:(Map A)) (m':(Map B))
+      (MapDomRestrBy A B m m')=(M0 A) -> (MapSubset A B m m').
+  Proof.
+    Intros. Apply MapSubset_2_imp. Unfold MapSubset_2. Rewrite H. Apply eqmap_refl.
+  Qed.
+
+End MapCanon.
+
+Section FSetCanon.
+
+  Variable A : Set.
+
+  Lemma MapDom_canon : (m:(Map A)) (mapcanon A m) -> (mapcanon unit (MapDom A m)).
+  Proof.
+    Induction m. Intro. Exact (M0_canon unit).
+    Intros a y H. Exact (M1_canon unit a ?).
+    Intros. Simpl. Apply M2_canon. Apply H. Exact (mapcanon_M2_1 A ? ? H1).
+    Apply H0. Exact (mapcanon_M2_2 A ? ? H1).
+    Change (le (2) (MapCard unit (MapDom A (M2 A m0 m1)))). Rewrite <- MapCard_Dom.
+    Exact (mapcanon_M2 A ? ? H1).
+  Qed.
+
+End FSetCanon.
+
+Section MapFoldCanon.
+
+  Variable A, B : Set.
+
+  Lemma MapFold_canon_1 : (m0:(Map B)) (mapcanon B m0) ->
+      (op : (Map B) -> (Map B) -> (Map B))
+      	((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
+	  (mapcanon B (op m1 m2))) ->
+      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
+	(m:(Map A)) (pf : ad->ad) (mapcanon B (MapFold1 A (Map B) m0 op f pf m)).
+  Proof.
+    Induction m. Intro. Exact H.
+    Intros a y pf. Simpl. Apply H1.
+    Intros. Simpl. Apply H0. Apply H2.
+    Apply H3.
+  Qed.
+
+  Lemma MapFold_canon : (m0:(Map B)) (mapcanon B m0) ->
+      (op : (Map B) -> (Map B) -> (Map B))
+      	((m1:(Map B)) (mapcanon B m1) -> (m2:(Map B)) (mapcanon B m2) ->
+	  (mapcanon B (op m1 m2))) ->
+      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
+	(m:(Map A)) (mapcanon B (MapFold A (Map B) m0 op f m)).
+  Proof.
+    Intros. Exact (MapFold_canon_1 m0 H op H0 f H1 m [a:ad]a).
+  Qed.
+
+  Lemma MapCollect_canon : 
+      (f : ad->A->(Map B)) ((a:ad) (y:A) (mapcanon B (f a y))) ->
+	(m:(Map A)) (mapcanon B (MapCollect A B f m)).
+  Proof.
+    Intros. Rewrite MapCollect_as_Fold. Apply MapFold_canon. Apply M0_canon.
+    Intros. Exact (MapMerge_canon B m1 m2 H0 H1).
+    Assumption.
+  Qed.
+
+End MapFoldCanon.
diff --git a/theories7/IntMap/Mapcard.v b/theories7/IntMap/Mapcard.v
new file mode 100644
index 00000000..5c5e2a93
--- /dev/null
+++ b/theories7/IntMap/Mapcard.v
@@ -0,0 +1,670 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapcard.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require Arith.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Mapaxioms.
+Require Mapiter.
+Require Fset.
+Require Mapsubset.
+Require PolyList.
+Require Lsort.
+Require Peano_dec.
+
+Section MapCard.
+
+  Variable A, B : Set.
+
+  Lemma MapCard_M0 : (MapCard A (M0 A))=O.
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapCard_M1 : (a:ad) (y:A) (MapCard A (M1 A a y))=(1).
+  Proof.
+    Trivial.
+  Qed.
+
+  Lemma MapCard_is_O : (m:(Map A)) (MapCard A m)=O -> 
+      (a:ad) (MapGet A m a)=(NONE A).
+  Proof.
+    Induction m. Trivial.
+    Intros a y H. Discriminate H.
+    Intros. Simpl in H1. Elim (plus_is_O ? ? H1). Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+    Case (ad_bit_0 a). Apply H0. Assumption.
+    Apply H. Assumption.
+  Qed.
+
+  Lemma MapCard_is_not_O : (m:(Map A)) (a:ad) (y:A) (MapGet A m a)=(SOME A y) ->
+      {n:nat | (MapCard A m)=(S n)}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Intros a y a0 y0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0. Split with O.
+    Reflexivity.
+    Intro H0. Rewrite H0 in H. Discriminate H.
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
+    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Elim (H0 (ad_div_2 a) y H1). Intros n H3.
+    Simpl. Rewrite H3. Split with (plus (MapCard A m0) n).
+    Rewrite <- (plus_Snm_nSm (MapCard A m0) n). Reflexivity.
+    Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Elim (H (ad_div_2 a) y H1).
+    Intros n H3. Simpl. Rewrite H3. Split with (plus n (MapCard A m1)). Reflexivity.
+  Qed.
+
+  Lemma MapCard_is_one : (m:(Map A)) (MapCard A m)=(1) ->
+      {a:ad & {y:A | (MapGet A m a)=(SOME A y)}}.
+  Proof.
+    Induction m. Intro. Discriminate H.
+    Intros a y H. Split with a. Split with y. Apply M1_semantics_1.
+    Intros. Simpl in H1. Elim (plus_is_one (MapCard A m0) (MapCard A m1) H1).
+    Intro H2. Elim H2. Intros. Elim (H0 H4). Intros a H5. Split with (ad_double_plus_un a).
+    Rewrite (MapGet_M2_bit_0_1 A ? (ad_double_plus_un_bit_0 a) m0 m1).
+    Rewrite ad_double_plus_un_div_2. Exact H5.
+    Intro H2. Elim H2. Intros. Elim (H H3). Intros a H5. Split with (ad_double a).
+    Rewrite (MapGet_M2_bit_0_0 A ? (ad_double_bit_0 a) m0 m1).
+    Rewrite ad_double_div_2. Exact H5.
+  Qed.
+
+  Lemma MapCard_is_one_unique : (m:(Map A)) (MapCard A m)=(1) -> (a,a':ad) (y,y':A) 
+      (MapGet A m a)=(SOME A y) -> (MapGet A m a')=(SOME A y') ->
+        a=a' /\ y=y'.
+  Proof.
+    Induction m. Intro. Discriminate H.
+    Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H0.
+    Rewrite (M1_semantics_1 A a1 a0) in H0. Inversion H0. Elim (sumbool_of_bool (ad_eq a a')).
+    Intro H5. Rewrite (ad_eq_complete ? ? H5) in H1. Rewrite (M1_semantics_1 A a' a0) in H1.
+    Inversion H1. Rewrite <- (ad_eq_complete ? ? H2). Rewrite <- (ad_eq_complete ? ? H5).
+    Rewrite <- H4. Rewrite <- H6. (Split; Reflexivity).
+    Intro H5. Rewrite (M1_semantics_2 A a a' a0 H5) in H1. Discriminate H1.
+    Intro H2. Rewrite (M1_semantics_2 A a a1 a0 H2) in H0. Discriminate H0.
+    Intros. Simpl in H1. Elim (plus_is_one ? ? H1). Intro H4. Elim H4. Intros.
+    Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2. Elim (sumbool_of_bool (ad_bit_0 a)).
+    Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
+    Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3. Elim (H0 H6 ? ? ? ? H2 H3).
+    Intros. Split. Rewrite <- (ad_div_2_double_plus_un a H7).
+    Rewrite <- (ad_div_2_double_plus_un a' H8). Rewrite H9. Reflexivity.
+    Assumption.
+    Intro H8. Rewrite H8 in H3. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a')) in H3.
+    Discriminate H3.
+    Intro H7. Rewrite H7 in H2. Rewrite (MapCard_is_O m0 H5 (ad_div_2 a)) in H2.
+    Discriminate H2.
+    Intro H4. Elim H4. Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 a) in H2.
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H7. Rewrite H7 in H2.
+    Rewrite (MapCard_is_O m1 H6 (ad_div_2 a)) in H2. Discriminate H2.
+    Intro H7. Rewrite H7 in H2. Rewrite (MapGet_M2_bit_0_if A m0 m1 a') in H3.
+    Elim (sumbool_of_bool (ad_bit_0 a')). Intro H8. Rewrite H8 in H3.
+    Rewrite (MapCard_is_O m1 H6 (ad_div_2 a')) in H3. Discriminate H3.
+    Intro H8. Rewrite H8 in H3. Elim (H H5 ? ? ? ? H2 H3). Intros. Split.
+    Rewrite <- (ad_div_2_double a H7). Rewrite <- (ad_div_2_double a' H8).
+    Rewrite H9. Reflexivity.
+    Assumption.
+  Qed.
+
+  Lemma length_as_fold : (C:Set) (l:(list C)) 
+      (length l)=(fold_right [_:C][n:nat](S n) O l).
+  Proof.
+    Induction l. Reflexivity.
+    Intros. Simpl. Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma length_as_fold_2 : (l:(alist A)) 
+      (length l)=(fold_right [r:ad*A][n:nat]let (a,y)=r in (plus (1) n) O l).
+  Proof.
+    Induction l. Reflexivity.
+    Intros. Simpl. Rewrite H. (Elim a; Reflexivity).
+  Qed.
+
+  Lemma MapCard_as_Fold_1 : (m:(Map A)) (pf:ad->ad)
+      (MapCard A m)=(MapFold1 A nat O plus [_:ad][_:A](1) pf m).
+  Proof.
+    Induction m. Trivial.
+    Trivial.
+    Intros. Simpl. Rewrite <- (H [a0:ad](pf (ad_double a0))).
+    Rewrite <- (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
+  Qed.
+
+  Lemma MapCard_as_Fold : 
+      (m:(Map A)) (MapCard A m)=(MapFold A nat O plus [_:ad][_:A](1) m).
+  Proof.
+    Intro. Exact (MapCard_as_Fold_1 m [a0:ad]a0).
+  Qed.
+ 
+  Lemma MapCard_as_length : (m:(Map A)) (MapCard A m)=(length (alist_of_Map A m)).
+  Proof.
+    Intro. Rewrite MapCard_as_Fold. Rewrite length_as_fold_2.
+    Apply MapFold_as_fold with op:=plus neutral:=O f:=[_:ad][_:A](1). Exact plus_assoc_r.
+    Trivial.
+    Intro. Rewrite <- plus_n_O. Reflexivity.
+  Qed.
+
+  Lemma MapCard_Put1_equals_2 : (p:positive) (a,a':ad) (y,y':A)
+      (MapCard A (MapPut1 A a y a' y' p))=(2).
+  Proof.
+    Induction p. Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
+    Intros. Simpl. Case (ad_bit_0 a). Exact (H (ad_div_2 a) (ad_div_2 a') y y').
+    Simpl. Rewrite <- plus_n_O. Exact (H (ad_div_2 a) (ad_div_2 a') y y').
+    Intros. Simpl. (Case (ad_bit_0 a); Reflexivity).
+  Qed.
+
+  Lemma MapCard_Put_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
+      m'=(MapPut A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
+        {n'=n}+{n'=(S n)}.
+  Proof.
+    Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Right .
+    Rewrite H0. Rewrite H1. Reflexivity.
+    Intros a y m' a0 y0 n n' H H0 H1. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H2.
+    Elim H2. Intros p H3. Rewrite H3 in H. Rewrite H in H1.
+    Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H1. Simpl in H0. Right .
+    Rewrite H0. Rewrite H1. Reflexivity.
+    Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Simpl in H0. Left .
+    Rewrite H0. Rewrite H1. Reflexivity.
+    Intros. Simpl in H2. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1.
+    Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4. Rewrite H4 in H1.
+    Elim (H0 (MapPut A m1 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m1)
+       (MapCard A (MapPut A m1 (ad_div_2 a) y)) (refl_equal ? ?)
+       (refl_equal ? ?) (refl_equal ? ?)).
+    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3. Left .
+    Assumption.
+    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3.
+    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)) in H3.
+    Simpl in H3. Rewrite <- H2 in H3. Right . Assumption.
+    Intro H4. Rewrite H4 in H1.
+    Elim (H (MapPut A m0 (ad_div_2 a) y) (ad_div_2 a) y (MapCard A m0)
+       (MapCard A (MapPut A m0 (ad_div_2 a) y)) (refl_equal ? ?)
+       (refl_equal ? ?) (refl_equal ? ?)).
+    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Rewrite <- H2 in H3.
+    Left . Assumption.
+    Intro H5. Rewrite H1 in H3. Simpl in H3. Rewrite H5 in H3. Simpl in H3. Rewrite <- H2 in H3.
+    Right . Assumption.
+  Qed.
+
+  Lemma MapCard_Put_lb : (m:(Map A)) (a:ad) (y:A)
+      (ge (MapCard A (MapPut A m a y)) (MapCard A m)).
+  Proof.
+    Unfold ge. Intros.
+    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+       (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
+       (refl_equal ? ?)).
+    Intro H. Rewrite H. Apply le_n.
+    Intro H. Rewrite H. Apply le_n_Sn.
+  Qed.
+
+  Lemma MapCard_Put_ub : (m:(Map A)) (a:ad) (y:A)
+      (le (MapCard A (MapPut A m a y)) (S (MapCard A m))).
+  Proof.
+    Intros.
+    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+       (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
+       (refl_equal ? ?)).
+    Intro H. Rewrite H. Apply le_n_Sn.
+    Intro H. Rewrite H. Apply le_n.
+  Qed.
+
+  Lemma MapCard_Put_1 : (m:(Map A)) (a:ad) (y:A)
+      (MapCard A (MapPut A m a y))=(MapCard A m) -> 
+        {y:A | (MapGet A m a)=(SOME A y)}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Intros a y a0 y0 H. Simpl in H. Elim (ad_sum (ad_xor a a0)). Intro H0. Elim H0.
+    Intros p H1. Rewrite H1 in H. Rewrite (MapCard_Put1_equals_2 p a a0 y y0) in H.
+    Discriminate H.
+    Intro H0. Rewrite H0 in H. Rewrite (ad_xor_eq ? ? H0). Split with y. Apply M1_semantics_1.
+    Intros. Rewrite (MapPut_semantics_3_1 A m0 m1 a y) in H1. Elim (sumbool_of_bool (ad_bit_0 a)).
+    Intro H2. Rewrite H2 in H1. Simpl in H1. Elim (H0 (ad_div_2 a) y (simpl_plus_l ? ? ? H1)).
+    Intros y0 H3. Split with y0. Rewrite <- H3. Exact (MapGet_M2_bit_0_1 A a H2 m0 m1).
+    Intro H2. Rewrite H2 in H1. Simpl in H1.
+    Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H1.
+    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1.
+    Elim (H (ad_div_2 a) y (simpl_plus_l ? ? ? H1)). Intros y0 H3. Split with y0.
+    Rewrite <- H3. Exact (MapGet_M2_bit_0_0 A a H2 m0 m1).
+  Qed.
+
+  Lemma MapCard_Put_2 : (m:(Map A)) (a:ad) (y:A)
+      (MapCard A (MapPut A m a y))=(S (MapCard A m)) -> (MapGet A m a)=(NONE A).
+  Proof.
+    Induction m. Trivial.
+    Intros. Simpl in H. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0.
+    Rewrite (ad_eq_complete ? ? H0) in H. Rewrite (ad_xor_nilpotent a1) in H. Discriminate H.
+    Intro H0. Exact (M1_semantics_2 A a a1 a0 H0).
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
+    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply (H0 (ad_div_2 a) y).
+    Apply simpl_plus_l with n:=(MapCard A m0).
+    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A m1)). Simpl in H1. Simpl. Rewrite <- H1.
+    Clear H1.
+    NewInduction a. Discriminate H2.
+    NewInduction p. Reflexivity.
+    Discriminate H2.
+    Reflexivity.
+    Intro H2. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply (H (ad_div_2 a) y).
+    Cut (plus (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1))
+         =(plus (S (MapCard A m0)) (MapCard A m1)).
+    Intro. Rewrite (plus_sym (MapCard A (MapPut A m0 (ad_div_2 a) y)) (MapCard A m1)) in H3.
+    Rewrite (plus_sym (S (MapCard A m0)) (MapCard A m1)) in H3. Exact (simpl_plus_l ? ? ? H3).
+    Simpl. Simpl in H1. Rewrite <- H1. NewInduction a. Trivial.
+    NewInduction p. Discriminate H2.
+    Reflexivity.
+    Discriminate H2.
+  Qed.
+
+  Lemma MapCard_Put_1_conv : (m:(Map A)) (a:ad) (y,y':A)
+      (MapGet A m a)=(SOME A y) -> (MapCard A (MapPut A m a y'))=(MapCard A m).
+  Proof.
+    Intros.
+    Elim (MapCard_Put_sum m (MapPut A m a y') a y' (MapCard A m)
+           (MapCard A (MapPut A m a y')) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Trivial.
+    Intro H0. Rewrite (MapCard_Put_2 m a y' H0) in H. Discriminate H.
+  Qed.
+
+  Lemma MapCard_Put_2_conv : (m:(Map A)) (a:ad) (y:A)
+      (MapGet A m a)=(NONE A) -> (MapCard A (MapPut A m a y))=(S (MapCard A m)).
+  Proof.
+    Intros.
+    Elim (MapCard_Put_sum m (MapPut A m a y) a y (MapCard A m)
+           (MapCard A (MapPut A m a y)) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Intro H0. Elim (MapCard_Put_1 m a y H0). Intros y' H1. Rewrite H1 in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma MapCard_ext : (m,m':(Map A))
+      (eqm A (MapGet A m) (MapGet A m')) -> (MapCard A m)=(MapCard A m').
+  Proof.
+    Unfold eqm. Intros. Rewrite (MapCard_as_length m). Rewrite (MapCard_as_length m').
+    Rewrite (alist_canonical A (alist_of_Map A m) (alist_of_Map A m')). Reflexivity.
+    Unfold eqm. Intro. Rewrite (Map_of_alist_semantics A (alist_of_Map A m) a).
+    Rewrite (Map_of_alist_semantics A (alist_of_Map A m') a). Rewrite (Map_of_alist_of_Map A m' a).
+    Rewrite (Map_of_alist_of_Map A m a). Exact (H a).
+    Apply alist_of_Map_sorts2.
+    Apply alist_of_Map_sorts2.
+  Qed.
+
+  Lemma MapCard_Dom : (m:(Map A)) (MapCard A m)=(MapCard unit (MapDom A m)).
+  Proof.
+    (Induction m; Trivial). Intros. Simpl. Rewrite H. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapCard_Dom_Put_behind : (m:(Map A)) (a:ad) (y:A)
+      (MapDom A (MapPut_behind A m a y))=(MapDom A (MapPut A m a y)).
+  Proof.
+    Induction m. Trivial.
+    Intros a y a0 y0. Simpl. Elim (ad_sum (ad_xor a a0)). Intro H. Elim H.
+    Intros p H0. Rewrite H0. Reflexivity.
+    Intro H. Rewrite H. Rewrite (ad_xor_eq ? ? H). Reflexivity.
+    Intros. Simpl. Elim (ad_sum a). Intro H1. Elim H1. Intros p H2. Rewrite H2. Case p.
+    Intro p0. Simpl. Rewrite H0. Reflexivity.
+    Intro p0. Simpl. Rewrite H. Reflexivity.
+    Simpl. Rewrite H0. Reflexivity.
+    Intro H1. Rewrite H1. Simpl. Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma MapCard_Put_behind_Put : (m:(Map A)) (a:ad) (y:A)
+      (MapCard A (MapPut_behind A m a y))=(MapCard A (MapPut A m a y)).
+  Proof.
+    Intros. Rewrite MapCard_Dom. Rewrite MapCard_Dom. Rewrite MapCard_Dom_Put_behind.
+    Reflexivity.
+  Qed.
+
+  Lemma MapCard_Put_behind_sum : (m,m':(Map A)) (a:ad) (y:A) (n,n':nat)
+      m'=(MapPut_behind A m a y) -> n=(MapCard A m) -> n'=(MapCard A m') ->
+        {n'=n}+{n'=(S n)}.
+  Proof.
+    Intros. (Apply (MapCard_Put_sum m (MapPut A m a y) a y n n'); Trivial).
+    Rewrite <- MapCard_Put_behind_Put. Rewrite <- H. Assumption.
+  Qed.
+
+  Lemma MapCard_makeM2 : (m,m':(Map A))
+      (MapCard A (makeM2 A m m'))=(plus (MapCard A m) (MapCard A m')).
+  Proof.
+    Intros. Rewrite (MapCard_ext ? ? (makeM2_M2 A m m')). Reflexivity.
+  Qed.
+ 
+  Lemma MapCard_Remove_sum : (m,m':(Map A)) (a:ad) (n,n':nat)
+      m'=(MapRemove A m a) -> n=(MapCard A m) -> n'=(MapCard A m') ->
+        {n=n'}+{n=(S n')}.
+  Proof.
+    Induction m. Simpl. Intros. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
+    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2. Rewrite H2 in H.
+    Rewrite H in H1. Simpl in H1. Right . Rewrite H1. Assumption.
+    Intro H2. Rewrite H2 in H. Rewrite H in H1. Simpl in H1. Left . Rewrite H1. Assumption.
+    Intros. Simpl in H1. Simpl in H2. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
+    Rewrite H4 in H1. Rewrite H1 in H3.
+    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H3.
+    Elim (H0 (MapRemove A m1 (ad_div_2 a)) (ad_div_2 a) (MapCard A m1)
+             (MapCard A (MapRemove A m1 (ad_div_2 a))) (refl_equal ? ?)
+             (refl_equal ? ?) (refl_equal ? ?)).
+    Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
+    Intro H5. Rewrite H5 in H2.
+    Rewrite <- (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H2.
+    Right . Rewrite H3. Exact H2.
+    Intro H4. Rewrite H4 in H1. Rewrite H1 in H3.
+    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H3.
+    Elim (H (MapRemove A m0 (ad_div_2 a)) (ad_div_2 a) (MapCard A m0)
+            (MapCard A (MapRemove A m0 (ad_div_2 a))) (refl_equal ? ?)
+            (refl_equal ? ?) (refl_equal ? ?)).
+    Intro H5. Rewrite H5 in H2. Left . Rewrite H3. Exact H2.
+    Intro H5. Rewrite H5 in H2. Right . Rewrite H3. Exact H2.
+  Qed.
+
+  Lemma MapCard_Remove_ub : (m:(Map A)) (a:ad)
+      (le (MapCard A (MapRemove A m a)) (MapCard A m)).
+  Proof.
+    Intros.
+    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Intro H. Rewrite H. Apply le_n.
+    Intro H. Rewrite H. Apply le_n_Sn.
+  Qed.
+
+  Lemma MapCard_Remove_lb : (m:(Map A)) (a:ad)
+      (ge (S (MapCard A (MapRemove A m a))) (MapCard A m)).
+  Proof.
+    Unfold ge. Intros.
+    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Intro H. Rewrite H. Apply le_n_Sn.
+    Intro H. Rewrite H. Apply le_n.
+  Qed.
+
+  Lemma MapCard_Remove_1 : (m:(Map A)) (a:ad)
+      (MapCard A (MapRemove A m a))=(MapCard A m) -> (MapGet A m a)=(NONE A).
+  Proof.
+    Induction m. Trivial.
+    Simpl. Intros a y a0 H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
+    Rewrite H0 in H. Discriminate H.
+    Intro H0. Rewrite H0. Reflexivity.
+    Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
+    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
+    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0. Exact (simpl_plus_l ? ? ? H1).
+    Intro H2. Rewrite H2 in H1.
+    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
+    Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
+    Rewrite (plus_sym (MapCard A (MapRemove A m0 (ad_div_2 a))) (MapCard A m1)) in H1.
+    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
+  Qed.
+
+  Lemma MapCard_Remove_2 : (m:(Map A)) (a:ad)
+      (S (MapCard A (MapRemove A m a)))=(MapCard A m) -> 
+        {y:A | (MapGet A m a)=(SOME A y)}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Intros a y a0 H. Simpl in H. Elim (sumbool_of_bool (ad_eq a a0)). Intro H0.
+    Rewrite (ad_eq_complete ? ? H0). Split with y. Exact (M1_semantics_1 A a0 y).
+    Intro H0. Rewrite H0 in H. Discriminate H.
+    Intros. Simpl in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2. Rewrite H2 in H1.
+    Rewrite (MapCard_makeM2 m0 (MapRemove A m1 (ad_div_2 a))) in H1.
+    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1). Apply H0.
+    Change (plus (S (MapCard A m0)) (MapCard A (MapRemove A m1 (ad_div_2 a))))
+            =(plus (MapCard A m0) (MapCard A m1)) in H1.
+    Rewrite (plus_Snm_nSm (MapCard A m0) (MapCard A (MapRemove A m1 (ad_div_2 a)))) in H1.
+    Exact (simpl_plus_l ? ? ? H1).
+    Intro H2. Rewrite H2 in H1. Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1). Apply H.
+    Rewrite (MapCard_makeM2 (MapRemove A m0 (ad_div_2 a)) m1) in H1.
+    Change (plus (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1))
+      	   =(plus (MapCard A m0) (MapCard A m1)) in H1.
+    Rewrite (plus_sym (S (MapCard A (MapRemove A m0 (ad_div_2 a)))) (MapCard A m1)) in H1.
+    Rewrite (plus_sym (MapCard A m0) (MapCard A m1)) in H1. Exact (simpl_plus_l ? ? ? H1).
+  Qed.
+
+  Lemma MapCard_Remove_1_conv : (m:(Map A)) (a:ad)
+      (MapGet A m a)=(NONE A) -> (MapCard A (MapRemove A m a))=(MapCard A m).
+  Proof.
+    Intros.
+    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Intro H0. Rewrite H0. Reflexivity.
+    Intro H0. Elim (MapCard_Remove_2 m a (sym_eq ? ? ? H0)). Intros y H1. Rewrite H1 in H.
+    Discriminate H.
+  Qed.
+
+  Lemma MapCard_Remove_2_conv : (m:(Map A)) (a:ad) (y:A)
+      (MapGet A m a)=(SOME A y) -> 
+        (S (MapCard A (MapRemove A m a)))=(MapCard A m).
+  Proof.
+    Intros.
+    Elim (MapCard_Remove_sum m (MapRemove A m a) a (MapCard A m)
+           (MapCard A (MapRemove A m a)) (refl_equal ? ?) (refl_equal ? ?)
+           (refl_equal ? ?)).
+    Intro H0. Rewrite (MapCard_Remove_1 m a (sym_eq ? ? ? H0)) in H. Discriminate H.
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapMerge_Restr_Card : (m,m':(Map A))
+      (plus (MapCard A m) (MapCard A m'))=
+      (plus (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
+  Proof.
+    Induction m. Simpl. Intro. Apply plus_n_O.
+    Simpl. Intros a y m'. Elim (option_sum A (MapGet A m' a)). Intro H. Elim H. Intros y0 H0.
+    Rewrite H0. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_1_conv m' a y0 y H0).
+    Simpl. Rewrite <- plus_Snm_nSm. Apply plus_n_O.
+    Intro H. Rewrite H. Rewrite MapCard_Put_behind_Put. Rewrite (MapCard_Put_2_conv m' a y H).
+    Apply plus_n_O.
+    Intros.
+    Change (plus (plus (MapCard A m0) (MapCard A m1)) (MapCard A m'))
+            =(plus (MapCard A (MapMerge A (M2 A m0 m1) m'))
+               (MapCard A (MapDomRestrTo A A (M2 A m0 m1) m'))).
+    Elim m'. Reflexivity.
+    Intros a y. Unfold MapMerge. Unfold MapDomRestrTo.
+    Elim (option_sum A (MapGet A (M2 A m0 m1) a)). Intro H1. Elim H1. Intros y0 H2. Rewrite H2.
+    Rewrite (MapCard_Put_1_conv (M2 A m0 m1) a y0 y H2). Reflexivity.
+    Intro H1. Rewrite H1. Rewrite (MapCard_Put_2_conv (M2 A m0 m1) a y H1). Simpl.
+    Rewrite <- (plus_Snm_nSm (plus (MapCard A m0) (MapCard A m1)) O). Reflexivity.
+    Intros. Simpl.
+    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m1) (MapCard A m2) (MapCard A m3)).
+    Rewrite (H m2). Rewrite (H0 m3).
+    Rewrite (MapCard_makeM2 (MapDomRestrTo A A m0 m2) (MapDomRestrTo A A m1 m3)).
+    Apply plus_permute_2_in_4.
+  Qed.
+
+  Lemma MapMerge_disjoint_Card : (m,m':(Map A)) (MapDisjoint A A m m') ->
+      	(MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')).
+  Proof.
+    Intros. Rewrite (MapMerge_Restr_Card m m').
+    Rewrite (MapCard_ext ? ? (MapDisjoint_imp_2 ? ? ? ? H)). Apply plus_n_O.
+  Qed.
+
+  Lemma MapSplit_Card : (m:(Map A)) (m':(Map B))
+      (MapCard A m)=(plus (MapCard A (MapDomRestrTo A B m m'))
+                          (MapCard A (MapDomRestrBy A B m m'))).
+  Proof.
+    Intros. Rewrite (MapCard_ext ? ? (MapDom_Split_1 A B m m')). Apply MapMerge_disjoint_Card.
+    Apply MapDisjoint_2_imp. Unfold MapDisjoint_2. Apply MapDom_Split_3.
+  Qed.
+
+  Lemma MapMerge_Card_ub : (m,m':(Map A))
+      (le (MapCard A (MapMerge A m m')) (plus (MapCard A m) (MapCard A m'))).
+  Proof.
+    Intros. Rewrite MapMerge_Restr_Card. Apply le_plus_l.
+  Qed.
+
+  Lemma MapDomRestrTo_Card_ub_l : (m:(Map A)) (m':(Map B))
+      (le (MapCard A (MapDomRestrTo A B m m')) (MapCard A m)).
+  Proof.
+    Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_l.
+  Qed.
+
+  Lemma MapDomRestrBy_Card_ub_l : (m:(Map A)) (m':(Map B))
+      (le (MapCard A (MapDomRestrBy A B m m')) (MapCard A m)).
+  Proof.
+    Intros. Rewrite (MapSplit_Card m m'). Apply le_plus_r.
+  Qed.
+
+  Lemma MapMerge_Card_disjoint : (m,m':(Map A))
+      (MapCard A (MapMerge A m m'))=(plus (MapCard A m) (MapCard A m')) ->
+        (MapDisjoint A A m m').
+  Proof.
+    Induction m. Intros. Apply Map_M0_disjoint.
+    Simpl. Intros. Rewrite (MapCard_Put_behind_Put m' a a0) in H. Unfold MapDisjoint in_dom.
+    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H2.
+    Rewrite (ad_eq_complete ? ? H2) in H. Rewrite (MapCard_Put_2 m' a1 a0 H) in H1.
+    Discriminate H1.
+    Intro H2. Rewrite H2 in H0. Discriminate H0.
+    Induction m'. Intros. Apply Map_disjoint_M0.
+    Intros a y H1. Rewrite <- (MapCard_ext ? ? (MapPut_as_Merge A (M2 A m0 m1) a y)) in H1.
+    Unfold 3 MapCard in H1. Rewrite <- (plus_Snm_nSm (MapCard A (M2 A m0 m1)) O) in H1.
+    Rewrite <- (plus_n_O (S (MapCard A (M2 A m0 m1)))) in H1. Unfold MapDisjoint in_dom.
+    Unfold 2 MapGet. Intros. Elim (sumbool_of_bool (ad_eq a a0)). Intro H4.
+    Rewrite <- (ad_eq_complete ? ? H4) in H2. Rewrite (MapCard_Put_2 ? ? ? H1) in H2.
+    Discriminate H2.
+    Intro H4. Rewrite H4 in H3. Discriminate H3.
+    Intros. Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H6.
+    Unfold MapDisjoint in H0. Apply H0 with m':=m3 a:=(ad_div_2 a). Apply le_antisym.
+    Apply MapMerge_Card_ub.
+    Apply simpl_le_plus_l with p:=(plus (MapCard A m0) (MapCard A m2)).
+    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
+    Change (MapCard A (M2 A (MapMerge A m0 m2) (MapMerge A m1 m3)))
+           =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
+    Rewrite <- H3. Simpl. Apply le_reg_r. Apply MapMerge_Card_ub.
+    Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m0 m1) in H7.
+    Unfold in_dom. Rewrite H7. Reflexivity.
+    Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_1 ? a H6 m2 m3) in H7.
+    Unfold in_dom. Rewrite H7. Reflexivity.
+    Intro H6. Unfold MapDisjoint in H. Apply H with m':=m2 a:=(ad_div_2 a). Apply le_antisym.
+    Apply MapMerge_Card_ub.
+    Apply simpl_le_plus_l with p:=(plus (MapCard A m1) (MapCard A m3)).
+    Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (plus (MapCard A m0) (MapCard A m2))).
+    Rewrite (plus_permute_2_in_4 (MapCard A m0) (MapCard A m2) (MapCard A m1) (MapCard A m3)).
+    Rewrite (plus_sym (plus (MapCard A m1) (MapCard A m3)) (MapCard A (MapMerge A m0 m2))).
+    Change (plus (MapCard A (MapMerge A m0 m2)) (MapCard A (MapMerge A m1 m3)))
+           =(plus (plus (MapCard A m0) (MapCard A m1)) (plus (MapCard A m2) (MapCard A m3))) in H3.
+    Rewrite <- H3. Apply le_reg_l. Apply MapMerge_Card_ub.
+    Elim (in_dom_some ? ? ? H4). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m0 m1) in H7.
+    Unfold in_dom. Rewrite H7. Reflexivity.
+    Elim (in_dom_some ? ? ? H5). Intros y H7. Rewrite (MapGet_M2_bit_0_0 ? a H6 m2 m3) in H7.
+    Unfold in_dom. Rewrite H7. Reflexivity.
+  Qed.
+
+  Lemma MapCard_is_Sn : (m:(Map A)) (n:nat) (MapCard ? m)=(S n) -> 
+      {a:ad | (in_dom ? a m)=true}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Intros a y n H. Split with a. Unfold in_dom. Rewrite (M1_semantics_1 ? a y). Reflexivity.
+    Intros. Simpl in H1. Elim (O_or_S (MapCard ? m0)). Intro H2. Elim H2. Intros m2 H3.
+    Elim (H ? (sym_eq ? ? ? H3)). Intros a H4. Split with (ad_double a). Unfold in_dom.
+    Rewrite (MapGet_M2_bit_0_0 A (ad_double a) (ad_double_bit_0 a) m0 m1).
+    Rewrite (ad_double_div_2 a). Elim (in_dom_some ? ? ? H4). Intros y H5. Rewrite H5. Reflexivity.
+    Intro H2. Rewrite <- H2 in H1. Simpl in H1. Elim (H0 ? H1). Intros a H3.
+    Split with (ad_double_plus_un a). Unfold in_dom.
+    Rewrite (MapGet_M2_bit_0_1 A (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
+    Rewrite (ad_double_plus_un_div_2 a). Elim (in_dom_some ? ? ? H3). Intros y H4. Rewrite H4.
+    Reflexivity.
+  Qed.
+
+End MapCard.
+
+Section MapCard2.
+
+  Variable A, B : Set.
+
+  Lemma MapSubset_card_eq_1 : (n:nat) (m:(Map A)) (m':(Map B))
+      (MapSubset ? ? m m') -> (MapCard ? m)=n -> (MapCard ? m')=n ->
+        (MapSubset ? ? m' m).
+  Proof.
+    Induction n. Intros. Unfold MapSubset in_dom. Intro. Rewrite (MapCard_is_O ? m H0 a).
+    Rewrite (MapCard_is_O ? m' H1 a). Intro H2. Discriminate H2.
+    Intros. Elim (MapCard_is_Sn A m n0 H1). Intros a H3. Elim (in_dom_some ? ? ? H3).
+    Intros y H4. Elim (in_dom_some ? ? ? (H0 ? H3)). Intros y' H6.
+    Cut (eqmap ? (MapPut ? (MapRemove ? m a) a y) m). Intro.
+    Cut (eqmap ? (MapPut ? (MapRemove ? m' a) a y') m'). Intro.
+    Apply MapSubset_ext with m0:=(MapPut ? (MapRemove ? m' a) a y')
+                             m2:=(MapPut ? (MapRemove ? m a) a y).
+    Assumption.
+    Assumption.
+    Apply MapSubset_Put_mono. Apply H. Apply MapSubset_Remove_mono. Assumption.
+    Rewrite <- (MapCard_Remove_2_conv ? m a y H4) in H1. Inversion_clear H1. Reflexivity.
+    Rewrite <- (MapCard_Remove_2_conv ? m' a y' H6) in H2. Inversion_clear H2. Reflexivity.
+    Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove B m' a) a y' a0).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
+    Apply sym_eq. Assumption.
+    Intro H7. Rewrite H7. Rewrite (MapRemove_semantics ? m' a a0). Rewrite H7. Reflexivity.
+    Unfold eqmap eqm. Intro. Rewrite (MapPut_semantics ? (MapRemove A m a) a y a0).
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H7. Rewrite H7. Rewrite <- (ad_eq_complete ? ? H7).
+    Apply sym_eq. Assumption.
+    Intro H7. Rewrite H7. Rewrite (MapRemove_semantics A m a a0). Rewrite H7. Reflexivity.
+  Qed.
+
+  Lemma MapDomRestrTo_Card_ub_r : (m:(Map A)) (m':(Map B))
+      (le (MapCard A (MapDomRestrTo A B m m')) (MapCard B m')).
+  Proof.
+    Induction m. Intro. Simpl. Apply le_O_n.
+    Intros a y m'. Simpl. Elim (option_sum B (MapGet B m' a)). Intro H. Elim H. Intros y0 H0.
+    Rewrite H0. Elim (MapCard_is_not_O B m' a y0 H0). Intros n H1. Rewrite H1. Simpl.
+    Apply le_n_S. Apply le_O_n.
+    Intro H. Rewrite H. Simpl. Apply le_O_n.
+    Induction m'. Simpl. Apply le_O_n.
+
+    Intros a y. Unfold MapDomRestrTo. Case (MapGet A (M2 A m0 m1) a). Simpl. Apply le_O_n.
+    Intro. Simpl. Apply le_n.
+    Intros. Simpl. Rewrite (MapCard_makeM2 A (MapDomRestrTo A B m0 m2) (MapDomRestrTo A B m1 m3)).
+    Apply le_plus_plus. Apply H.
+    Apply H0.
+  Qed.
+
+End MapCard2.
+
+Section MapCard3.
+
+  Variable A, B : Set.
+
+  Lemma MapMerge_Card_lb_l : (m,m':(Map A))
+      (ge (MapCard A (MapMerge A m m')) (MapCard A m)).
+  Proof.
+    Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m')).
+    Rewrite (plus_sym (MapCard A m') (MapCard A m)).
+    Rewrite (plus_sym (MapCard A m') (MapCard A (MapMerge A m m'))).
+    Rewrite (MapMerge_Restr_Card A m m'). Apply le_reg_l. Apply MapDomRestrTo_Card_ub_r.
+  Qed.
+
+  Lemma MapMerge_Card_lb_r : (m,m':(Map A))
+      (ge (MapCard A (MapMerge A m m')) (MapCard A m')).
+  Proof.
+    Unfold ge. Intros. Apply (simpl_le_plus_l (MapCard A m)). Rewrite (MapMerge_Restr_Card A m m').
+    Rewrite (plus_sym (MapCard A (MapMerge A m m')) (MapCard A (MapDomRestrTo A A m m'))).
+    Apply le_reg_r. Apply MapDomRestrTo_Card_ub_l.
+  Qed.
+
+  Lemma MapDomRestrBy_Card_lb : (m:(Map A)) (m':(Map B))
+      (ge (plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))) (MapCard A m)).
+  Proof.
+    Unfold ge. Intros. Rewrite (MapSplit_Card A B m m'). Apply le_reg_r.
+    Apply MapDomRestrTo_Card_ub_r.
+  Qed.
+
+  Lemma MapSubset_Card_le : (m:(Map A)) (m':(Map B))
+      (MapSubset A B m m') -> (le (MapCard A m) (MapCard B m')).
+  Proof.
+    Intros. Apply le_trans with m:=(plus (MapCard B m') (MapCard A (MapDomRestrBy A B m m'))).
+    Exact (MapDomRestrBy_Card_lb m m').
+    Rewrite (MapCard_ext ? ? ? (MapSubset_imp_2 ? ? ? ? H)). Simpl. Rewrite <- plus_n_O.
+    Apply le_n.
+  Qed.
+
+  Lemma MapSubset_card_eq : (m:(Map A)) (m':(Map B))
+      (MapSubset ? ? m m') -> (le (MapCard ? m') (MapCard ? m)) ->
+        (eqmap ? (MapDom ? m) (MapDom ? m')).
+  Proof.
+    Intros. Apply MapSubset_antisym. Assumption.
+    Cut (MapCard B m')=(MapCard A m). Intro. Apply (MapSubset_card_eq_1 A B (MapCard A m)).
+    Assumption.
+    Reflexivity.
+    Assumption.
+    Apply le_antisym. Assumption.
+    Apply MapSubset_Card_le. Assumption.
+  Qed.
+
+End MapCard3.
diff --git a/theories7/IntMap/Mapfold.v b/theories7/IntMap/Mapfold.v
new file mode 100644
index 00000000..8061f253
--- /dev/null
+++ b/theories7/IntMap/Mapfold.v
@@ -0,0 +1,381 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i   	  $Id: Mapfold.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $      i*)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Fset.
+Require Mapaxioms.
+Require Mapiter.
+Require Lsort.
+Require Mapsubset.
+Require PolyList.
+
+Section MapFoldResults.
+
+  Variable A : Set.
+
+  Variable M : Set.
+  Variable neutral : M.
+  Variable op : M -> M -> M.
+
+  Variable nleft : (a:M) (op neutral a)=a.
+  Variable nright : (a:M) (op a neutral)=a.
+  Variable assoc : (a,b,c:M) (op (op a b) c)=(op a (op b c)).
+
+  Lemma MapFold_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') ->
+      (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op f m').
+  Proof.
+    Intros. Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m).
+    Rewrite (MapFold_as_fold A M neutral op assoc nleft nright f m').
+    Cut (alist_of_Map A m)=(alist_of_Map A m'). Intro. Rewrite H0. Reflexivity.
+    Apply alist_canonical. Unfold eqmap in H. Apply eqm_trans with f':=(MapGet A m).
+    Apply eqm_sym. Apply alist_of_Map_semantics.
+    Apply eqm_trans with f':=(MapGet A m'). Assumption.
+    Apply alist_of_Map_semantics.
+    Apply alist_of_Map_sorts2.
+    Apply alist_of_Map_sorts2.
+  Qed.
+
+  Lemma MapFold_ext_f_1 : (m:(Map A)) (f,g:ad->A->M) (pf:ad->ad)
+      ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f (pf a) y)=(g (pf a) y)) ->
+        (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op g pf m).
+  Proof.
+    Induction m. Trivial.
+    Simpl. Intros. Apply H. Rewrite (ad_eq_correct a). Reflexivity.
+    Intros. Simpl. Rewrite (H f g [a0:ad](pf (ad_double a0))).
+    Rewrite (H0 f g [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
+    Intros. Apply H1. Rewrite MapGet_M2_bit_0_1. Rewrite ad_double_plus_un_div_2. Assumption.
+    Apply ad_double_plus_un_bit_0.
+    Intros. Apply H1. Rewrite MapGet_M2_bit_0_0. Rewrite ad_double_div_2. Assumption.
+    Apply ad_double_bit_0.
+  Qed.
+
+  Lemma MapFold_ext_f : (f,g:ad->A->M) (m:(Map A))
+      ((a:ad) (y:A) (MapGet ? m a)=(SOME ? y) -> (f a y)=(g a y)) ->
+        (MapFold ? ? neutral op f m)=(MapFold ? ? neutral op g m).
+  Proof.
+    Intros. Exact (MapFold_ext_f_1 m f g [a0:ad]a0 H).
+  Qed.
+
+  Lemma MapFold1_as_Fold_1 : (m:(Map A)) (f,f':ad->A->M) (pf, pf':ad->ad)
+      ((a:ad) (y:A) (f (pf a) y)=(f' (pf' a) y)) ->
+        (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f' pf' m).
+  Proof.
+    Induction m. Trivial.
+    Intros. Simpl. Apply H.
+    Intros. Simpl.
+    Rewrite (H f f' [a0:ad](pf (ad_double a0)) [a0:ad](pf' (ad_double a0))).
+    Rewrite (H0 f f' [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](pf' (ad_double_plus_un a0))).
+    Reflexivity.
+    Intros. Apply H1.
+    Intros. Apply H1.
+  Qed.
+
+  Lemma MapFold1_as_Fold : (f:ad->A->M) (pf:ad->ad) (m:(Map A))
+      (MapFold1 ? ? neutral op f pf m)=(MapFold ? ? neutral op [a:ad][y:A] (f (pf a) y) m).
+  Proof.
+    Intros. Unfold MapFold. Apply MapFold1_as_Fold_1. Trivial.
+  Qed.
+
+  Lemma MapFold1_ext : (f:ad->A->M) (m,m':(Map A)) (eqmap A m m') -> (pf:ad->ad)
+      (MapFold1 ? ? neutral op f pf m)=(MapFold1 ? ? neutral op f pf m').
+  Proof.
+    Intros. Rewrite MapFold1_as_Fold. Rewrite MapFold1_as_Fold. Apply MapFold_ext. Assumption.
+  Qed.
+
+  Variable comm : (a,b:M) (op a b)=(op b a).
+
+  Lemma MapFold_Put_disjoint_1 : (p:positive)
+        (f:ad->A->M) (pf:ad->ad) (a1,a2:ad) (y1,y2:A) 
+	  (ad_xor a1 a2)=(ad_x p) ->
+      	    (MapFold1 A M neutral op f pf (MapPut1 A a1 y1 a2 y2 p))=
+	    (op (f (pf a1) y1) (f (pf a2) y2)).
+  Proof.
+    Induction p. Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1.
+    Simpl. Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double. Apply comm.
+    Change (ad_bit_0 a2)=(negb true). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
+    Rewrite negb_elim. Reflexivity.
+    Assumption.
+    Intro H1. Rewrite H1. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
+    Reflexivity.
+    Change (ad_bit_0 a2)=(negb false). Rewrite <- H1. Rewrite (ad_neg_bit_0_2 ? ? ? H0).
+    Rewrite negb_elim. Reflexivity.
+    Assumption.
+    Simpl. Intros. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H1. Rewrite H1. Simpl.
+    Rewrite nleft.
+    Rewrite (H f [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
+    Rewrite ad_div_2_double_plus_un. Rewrite ad_div_2_double_plus_un. Reflexivity.
+    Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
+    Assumption.
+    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
+    Intro H1. Rewrite H1. Simpl. Rewrite nright.
+    Rewrite (H f [a0:ad](pf (ad_double a0)) (ad_div_2 a1) (ad_div_2 a2) y1 y2).
+    Rewrite ad_div_2_double. Rewrite ad_div_2_double. Reflexivity.
+    Rewrite <- (ad_same_bit_0 ? ? ? H0). Assumption.
+    Assumption.
+    Rewrite <- ad_xor_div_2. Rewrite H0. Reflexivity.
+    Intros. Simpl. Elim (sumbool_of_bool (ad_bit_0 a1)). Intro H0. Rewrite H0. Simpl.
+    Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un. Apply comm.
+    Assumption.
+    Change (ad_bit_0 a2)=(negb true). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
+    Rewrite negb_elim. Reflexivity.
+    Intro H0. Rewrite H0. Simpl. Rewrite ad_div_2_double. Rewrite ad_div_2_double_plus_un.
+    Reflexivity.
+    Change (ad_bit_0 a2)=(negb false). Rewrite <- H0. Rewrite (ad_neg_bit_0_1 ? ? H).
+    Rewrite negb_elim. Reflexivity.
+    Assumption.
+  Qed.
+
+  Lemma MapFold_Put_disjoint_2 : 
+        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
+	  (MapGet A m a)=(NONE A) ->
+      	    (MapFold1 A M neutral op f pf (MapPut A m a y))=
+	    (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
+  Proof.
+    Induction m. Intros. Simpl. Rewrite (nright (f (pf a) y)). Reflexivity.
+    Intros a1 y1 a2 y2 pf H. Simpl. Elim (ad_sum (ad_xor a1 a2)). Intro H0. Elim H0.
+    Intros p H1. Rewrite H1. Rewrite comm. Exact (MapFold_Put_disjoint_1 p f pf a1 a2 y1 y2 H1).
+    Intro H0. Rewrite (ad_eq_complete ? ? (ad_xor_eq_true ? ? H0)) in H.
+    Rewrite (M1_semantics_1 A a2 y1) in H. Discriminate H.
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H2.
+    Cut (MapPut A (M2 A m0 m1) a y)=(M2 A m0 (MapPut A m1 (ad_div_2 a) y)). Intro.
+    Rewrite H3. Simpl. Rewrite (H0 (ad_div_2 a) y [a0:ad](pf (ad_double_plus_un a0))).
+    Rewrite ad_div_2_double_plus_un. Rewrite <- assoc.
+    Rewrite (comm (MapFold1 A M neutral op f [a0:ad](pf (ad_double a0)) m0) (f (pf a) y)).
+    Rewrite assoc. Reflexivity.
+    Assumption.
+    Rewrite (MapGet_M2_bit_0_1 A a H2 m0 m1) in H1. Assumption.
+    Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5.
+    Reflexivity.
+    Intros p0 H4 H5. Rewrite H5 in H2. Discriminate H2.
+    Intro H4. Rewrite H4. Reflexivity.
+    Intro H3. Rewrite H3 in H2. Discriminate H2.
+    Intro H2. Cut (MapPut A (M2 A m0 m1) a y)=(M2 A (MapPut A m0 (ad_div_2 a) y) m1).
+    Intro. Rewrite H3. Simpl. Rewrite (H (ad_div_2 a) y [a0:ad](pf (ad_double a0))).
+    Rewrite ad_div_2_double. Rewrite <- assoc. Reflexivity.
+    Assumption.
+    Rewrite (MapGet_M2_bit_0_0 A a H2 m0 m1) in H1. Assumption.
+    Simpl. Elim (ad_sum a). Intro H3. Elim H3. Intro p. Elim p. Intros p0 H4 H5. Rewrite H5 in H2.
+    Discriminate H2.
+    Intros p0 H4 H5. Rewrite H5. Reflexivity.
+    Intro H4. Rewrite H4 in H2. Discriminate H2.
+    Intro H3. Rewrite H3. Reflexivity.
+  Qed.
+
+  Lemma MapFold_Put_disjoint : 
+        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
+	  (MapGet A m a)=(NONE A) ->
+      	    (MapFold A M neutral op f (MapPut A m a y))=
+	    (op (f a y) (MapFold A M neutral op f m)).
+  Proof.
+    Intros. Exact (MapFold_Put_disjoint_2 f m a y [a0:ad]a0 H).
+  Qed.
+
+  Lemma MapFold_Put_behind_disjoint_2 : 
+        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A) (pf:ad->ad)
+	  (MapGet A m a)=(NONE A) ->
+      	    (MapFold1 A M neutral op f pf (MapPut_behind A m a y))=
+	    (op (f (pf a) y) (MapFold1 A M neutral op f pf m)).
+  Proof.
+    Intros. Cut (eqmap A (MapPut_behind A m a y) (MapPut A m a y)). Intro.
+    Rewrite (MapFold1_ext f ? ? H0 pf). Apply MapFold_Put_disjoint_2. Assumption.
+    Apply eqmap_trans with m':=(MapMerge A (M1 A a y) m). Apply MapPut_behind_as_Merge.
+    Apply eqmap_trans with m':=(MapMerge A m (M1 A a y)).
+    Apply eqmap_trans with m':=(MapDelta A (M1 A a y) m). Apply eqmap_sym. Apply MapDelta_disjoint.
+    Unfold MapDisjoint. Unfold in_dom. Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a0)).
+    Intro H2. Rewrite (ad_eq_complete ? ? H2) in H. Rewrite H in H1. Discriminate H1.
+    Intro H2. Rewrite H2 in H0. Discriminate H0.
+    Apply eqmap_trans with m':=(MapDelta A m (M1 A a y)). Apply MapDelta_sym.
+    Apply MapDelta_disjoint. Unfold MapDisjoint. Unfold in_dom. Simpl. Intros.
+    Elim (sumbool_of_bool (ad_eq a a0)). Intro H2. Rewrite (ad_eq_complete ? ? H2) in H.
+    Rewrite H in H0. Discriminate H0.
+    Intro H2. Rewrite H2 in H1. Discriminate H1.
+    Apply eqmap_sym. Apply MapPut_as_Merge.
+  Qed.
+
+  Lemma MapFold_Put_behind_disjoint : 
+        (f:ad->A->M) (m:(Map A)) (a:ad) (y:A)
+	  (MapGet A m a)=(NONE A) ->
+      	    (MapFold A M neutral op f (MapPut_behind A m a y))
+            =(op (f a y) (MapFold A M neutral op f m)).
+  Proof.
+    Intros. Exact (MapFold_Put_behind_disjoint_2 f m a y [a0:ad]a0 H).
+  Qed.
+
+  Lemma MapFold_Merge_disjoint_1 :
+        (f:ad->A->M) (m1,m2:(Map A)) (pf:ad->ad)
+	  (MapDisjoint A A m1 m2) ->
+      	    (MapFold1 A M neutral op f pf (MapMerge A m1 m2))=
+	    (op (MapFold1 A M neutral op f pf m1) (MapFold1 A M neutral op f pf m2)).
+  Proof.
+    Induction m1. Simpl. Intros. Rewrite nleft. Reflexivity.
+    Intros. Unfold MapMerge. Apply (MapFold_Put_behind_disjoint_2 f m2 a a0 pf).
+    Apply in_dom_none. Exact (MapDisjoint_M1_l ? ? m2 a a0 H).
+    Induction m2. Intros. Simpl. Rewrite nright. Reflexivity.
+    Intros. Unfold MapMerge. Rewrite (MapFold_Put_disjoint_2 f (M2 A m m0) a a0 pf). Apply comm.
+    Apply in_dom_none. Exact (MapDisjoint_M1_r ? ? (M2 A m m0) a a0 H1).
+    Intros. Simpl. Rewrite (H m3 [a0:ad](pf (ad_double a0))).
+    Rewrite (H0 m4 [a0:ad](pf (ad_double_plus_un a0))).
+    Cut (a,b,c,d:M)(op (op a b) (op c d))=(op (op a c) (op b d)). Intro. Apply H4.
+    Intros. Rewrite assoc. Rewrite <- (assoc b c d). Rewrite (comm b c). Rewrite (assoc c b d).
+    Rewrite assoc. Reflexivity.
+    Exact (MapDisjoint_M2_r ? ? ? ? ? ? H3).
+    Exact (MapDisjoint_M2_l ? ? ? ? ? ? H3).
+  Qed.
+
+  Lemma MapFold_Merge_disjoint :
+        (f:ad->A->M) (m1,m2:(Map A))
+	  (MapDisjoint A A m1 m2) ->
+      	    (MapFold A M neutral op f (MapMerge A m1 m2))=
+	    (op (MapFold A M neutral op f m1) (MapFold A M neutral op f m2)).
+  Proof.
+    Intros. Exact (MapFold_Merge_disjoint_1 f m1 m2 [a0:ad]a0 H).
+  Qed.
+ 
+End MapFoldResults.
+
+Section MapFoldDistr.
+
+  Variable A : Set.
+
+  Variable M : Set.
+  Variable neutral : M.
+  Variable op : M -> M -> M.
+
+  Variable M' : Set.
+  Variable neutral' : M'.
+  Variable op' : M' -> M' -> M'.
+
+  Variable N : Set.
+
+  Variable times : M -> N -> M'.
+
+  Variable absorb : (c:N)(times neutral c)=neutral'.
+  Variable distr : (a,b:M) (c:N) (times (op a b) c) = (op' (times a c) (times b c)).
+
+  Lemma MapFold_distr_r_1 : (f:ad->A->M) (m:(Map A)) (c:N) (pf:ad->ad)
+      (times (MapFold1 A M neutral op f pf m) c)=
+      (MapFold1 A M' neutral' op' [a:ad][y:A] (times (f a y) c) pf m).
+  Proof.
+    Induction m. Intros. Exact (absorb c).
+    Trivial.
+    Intros. Simpl. Rewrite distr. Rewrite H. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapFold_distr_r : (f:ad->A->M) (m:(Map A)) (c:N)
+      (times (MapFold A M neutral op f m) c)=
+      (MapFold A M' neutral' op' [a:ad][y:A] (times (f a y) c) m).
+  Proof.
+    Intros. Exact (MapFold_distr_r_1 f m c [a:ad]a).
+  Qed.
+
+End MapFoldDistr.
+
+Section MapFoldDistrL.
+
+  Variable A : Set.
+
+  Variable M : Set.
+  Variable neutral : M.
+  Variable op : M -> M -> M.
+
+  Variable M' : Set.
+  Variable neutral' : M'.
+  Variable op' : M' -> M' -> M'.
+
+  Variable N : Set.
+
+  Variable times : N -> M -> M'.
+
+  Variable absorb : (c:N)(times c neutral)=neutral'.
+  Variable distr : (a,b:M) (c:N) (times c (op a b)) = (op' (times c a) (times c b)).
+
+  Lemma MapFold_distr_l : (f:ad->A->M) (m:(Map A)) (c:N)
+      (times c (MapFold A M neutral op f m))=
+      (MapFold A M' neutral' op' [a:ad][y:A] (times c (f a y)) m).
+  Proof.
+    Intros. Apply MapFold_distr_r with times:=[a:M][b:N](times b a); Assumption.
+  Qed.
+
+End MapFoldDistrL.
+
+Section MapFoldExists.
+
+  Variable A : Set.
+
+  Lemma MapFold_orb_1 : (f:ad->A->bool) (m:(Map A)) (pf:ad->ad)
+      	       	      (MapFold1 A bool false orb f pf m)=
+                      (Cases (MapSweep1 A f pf m) of
+		           (SOME _) => true
+			 | _ => false
+	               end).
+  Proof.
+    Induction m. Trivial.
+    Intros a y pf. Simpl. Unfold MapSweep2. (Case (f (pf a) y); Reflexivity).
+    Intros. Simpl. Rewrite (H [a0:ad](pf (ad_double a0))).
+    Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
+    Case (MapSweep1 A f [a0:ad](pf (ad_double a0)) m0); Reflexivity.
+  Qed.
+
+  Lemma MapFold_orb : (f:ad->A->bool) (m:(Map A)) (MapFold A bool false orb f m)=
+                      (Cases (MapSweep A f m) of
+		           (SOME _) => true
+			 | _ => false
+	               end).
+  Proof.
+    Intros. Exact (MapFold_orb_1 f m [a:ad]a).
+  Qed.
+
+End MapFoldExists.
+
+Section DMergeDef.
+
+  Variable A : Set.
+
+  Definition DMerge := (MapFold (Map A) (Map A) (M0 A) (MapMerge A) [_:ad][m:(Map A)] m).
+
+  Lemma in_dom_DMerge_1 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=
+                              (Cases (MapSweep ? [_:ad][m0:(Map A)] (in_dom A a m0) m) of
+			           (SOME _) => true
+				 | _ => false
+		               end).
+  Proof.
+    Unfold DMerge. Intros.
+    Rewrite (MapFold_distr_l (Map A) (Map A) (M0 A) (MapMerge A) bool false
+               orb ad (in_dom A) [c:ad](refl_equal ? ?) (in_dom_merge A)).
+    Apply MapFold_orb.
+  Qed.
+
+  Lemma in_dom_DMerge_2 : (m:(Map (Map A))) (a:ad) (in_dom A a (DMerge m))=true ->
+                               {b:ad & {m0:(Map A) | (MapGet ? m b)=(SOME ? m0) /\
+			                             (in_dom A a m0)=true}}.
+  Proof.
+    Intros m a. Rewrite in_dom_DMerge_1.
+    Elim (option_sum ? (MapSweep (Map A) [_:ad][m0:(Map A)](in_dom A a m0) m)).
+    Intro H. Elim H. Intro r. Elim r. Intros b m0 H0. Intro. Split with b. Split with m0.
+    Split. Exact (MapSweep_semantics_2 ? ? ? ? ? H0).
+    Exact (MapSweep_semantics_1 ? ? ? ? ? H0).
+    Intro H. Rewrite H. Intro. Discriminate H0.
+  Qed.
+
+  Lemma in_dom_DMerge_3 : (m:(Map (Map A))) (a,b:ad) (m0:(Map A))
+      (MapGet ? m a)=(SOME ? m0) -> (in_dom A b m0)=true -> 
+        (in_dom A b (DMerge m))=true.
+  Proof.
+    Intros m a b m0 H H0. Rewrite in_dom_DMerge_1.
+    Elim (MapSweep_semantics_4 ? [_:ad][m'0:(Map A)](in_dom A b m'0) ? ? ? H H0).
+    Intros a' H1. Elim H1. Intros m'0 H2. Rewrite H2. Reflexivity.
+  Qed.
+
+End DMergeDef.
diff --git a/theories7/IntMap/Mapiter.v b/theories7/IntMap/Mapiter.v
new file mode 100644
index 00000000..144572fd
--- /dev/null
+++ b/theories7/IntMap/Mapiter.v
@@ -0,0 +1,527 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapiter.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Mapaxioms.
+Require Fset.
+Require PolyList.
+
+Section MapIter.
+
+  Variable A : Set.
+
+  Section MapSweepDef.
+
+  Variable f:ad->A->bool.
+
+  Definition MapSweep2 := [a0:ad; y:A] if (f a0 y) then (SOME ? (a0, y)) else (NONE ?).
+
+  Fixpoint MapSweep1 [pf:ad->ad; m:(Map A)] : (option (ad * A)) :=
+    Cases m of
+        M0 => (NONE ?)
+      | (M1 a y) => (MapSweep2 (pf a) y)
+      | (M2 m m') => Cases (MapSweep1 ([a:ad] (pf (ad_double a))) m) of
+                         (SOME r) => (SOME ? r)
+		       | NONE => (MapSweep1 ([a:ad] (pf (ad_double_plus_un a))) m')
+		     end
+    end.
+
+  Definition MapSweep := [m:(Map A)] (MapSweep1 ([a:ad] a) m).
+
+  Lemma MapSweep_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
+      (MapSweep1 pf m)=(SOME ? (a, y)) -> (f a y)=true.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (f (pf a) y)). Intro H. Unfold MapSweep2.
+    Rewrite H. Intro H0. Inversion H0. Rewrite <- H3. Assumption.
+    Intro H. Unfold MapSweep2. Rewrite H. Intro H0. Discriminate H0.
+    Simpl. Intros. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
+    Intro H2. Elim H2. Intros r H3. Rewrite H3 in H1. Inversion H1. Rewrite H5 in H3.
+    Exact (H [a0:ad](pf (ad_double a0)) a y H3).
+    Intro H2. Rewrite H2 in H1. Exact (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
+  Qed.
+
+  Lemma MapSweep_semantics_1 : (m:(Map A)) (a:ad) (y:A)
+      (MapSweep m)=(SOME ? (a, y)) -> (f a y)=true.
+  Proof.
+    Intros. Exact (MapSweep_semantics_1_1 m [a:ad]a a y H).
+  Qed.
+
+  Lemma MapSweep_semantics_2_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
+      	(MapSweep1 pf m)=(SOME ? (a, y)) -> {a':ad | a=(pf a')}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Simpl. Unfold MapSweep2. Intros a y pf a0 y0. Case (f (pf a) y). Intros. Split with a.
+    Inversion H. Reflexivity.
+    Intro. Discriminate H.
+    Intros m0 H m1 H0 pf a y. Simpl.
+    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H1. Elim H1.
+    Intros r H2. Rewrite H2. Intro H3. Inversion H3. Rewrite H5 in H2.
+    Elim (H [a0:ad](pf (ad_double a0)) a y H2). Intros a0 H6. Split with (ad_double a0).
+    Assumption.
+    Intro H1. Rewrite H1. Intro H2. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
+    Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
+  Qed.
+
+  Lemma MapSweep_semantics_2_2 : (m:(Map A))
+      (pf,fp:ad->ad) ((a0:ad) (fp (pf a0))=a0) -> (a:ad) (y:A)
+      	(MapSweep1 pf m)=(SOME ? (a, y)) -> (MapGet A m (fp a))=(SOME ? y).
+  Proof.
+    Induction m. Intros. Discriminate H0.
+    Simpl. Intros a y pf fp H a0 y0. Unfold MapSweep2. Elim (sumbool_of_bool (f (pf a) y)).
+    Intro H0. Rewrite H0. Intro H1. Inversion H1. Rewrite (H a). Rewrite (ad_eq_correct a).
+    Reflexivity.
+    Intro H0. Rewrite H0. Intro H1. Discriminate H1.
+    Intros. Rewrite (MapGet_M2_bit_0_if A m0 m1 (fp a)). Elim (sumbool_of_bool (ad_bit_0 (fp a))).
+    Intro H3. Rewrite H3. Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)).
+    Intro H4. Simpl in H2. Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))).
+    Intro. Rewrite H1. Apply ad_double_plus_un_div_2.
+    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H5. Elim H5.
+    Intros r H6. Rewrite H6 in H2. Inversion H2. Rewrite H8 in H6.
+    Elim (MapSweep_semantics_2_1 m0 [a0:ad](pf (ad_double a0)) a y H6). Intros a0 H9.
+    Rewrite H9 in H3. Rewrite (H1 (ad_double a0)) in H3. Rewrite (ad_double_bit_0 a0) in H3.
+    Discriminate H3.
+    Intro H5. Rewrite H5 in H2. Assumption.
+    Intro H4. Simpl in H2. Rewrite H4 in H2.
+    Apply (H0 [a0:ad](pf (ad_double_plus_un a0)) [a0:ad](ad_div_2 (fp a0))). Intro.
+    Rewrite H1. Apply ad_double_plus_un_div_2.
+    Assumption.
+    Intro H3. Rewrite H3. Simpl in H2.
+    Elim (option_sum ad*A (MapSweep1 [a0:ad](pf (ad_double a0)) m0)). Intro H4. Elim H4.
+    Intros r H5. Rewrite H5 in H2. Inversion H2. Rewrite H7 in H5.
+    Apply (H [a0:ad](pf (ad_double a0)) [a0:ad](ad_div_2 (fp a0))). Intro. Rewrite H1.
+    Apply ad_double_div_2.
+    Assumption.
+    Intro H4. Rewrite H4 in H2.
+    Elim (MapSweep_semantics_2_1 m1 [a0:ad](pf (ad_double_plus_un a0)) a y H2).
+    Intros a0 H5. Rewrite H5 in H3. Rewrite (H1 (ad_double_plus_un a0)) in H3.
+    Rewrite (ad_double_plus_un_bit_0 a0) in H3. Discriminate H3.
+  Qed.
+
+  Lemma MapSweep_semantics_2 : (m:(Map A)) (a:ad) (y:A)
+      (MapSweep m)=(SOME ? (a, y)) -> (MapGet A m a)=(SOME ? y).
+  Proof.
+    Intros.
+    Exact (MapSweep_semantics_2_2 m [a0:ad]a0 [a0:ad]a0 [a0:ad](refl_equal ad a0) a y H).
+  Qed.
+
+  Lemma MapSweep_semantics_3_1 : (m:(Map A)) (pf:ad->ad)
+      (MapSweep1 pf m)=(NONE ?) ->
+        (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> (f (pf a) y)=false.
+  Proof.
+    Induction m. Intros. Discriminate H0.
+    Simpl. Unfold MapSweep2. Intros a y pf. Elim (sumbool_of_bool (f (pf a) y)). Intro H.
+    Rewrite H. Intro. Discriminate H0.
+    Intro H. Rewrite H. Intros H0 a0 y0. Elim (sumbool_of_bool (ad_eq a a0)). Intro H1. Rewrite H1.
+    Intro H2. Inversion H2. Rewrite <- H4. Rewrite <- (ad_eq_complete ? ? H1). Assumption.
+    Intro H1. Rewrite H1. Intro. Discriminate H2.
+    Intros. Simpl in H1. Elim (option_sum ad*A (MapSweep1 [a:ad](pf (ad_double a)) m0)).
+    Intro H3. Elim H3. Intros r H4. Rewrite H4 in H1. Discriminate H1.
+    Intro H3. Rewrite H3 in H1. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H4.
+    Rewrite (MapGet_M2_bit_0_1 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double_plus_un a H4).
+    Exact (H0 [a:ad](pf (ad_double_plus_un a)) H1 (ad_div_2 a) y H2).
+    Intro H4. Rewrite (MapGet_M2_bit_0_0 A a H4 m0 m1) in H2. Rewrite <- (ad_div_2_double a H4).
+    Exact (H [a:ad](pf (ad_double a)) H3 (ad_div_2 a) y H2).
+  Qed.
+
+  Lemma MapSweep_semantics_3 : (m:(Map A))
+      (MapSweep m)=(NONE ?) -> (a:ad) (y:A) (MapGet A m a)=(SOME ? y) -> 
+        (f a y)=false.
+  Proof.
+    Intros.
+    Exact (MapSweep_semantics_3_1 m [a0:ad]a0 H a y H0).
+  Qed.
+
+  Lemma MapSweep_semantics_4_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
+      (MapGet A m a)=(SOME A y) -> (f (pf a) y)=true ->
+      	{a':ad & {y':A | (MapSweep1 pf m)=(SOME ? (a', y'))}}.
+  Proof.
+    Induction m. Intros. Discriminate H.
+    Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H1. Split with (pf a1). Split with y.
+    Rewrite (ad_eq_complete ? ? H1). Unfold MapSweep1 MapSweep2.
+    Rewrite (ad_eq_complete ? ? H1) in H. Rewrite (M1_semantics_1 ? a1 a0) in H.
+    Inversion H. Rewrite H0. Reflexivity.
+
+    Intro H1. Rewrite (M1_semantics_2 ? a a1 a0 H1) in H. Discriminate H.
+
+    Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
+    Rewrite (MapGet_M2_bit_0_1 ? ? H3 m0 m1) in H1.
+    Rewrite <- (ad_div_2_double_plus_un a H3) in H2.
+    Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
+    Intros y'' H5. Simpl. Elim (option_sum ? (MapSweep1 [a:ad](pf (ad_double a)) m0)).
+    Intro H6. Elim H6. Intro r. Elim r. Intros a''' y''' H7. Rewrite H7. Split with a'''.
+    Split with y'''. Reflexivity.
+    Intro H6. Rewrite H6. Split with a''. Split with y''. Assumption.
+    Intro H3. Rewrite (MapGet_M2_bit_0_0 ? ? H3 m0 m1) in H1.
+    Rewrite <- (ad_div_2_double a H3) in H2.
+    Elim (H [a0:ad](pf (ad_double a0)) (ad_div_2 a) y H1 H2). Intros a'' H4. Elim H4.
+    Intros y'' H5. Split with a''. Split with y''. Simpl. Rewrite H5. Reflexivity.
+  Qed.
+
+  Lemma MapSweep_semantics_4 : (m:(Map A)) (a:ad) (y:A)
+      (MapGet A m a)=(SOME A y) -> (f a y)=true ->
+      	{a':ad & {y':A | (MapSweep m)=(SOME ? (a', y'))}}.
+  Proof.
+    Intros. Exact (MapSweep_semantics_4_1 m [a0:ad]a0 a y H H0).
+  Qed.
+
+  End MapSweepDef.
+
+  Variable B : Set.
+
+  Fixpoint MapCollect1 [f:ad->A->(Map B); pf:ad->ad; m:(Map A)] : (Map B) :=
+    Cases m of
+        M0 => (M0 B)
+      | (M1 a y) => (f (pf a) y)
+      | (M2 m1 m2) => (MapMerge B (MapCollect1 f [a0:ad] (pf (ad_double a0)) m1)
+                                  (MapCollect1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
+    end.
+
+  Definition MapCollect := [f:ad->A->(Map B); m:(Map A)] (MapCollect1 f [a:ad]a m).
+
+  Section MapFoldDef.
+
+    Variable M : Set.
+    Variable neutral : M.
+    Variable op : M -> M -> M.
+
+    Fixpoint MapFold1 [f:ad->A->M; pf:ad->ad; m:(Map A)] : M :=
+      Cases m of
+      	  M0 => neutral
+        | (M1 a y) => (f (pf a) y)
+        | (M2 m1 m2) => (op (MapFold1 f [a0:ad] (pf (ad_double a0)) m1)
+                            (MapFold1 f [a0:ad] (pf (ad_double_plus_un a0)) m2))
+      end.
+
+    Definition MapFold := [f:ad->A->M; m:(Map A)] (MapFold1 f [a:ad]a m).
+
+    Lemma MapFold_empty : (f:ad->A->M) (MapFold f (M0 A))=neutral.
+    Proof.
+      Trivial.
+    Qed.
+
+    Lemma MapFold_M1 : (f:ad->A->M) (a:ad) (y:A) (MapFold f (M1 A a y)) = (f a y).
+    Proof.
+      Trivial.
+    Qed.
+
+    Variable State : Set.
+    Variable f:State -> ad -> A -> State * M.
+
+    Fixpoint MapFold1_state [state:State; pf:ad->ad; m:(Map A)]
+                            : State * M :=
+      Cases m of
+          M0 => (state, neutral)
+	| (M1 a y) => (f state (pf a) y)
+	| (M2 m1 m2) =>
+          Cases (MapFold1_state state [a0:ad] (pf (ad_double a0)) m1) of
+              (state1, x1) =>
+	      Cases (MapFold1_state state1 [a0:ad] (pf (ad_double_plus_un a0)) m2) of
+	          (state2, x2) => (state2, (op x1 x2))
+	      end
+          end
+      end.
+
+    Definition MapFold_state := [state:State] (MapFold1_state state [a:ad]a).
+
+    Lemma pair_sp : (B,C:Set) (x:B*C) x=(Fst x, Snd x).
+    Proof.
+      Induction x. Trivial.
+    Qed.
+
+    Lemma MapFold_state_stateless_1 : (m:(Map A)) (g:ad->A->M) (pf:ad->ad)
+        ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
+      	  (state:State)
+      	    (Snd (MapFold1_state state pf m))=(MapFold1 g pf m).
+    Proof.
+      Induction m. Trivial.
+      Intros. Simpl. Apply H.
+      Intros. Simpl. Rewrite (pair_sp ? ?
+          (MapFold1_state state [a0:ad](pf (ad_double a0)) m0)).
+      Rewrite (H g [a0:ad](pf (ad_double a0)) H1 state).
+      Rewrite (pair_sp ? ?
+          (MapFold1_state
+            (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))
+            [a0:ad](pf (ad_double_plus_un a0)) m1)).
+      Simpl.
+      Rewrite (H0 g [a0:ad](pf (ad_double_plus_un a0)) H1
+          (Fst (MapFold1_state state [a0:ad](pf (ad_double a0)) m0))).
+      Reflexivity.
+    Qed.
+
+    Lemma MapFold_state_stateless : (g:ad->A->M)
+        ((state:State) (a:ad) (y:A) (Snd (f state a y))=(g a y)) ->
+      	  (state:State) (m:(Map A))
+      	    (Snd (MapFold_state state m))=(MapFold g m).
+    Proof.
+      Intros. Exact (MapFold_state_stateless_1 m g [a0:ad]a0 H state).
+    Qed.
+
+  End MapFoldDef.
+
+  Lemma MapCollect_as_Fold : (f:ad->A->(Map B)) (m:(Map A))
+      (MapCollect f m)=(MapFold (Map B) (M0 B) (MapMerge B) f m).
+  Proof.
+    Induction m;Trivial.
+  Qed.
+
+  Definition alist := (list (ad*A)).
+  Definition anil := (nil (ad*A)).
+  Definition acons := (!cons (ad*A)).
+  Definition aapp := (!app (ad*A)).
+
+  Definition alist_of_Map := (MapFold alist anil aapp [a:ad;y:A] (acons (pair ? ? a y) anil)).
+
+  Fixpoint alist_semantics [l:alist] : ad -> (option A) :=
+    Cases l of
+        nil => [_:ad] (NONE A)
+      | (cons (a, y) l') => [a0:ad] if (ad_eq a a0) then (SOME A y) else (alist_semantics l' a0)
+    end.
+
+  Lemma alist_semantics_app : (l,l':alist) (a:ad)
+      (alist_semantics (aapp l l') a)=
+      (Cases (alist_semantics l a) of
+           NONE => (alist_semantics l' a)
+	 | (SOME y) => (SOME A y)
+       end).
+  Proof.
+    Unfold aapp. Induction l. Trivial.
+    Intros. Elim a. Intros a1 y1. Simpl. Case (ad_eq a1 a0). Reflexivity.
+    Apply H.
+  Qed.
+
+  Lemma alist_of_Map_semantics_1_1 : (m:(Map A)) (pf:ad->ad) (a:ad) (y:A)
+      (alist_semantics (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil) pf m) a)
+      =(SOME A y) -> {a':ad | a=(pf a')}.
+  Proof.
+    Induction m. Simpl. Intros. Discriminate H.
+    Simpl. Intros a y pf a0 y0. Elim (sumbool_of_bool (ad_eq (pf a) a0)). Intro H. Rewrite H.
+    Intro H0. Split with a. Rewrite (ad_eq_complete ? ? H). Reflexivity.
+    Intro H. Rewrite H. Intro H0. Discriminate H0.
+    Intros. Change (alist_semantics
+         (aapp
+           (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
+             [a0:ad](pf (ad_double a0)) m0)
+           (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
+             [a0:ad](pf (ad_double_plus_un a0)) m1)) a)=(SOME A y)  in H1.
+    Rewrite (alist_semantics_app
+          (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
+            [a0:ad](pf (ad_double a0)) m0)
+          (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
+            [a0:ad](pf (ad_double_plus_un a0)) m1) a) in H1.
+    Elim (option_sum A
+       (alist_semantics
+         (MapFold1 alist anil aapp [a0:ad][y0:A](acons (a0,y0) anil)
+           [a0:ad](pf (ad_double a0)) m0) a)).
+    Intro H2. Elim H2. Intros y0 H3. Elim (H [a0:ad](pf (ad_double a0)) a y0 H3). Intros a0 H4.
+    Split with (ad_double a0). Assumption.
+    Intro H2. Rewrite H2 in H1. Elim (H0 [a0:ad](pf (ad_double_plus_un a0)) a y H1).
+    Intros a0 H3. Split with (ad_double_plus_un a0). Assumption.
+  Qed.
+
+  Definition ad_inj := [pf:ad->ad] (a0,a1:ad) (pf a0)=(pf a1) -> a0=a1.
+
+  Lemma ad_comp_double_inj : 
+      (pf:ad->ad) (ad_inj pf) -> (ad_inj [a0:ad] (pf (ad_double a0))).
+  Proof.
+    Unfold ad_inj. Intros. Apply ad_double_inj. Exact (H ? ? H0).
+  Qed.
+
+  Lemma ad_comp_double_plus_un_inj : (pf:ad->ad) (ad_inj pf) ->
+      (ad_inj [a0:ad] (pf (ad_double_plus_un a0))).
+  Proof.
+    Unfold ad_inj. Intros. Apply ad_double_plus_un_inj. Exact (H ? ? H0).
+  Qed.
+
+  Lemma alist_of_Map_semantics_1 : (m:(Map A)) (pf:ad->ad) (ad_inj pf) ->
+      (a:ad) (MapGet A m a)=(alist_semantics (MapFold1 alist anil aapp
+                                                   [a0:ad;y:A] (acons (pair ? ? a0 y) anil) pf m)
+                                      (pf a)).
+  Proof.
+    Induction m. Trivial.
+    Simpl. Intros. Elim (sumbool_of_bool (ad_eq a a1)). Intro H0. Rewrite H0.
+    Rewrite (ad_eq_complete ? ? H0). Rewrite (ad_eq_correct (pf a1)). Reflexivity.
+    Intro H0. Rewrite H0. Elim (sumbool_of_bool (ad_eq (pf a) (pf a1))). Intro H1.
+    Rewrite (H a a1 (ad_eq_complete ? ? H1)) in H0. Rewrite (ad_eq_correct a1) in H0.
+    Discriminate H0.
+    Intro H1. Rewrite H1. Reflexivity.
+    Intros. Change (MapGet A (M2 A m0 m1) a)
+        =(alist_semantics
+           (aapp
+             (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
+               [a0:ad](pf (ad_double a0)) m0)
+             (MapFold1 alist anil aapp [a0:ad][y:A](acons (a0,y) anil)
+               [a0:ad](pf (ad_double_plus_un a0)) m1)) (pf a)).
+    Rewrite alist_semantics_app. Rewrite (MapGet_M2_bit_0_if A m0 m1 a).
+    Elim (ad_double_or_double_plus_un a). Intro H2. Elim H2. Intros a0 H3. Rewrite H3.
+    Rewrite (ad_double_bit_0 a0).
+    Rewrite <- (H [a1:ad](pf (ad_double a1)) (ad_comp_double_inj pf H1) a0).
+    Rewrite ad_double_div_2. Case (MapGet A m0 a0).
+    Elim (option_sum A
+       (alist_semantics
+         (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
+           [a1:ad](pf (ad_double_plus_un a1)) m1) (pf (ad_double a0)))).
+    Intro H4. Elim H4. Intros y H5.
+    Elim (alist_of_Map_semantics_1_1 m1 [a1:ad](pf (ad_double_plus_un a1))
+          (pf (ad_double a0)) y H5).
+    Intros a1 H6. Cut (ad_bit_0 (ad_double a0))=(ad_bit_0 (ad_double_plus_un a1)).
+    Intro. Rewrite (ad_double_bit_0 a0) in H7. Rewrite (ad_double_plus_un_bit_0 a1) in H7.
+    Discriminate H7.
+    Rewrite (H1 (ad_double a0) (ad_double_plus_un a1) H6). Reflexivity.
+    Intro H4. Rewrite H4. Reflexivity.
+    Trivial.
+    Intro H2. Elim H2. Intros a0 H3. Rewrite H3. Rewrite (ad_double_plus_un_bit_0 a0).
+    Rewrite <- (H0 [a1:ad](pf (ad_double_plus_un a1)) (ad_comp_double_plus_un_inj pf H1) a0).
+    Rewrite ad_double_plus_un_div_2.
+    Elim (option_sum A
+       (alist_semantics
+         (MapFold1 alist anil aapp [a1:ad][y:A](acons (a1,y) anil)
+           [a1:ad](pf (ad_double a1)) m0) (pf (ad_double_plus_un a0)))).
+    Intro H4. Elim H4. Intros y H5.
+    Elim (alist_of_Map_semantics_1_1 m0 [a1:ad](pf (ad_double a1))
+       (pf (ad_double_plus_un a0)) y H5).
+    Intros a1 H6. Cut (ad_bit_0 (ad_double_plus_un a0))=(ad_bit_0 (ad_double a1)).
+    Intro H7. Rewrite (ad_double_plus_un_bit_0 a0) in H7. Rewrite (ad_double_bit_0 a1) in H7.
+    Discriminate H7.
+    Rewrite (H1 (ad_double_plus_un a0) (ad_double a1) H6). Reflexivity.
+    Intro H4. Rewrite H4. Reflexivity.
+  Qed.
+
+  Lemma alist_of_Map_semantics : (m:(Map A))
+      (eqm A (MapGet A m) (alist_semantics (alist_of_Map m))).
+  Proof.
+    Unfold eqm. Intros. Exact (alist_of_Map_semantics_1 m [a0:ad]a0 [a0,a1:ad][p:a0=a1]p a).
+  Qed.
+
+  Fixpoint Map_of_alist [l:alist] : (Map A) :=
+    Cases l of
+        nil => (M0 A)
+      | (cons (a, y) l') => (MapPut A (Map_of_alist l') a y)
+    end.
+
+  Lemma Map_of_alist_semantics : (l:alist)
+      (eqm A (alist_semantics l) (MapGet A (Map_of_alist l))).
+  Proof.
+    Unfold eqm. Induction l. Trivial.
+    Intros r l0 H a. Elim r. Intros a0 y0. Simpl. Elim (sumbool_of_bool (ad_eq a0 a)).
+    Intro H0. Rewrite H0. Rewrite (ad_eq_complete ? ? H0).
+    Rewrite (MapPut_semantics A (Map_of_alist l0) a y0 a). Rewrite (ad_eq_correct a).
+    Reflexivity.
+    Intro H0. Rewrite H0. Rewrite (MapPut_semantics A (Map_of_alist l0) a0 y0 a).
+    Rewrite H0. Apply H.
+  Qed.
+
+  Lemma Map_of_alist_of_Map : (m:(Map A)) (eqmap A (Map_of_alist (alist_of_Map m)) m).
+  Proof.
+    Unfold eqmap. Intro. Apply eqm_trans with f':=(alist_semantics (alist_of_Map m)).
+    Apply eqm_sym. Apply Map_of_alist_semantics.
+    Apply eqm_sym. Apply alist_of_Map_semantics.
+  Qed.
+
+  Lemma alist_of_Map_of_alist : (l:alist)
+      (eqm A (alist_semantics (alist_of_Map (Map_of_alist l))) (alist_semantics l)).
+  Proof.
+    Intro. Apply eqm_trans with f':=(MapGet A (Map_of_alist l)).
+    Apply eqm_sym. Apply alist_of_Map_semantics.
+    Apply eqm_sym. Apply Map_of_alist_semantics.
+  Qed.
+
+  Lemma fold_right_aapp : (M:Set) (neutral:M) (op:M->M->M)
+      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
+      ((a:M) (op neutral a)=a) ->
+      (f:ad->A->M) (l,l':alist)
+        (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral
+                    (aapp l l'))=
+        (op (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l)
+            (fold_right [r:ad*A][m:M] let (a,y)=r in (op (f a y) m) neutral l'))
+.
+  Proof.
+    Induction l. Simpl. Intro. Rewrite H0. Reflexivity.
+    Intros r l0 H1 l'. Elim r. Intros a y. Simpl. Rewrite H. Rewrite (H1 l'). Reflexivity.
+  Qed.
+
+  Lemma MapFold_as_fold_1 : (M:Set) (neutral:M) (op:M->M->M)
+      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
+      ((a:M) (op neutral a)=a) ->
+      ((a:M) (op a neutral)=a) ->
+        (f:ad->A->M) (m:(Map A)) (pf:ad->ad)
+         (MapFold1 M neutral op f pf m)=
+         (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
+                    (MapFold1 alist anil aapp [a:ad;y:A] (acons (pair ? ? 
+a y) anil) pf m)).
+  Proof.
+    Induction m. Trivial.
+    Intros. Simpl. Rewrite H1. Reflexivity.
+    Intros. Simpl. Rewrite (fold_right_aapp M neutral op H H0 f).
+    Rewrite (H2 [a0:ad](pf (ad_double a0))). Rewrite (H3 [a0:ad](pf (ad_double_plus_un a0))).
+    Reflexivity.
+  Qed.
+
+  Lemma MapFold_as_fold : (M:Set) (neutral:M) (op:M->M->M)
+      ((a,b,c:M) (op (op a b) c)=(op a (op b c))) ->
+      ((a:M) (op neutral a)=a) ->
+      ((a:M) (op a neutral)=a) ->
+        (f:ad->A->M) (m:(Map A))
+         (MapFold M neutral op f m)=
+         (fold_right [r:(ad*A)][m:M] let (a,y)=r in (op (f a y) m) neutral
+  (alist_of_Map m)).
+  Proof.
+    Intros. Exact (MapFold_as_fold_1 M neutral op H H0 H1 f m [a0:ad]a0).
+  Qed.
+
+  Lemma alist_MapMerge_semantics : (m,m':(Map A))
+      (eqm A (alist_semantics (aapp (alist_of_Map m') (alist_of_Map m)))
+             (alist_semantics (alist_of_Map (MapMerge A m m')))).
+  Proof.
+    Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
+    Rewrite <- (alist_of_Map_semantics m' a).
+    Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a).
+    Rewrite (MapMerge_semantics A m m' a). Reflexivity.
+  Qed.
+
+  Lemma alist_MapMerge_semantics_disjoint : (m,m':(Map A))
+        (eqmap A (MapDomRestrTo A A m m') (M0 A)) ->
+	  (eqm A (alist_semantics (aapp (alist_of_Map m) (alist_of_Map m')))
+	         (alist_semantics (alist_of_Map (MapMerge A m m')))).
+  Proof.
+    Unfold eqm. Intros. Rewrite alist_semantics_app. Rewrite <- (alist_of_Map_semantics m a).
+    Rewrite <- (alist_of_Map_semantics m' a).
+    Rewrite <- (alist_of_Map_semantics (MapMerge A m m') a). Rewrite (MapMerge_semantics A m m' a).
+    Elim (option_sum ? (MapGet A m a)). Intro H0. Elim H0. Intros y H1. Rewrite H1.
+    Elim (option_sum ? (MapGet A m' a)). Intro H2. Elim H2. Intros y' H3.
+    Cut (MapGet A (MapDomRestrTo A A m m') a)=(NONE A).
+    Rewrite (MapDomRestrTo_semantics A A m m' a). Rewrite H3. Rewrite H1. Intro. Discriminate H4.
+    Exact (H a).
+    Intro H2. Rewrite H2. Reflexivity.
+    Intro H0. Rewrite H0. Case (MapGet A m' a); Trivial.
+  Qed.
+
+  Lemma alist_semantics_disjoint_comm : (l,l':alist)
+      (eqmap A (MapDomRestrTo A A (Map_of_alist l) (Map_of_alist l')) (M0 A)) ->
+      	(eqm A (alist_semantics (aapp l l')) (alist_semantics (aapp l' l))).
+  Proof.
+    Unfold eqm. Intros. Rewrite (alist_semantics_app l l' a). Rewrite (alist_semantics_app l' l a).
+    Rewrite <- (alist_of_Map_of_alist l a). Rewrite <- (alist_of_Map_of_alist l' a).
+    Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l))
+                                    (alist_of_Map (Map_of_alist l')) a).
+    Rewrite <- (alist_semantics_app (alist_of_Map (Map_of_alist l'))
+                                    (alist_of_Map (Map_of_alist l)) a).
+    Rewrite (alist_MapMerge_semantics (Map_of_alist l) (Map_of_alist l') a).
+    Rewrite (alist_MapMerge_semantics_disjoint (Map_of_alist l) (Map_of_alist l') H a).
+    Reflexivity.
+  Qed.
+
+End MapIter.
+
diff --git a/theories7/IntMap/Maplists.v b/theories7/IntMap/Maplists.v
new file mode 100644
index 00000000..f01ee3d8
--- /dev/null
+++ b/theories7/IntMap/Maplists.v
@@ -0,0 +1,399 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Maplists.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Addr.
+Require Addec.
+Require Map.
+Require Fset.
+Require Mapaxioms.
+Require Mapsubset.
+Require Mapcard.
+Require Mapcanon.
+Require Mapc.
+Require Bool.
+Require Sumbool.
+Require PolyList.
+Require Arith.
+Require Mapiter.
+Require Mapfold.
+
+Section MapLists.
+
+  Fixpoint ad_in_list [a:ad;l:(list ad)] : bool :=
+    Cases l of
+	nil => false
+      | (cons a' l') => (orb (ad_eq a a') (ad_in_list a l'))
+    end.
+
+  Fixpoint ad_list_stutters [l:(list ad)] : bool :=
+    Cases l of
+	nil => false
+      | (cons a l') => (orb (ad_in_list a l') (ad_list_stutters l'))
+    end.
+
+  Lemma ad_in_list_forms_circuit : (x:ad) (l:(list ad)) (ad_in_list x l)=true ->
+      {l1 : (list ad) & {l2 : (list ad) | l=(app l1 (cons x l2))}}.
+  Proof.
+    Induction l. Intro. Discriminate H.
+    Intros. Elim (sumbool_of_bool (ad_eq x a)). Intro H1. Simpl in H0. Split with (nil ad).
+    Split with l0. Rewrite (ad_eq_complete ? ? H1). Reflexivity.
+    Intro H2. Simpl in H0. Rewrite H2 in H0. Simpl in H0. Elim (H H0). Intros l'1 H3.
+    Split with (cons a l'1). Elim H3. Intros l2 H4. Split with l2. Rewrite H4. Reflexivity.
+  Qed.
+
+  Lemma ad_list_stutters_has_circuit : (l:(list ad)) (ad_list_stutters l)=true ->
+      {x:ad & {l0 : (list ad) & {l1 : (list ad) & {l2 : (list ad) |
+        l=(app l0 (cons x (app l1 (cons x l2))))}}}}.
+  Proof.
+    Induction l. Intro. Discriminate H.
+    Intros. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Split with a.
+    Split with (nil ad). Simpl. Elim (ad_in_list_forms_circuit a l0 H1). Intros l1 H2.
+    Split with l1. Elim H2. Intros l2 H3. Split with l2. Rewrite H3. Reflexivity.
+    Intro H1. Elim (H H1). Intros x H2. Split with x. Elim H2. Intros l1 H3.
+    Split with (cons a l1). Elim H3. Intros l2 H4. Split with l2. Elim H4. Intros l3 H5.
+    Split with l3. Rewrite H5. Reflexivity.
+  Qed.
+
+  Fixpoint Elems [l:(list ad)] : FSet :=
+    Cases l of
+	nil => (M0 unit)
+      | (cons a l') => (MapPut ? (Elems l') a tt)
+    end.
+
+  Lemma Elems_canon : (l:(list ad)) (mapcanon ? (Elems l)).
+  Proof.
+    Induction l. Exact (M0_canon unit).
+    Intros. Simpl. Apply MapPut_canon. Assumption.
+  Qed.
+
+  Lemma Elems_app : (l,l':(list ad)) (Elems (app l l'))=(FSetUnion (Elems l) (Elems l')).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
+    Rewrite (MapPut_as_Merge_c unit (Elems (app l0 l'))).
+    Change (FSetUnion (Elems (app l0 l')) (M1 unit a tt))
+           =(FSetUnion (FSetUnion (Elems l0) (M1 unit a tt)) (Elems l')).
+    Rewrite FSetUnion_comm_c. Rewrite (FSetUnion_comm_c (Elems l0) (M1 unit a tt)).
+    Rewrite FSetUnion_assoc_c. Rewrite (H l'). Reflexivity.
+    Apply M1_canon.
+    Apply Elems_canon.
+    Apply Elems_canon.
+    Apply Elems_canon.
+    Apply M1_canon.
+    Apply Elems_canon.
+    Apply M1_canon.
+    Apply Elems_canon.
+    Apply Elems_canon.
+  Qed.
+
+  Lemma Elems_rev : (l:(list ad)) (Elems (rev l))=(Elems l).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite Elems_app. Simpl. Rewrite (MapPut_as_Merge_c unit (Elems l0)).
+    Rewrite H. Reflexivity.
+    Apply Elems_canon.
+  Qed.
+
+  Lemma ad_in_elems_in_list : (l:(list ad)) (a:ad) (in_FSet a (Elems l))=(ad_in_list a l).
+  Proof.
+    Induction l. Trivial.
+    Simpl. Unfold in_FSet. Intros. Rewrite (in_dom_put ? (Elems l0) a tt a0).
+    Rewrite (H a0). Reflexivity.
+  Qed.
+
+  Lemma ad_list_not_stutters_card : (l:(list ad)) (ad_list_stutters l)=false ->
+      	  (length l)=(MapCard ? (Elems l)).
+  Proof.
+    Induction l. Trivial.
+    Simpl. Intros. Rewrite MapCard_Put_2_conv. Rewrite H. Reflexivity.
+    Elim (orb_false_elim ? ? H0). Trivial.
+    Elim (sumbool_of_bool (in_FSet a (Elems l0))). Rewrite ad_in_elems_in_list.
+    Intro H1. Rewrite H1 in H0. Discriminate H0.
+    Exact (in_dom_none unit (Elems l0) a).
+  Qed.
+
+  Lemma ad_list_card : (l:(list ad)) (le (MapCard ? (Elems l)) (length l)).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Apply le_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
+    Apply le_n_S. Assumption.
+  Qed.
+
+  Lemma ad_list_stutters_card : (l:(list ad)) (ad_list_stutters l)=true ->
+      	 (lt (MapCard ? (Elems l)) (length l)).
+  Proof.
+    Induction l. Intro. Discriminate H.
+    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
+    Rewrite <- (ad_in_elems_in_list l0 a) in H1. Elim (in_dom_some ? ? ? H1). Intros y H2.
+    Rewrite (MapCard_Put_1_conv ? ? ? ? tt H2). Apply le_lt_trans with m:=(length l0).
+    Apply ad_list_card.
+    Apply lt_n_Sn.
+    Intro H1. Apply le_lt_trans with m:=(S (MapCard ? (Elems l0))). Apply MapCard_Put_ub.
+    Apply lt_n_S. Apply H. Assumption.
+  Qed.
+
+  Lemma ad_list_not_stutters_card_conv : (l:(list ad)) (length l)=(MapCard ? (Elems l)) ->
+      (ad_list_stutters l)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
+    Cut (lt (MapCard ? (Elems l)) (length l)). Intro. Rewrite H in H1. Elim (lt_n_n ? H1).
+    Exact (ad_list_stutters_card ? H0).
+    Trivial.
+  Qed.
+
+  Lemma ad_list_stutters_card_conv : (l:(list ad)) (lt (MapCard ? (Elems l)) (length l)) ->
+      (ad_list_stutters l)=true.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Trivial.
+    Intro H0. Rewrite (ad_list_not_stutters_card ? H0) in H. Elim (lt_n_n ? H).
+  Qed.
+
+  Lemma ad_in_list_l : (l,l':(list ad)) (a:ad) (ad_in_list a l)=true ->
+      (ad_in_list a (app l l'))=true.
+  Proof.
+    Induction l. Intros. Discriminate H.
+    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
+    Intro H1. Rewrite (H l' a0 H1). Apply orb_b_true.
+  Qed.
+
+  Lemma ad_list_stutters_app_l : (l,l':(list ad)) (ad_list_stutters l)=true ->
+      (ad_list_stutters (app l l'))=true.
+  Proof.
+    Induction l. Intros. Discriminate H.
+    Intros. Simpl. Simpl in H0. Elim (orb_true_elim ? ? H0). Intro H1.
+    Rewrite (ad_in_list_l l0 l' a H1). Reflexivity.
+    Intro H1. Rewrite (H l' H1). Apply orb_b_true.
+  Qed.
+
+  Lemma ad_in_list_r : (l,l':(list ad)) (a:ad) (ad_in_list a l')=true ->
+      (ad_in_list a (app l l'))=true.
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (H l' a0 H0). Apply orb_b_true. 
+  Qed.
+
+  Lemma ad_list_stutters_app_r : (l,l':(list ad)) (ad_list_stutters l')=true ->
+      (ad_list_stutters (app l l'))=true.
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (H l' H0). Apply orb_b_true.
+  Qed.
+
+  Lemma ad_list_stutters_app_conv_l : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
+      (ad_list_stutters l)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H0.
+    Rewrite (ad_list_stutters_app_l l l' H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_list_stutters_app_conv_r : (l,l':(list ad)) (ad_list_stutters (app l l'))=false ->
+      (ad_list_stutters l')=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_list_stutters l')). Intro H0.
+    Rewrite (ad_list_stutters_app_r l l' H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_in_list_app_1 : (l,l':(list ad)) (x:ad) (ad_in_list x (app l (cons x l')))=true.
+  Proof.
+    Induction l. Simpl. Intros. Rewrite (ad_eq_correct x). Reflexivity.
+    Intros. Simpl. Rewrite (H l' x). Apply orb_b_true.
+  Qed.
+
+  Lemma ad_in_list_app : (l,l':(list ad)) (x:ad)
+      (ad_in_list x (app l l'))=(orb (ad_in_list x l) (ad_in_list x l')).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite <- orb_assoc. Rewrite (H l' x). Reflexivity.
+  Qed.
+
+  Lemma ad_in_list_rev : (l:(list ad)) (x:ad)
+      (ad_in_list x (rev l))=(ad_in_list x l).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite ad_in_list_app. Rewrite (H x). Simpl. Rewrite orb_b_false.
+    Apply orb_sym.
+  Qed.
+
+  Lemma ad_list_has_circuit_stutters : (l0,l1,l2:(list ad)) (x:ad)
+      (ad_list_stutters (app l0 (cons x (app l1 (cons x l2)))))=true.
+  Proof.
+    Induction l0. Simpl. Intros. Rewrite (ad_in_list_app_1 l1 l2 x). Reflexivity.
+    Intros. Simpl. Rewrite (H l1 l2 x). Apply orb_b_true.
+  Qed.
+
+  Lemma ad_list_stutters_prev_l : (l,l':(list ad)) (x:ad) (ad_in_list x l)=true ->
+      (ad_list_stutters (app l (cons x l')))=true.
+  Proof.
+    Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
+    Rewrite H1. Rewrite app_ass. Simpl. Apply ad_list_has_circuit_stutters.
+  Qed.
+
+  Lemma ad_list_stutters_prev_conv_l : (l,l':(list ad)) (x:ad)
+      (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l)=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_in_list x l)). Intro H0.
+    Rewrite (ad_list_stutters_prev_l l l' x H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_list_stutters_prev_r : (l,l':(list ad)) (x:ad) (ad_in_list x l')=true ->
+      (ad_list_stutters (app l (cons x l')))=true.
+  Proof.
+    Intros. Elim (ad_in_list_forms_circuit ? ? H). Intros l0 H0. Elim H0. Intros l1 H1.
+    Rewrite H1. Apply ad_list_has_circuit_stutters.
+  Qed.
+
+  Lemma ad_list_stutters_prev_conv_r : (l,l':(list ad)) (x:ad)
+      (ad_list_stutters (app l (cons x l')))=false -> (ad_in_list x l')=false.
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_in_list x l')). Intro H0.
+    Rewrite (ad_list_stutters_prev_r l l' x H0) in H. Discriminate H.
+    Trivial.
+  Qed.
+
+  Lemma ad_list_Elems : (l,l':(list ad)) (MapCard ? (Elems l))=(MapCard ? (Elems l')) ->
+      (length l)=(length l') ->
+        (ad_list_stutters l)=(ad_list_stutters l').
+  Proof.
+    Intros. Elim (sumbool_of_bool (ad_list_stutters l)). Intro H1. Rewrite H1. Apply sym_eq.
+    Apply ad_list_stutters_card_conv. Rewrite <- H. Rewrite <- H0. Apply ad_list_stutters_card.
+    Assumption.
+    Intro H1. Rewrite H1. Apply sym_eq. Apply ad_list_not_stutters_card_conv. Rewrite <- H.
+    Rewrite <- H0. Apply ad_list_not_stutters_card. Assumption.
+  Qed.
+
+  Lemma ad_list_app_length : (l,l':(list ad)) (length (app l l'))=(plus (length l) (length l')).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (H l'). Reflexivity.
+  Qed.
+
+  Lemma ad_list_stutters_permute : (l,l':(list ad))
+      (ad_list_stutters (app l l'))=(ad_list_stutters (app l' l)).
+  Proof.
+    Intros. Apply ad_list_Elems. Rewrite Elems_app. Rewrite Elems_app.
+    Rewrite (FSetUnion_comm_c ? ? (Elems_canon l) (Elems_canon l')). Reflexivity.
+    Rewrite ad_list_app_length. Rewrite ad_list_app_length. Apply plus_sym.
+  Qed.
+
+  Lemma ad_list_rev_length : (l:(list ad)) (length (rev l))=(length l).
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite ad_list_app_length. Simpl. Rewrite H. Rewrite <- plus_Snm_nSm.
+    Rewrite <- plus_n_O. Reflexivity.
+  Qed.
+
+  Lemma ad_list_stutters_rev : (l:(list ad)) (ad_list_stutters (rev l))=(ad_list_stutters l).
+  Proof.
+    Intros. Apply ad_list_Elems. Rewrite Elems_rev. Reflexivity.
+    Apply ad_list_rev_length.
+  Qed.
+
+  Lemma ad_list_app_rev : (l,l':(list ad)) (x:ad)
+      (app (rev l) (cons x l'))=(app (rev (cons x l)) l').
+  Proof.
+    Induction l. Trivial.
+    Intros. Simpl. Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x l')). Simpl.
+    Rewrite (H (cons x l') a). Simpl.
+    Rewrite (app_ass (rev l0) (cons a (nil ad)) (cons x (nil ad))). Simpl.
+    Rewrite app_ass. Simpl. Rewrite app_ass. Reflexivity.
+  Qed.
+
+  Section ListOfDomDef.
+
+  Variable A : Set.
+
+  Definition ad_list_of_dom :=
+      (MapFold A (list ad) (nil ad) (!app ad) [a:ad][_:A] (cons a (nil ad))).
+
+  Lemma ad_in_list_of_dom_in_dom : (m:(Map A)) (a:ad)
+      (ad_in_list a (ad_list_of_dom m))=(in_dom A a m).
+  Proof.
+    Unfold ad_list_of_dom. Intros.
+    Rewrite (MapFold_distr_l A (list ad) (nil ad) (!app ad) bool false orb
+              ad [a:ad][l:(list ad)](ad_in_list a l) [c:ad](refl_equal ? ?)
+              ad_in_list_app [a0:ad][_:A](cons a0 (nil ad)) m a).
+    Simpl. Rewrite (MapFold_orb A [a0:ad][_:A](orb (ad_eq a a0) false) m).
+    Elim (option_sum ? (MapSweep A [a0:ad][_:A](orb (ad_eq a a0) false) m)). Intro H. Elim H.
+    Intro r. Elim r. Intros a0 y H0. Rewrite H0. Unfold in_dom.
+    Elim (orb_prop ? ? (MapSweep_semantics_1 ? ? ? ? ? H0)). Intro H1.
+    Rewrite (ad_eq_complete ? ? H1). Rewrite (MapSweep_semantics_2 A ? ? ? ? H0). Reflexivity.
+    Intro H1. Discriminate H1.
+    Intro H. Rewrite H. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
+    Elim (in_dom_some A m a H0). Intros y H1.
+    Elim (orb_false_elim ? ? (MapSweep_semantics_3 ? ? ? H ? ? H1)). Intro H2.
+    Rewrite (ad_eq_correct a) in H2. Discriminate H2.
+    Exact (sym_eq ? ? ?).
+  Qed.
+
+  Lemma Elems_of_list_of_dom : 
+      (m:(Map A)) (eqmap unit (Elems (ad_list_of_dom m)) (MapDom A m)).
+  Proof.
+    Unfold eqmap eqm. Intros. Elim (sumbool_of_bool (in_FSet a (Elems (ad_list_of_dom m)))).
+    Intro H. Elim (in_dom_some ? ? ? H). Intro t. Elim t. Intro H0.
+    Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
+    Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
+    Elim (in_dom_some ? ? ? H). Intro t'. Elim t'. Intro H1. Rewrite H1. Assumption.
+    Intro H. Rewrite (in_dom_none ? ? ? H).
+    Rewrite (ad_in_elems_in_list (ad_list_of_dom m) a) in H.
+    Rewrite (ad_in_list_of_dom_in_dom m a) in H. Rewrite (MapDom_Dom A m a) in H.
+    Rewrite (in_dom_none ? ? ? H). Reflexivity.
+  Qed.
+
+  Lemma Elems_of_list_of_dom_c : (m:(Map A)) (mapcanon A m) ->
+      (Elems (ad_list_of_dom m))=(MapDom A m).
+  Proof.
+    Intros. Apply (mapcanon_unique unit). Apply Elems_canon.
+    Apply MapDom_canon. Assumption.
+    Apply Elems_of_list_of_dom.
+  Qed.
+
+  Lemma ad_list_of_dom_card_1 : (m:(Map A)) (pf:ad->ad)
+      (length (MapFold1 A (list ad) (nil ad) (app 1!ad) [a:ad][_:A](cons a (nil ad)) pf m))=
+      (MapCard A m).
+  Proof.
+    Induction m; Try Trivial. Simpl. Intros. Rewrite ad_list_app_length.
+    Rewrite (H [a0:ad](pf (ad_double a0))). Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))).
+    Reflexivity.
+  Qed.
+
+  Lemma ad_list_of_dom_card : (m:(Map A)) (length (ad_list_of_dom m))=(MapCard A m).
+  Proof.
+    Exact [m:(Map A)](ad_list_of_dom_card_1 m [a:ad]a).
+  Qed.
+
+  Lemma ad_list_of_dom_not_stutters : 
+      (m:(Map A)) (ad_list_stutters (ad_list_of_dom m))=false.
+  Proof.
+    Intro. Apply ad_list_not_stutters_card_conv. Rewrite ad_list_of_dom_card. Apply sym_eq.
+    Rewrite (MapCard_Dom A m). Apply MapCard_ext. Exact (Elems_of_list_of_dom m).
+  Qed.
+
+  End ListOfDomDef.
+
+  Lemma ad_list_of_dom_Dom_1 : (A:Set)
+    (m:(Map A)) (pf:ad->ad)
+      (MapFold1 A (list ad) (nil ad) (app 1!ad) 
+        [a:ad][_:A](cons a (nil ad)) pf m)=
+      (MapFold1 unit (list ad) (nil ad) (app 1!ad)
+        [a:ad][_:unit](cons a (nil ad)) pf (MapDom A m)).
+  Proof.
+    Induction m; Try Trivial. Simpl. Intros. Rewrite (H [a0:ad](pf (ad_double a0))).
+    Rewrite (H0 [a0:ad](pf (ad_double_plus_un a0))). Reflexivity.
+  Qed.
+
+  Lemma ad_list_of_dom_Dom : (A:Set) (m:(Map A))
+      (ad_list_of_dom A m)=(ad_list_of_dom unit (MapDom A m)).
+  Proof.
+    Intros. Exact (ad_list_of_dom_Dom_1 A m [a0:ad]a0).
+  Qed.
+
+End MapLists.
diff --git a/theories7/IntMap/Mapsubset.v b/theories7/IntMap/Mapsubset.v
new file mode 100644
index 00000000..c0b1cccd
--- /dev/null
+++ b/theories7/IntMap/Mapsubset.v
@@ -0,0 +1,554 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Mapsubset.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $	 i*)
+
+Require Bool.
+Require Sumbool.
+Require Arith.
+Require ZArith.
+Require Addr.
+Require Adist.
+Require Addec.
+Require Map.
+Require Fset.
+Require Mapaxioms.
+Require Mapiter.
+
+Section MapSubsetDef.
+
+  Variable A, B : Set.
+
+  Definition MapSubset := [m:(Map A)] [m':(Map B)]
+      (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true.
+
+  Definition MapSubset_1 := [m:(Map A)] [m':(Map B)]
+      Cases (MapSweep A [a:ad][_:A] (negb (in_dom B a m')) m) of
+          NONE => true
+	| _ => false
+      end.
+
+  Definition MapSubset_2 := [m:(Map A)] [m':(Map B)] 
+      (eqmap A (MapDomRestrBy A B m m') (M0 A)).
+
+  Lemma MapSubset_imp_1 : (m:(Map A)) (m':(Map B))
+      (MapSubset m m') -> (MapSubset_1 m m')=true.
+  Proof.
+    Unfold MapSubset MapSubset_1. Intros.
+    Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)).
+    Intro H0. Elim H0. Intro r. Elim r. Intros a y H1. Cut (negb (in_dom B a m'))=true.
+    Intro. Cut (in_dom A a m)=false. Intro. Unfold in_dom in H3.
+    Rewrite (MapSweep_semantics_2 ? ? m a y H1) in H3. Discriminate H3.
+    Elim (sumbool_of_bool (in_dom A a m)). Intro H3. Rewrite (H a H3) in H2. Discriminate H2.
+    Trivial.
+    Exact (MapSweep_semantics_1 ? ? m a y H1).
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapSubset_1_imp : (m:(Map A)) (m':(Map B))
+      (MapSubset_1 m m')=true -> (MapSubset m m').
+  Proof.
+    Unfold MapSubset MapSubset_1. Unfold 2 in_dom. Intros. Elim (option_sum ? (MapGet A m a)).
+    Intro H1. Elim H1. Intros y H2.
+    Elim (option_sum ? (MapSweep A [a:ad][_:A](negb (in_dom B a m')) m)). Intro H3.
+    Elim H3. Intro r. Elim r. Intros a' y' H4. Rewrite H4 in H. Discriminate H.
+    Intro H3. Cut (negb (in_dom B a m'))=false. Intro. Rewrite (negb_intro (in_dom B a m')).
+    Rewrite H4. Reflexivity.
+    Exact (MapSweep_semantics_3 ? ? m H3 a y H2).
+    Intro H1. Rewrite H1 in H0. Discriminate H0.
+  Qed.
+
+  Lemma map_dom_empty_1 : 
+      (m:(Map A)) (eqmap A m (M0 A)) -> (a:ad) (in_dom ? a m)=false.
+  Proof.
+    Unfold eqmap eqm in_dom. Intros. Rewrite (H a). Reflexivity.
+  Qed.
+
+  Lemma map_dom_empty_2 : 
+      (m:(Map A)) ((a:ad) (in_dom ? a m)=false) -> (eqmap A m (M0 A)).
+  Proof.
+    Unfold eqmap eqm in_dom. Intros.
+    Cut (Cases (MapGet A m a) of NONE => false | (SOME _) => true end)=false.
+    Case (MapGet A m a). Trivial.
+    Intros. Discriminate H0.
+    Exact (H a).
+  Qed.
+
+  Lemma MapSubset_imp_2 : 
+      (m:(Map A)) (m':(Map B)) (MapSubset m m') -> (MapSubset_2 m m').
+  Proof.
+    Unfold MapSubset MapSubset_2. Intros. Apply map_dom_empty_2. Intro. Rewrite in_dom_restrby.
+    Elim (sumbool_of_bool (in_dom A a m)). Intro H0. Rewrite H0. Rewrite (H a H0). Reflexivity.
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapSubset_2_imp : 
+      (m:(Map A)) (m':(Map B)) (MapSubset_2 m m') -> (MapSubset m m').
+  Proof.
+    Unfold MapSubset MapSubset_2. Intros. Cut (in_dom ? a (MapDomRestrBy A B m m'))=false.
+    Rewrite in_dom_restrby. Intro. Elim (andb_false_elim ? ? H1). Rewrite H0.
+    Intro H2. Discriminate H2.
+    Intro H2. Rewrite (negb_intro (in_dom B a m')). Rewrite H2. Reflexivity.
+    Exact (map_dom_empty_1 ? H a).
+  Qed.
+
+End MapSubsetDef.
+
+Section MapSubsetOrder.
+
+  Variable A, B, C : Set.
+
+  Lemma MapSubset_refl : (m:(Map A)) (MapSubset A A m m).
+  Proof.
+      Unfold MapSubset. Trivial.
+  Qed.
+
+  Lemma MapSubset_antisym : (m:(Map A)) (m':(Map B))
+      (MapSubset A B m m') -> (MapSubset B A m' m) -> 
+        (eqmap unit (MapDom A m) (MapDom B m')).
+  Proof.
+    Unfold MapSubset eqmap eqm. Intros. Elim (option_sum ? (MapGet ? (MapDom A m) a)).
+    Intro H1. Elim H1. Intro t. Elim t. Intro H2. Elim (option_sum ? (MapGet ? (MapDom B m') a)).
+    Intro H3. Elim H3. Intro t'. Elim t'. Intro H4. Rewrite H4. Exact H2. 
+    Intro H3. Cut (in_dom B a m')=true. Intro. Rewrite (MapDom_Dom B m' a) in H4.
+    Unfold in_FSet in_dom in H4. Rewrite H3 in H4. Discriminate H4.
+    Apply H. Rewrite (MapDom_Dom A m a). Unfold in_FSet in_dom. Rewrite H2. Reflexivity.
+    Intro H1. Elim (option_sum ? (MapGet ? (MapDom B m') a)). Intro H2. Elim H2. Intros t H3.
+    Cut (in_dom A a m)=true. Intro. Rewrite (MapDom_Dom A m a) in H4. Unfold in_FSet in_dom in H4.
+    Rewrite H1 in H4. Discriminate H4.
+    Apply H0. Rewrite (MapDom_Dom B m' a). Unfold in_FSet in_dom. Rewrite H3. Reflexivity.
+    Intro H2. Rewrite H2. Exact H1.
+  Qed.
+
+  Lemma MapSubset_trans : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (MapSubset A B m m') -> (MapSubset B C m' m'') -> (MapSubset A C m m'').
+  Proof.
+    Unfold MapSubset. Intros. Apply H0. Apply H. Assumption.
+  Qed.
+
+End MapSubsetOrder.
+
+Section FSubsetOrder.
+
+  Lemma FSubset_refl : (s:FSet) (MapSubset ? ? s s).
+  Proof.
+    Exact (MapSubset_refl unit).
+  Qed.
+
+  Lemma FSubset_antisym : (s,s':FSet)
+      (MapSubset ? ? s s') -> (MapSubset ? ? s' s) -> (eqmap unit s s').
+  Proof.
+    Intros. Rewrite <- (FSet_Dom s). Rewrite <- (FSet_Dom s').
+    Exact (MapSubset_antisym ? ? s s' H H0).
+  Qed.
+
+  Lemma FSubset_trans : (s,s',s'':FSet)
+      (MapSubset ? ? s s') -> (MapSubset ? ? s' s'') -> (MapSubset ? ? s s'').
+  Proof.
+    Exact (MapSubset_trans unit unit unit).
+  Qed.
+
+End FSubsetOrder.
+
+Section MapSubsetExtra.
+
+  Variable A, B : Set.
+
+  Lemma MapSubset_Dom_1 : (m:(Map A)) (m':(Map B))
+      (MapSubset A B m m') -> (MapSubset unit unit (MapDom A m) (MapDom B m')).
+  Proof.
+    Unfold MapSubset. Intros. Elim (MapDom_semantics_2 ? m a H0). Intros y H1.
+    Cut (in_dom A a m)=true->(in_dom B a m')=true. Intro. Unfold in_dom in H2.
+    Rewrite H1 in H2. Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3.
+    Intros y' H4. Exact (MapDom_semantics_1 ? m' a y' H4).
+    Intro H3. Rewrite H3 in H2. Cut false=true. Intro. Discriminate H4.
+    Apply H2. Reflexivity.
+    Exact (H a).
+  Qed.
+
+  Lemma MapSubset_Dom_2 : (m:(Map A)) (m':(Map B))
+      (MapSubset unit unit (MapDom A m) (MapDom B m')) -> (MapSubset A B m m').
+  Proof.
+    Unfold MapSubset. Intros. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)).
+    Intro H1. Elim H1. Intros y H2.
+    Elim (MapDom_semantics_2 ? ? ? (H a (MapDom_semantics_1 ? ? ? ? H2))). Intros y' H3.
+    Unfold in_dom. Rewrite H3. Reflexivity.
+    Intro H1. Rewrite H1 in H0. Discriminate H0.
+  Qed.
+
+  Lemma MapSubset_1_Dom : (m:(Map A)) (m':(Map B))
+      (MapSubset_1 A B m m')=(MapSubset_1 unit unit (MapDom A m) (MapDom B m')).
+  Proof.
+    Intros. Elim (sumbool_of_bool (MapSubset_1 A B m m')). Intro H. Rewrite H.
+    Apply sym_eq. Apply MapSubset_imp_1. Apply MapSubset_Dom_1. Exact (MapSubset_1_imp ? ? ? ? H).
+    Intro H. Rewrite H. Elim (sumbool_of_bool (MapSubset_1 unit unit (MapDom A m) (MapDom B m'))).
+    Intro H0.
+    Rewrite (MapSubset_imp_1 ? ? ? ? (MapSubset_Dom_2 ? ? (MapSubset_1_imp ? ? ? ? H0))) in H.
+    Discriminate H.
+    Intro. Apply sym_eq. Assumption.
+  Qed.
+
+  Lemma MapSubset_Put : (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut A m a y)).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite H. Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_Put_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
+      (MapSubset A B m m') -> (MapSubset A B (MapPut A m a y) (MapPut B m' a y')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_put. Rewrite (in_dom_put A m a y a0) in H0.
+    Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
+    Intro H1. Rewrite (H ? H1). Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_Put_behind : 
+      (m:(Map A)) (a:ad) (y:A) (MapSubset A A m (MapPut_behind A m a y)).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_put_behind. Rewrite H. Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_Put_behind_mono : (m:(Map A)) (m':(Map B)) (a:ad) (y:A) (y':B)
+      (MapSubset A B m m') -> 
+        (MapSubset A B (MapPut_behind A m a y) (MapPut_behind B m' a y')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_put_behind.
+    Rewrite (in_dom_put_behind A m a y a0) in H0.
+    Elim (orb_true_elim ? ? H0). Intro H1. Rewrite H1. Reflexivity.
+    Intro H1. Rewrite (H ? H1). Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_Remove : (m:(Map A)) (a:ad) (MapSubset A A (MapRemove A m a) m).
+  Proof.
+    Unfold MapSubset. Intros. Unfold MapSubset. Intros. Rewrite (in_dom_remove ? m a a0) in H.
+    Elim (andb_prop ? ? H). Trivial.
+  Qed.
+
+  Lemma MapSubset_Remove_mono : (m:(Map A)) (m':(Map B)) (a:ad)
+      (MapSubset A B m m') -> (MapSubset A B (MapRemove A m a) (MapRemove B m' a)).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_remove. Rewrite (in_dom_remove A m a a0) in H0.
+    Elim (andb_prop ? ? H0). Intros. Rewrite H1. Rewrite (H ? H2). Reflexivity.
+  Qed.
+
+  Lemma MapSubset_Merge_l : (m,m':(Map A)) (MapSubset A A m (MapMerge A m m')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Reflexivity.
+  Qed.
+
+  Lemma MapSubset_Merge_r : (m,m':(Map A)) (MapSubset A A m' (MapMerge A m m')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite H. Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_Merge_mono : (m,m':(Map A)) (m'',m''':(Map B))
+      (MapSubset A B m m'') -> (MapSubset A B m' m''') ->
+      	(MapSubset A B (MapMerge A m m') (MapMerge B m'' m''')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_merge. Rewrite (in_dom_merge A m m' a) in H1.
+    Elim (orb_true_elim ? ? H1). Intro H2. Rewrite (H ? H2). Reflexivity.
+    Intro H2. Rewrite (H0 ? H2). Apply orb_b_true.
+  Qed.
+
+  Lemma MapSubset_DomRestrTo_l : (m:(Map A)) (m':(Map B))
+      (MapSubset A A (MapDomRestrTo A B m m') m).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
+    Trivial.
+  Qed.
+
+  Lemma MapSubset_DomRestrTo_r: (m:(Map A)) (m':(Map B))
+      (MapSubset A B (MapDomRestrTo A B m m') m').
+  Proof.
+    Unfold MapSubset. Intros. Rewrite (in_dom_restrto ? ? m m' a) in H. Elim (andb_prop ? ? H).
+    Trivial.
+  Qed.
+
+  Lemma MapSubset_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
+      (eqmap A m0 m1) -> (eqmap B m2 m3) ->
+        (MapSubset A B m0 m2) -> (MapSubset A B m1 m3).
+  Proof.
+    Intros. Apply MapSubset_2_imp. Unfold MapSubset_2.
+    Apply eqmap_trans with m':=(MapDomRestrBy A B m0 m2). Apply MapDomRestrBy_ext. Apply eqmap_sym.
+    Assumption.
+    Apply eqmap_sym. Assumption.
+    Exact (MapSubset_imp_2 ? ? ? ? H1).
+  Qed.
+
+  Variable C, D : Set.
+
+  Lemma MapSubset_DomRestrTo_mono : 
+      (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
+        (MapSubset ? ? m m'') -> (MapSubset ? ?  m' m''') ->
+      	  (MapSubset ? ? (MapDomRestrTo ? ? m m') (MapDomRestrTo ? ? m'' m''')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_restrto. Rewrite (in_dom_restrto A B m m' a) in H1.
+    Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Rewrite (H0 ? H3). Reflexivity.
+  Qed.
+
+  Lemma MapSubset_DomRestrBy_l : (m:(Map A)) (m':(Map B))
+      (MapSubset A A (MapDomRestrBy A B m m') m).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite (in_dom_restrby ? ? m m' a) in H. Elim (andb_prop ? ? H).
+    Trivial.
+  Qed.
+
+  Lemma MapSubset_DomRestrBy_mono : 
+      (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
+        (MapSubset ? ? m m'') -> (MapSubset ? ?  m''' m') ->
+      	  (MapSubset ? ? (MapDomRestrBy ? ? m m') (MapDomRestrBy ? ? m'' m''')).
+  Proof.
+    Unfold MapSubset. Intros. Rewrite in_dom_restrby. Rewrite (in_dom_restrby A B m m' a) in H1.
+    Elim (andb_prop ? ? H1). Intros. Rewrite (H ? H2). Elim (sumbool_of_bool (in_dom D a m''')).
+    Intro H4. Rewrite (H0 ? H4) in H3. Discriminate H3.
+    Intro H4. Rewrite H4. Reflexivity.
+  Qed.
+  
+End MapSubsetExtra.
+
+Section MapDisjointDef.
+
+  Variable A, B : Set.
+
+  Definition MapDisjoint := [m:(Map A)] [m':(Map B)]
+      (a:ad) (in_dom A a m)=true -> (in_dom B a m')=true -> False.
+
+  Definition MapDisjoint_1 := [m:(Map A)] [m':(Map B)]
+      Cases (MapSweep A [a:ad][_:A] (in_dom B a m') m) of
+          NONE => true
+	| _ => false
+      end.
+
+  Definition MapDisjoint_2 := [m:(Map A)] [m':(Map B)] 
+      (eqmap A (MapDomRestrTo A B m m') (M0 A)).
+
+  Lemma MapDisjoint_imp_1 : (m:(Map A)) (m':(Map B))
+      (MapDisjoint m m') -> (MapDisjoint_1 m m')=true.
+  Proof.
+    Unfold MapDisjoint MapDisjoint_1. Intros.
+    Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H0. Elim H0.
+    Intro r. Elim r. Intros a y H1. Cut (in_dom A a m)=true->(in_dom B a m')=true->False.
+    Intro. Unfold 1 in_dom in H2. Rewrite (MapSweep_semantics_2 ? ? ? ? ? H1) in H2.
+    Rewrite (MapSweep_semantics_1 ? ? ? ? ? H1) in H2. Elim (H2 (refl_equal ? ?) (refl_equal ? ?)).
+    Exact (H a).
+    Intro H0. Rewrite H0. Reflexivity.
+  Qed.
+
+  Lemma MapDisjoint_1_imp : (m:(Map A)) (m':(Map B))
+      (MapDisjoint_1 m m')=true -> (MapDisjoint m m').
+  Proof.
+    Unfold MapDisjoint MapDisjoint_1. Intros.
+    Elim (option_sum ? (MapSweep A [a:ad][_:A](in_dom B a m') m)). Intro H2. Elim H2.
+    Intro r. Elim r. Intros a' y' H3. Rewrite H3 in H. Discriminate H.
+    Intro H2. Unfold in_dom in H0. Elim (option_sum ? (MapGet A m a)). Intro H3. Elim H3.
+    Intros y H4. Rewrite (MapSweep_semantics_3 ? ? ? H2 a y H4) in H1. Discriminate H1.
+    Intro H3. Rewrite H3 in H0. Discriminate H0.
+  Qed.
+
+  Lemma MapDisjoint_imp_2 : (m:(Map A)) (m':(Map B)) (MapDisjoint m m') -> 
+      (MapDisjoint_2 m m').
+  Proof.
+    Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros.
+    Rewrite (MapDomRestrTo_semantics A B m m' a).
+    Cut (in_dom A a m)=true->(in_dom B a m')=true->False. Intro.
+    Elim (option_sum ? (MapGet A m a)). Intro H1. Elim H1. Intros y H2. Unfold 1 in_dom in H0.
+    Elim (option_sum ? (MapGet B m' a)). Intro H3. Elim H3. Intros y' H4. Unfold 1 in_dom in H0.
+    Rewrite H4 in H0. Rewrite H2 in H0. Elim (H0 (refl_equal ? ?) (refl_equal ? ?)).
+    Intro H3. Rewrite H3. Reflexivity.
+    Intro H1. Rewrite H1. Case (MapGet B m' a); Reflexivity.
+    Exact (H a).
+  Qed.
+
+  Lemma MapDisjoint_2_imp : (m:(Map A)) (m':(Map B)) (MapDisjoint_2 m m') -> 
+      (MapDisjoint m m').
+  Proof.
+    Unfold MapDisjoint MapDisjoint_2. Unfold eqmap eqm. Intros. Elim (in_dom_some ? ? ? H0).
+    Intros y H2. Elim (in_dom_some ? ? ? H1). Intros y' H3.
+    Cut (MapGet A (MapDomRestrTo A B m m') a)=(NONE A). Intro.
+    Rewrite (MapDomRestrTo_semantics ? ? m m' a) in H4. Rewrite H3 in H4. Rewrite H2 in H4.
+    Discriminate H4.
+    Exact (H a).
+  Qed.
+
+  Lemma Map_M0_disjoint : (m:(Map B)) (MapDisjoint (M0 A) m).
+  Proof.
+    Unfold MapDisjoint in_dom. Intros. Discriminate H.
+  Qed.
+
+  Lemma Map_disjoint_M0 : (m:(Map A)) (MapDisjoint m (M0 B)).
+  Proof.
+    Unfold MapDisjoint in_dom. Intros. Discriminate H0.
+  Qed.
+
+End MapDisjointDef.
+
+Section MapDisjointExtra.
+
+  Variable A, B : Set.
+
+  Lemma MapDisjoint_ext : (m0,m1:(Map A)) (m2,m3:(Map B))
+      (eqmap A m0 m1) -> (eqmap B m2 m3) -> 
+        (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3).
+  Proof.
+    Intros. Apply MapDisjoint_2_imp. Unfold MapDisjoint_2.
+    Apply eqmap_trans with m':=(MapDomRestrTo A B m0 m2). Apply eqmap_sym. Apply MapDomRestrTo_ext.
+    Assumption.
+    Assumption.
+    Exact (MapDisjoint_imp_2 ? ? ? ? H1).
+  Qed.
+
+  Lemma MapMerge_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
+      	(a:ad) (in_dom A a (MapMerge A m m'))=
+	       (orb (andb (in_dom A a m) (negb (in_dom A a m')))
+	            (andb (in_dom A a m') (negb (in_dom A a m)))).
+  Proof.
+    Unfold MapDisjoint. Intros. Rewrite in_dom_merge. Elim (sumbool_of_bool (in_dom A a m)).
+    Intro H0. Rewrite H0. Elim (sumbool_of_bool (in_dom A a m')). Intro H1. Elim (H a H0 H1).
+    Intro H1. Rewrite H1. Reflexivity.
+    Intro H0. Rewrite H0. Simpl. Rewrite andb_b_true. Reflexivity.
+  Qed.
+
+  Lemma MapDisjoint_M2_l : (m0,m1:(Map A)) (m2,m3:(Map B))
+      (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m0 m2).
+  Proof.
+    Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m0 a)). Intro H2.
+    Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m2 a)). Intro H4. Elim H4.
+    Intros y' H5. Apply (H (ad_double a)).
+    Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m0 m1).
+    Rewrite (ad_double_div_2 a). Rewrite H3. Reflexivity.
+    Rewrite (MapGet_M2_bit_0_0 ? (ad_double a) (ad_double_bit_0 a) m2 m3).
+    Rewrite (ad_double_div_2 a). Rewrite H5. Reflexivity.
+    Intro H4. Rewrite H4 in H1. Discriminate H1.
+    Intro H2. Rewrite H2 in H0. Discriminate H0.
+  Qed.
+
+  Lemma MapDisjoint_M2_r : (m0,m1:(Map A)) (m2,m3:(Map B))
+      (MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)) -> (MapDisjoint A B m1 m3).
+  Proof.
+    Unfold MapDisjoint in_dom. Intros. Elim (option_sum ? (MapGet A m1 a)). Intro H2.
+    Elim H2. Intros y H3. Elim (option_sum ? (MapGet B m3 a)). Intro H4. Elim H4.
+    Intros y' H5. Apply (H (ad_double_plus_un a)).
+    Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m0 m1).
+    Rewrite (ad_double_plus_un_div_2 a). Rewrite H3. Reflexivity.
+    Rewrite (MapGet_M2_bit_0_1 ? (ad_double_plus_un a) (ad_double_plus_un_bit_0 a) m2 m3).
+    Rewrite (ad_double_plus_un_div_2 a). Rewrite H5. Reflexivity.
+    Intro H4. Rewrite H4 in H1. Discriminate H1.
+    Intro H2. Rewrite H2 in H0. Discriminate H0.
+  Qed.
+
+  Lemma MapDisjoint_M2 : (m0,m1:(Map A)) (m2,m3:(Map B))
+      (MapDisjoint A B m0 m2) -> (MapDisjoint A B m1 m3) ->
+      	(MapDisjoint A B (M2 A m0 m1) (M2 B m2 m3)).
+  Proof.
+    Unfold MapDisjoint in_dom. Intros. Elim (sumbool_of_bool (ad_bit_0 a)). Intro H3.
+    Rewrite (MapGet_M2_bit_0_1 A a H3 m0 m1) in H1.
+    Rewrite (MapGet_M2_bit_0_1 B a H3 m2 m3) in H2. Exact (H0 (ad_div_2 a) H1 H2).
+    Intro H3. Rewrite (MapGet_M2_bit_0_0 A a H3 m0 m1) in H1.
+    Rewrite (MapGet_M2_bit_0_0 B a H3 m2 m3) in H2. Exact (H (ad_div_2 a) H1 H2).
+  Qed.
+
+  Lemma MapDisjoint_M1_l : (m:(Map A)) (a:ad) (y:B)
+      (MapDisjoint B A (M1 B a y) m) -> (in_dom A a m)=false.
+  Proof.
+    Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
+    Elim (H a (in_dom_M1_1 B a y) H0).
+    Trivial.
+  Qed.
+
+  Lemma MapDisjoint_M1_r : (m:(Map A)) (a:ad) (y:B)
+      (MapDisjoint A B m (M1 B a y)) -> (in_dom A a m)=false.
+  Proof.
+    Unfold MapDisjoint. Intros. Elim (sumbool_of_bool (in_dom A a m)). Intro H0.
+    Elim (H a H0 (in_dom_M1_1 B a y)).
+    Trivial.
+  Qed.
+
+  Lemma MapDisjoint_M1_conv_l : (m:(Map A)) (a:ad) (y:B)
+      (in_dom A a m)=false -> (MapDisjoint B A (M1 B a y) m).
+  Proof.
+    Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H0) in H. Rewrite H1 in H.
+    Discriminate H.
+  Qed.
+
+  Lemma MapDisjoint_M1_conv_r : (m:(Map A)) (a:ad) (y:B)
+      (in_dom A a m)=false -> (MapDisjoint A B m (M1 B a y)).
+  Proof.
+    Unfold MapDisjoint. Intros. Rewrite (in_dom_M1_2 B a a0 y H1) in H. Rewrite H0 in H.
+    Discriminate H.
+  Qed.
+ 
+  Lemma MapDisjoint_sym : (m:(Map A)) (m':(Map B))
+      (MapDisjoint A B m m') -> (MapDisjoint B A m' m).
+  Proof.
+    Unfold MapDisjoint. Intros. Exact (H ? H1 H0).
+  Qed.
+
+  Lemma MapDisjoint_empty : (m:(Map A)) (MapDisjoint A A m m) -> (eqmap A m (M0 A)).
+  Proof.
+    Unfold eqmap eqm. Intros. Rewrite <- (MapDomRestrTo_idempotent A m a).
+    Exact (MapDisjoint_imp_2 A A m m H a).
+  Qed.
+
+  Lemma MapDelta_disjoint : (m,m':(Map A)) (MapDisjoint A A m m') ->
+      (eqmap A (MapDelta A m m') (MapMerge A m m')).
+  Proof.
+    Intros.
+    Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (MapDomRestrTo A A m m')).
+    Apply MapDelta_as_DomRestrBy.
+    Apply eqmap_trans with m':=(MapDomRestrBy A A (MapMerge A m m') (M0 A)).
+    Apply MapDomRestrBy_ext. Apply eqmap_refl.
+    Exact (MapDisjoint_imp_2 A A m m' H).
+    Apply MapDomRestrBy_m_empty.
+  Qed.
+
+  Variable C : Set.
+
+  Lemma MapDomRestr_disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (MapDisjoint A B (MapDomRestrTo A C m m'') (MapDomRestrBy B C m' m'')).
+  Proof.
+    Unfold MapDisjoint. Intros m m' m'' a. Rewrite in_dom_restrto. Rewrite in_dom_restrby.
+    Intros. Elim (andb_prop ? ? H). Elim (andb_prop ? ? H0). Intros. Rewrite H4 in H2.
+    Discriminate H2.
+  Qed.
+
+  Lemma MapDelta_RestrTo_disjoint : (m,m':(Map A))
+      (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m m')).
+  Proof.
+    Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
+    Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
+  Qed.
+
+  Lemma MapDelta_RestrTo_disjoint_2 : (m,m':(Map A))
+      (MapDisjoint A A (MapDelta A m m') (MapDomRestrTo A A m' m)).
+  Proof.
+    Unfold MapDisjoint. Intros m m' a. Rewrite in_dom_delta. Rewrite in_dom_restrto.
+    Intros. Elim (andb_prop ? ? H0). Intros. Rewrite H1 in H. Rewrite H2 in H. Discriminate H.
+  Qed.
+
+  Variable D : Set.
+
+  Lemma MapSubset_Disjoint : (m:(Map A)) (m':(Map B)) (m'':(Map C)) (m''':(Map D))
+      (MapSubset ? ? m m') -> (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m' m''') ->
+        (MapDisjoint ? ? m m'').
+  Proof.
+    Unfold MapSubset MapDisjoint. Intros. Exact (H1 ? (H ? H2) (H0 ? H3)).
+  Qed.
+
+  Lemma MapSubset_Disjoint_l : (m:(Map A)) (m':(Map B)) (m'':(Map C))
+      (MapSubset ? ? m m') -> (MapDisjoint ? ? m' m'') ->
+        (MapDisjoint ? ? m m'').
+  Proof.
+    Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? (H ? H1) H2).
+  Qed.
+
+  Lemma MapSubset_Disjoint_r : (m:(Map A)) (m'':(Map C)) (m''':(Map D))
+      (MapSubset ? ? m'' m''') -> (MapDisjoint ? ? m m''') ->
+        (MapDisjoint ? ? m m'').
+  Proof.
+    Unfold MapSubset MapDisjoint. Intros. Exact (H0 ? H1 (H ? H2)).
+  Qed.
+
+End MapDisjointExtra.
diff --git a/theories7/Lists/List.v b/theories7/Lists/List.v
new file mode 100755
index 00000000..574b2688
--- /dev/null
+++ b/theories7/Lists/List.v
@@ -0,0 +1,261 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: List.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
+
+(* This file is a copy of file MonoList.v *)
+
+(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
+
+Require Le.
+
+Parameter List_Dom:Set.
+Definition A := List_Dom.
+
+Inductive list : Set := nil : list | cons : A -> list -> list.
+
+Fixpoint app [l:list] : list -> list 
+      := [m:list]<list>Cases l of
+                           nil =>  m 
+                       | (cons a l1) => (cons a (app l1 m)) 
+                   end.
+
+
+Lemma app_nil_end : (l:list)(l=(app l nil)).
+Proof. 
+	Intro l ; Elim l ; Simpl ; Auto.
+        Induction 1; Auto.
+Qed.
+Hints Resolve app_nil_end : list v62.
+
+Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
+Proof. 
+	Intros l m n ; Elim l ; Simpl ; Auto with list.
+	Induction 1; Auto with list.
+Qed.
+Hints Resolve app_ass : list v62.
+
+Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
+Proof. 
+	Auto with list.
+Qed.
+Hints Resolve ass_app : list v62.
+
+Definition tail := 
+    [l:list] <list>Cases l of  (cons _ m) => m | _ => nil end : list->list.
+                   
+
+Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
+  Intros; Discriminate.
+Qed.
+
+(****************************************)
+(* Length of lists                      *)
+(****************************************)
+
+Fixpoint length [l:list] : nat 
+   := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
+
+(******************************)
+(* Length order of lists      *)
+(******************************)
+
+Section length_order.
+Definition lel := [l,m:list](le (length l) (length m)).
+
+Hints Unfold lel : list.
+
+Variables a,b:A.
+Variables l,m,n:list.
+
+Lemma lel_refl : (lel l l).
+Proof. 
+	Unfold lel ; Auto with list.
+Qed.
+
+Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
+Proof. 
+	Unfold lel ; Intros.
+        Apply le_trans with (length m) ; Auto with list.
+Qed.
+
+Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_cons : (lel l m)->(lel l (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
+Proof. 
+	Intro l' ; Elim l' ; Auto with list arith.
+	Intros a' y H H0.
+	(*  <list>nil=(cons a' y)
+	    ============================
+	      H0 : (lel (cons a' y) nil)
+	      H : (lel y nil)->(<list>nil=y)
+	      y : list
+	      a' : A
+	      l' : list *)
+	Absurd (le (S (length y)) O); Auto with list arith.
+Qed.
+End length_order.
+
+Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
+
+Fixpoint In  [a:A;l:list] : Prop :=
+      Cases l of
+         nil => False 
+      | (cons b m) => (b=a)\/(In a m)
+      end.
+
+Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
+Proof. 
+	Simpl ; Auto with list.
+Qed.
+Hints Resolve in_eq : list v62.
+
+Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
+Proof. 
+	Simpl ; Auto with list.
+Qed.
+Hints Resolve in_cons : list v62.
+
+Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Auto with list.
+	Intros a0 y H H0.
+	(*  ((<A>a0=a)\/(In a y))\/(In a m)
+	    ============================
+	      H0 : (<A>a0=a)\/(In a (app y m))
+	      H : (In a (app y m))->((In a y)\/(In a m))
+	      y : list
+	      a0 : A
+	      a : A
+	      m : list
+	      l : list *)
+	Elim H0 ; Auto with list.
+	Intro H1.
+	(*  ((<A>a0=a)\/(In a y))\/(In a m)
+	    ============================
+	      H1 : (In a (app y m)) *)
+	Elim (H H1) ; Auto with list.
+Qed.
+Hints Immediate in_app_or : list v62.
+
+Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Intro H.
+	(* 1 (In a m)
+	    ============================
+	      H : False\/(In a m)
+	      a : A
+	      m : list
+	      l : list *)
+	Elim H ; Auto with list ; Intro H0.
+	(*  (In a m)
+	    ============================
+	      H0 : False *)
+	Elim H0. (* subProof completed *)
+	Intros y H0 H1.
+	(*  2 (<A>H=a)\/(In a (app y m))
+	    ============================
+	      H1 : ((<A>H=a)\/(In a y))\/(In a m)
+	      H0 : ((In a y)\/(In a m))->(In a (app y m))
+	      y : list *)
+	Elim H1 ; Auto 4 with list.
+	Intro H2.
+	(*  (<A>H=a)\/(In a (app y m))
+	    ============================
+	      H2 : (<A>H=a)\/(In a y) *)
+	Elim H2 ; Auto with list.
+Qed.
+Hints Resolve in_or_app : list v62.
+
+Definition incl := [l,m:list](a:A)(In a l)->(In a m).
+
+Hints Unfold  incl : list v62.
+
+Lemma incl_refl : (l:list)(incl l l).
+Proof. 
+	Auto with list.
+Qed.
+Hints Resolve incl_refl : list v62.
+
+Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_tl : list v62.
+
+Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
+Proof. 
+	Auto with list.
+Qed.
+
+Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_appl : list v62.
+
+Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_appr : list v62.
+
+Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
+Proof. 
+	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
+	(*  (In a0 m)
+	    ============================
+	      H1 : (<A>a=a0)\/(In a0 l)
+	      a0 : A
+	      H0 : (a:A)(In a l)->(In a m)
+	      H : (In a m)
+	      m : list
+	      l : list
+	      a : A *)
+	Elim H1.
+	(*  1 (<A>a=a0)->(In a0 m) *)
+	Elim H1 ; Auto with list ; Intro H2.
+	(*  (<A>a=a0)->(In a0 m)
+	    ============================
+	      H2 : <A>a=a0 *)
+	Elim H2 ; Auto with list. (* solves subgoal *)
+	(*  2 (In a0 l)->(In a0 m) *)
+	Auto with list.
+Qed.
+Hints Resolve incl_cons : list v62.
+
+Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
+Proof. 
+	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
+	(*  (In a n)
+	    ============================
+	      H1 : (In a (app l m))
+	      a : A
+	      H0 : (a:A)(In a m)->(In a n)
+	      H : (a:A)(In a l)->(In a n)
+	      n : list
+	      m : list
+	      l : list *)
+	Elim (in_app_or l m a) ; Auto with list.
+Qed.
+Hints Resolve incl_app : list v62.
diff --git a/theories7/Lists/ListSet.v b/theories7/Lists/ListSet.v
new file mode 100644
index 00000000..9bf259da
--- /dev/null
+++ b/theories7/Lists/ListSet.v
@@ -0,0 +1,389 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ListSet.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
+
+(** A Library for finite sets, implemented as lists 
+    A Library with similar interface will soon be available under
+    the name TreeSet in the theories/Trees directory *)
+
+(** PolyList is loaded, but not exported.
+    This allow to "hide" the definitions, functions and theorems of PolyList
+    and to see only the ones of ListSet *)
+
+Require PolyList.
+
+Set Implicit Arguments.
+V7only [Implicits nil [1].].
+
+Section first_definitions.
+
+  Variable A : Set.
+  Hypothesis Aeq_dec : (x,y:A){x=y}+{~x=y}.
+
+  Definition set := (list A).
+
+  Definition empty_set := (!nil ?) : set.
+
+  Fixpoint set_add [a:A; x:set] : set :=
+    Cases x of
+    | nil => (cons a nil)
+    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
+                    | (left _) => (cons a1 x1) 
+                    | (right _) => (cons a1 (set_add a x1))
+                   end
+    end.
+
+
+  Fixpoint set_mem [a:A; x:set] : bool :=
+    Cases x of
+    | nil => false
+    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
+                    | (left _) => true 
+                    | (right _) => (set_mem a x1)
+                   end
+    end.
+ 
+  (** If [a] belongs to [x], removes [a] from [x]. If not, does nothing *)
+  Fixpoint set_remove [a:A; x:set] : set :=
+    Cases x of
+    | nil => empty_set
+    | (cons a1 x1) => Cases (Aeq_dec a a1) of 
+                    | (left _) => x1 
+                    | (right _) => (cons a1 (set_remove a x1))
+                   end
+    end.
+
+  Fixpoint set_inter [x:set] : set -> set :=
+    Cases x of
+    | nil => [y]nil
+    | (cons a1 x1) => [y]if (set_mem a1 y) 
+                      then (cons a1 (set_inter x1 y))
+		      else (set_inter x1 y)
+    end.
+
+  Fixpoint set_union [x,y:set] : set :=
+    Cases y of
+    | nil => x
+    | (cons a1 y1) => (set_add a1 (set_union x y1))
+    end.
+        
+  (** returns the set of all els of [x] that does not belong to [y] *)
+  Fixpoint set_diff [x:set] : set -> set :=
+    [y]Cases x of
+    | nil => nil
+    | (cons a1 x1) => if (set_mem a1 y) 
+                      then (set_diff x1 y)
+		      else (set_add a1 (set_diff x1 y))
+    end.
+   
+
+  Definition set_In : A -> set -> Prop := (In 1!A).
+
+  Lemma set_In_dec : (a:A; x:set){(set_In a x)}+{~(set_In a x)}.
+
+  Proof.
+    Unfold set_In.
+    (*** Realizer set_mem. Program_all. ***)
+    Induction x.
+    Auto.
+    Intros a0 x0 Ha0. Case (Aeq_dec a a0); Intro eq.
+    Rewrite eq; Simpl; Auto with datatypes.
+    Elim Ha0.
+    Auto with datatypes.
+    Right; Simpl; Unfold not; Intros [Hc1 | Hc2 ]; Auto with datatypes.
+  Qed.
+
+  Lemma set_mem_ind : 
+    (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
+      ((set_In a x) -> (P y))
+       ->(P z)
+       ->(P (if (set_mem a x) then y else z)).
+
+  Proof.
+    Induction x; Simpl; Intros.
+    Assumption.
+    Elim (Aeq_dec a a0); Auto with datatypes.
+  Qed.
+
+  Lemma set_mem_ind2 : 
+    (B:Set)(P:B->Prop)(y,z:B)(a:A)(x:set)
+      ((set_In a x) -> (P y))
+       ->(~(set_In a x) -> (P z))
+       ->(P (if (set_mem a x) then y else z)).
+
+  Proof.
+    Induction x; Simpl; Intros.
+    Apply H0; Red; Trivial.
+    Case (Aeq_dec a a0); Auto with datatypes.
+    Intro; Apply H; Intros; Auto.
+    Apply H1; Red; Intro.
+    Case H3; Auto.
+  Qed.
+
+ 
+  Lemma set_mem_correct1 :
+    (a:A)(x:set)(set_mem a x)=true -> (set_In a x).
+  Proof.
+    Induction x; Simpl.
+    Discriminate.
+    Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
+  Qed.
+
+  Lemma set_mem_correct2 :
+    (a:A)(x:set)(set_In a x) -> (set_mem a x)=true.
+  Proof.
+    Induction x; Simpl.
+    Intro Ha; Elim Ha.
+    Intros a0 l; Elim (Aeq_dec a a0); Auto with datatypes.
+    Intros H1 H2 [H3 | H4].
+    Absurd a0=a; Auto with datatypes.
+    Auto with datatypes.
+  Qed.
+
+  Lemma set_mem_complete1 :
+    (a:A)(x:set)(set_mem a x)=false -> ~(set_In a x).
+  Proof.
+    Induction x; Simpl.
+    Tauto.
+    Intros a0 l; Elim (Aeq_dec a a0).
+    Intros; Discriminate H0.
+    Unfold not; Intros; Elim H1; Auto with datatypes.
+  Qed.
+
+  Lemma set_mem_complete2 :
+    (a:A)(x:set)~(set_In a x) -> (set_mem a x)=false.
+  Proof.
+    Induction x; Simpl.
+    Tauto.
+    Intros a0 l; Elim (Aeq_dec a a0).
+    Intros; Elim H0; Auto with datatypes.
+    Tauto.
+  Qed.
+
+  Lemma set_add_intro1 : (a,b:A)(x:set) 
+    (set_In a x) -> (set_In a (set_add b x)).
+
+  Proof.
+    Unfold set_In; Induction x; Simpl.
+    Auto with datatypes.
+    Intros a0 l H [ Ha0a | Hal ].
+    Elim (Aeq_dec b a0); Left; Assumption.
+    Elim (Aeq_dec b a0); Right; [ Assumption | Auto with datatypes ].
+  Qed.
+
+  Lemma set_add_intro2 : (a,b:A)(x:set) 
+    a=b -> (set_In a (set_add b x)).
+
+  Proof.
+    Unfold set_In; Induction x; Simpl.
+    Auto with datatypes.
+    Intros a0 l H Hab.
+    Elim (Aeq_dec b a0); 
+    [ Rewrite Hab; Intro Hba0; Rewrite Hba0; Simpl; Auto with datatypes
+    | Auto with datatypes ].
+  Qed.
+
+  Hints Resolve set_add_intro1 set_add_intro2.
+
+  Lemma set_add_intro : (a,b:A)(x:set) 
+    a=b\/(set_In a x) -> (set_In a (set_add b x)).
+  
+  Proof.
+    Intros a b x [H1 | H2] ; Auto with datatypes.
+  Qed.
+ 
+  Lemma set_add_elim : (a,b:A)(x:set) 
+    (set_In a (set_add b x)) -> a=b\/(set_In a x).
+
+  Proof.
+    Unfold set_In.
+    Induction x.
+    Simpl; Intros [H1|H2]; Auto with datatypes.
+    Simpl; Do 3 Intro.
+    Elim (Aeq_dec b a0).
+    Simpl; Tauto.
+    Simpl; Intros; Elim H0.
+    Trivial with datatypes.
+    Tauto.
+    Tauto.
+  Qed.
+
+  Lemma set_add_elim2 :  (a,b:A)(x:set) 
+    (set_In a (set_add b x)) -> ~(a=b) -> (set_In a x).
+   Intros a b x H; Case (set_add_elim H); Intros; Trivial.
+   Case H1; Trivial.
+   Qed.
+
+  Hints Resolve set_add_intro set_add_elim set_add_elim2.
+
+  Lemma set_add_not_empty : (a:A)(x:set)~(set_add a x)=empty_set.
+  Proof.
+    Induction x; Simpl.
+    Discriminate.
+    Intros; Elim  (Aeq_dec a a0); Intros; Discriminate.
+  Qed.   
+
+
+  Lemma set_union_intro1 : (a:A)(x,y:set)
+    (set_In a x) -> (set_In a (set_union x y)).
+  Proof.
+    Induction y; Simpl; Auto with datatypes.
+  Qed.
+
+  Lemma set_union_intro2 : (a:A)(x,y:set)
+    (set_In a y) -> (set_In a (set_union x y)).
+  Proof.
+    Induction y; Simpl.
+    Tauto.
+    Intros; Elim H0; Auto with datatypes.
+  Qed.
+
+  Hints Resolve set_union_intro2 set_union_intro1.
+
+  Lemma set_union_intro : (a:A)(x,y:set)
+    (set_In a x)\/(set_In a y) -> (set_In a (set_union x y)).
+  Proof.
+    Intros; Elim H; Auto with datatypes.
+  Qed.
+
+  Lemma set_union_elim : (a:A)(x,y:set)
+    (set_In a (set_union x y)) -> (set_In a x)\/(set_In a y).
+  Proof.
+    Induction y; Simpl.
+    Auto with datatypes.
+    Intros.
+    Generalize (set_add_elim H0).
+    Intros [H1 | H1].
+    Auto with datatypes.
+    Tauto.
+  Qed.
+
+  Lemma set_union_emptyL : (a:A)(x:set)(set_In a (set_union empty_set x)) -> (set_In a x).
+    Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
+  Qed.
+
+
+  Lemma set_union_emptyR : (a:A)(x:set)(set_In a (set_union x empty_set)) -> (set_In a x).
+    Intros a x H; Case (set_union_elim H); Auto Orelse Contradiction.
+  Qed.
+
+
+  Lemma set_inter_intro :  (a:A)(x,y:set)
+    (set_In a x) -> (set_In a y) -> (set_In a (set_inter x y)).
+  Proof.
+    Induction x.
+    Auto with datatypes.
+    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; Intros.
+    Auto with datatypes.
+    Absurd (set_In a y); Auto with datatypes.
+    Elim (set_mem a0 y); [ Right; Auto with datatypes | Auto with datatypes].     
+  Qed.
+
+  Lemma set_inter_elim1 : (a:A)(x,y:set)
+    (set_In a (set_inter x y)) -> (set_In a x).
+  Proof.
+    Induction x.
+    Auto with datatypes.
+    Simpl; Intros a0 l Hrec y.
+    Generalize (!set_mem_correct1 a0 y).
+    Elim (set_mem a0 y); Simpl; Intros.
+    Elim H0; EAuto with datatypes.
+    EAuto with datatypes.
+  Qed.
+
+  Lemma set_inter_elim2 : (a:A)(x,y:set)
+    (set_In a (set_inter x y)) -> (set_In a y).
+  Proof.
+    Induction x.
+    Simpl; Tauto.
+    Simpl; Intros a0 l Hrec y.
+    Generalize (!set_mem_correct1 a0 y).
+    Elim (set_mem a0 y); Simpl; Intros.
+    Elim H0; [ Intro Hr; Rewrite <- Hr; EAuto with datatypes  | EAuto with datatypes ] .
+    EAuto with datatypes.
+  Qed.
+
+  Hints Resolve set_inter_elim1 set_inter_elim2.
+
+  Lemma set_inter_elim : (a:A)(x,y:set)
+    (set_In a (set_inter x y)) -> (set_In a x)/\(set_In a y).
+  Proof.
+    EAuto with datatypes.
+  Qed. 
+
+  Lemma set_diff_intro : (a:A)(x,y:set)
+    (set_In a x) -> ~(set_In a y) -> (set_In a (set_diff x y)).
+  Proof.
+    Induction x.
+    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 ].
+    Elim (set_mem a0 y); Auto with datatypes.
+  Qed.
+
+  Lemma set_diff_elim1 : (a:A)(x,y:set)
+    (set_In a (set_diff x y)) -> (set_In a x).
+  Proof.
+    Induction x.
+    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.
+  Qed.
+
+  Lemma set_diff_elim2 : (a:A)(x,y:set)
+    (set_In a (set_diff x y)) -> ~(set_In a y).
+  Intros a x y; Elim x; Simpl.
+  Intros; Contradiction.
+  Intros a0 l Hrec. 
+  Apply set_mem_ind2; Auto.
+  Intros H1 H2; Case (set_add_elim H2); Intros; Auto.
+  Rewrite H; Trivial.
+  Qed.
+
+  Lemma set_diff_trivial : (a:A)(x:set)~(set_In a (set_diff x x)).
+  Red; Intros a x H.
+  Apply (set_diff_elim2 H).
+  Apply (set_diff_elim1 H).
+  Qed.
+
+Hints Resolve set_diff_intro set_diff_trivial.
+
+
+End first_definitions.
+
+Section other_definitions.
+
+  Variables A,B : Set.
+
+  Definition set_prod : (set A) -> (set B) -> (set A*B) := (list_prod 1!A 2!B).
+
+  (** [B^A], set of applications from [A] to [B] *)
+  Definition set_power : (set A) -> (set B) -> (set (set A*B)) := 
+    (list_power 1!A 2!B).
+
+  Definition set_map : (A->B) -> (set A) ->  (set B) := (map 1!A 2!B).
+
+  Definition set_fold_left : (B -> A -> B) -> (set A) -> B -> B := 
+     (fold_left 1!B 2!A).
+
+  Definition set_fold_right : (A -> B -> B) -> (set A) -> B -> B  := 
+     [f][x][b](fold_right f b x).
+
+ 
+End other_definitions.
+
+V7only [Implicits nil [].].
+Unset Implicit Arguments.
diff --git a/theories7/Lists/MonoList.v b/theories7/Lists/MonoList.v
new file mode 100755
index 00000000..2ab78f7f
--- /dev/null
+++ b/theories7/Lists/MonoList.v
@@ -0,0 +1,259 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: MonoList.v,v 1.1.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
+
+(** THIS IS A OLD CONTRIB. IT IS NO LONGER MAINTAINED ***)
+
+Require Le.
+
+Parameter List_Dom:Set.
+Definition A := List_Dom.
+
+Inductive list : Set := nil : list | cons : A -> list -> list.
+
+Fixpoint app [l:list] : list -> list 
+      := [m:list]<list>Cases l of
+                           nil =>  m 
+                       | (cons a l1) => (cons a (app l1 m)) 
+                   end.
+
+
+Lemma app_nil_end : (l:list)(l=(app l nil)).
+Proof. 
+	Intro l ; Elim l ; Simpl ; Auto.
+        Induction 1; Auto.
+Qed.
+Hints Resolve app_nil_end : list v62.
+
+Lemma app_ass : (l,m,n : list)(app (app l m) n)=(app l (app m n)).
+Proof. 
+	Intros l m n ; Elim l ; Simpl ; Auto with list.
+	Induction 1; Auto with list.
+Qed.
+Hints Resolve app_ass : list v62.
+
+Lemma ass_app : (l,m,n : list)(app l (app m n))=(app (app l m) n).
+Proof. 
+	Auto with list.
+Qed.
+Hints Resolve ass_app : list v62.
+
+Definition tail := 
+    [l:list] <list>Cases l of  (cons _ m) => m | _ => nil end : list->list.
+                   
+
+Lemma nil_cons : (a:A)(m:list)~nil=(cons a m).
+  Intros; Discriminate.
+Qed.
+
+(****************************************)
+(* Length of lists                      *)
+(****************************************)
+
+Fixpoint length [l:list] : nat 
+   := <nat>Cases l of (cons _ m) => (S (length m)) | _ => O end.
+
+(******************************)
+(* Length order of lists      *)
+(******************************)
+
+Section length_order.
+Definition lel := [l,m:list](le (length l) (length m)).
+
+Hints Unfold lel : list.
+
+Variables a,b:A.
+Variables l,m,n:list.
+
+Lemma lel_refl : (lel l l).
+Proof. 
+	Unfold lel ; Auto with list.
+Qed.
+
+Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
+Proof. 
+	Unfold lel ; Intros.
+        Apply le_trans with (length m) ; Auto with list.
+Qed.
+
+Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_cons : (lel l m)->(lel l (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
+Proof. 
+	Unfold lel ; Simpl ; Auto with list arith.
+Qed.
+
+Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
+Proof. 
+	Intro l' ; Elim l' ; Auto with list arith.
+	Intros a' y H H0.
+	(*  <list>nil=(cons a' y)
+	    ============================
+	      H0 : (lel (cons a' y) nil)
+	      H : (lel y nil)->(<list>nil=y)
+	      y : list
+	      a' : A
+	      l' : list *)
+	Absurd (le (S (length y)) O); Auto with list arith.
+Qed.
+End length_order.
+
+Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons : list v62.
+
+Fixpoint In  [a:A;l:list] : Prop :=
+      Cases l of
+         nil => False 
+      | (cons b m) => (b=a)\/(In a m)
+      end.
+
+Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
+Proof. 
+	Simpl ; Auto with list.
+Qed.
+Hints Resolve in_eq : list v62.
+
+Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
+Proof. 
+	Simpl ; Auto with list.
+Qed.
+Hints Resolve in_cons : list v62.
+
+Lemma in_app_or : (l,m:list)(a:A)(In a (app l m))->((In a l)\/(In a m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Auto with list.
+	Intros a0 y H H0.
+	(*  ((<A>a0=a)\/(In a y))\/(In a m)
+	    ============================
+	      H0 : (<A>a0=a)\/(In a (app y m))
+	      H : (In a (app y m))->((In a y)\/(In a m))
+	      y : list
+	      a0 : A
+	      a : A
+	      m : list
+	      l : list *)
+	Elim H0 ; Auto with list.
+	Intro H1.
+	(*  ((<A>a0=a)\/(In a y))\/(In a m)
+	    ============================
+	      H1 : (In a (app y m)) *)
+	Elim (H H1) ; Auto with list.
+Qed.
+Hints Immediate in_app_or : list v62.
+
+Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (app l m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Intro H.
+	(* 1 (In a m)
+	    ============================
+	      H : False\/(In a m)
+	      a : A
+	      m : list
+	      l : list *)
+	Elim H ; Auto with list ; Intro H0.
+	(*  (In a m)
+	    ============================
+	      H0 : False *)
+	Elim H0. (* subProof completed *)
+	Intros y H0 H1.
+	(*  2 (<A>H=a)\/(In a (app y m))
+	    ============================
+	      H1 : ((<A>H=a)\/(In a y))\/(In a m)
+	      H0 : ((In a y)\/(In a m))->(In a (app y m))
+	      y : list *)
+	Elim H1 ; Auto 4 with list.
+	Intro H2.
+	(*  (<A>H=a)\/(In a (app y m))
+	    ============================
+	      H2 : (<A>H=a)\/(In a y) *)
+	Elim H2 ; Auto with list.
+Qed.
+Hints Resolve in_or_app : list v62.
+
+Definition incl := [l,m:list](a:A)(In a l)->(In a m).
+
+Hints Unfold  incl : list v62.
+
+Lemma incl_refl : (l:list)(incl l l).
+Proof. 
+	Auto with list.
+Qed.
+Hints Resolve incl_refl : list v62.
+
+Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_tl : list v62.
+
+Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
+Proof. 
+	Auto with list.
+Qed.
+
+Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (app n m)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_appl : list v62.
+
+Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (app m n)).
+Proof. 
+	Auto with list.
+Qed.
+Hints Immediate incl_appr : list v62.
+
+Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
+Proof. 
+	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
+	(*  (In a0 m)
+	    ============================
+	      H1 : (<A>a=a0)\/(In a0 l)
+	      a0 : A
+	      H0 : (a:A)(In a l)->(In a m)
+	      H : (In a m)
+	      m : list
+	      l : list
+	      a : A *)
+	Elim H1.
+	(*  1 (<A>a=a0)->(In a0 m) *)
+	Elim H1 ; Auto with list ; Intro H2.
+	(*  (<A>a=a0)->(In a0 m)
+	    ============================
+	      H2 : <A>a=a0 *)
+	Elim H2 ; Auto with list. (* solves subgoal *)
+	(*  2 (In a0 l)->(In a0 m) *)
+	Auto with list.
+Qed.
+Hints Resolve incl_cons : list v62.
+
+Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (app l m) n).
+Proof. 
+	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
+	(*  (In a n)
+	    ============================
+	      H1 : (In a (app l m))
+	      a : A
+	      H0 : (a:A)(In a m)->(In a n)
+	      H : (a:A)(In a l)->(In a n)
+	      n : list
+	      m : list
+	      l : list *)
+	Elim (in_app_or l m a) ; Auto with list.
+Qed.
+Hints Resolve incl_app : list v62.
diff --git a/theories7/Lists/PolyList.v b/theories7/Lists/PolyList.v
new file mode 100644
index 00000000..e69ecd10
--- /dev/null
+++ b/theories7/Lists/PolyList.v
@@ -0,0 +1,646 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: PolyList.v,v 1.2.2.1 2004/07/16 19:31:28 herbelin Exp $ i*)
+
+Require Le.
+
+
+Section Lists.
+
+Variable A : Set.
+
+Set Implicit Arguments.
+
+Inductive list : Set := nil : list | cons : A -> list -> list.
+
+Infix "::" cons (at level 7, right associativity) : list_scope
+  V8only (at level 60, right associativity).
+
+Open Scope list_scope.
+
+(*************************)
+(** Discrimination       *)
+(*************************)
+
+Lemma nil_cons : (a:A)(m:list)~(nil=(cons a m)).
+Proof. 
+  Intros; Discriminate.
+Qed.
+
+(*************************)
+(** Concatenation        *)
+(*************************)
+
+Fixpoint app [l:list] : list -> list 
+      := [m:list]Cases l of
+                   nil         => m 
+                 | (cons a l1) => (cons a (app l1 m))
+                 end.
+
+Infix RIGHTA 7 "^" app : list_scope
+  V8only RIGHTA 60 "++".
+
+Lemma app_nil_end : (l:list)l=(l^nil).
+Proof. 
+	NewInduction l ; Simpl ; Auto.
+        Rewrite <- IHl; Auto.
+Qed.
+Hints Resolve app_nil_end.
+
+Tactic Definition now_show c := Change c.
+V7only [Tactic Definition NowShow := now_show.].
+
+Lemma app_ass : (l,m,n : list)((l^m)^ n)=(l^(m^n)).
+Proof. 
+	Intros. NewInduction l ; Simpl ; Auto.
+        NowShow '(cons a (app (app l m) n))=(cons a (app l (app m n))).
+	Rewrite <- IHl; Auto.
+Qed.
+Hints Resolve app_ass.
+
+Lemma ass_app : (l,m,n : list)(l^(m^n))=((l^m)^n).
+Proof. 
+	Auto.
+Qed.
+Hints Resolve ass_app.
+
+Lemma app_comm_cons : (x,y:list)(a:A) (cons a (x^y))=((cons a x)^y).
+Proof.
+ Auto.
+Qed.
+
+Lemma app_eq_nil: (x,y:list) (x^y)=nil -> x=nil /\ y=nil.
+Proof.
+  NewDestruct x;NewDestruct y;Simpl;Auto.
+  Intros H;Discriminate H.
+  Intros;Discriminate H.
+Qed.
+
+Lemma app_cons_not_nil: (x,y:list)(a:A)~nil=(x^(cons a y)).
+Proof.
+Unfold not .
+  NewDestruct x;Simpl;Intros.
+  Discriminate H.
+  Discriminate H.
+Qed.
+
+Lemma app_eq_unit:(x,y:list)(a:A)
+     (x^y)=(cons a nil)-> (x=nil)/\ y=(cons a nil) \/ x=(cons a nil)/\ y=nil.
+
+Proof.
+  NewDestruct x;NewDestruct y;Simpl.
+  Intros a H;Discriminate H.
+  Left;Split;Auto.
+  Right;Split;Auto.
+  Generalize H .
+  Generalize (app_nil_end  l) ;Intros E.
+  Rewrite <- E;Auto.
+  Intros.
+  Injection H.
+  Intro.
+  Cut  nil=(l^(cons a0 l0));Auto.
+  Intro.
+  Generalize (app_cons_not_nil H1); Intro.
+  Elim H2.
+Qed.
+
+Lemma app_inj_tail : (x,y:list)(a,b:A)
+   (x^(cons a nil))=(y^(cons b nil)) -> x=y /\ a=b.
+Proof.
+  NewInduction x as [|x l IHl];NewDestruct y;Simpl;Auto.
+  Intros a b H.
+  Injection H.
+  Auto.
+  Intros a0 b H.
+  Injection H;Intros.
+  Generalize (app_cons_not_nil H0) ;NewDestruct 1.
+  Intros a b H.
+  Injection H;Intros.
+  Cut   nil=(l^(cons a nil));Auto.
+  Intro.
+  Generalize (app_cons_not_nil H2) ;NewDestruct 1.
+  Intros a0 b H.
+  Injection H;Intros.
+  NewDestruct (IHl l0 a0 b H0). 
+  Split;Auto.
+  Rewrite <- H1;Rewrite <- H2;Reflexivity.
+Qed.
+
+(*************************)
+(** Head and tail        *)
+(*************************)
+
+Definition head :=
+  [l:list]Cases l of
+  | nil => Error
+  | (cons x _) => (Value x)
+  end.
+
+Definition tail : list -> list :=
+  [l:list]Cases l of
+  | nil => nil 
+  | (cons a m) => m
+  end.
+
+(****************************************)
+(** Length of lists                     *)
+(****************************************)
+
+Fixpoint length [l:list] : nat 
+   := Cases l of nil => O | (cons _ m) => (S (length m)) end.
+
+(******************************)
+(** Length order of lists     *)
+(******************************)
+
+Section length_order.
+Definition lel := [l,m:list](le (length l) (length m)).
+
+Variables a,b:A.
+Variables l,m,n:list.
+
+Lemma lel_refl : (lel l l).
+Proof. 
+	Unfold lel ; Auto with arith.
+Qed.
+
+Lemma lel_trans : (lel l m)->(lel m n)->(lel l n).
+Proof. 
+	Unfold lel ; Intros.
+        NowShow '(le (length l) (length n)).
+        Apply le_trans with (length m) ; Auto with arith.
+Qed.
+
+Lemma lel_cons_cons : (lel l m)->(lel (cons a l) (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with arith.
+Qed.
+
+Lemma lel_cons : (lel l m)->(lel l (cons b m)).
+Proof. 
+	Unfold lel ; Simpl ; Auto with arith.
+Qed.
+
+Lemma lel_tail : (lel (cons a l) (cons b m)) -> (lel l m).
+Proof. 
+	Unfold lel ; Simpl ; Auto with arith.
+Qed.
+
+Lemma lel_nil : (l':list)(lel l' nil)->(nil=l').
+Proof. 
+	Intro l' ; Elim l' ; Auto with arith.
+	Intros a' y H H0.
+        NowShow 'nil=(cons a' y).
+	Absurd (le (S (length y)) O); Auto with arith.
+Qed.
+End length_order.
+
+Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons.
+
+(*********************************)
+(** The [In] predicate           *)
+(*********************************)
+
+Fixpoint In  [a:A;l:list] : Prop :=
+      Cases l of nil => False | (cons b m) => (b=a)\/(In a m) end.
+
+Lemma in_eq : (a:A)(l:list)(In a (cons a l)).
+Proof. 
+	Simpl ; Auto.
+Qed.
+Hints Resolve in_eq.
+
+Lemma in_cons : (a,b:A)(l:list)(In b l)->(In b (cons a l)).
+Proof. 
+	Simpl ; Auto.
+Qed.
+Hints Resolve in_cons.
+
+Lemma in_nil : (a:A)~(In a nil).
+Proof.
+  Unfold not; Intros a H; Inversion_clear H.
+Qed.
+
+
+Lemma in_inv : (a,b:A)(l:list)
+               (In b (cons a l)) -> a=b \/ (In b l).
+Proof.
+ Intros a b l H ; Inversion_clear H ; Auto.
+Qed.
+
+Lemma In_dec : ((x,y:A){x=y}+{~x=y}) ->   (a:A)(l:list){(In a l)}+{~(In a l)}.
+
+Proof.
+  NewInduction l as [|a0 l IHl].
+  Right; Apply in_nil.
+  NewDestruct (H a0 a); Simpl; Auto.
+  NewDestruct IHl; Simpl; Auto. 
+  Right; Unfold not; Intros [Hc1 | Hc2]; Auto.
+Qed.
+
+Lemma in_app_or : (l,m:list)(a:A)(In a (l^m))->((In a l)\/(In a m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Auto.
+	Intros a0 y H H0.
+	NowShow '(a0=a\/(In a y))\/(In a m).
+	Elim H0 ; Auto.
+	Intro H1.
+        NowShow '(a0=a\/(In a y))\/(In a m).
+	Elim (H H1) ; Auto.
+Qed.
+Hints Immediate in_app_or.
+
+Lemma in_or_app : (l,m:list)(a:A)((In a l)\/(In a m))->(In a (l^m)).
+Proof. 
+	Intros l m a.
+	Elim l ; Simpl ; Intro H.
+        NowShow '(In a m).
+	Elim H ; Auto ; Intro H0.
+	NowShow '(In a m).
+	Elim H0. (* subProof completed *)
+	Intros y H0 H1.
+	NowShow 'H=a\/(In a (app y m)).
+	Elim H1 ; Auto 4.
+	Intro H2.
+	NowShow 'H=a\/(In a (app y m)).
+	Elim H2 ; Auto.
+Qed.
+Hints Resolve in_or_app.
+
+(***************************)
+(** Set inclusion on list  *)
+(***************************)
+
+Definition incl := [l,m:list](a:A)(In a l)->(In a m).
+Hints Unfold  incl.
+
+Lemma incl_refl : (l:list)(incl l l).
+Proof. 
+	Auto.
+Qed.
+Hints Resolve incl_refl.
+
+Lemma incl_tl : (a:A)(l,m:list)(incl l m)->(incl l (cons a m)).
+Proof. 
+	Auto.
+Qed.
+Hints Immediate incl_tl.
+
+Lemma incl_tran : (l,m,n:list)(incl l m)->(incl m n)->(incl l n).
+Proof. 
+	Auto.
+Qed.
+
+Lemma incl_appl : (l,m,n:list)(incl l n)->(incl l (n^m)).
+Proof. 
+	Auto.
+Qed.
+Hints Immediate incl_appl.
+
+Lemma incl_appr : (l,m,n:list)(incl l n)->(incl l (m^n)).
+Proof. 
+	Auto.
+Qed.
+Hints Immediate incl_appr.
+
+Lemma incl_cons : (a:A)(l,m:list)(In a m)->(incl l m)->(incl (cons a l) m).
+Proof. 
+	Unfold incl ; Simpl ; Intros a l m H H0 a0 H1.
+        NowShow '(In a0 m).
+	Elim H1.
+	NowShow 'a=a0->(In a0 m).
+	Elim H1 ; Auto ; Intro H2.
+	NowShow 'a=a0->(In a0 m).
+	Elim H2 ; Auto. (* solves subgoal *)
+	NowShow '(In a0 l)->(In a0 m).
+	Auto.
+Qed.
+Hints Resolve incl_cons.
+
+Lemma incl_app : (l,m,n:list)(incl l n)->(incl m n)->(incl (l^m) n).
+Proof. 
+	Unfold incl ; Simpl ; Intros l m n H H0 a H1.
+        NowShow '(In a n).
+	Elim (in_app_or H1); Auto.
+Qed.
+Hints Resolve incl_app.
+
+(**************************)
+(** Nth element of a list *)
+(**************************)
+
+Fixpoint nth [n:nat; l:list] : A->A :=
+  [default]Cases n l of
+    O (cons x l') => x
+  | O other => default
+  | (S m) nil => default
+  | (S m) (cons x t) => (nth m t default)
+  end.
+
+Fixpoint nth_ok [n:nat; l:list] : A->bool :=
+  [default]Cases n l of
+    O (cons x l') => true
+  | O other => false
+  | (S m) nil => false
+  | (S m) (cons x t) => (nth_ok m t default)
+  end.
+
+Lemma nth_in_or_default :
+  (n:nat)(l:list)(d:A){(In (nth n l d) l)}+{(nth n l d)=d}.
+(* Realizer nth_ok. Program_all. *)
+Proof. 
+  Intros n l d; Generalize n; NewInduction l; Intro n0.
+  Right; Case n0; Trivial.
+  Case n0; Simpl.
+  Auto.
+  Intro n1; Elim (IHl n1); Auto.     
+Qed.
+
+Lemma nth_S_cons :
+ (n:nat)(l:list)(d:A)(a:A)(In (nth n l d) l)
+   ->(In (nth (S n) (cons a l) d) (cons a l)).
+Proof. 
+  Simpl; Auto.
+Qed.
+
+Fixpoint nth_error [l:list;n:nat] : (Exc A) :=
+  Cases n l of
+  | O (cons x _) => (Value x)
+  | (S n) (cons _ l) => (nth_error l n)
+  | _ _ => Error 
+  end.
+
+Definition nth_default : A -> list -> nat -> A :=
+  [default,l,n]Cases (nth_error l n) of
+  | (Some x) => x
+  | None => default
+  end.
+
+Lemma nth_In :
+  (n:nat)(l:list)(d:A)(lt n (length l))->(In (nth n l d) l).
+
+Proof.
+Unfold lt; NewInduction n as [|n hn]; Simpl.
+NewDestruct l ; Simpl ;  [ Inversion 2 | Auto].
+NewDestruct l as [|a l hl] ; Simpl.
+Inversion 2.
+Intros d ie ; Right ; Apply hn ; Auto with arith.
+Qed.
+
+(********************************)
+(** Decidable equality on lists *)
+(********************************)
+
+
+Lemma list_eq_dec : ((x,y:A){x=y}+{~x=y})->(x,y:list){x=y}+{~x=y}.
+Proof.
+  NewInduction x as [|a l IHl]; NewDestruct y as [|a0 l0]; Auto.
+  NewDestruct (H a a0) as [e|e].
+  NewDestruct (IHl l0) as [e'|e'].
+  Left; Rewrite e; Rewrite e'; Trivial.
+  Right; Red; Intro.
+  Apply e'; Injection H0; Trivial.
+  Right; Red; Intro.
+  Apply e; Injection H0; Trivial.
+Qed.
+
+(*************************)
+(**  Reverse             *)
+(*************************)
+
+Fixpoint rev [l:list] : list :=
+   Cases l of
+      nil        => nil
+   | (cons x l') => (rev l')^(cons x nil)
+   end.
+
+Lemma distr_rev : 
+ (x,y:list) (rev (x^y))=((rev y)^(rev x)).
+Proof.
+ NewInduction x as [|a l IHl].
+ NewDestruct y.
+ Simpl.
+ Auto.
+
+ Simpl.
+ Apply app_nil_end;Auto.
+
+ Intro y.
+ Simpl.
+ Rewrite (IHl y).
+ Apply (app_ass (rev y) (rev l) (cons a nil)).
+Qed.
+
+Remark  rev_unit : (l:list)(a:A) (rev  l^(cons a nil))= (cons a (rev l)).
+Proof.
+ Intros.
+ Apply (distr_rev l (cons a nil));Simpl;Auto.
+Qed.
+
+Lemma idempot_rev : (l:list)(rev (rev l))=l.
+Proof.
+ NewInduction l as [|a l IHl].
+ Simpl;Auto.
+
+ Simpl.
+ Rewrite (rev_unit (rev l) a).
+ Rewrite -> IHl;Auto.
+Qed.
+
+(*********************************************)
+(**  Reverse Induction Principle on Lists    *)
+(*********************************************)
+
+Section Reverse_Induction.
+
+Unset Implicit Arguments.
+
+Remark rev_list_ind: (P:list->Prop)
+      (P nil)
+       ->((a:A)(l:list)(P (rev l))->(P (rev  (cons a l)))) 
+             ->(l:list) (P (rev  l)).
+Proof.
+ NewInduction l; Auto.
+Qed.
+Set Implicit Arguments.
+
+Lemma rev_ind : 
+ (P:list->Prop)
+   (P nil)->
+    ((x:A)(l:list)(P l)->(P l^(cons x nil)))
+      ->(l:list)(P l).
+Proof.
+ Intros.
+ Generalize (idempot_rev l) .
+ Intros E;Rewrite <- E.
+ Apply (rev_list_ind P).
+ Auto.
+
+ Simpl.
+ Intros.
+ Apply (H0 a (rev l0)).
+ Auto.
+Qed.
+
+End Reverse_Induction.
+
+End Lists.
+
+Implicits nil [1].
+
+Hints Resolve nil_cons app_nil_end ass_app app_ass : datatypes v62.
+Hints Resolve app_comm_cons  app_cons_not_nil : datatypes v62.
+Hints Immediate app_eq_nil : datatypes v62.
+Hints Resolve app_eq_unit app_inj_tail : datatypes v62. 
+Hints Resolve lel_refl lel_cons_cons lel_cons lel_nil lel_nil nil_cons 
+   : datatypes v62.
+Hints Resolve in_eq in_cons in_inv in_nil in_app_or in_or_app : datatypes v62.
+Hints Resolve incl_refl incl_tl incl_tran incl_appl incl_appr incl_cons incl_app 
+  : datatypes v62.
+
+Section Functions_on_lists.
+
+(****************************************************************)
+(** Some generic functions on lists and basic functions of them *)
+(****************************************************************)
+
+Section Map.
+Variables A,B:Set.
+Variable  f:A->B.
+Fixpoint map [l:(list A)] : (list B) :=
+  Cases l of 
+     nil       => nil
+  | (cons a t) => (cons (f a) (map t))
+  end.
+End Map.
+
+Lemma in_map : (A,B:Set)(f:A->B)(l:(list A))(x:A)
+  (In x l) -> (In (f x) (map f l)).
+Proof. 
+  NewInduction l as [|a l IHl]; Simpl;
+  [ Auto
+  | NewDestruct 1;
+    [ Left; Apply f_equal with f:=f; Assumption
+    | Auto]
+  ].
+Qed.
+
+Fixpoint flat_map [A,B:Set; f:A->(list B); l:(list A)] : (list B) :=
+  Cases l of
+    nil => nil
+  | (cons x t) => (app (f x) (flat_map f t))
+  end.
+
+Fixpoint list_prod [A:Set; B:Set; l:(list A)] : (list B)->(list A*B) :=
+  [l']Cases l of
+    nil => nil
+  | (cons x t) => (app (map [y:B](x,y) l')
+      	       	       	     (list_prod t l'))
+  end.
+
+Lemma in_prod_aux :
+  (A:Set)(B:Set)(x:A)(y:B)(l:(list B))
+    (In y l) -> (In (x,y) (map [y0:B](x,y0) l)).
+Proof. 
+  NewInduction l;
+  [ Simpl; Auto
+  | Simpl; NewDestruct 1 as [H1|];
+    [ Left; Rewrite H1; Trivial
+    | Right; Auto]
+  ].
+Qed.
+
+Lemma in_prod : (A:Set)(B:Set)(l:(list A))(l':(list B))
+  (x:A)(y:B)(In x l)->(In y l')->(In (x,y) (list_prod l l')).
+Proof. 
+  NewInduction l;
+  [ Simpl; Tauto
+  | Simpl; Intros; Apply in_or_app; NewDestruct H;
+    [ Left; Rewrite H; Apply in_prod_aux; Assumption
+    | Right; Auto]
+  ].
+Qed.
+
+(** [(list_power x y)] is [y^x], or the set of sequences of elts of [y]
+    indexed by elts of [x], sorted in lexicographic order. *)
+
+Fixpoint list_power [A,B:Set; l:(list A)] : (list B)->(list (list A*B)) :=
+  [l']Cases l of
+    nil => (cons nil nil)
+  | (cons x t) => (flat_map [f:(list A*B)](map [y:B](cons (x,y) f) l') 
+      	       	       	    (list_power t l'))
+  end.
+
+(************************************)
+(** Left-to-right iterator on lists *)
+(************************************)
+
+Section Fold_Left_Recursor.
+Variables A,B:Set.
+Variable  f:A->B->A.
+Fixpoint fold_left[l:(list B)] : A -> A :=
+[a0]Cases l of
+     nil       => a0
+  | (cons b t) => (fold_left t (f a0 b))
+  end.
+End Fold_Left_Recursor.
+
+(************************************)
+(** Right-to-left iterator on lists *)
+(************************************)
+
+Section Fold_Right_Recursor.
+Variables A,B:Set.
+Variable  f:B->A->A.
+Variable  a0:A.
+Fixpoint fold_right [l:(list B)] : A :=
+  Cases l of
+    nil => a0
+  | (cons b t) => (f b (fold_right t))
+  end.
+End Fold_Right_Recursor.
+
+Theorem fold_symmetric :
+  (A:Set)(f:A->A->A)
+   ((x,y,z:A)(f x (f y z))=(f (f x y) z))
+    ->((x,y:A)(f x y)=(f y x))
+     ->(a0:A)(l:(list A))(fold_left f l a0)=(fold_right f a0 l).
+Proof.
+NewDestruct l as [|a l].
+Reflexivity.
+Simpl.
+Rewrite <- H0.
+Generalize a0 a.
+NewInduction l as [|a3 l IHl]; Simpl.
+Trivial.
+Intros.
+Rewrite H.
+Rewrite (H0 a2).
+Rewrite <- (H a1).
+Rewrite (H0 a1).
+Rewrite IHl.
+Reflexivity.
+Qed.
+
+End Functions_on_lists.
+
+V7only [Implicits nil [].].
+
+(** Exporting list notations *)
+
+V8Infix "::" cons (at level 60, right associativity) : list_scope.
+
+Infix RIGHTA 7 "^" app : list_scope V8only RIGHTA 60 "++".
+
+Open Scope list_scope.
+
+Delimits Scope list_scope with list.
+
+Bind Scope list_scope with list.
diff --git a/theories7/Lists/PolyListSyntax.v b/theories7/Lists/PolyListSyntax.v
new file mode 100644
index 00000000..15c57166
--- /dev/null
+++ b/theories7/Lists/PolyListSyntax.v
@@ -0,0 +1,10 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: PolyListSyntax.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
diff --git a/theories7/Lists/Streams.v b/theories7/Lists/Streams.v
new file mode 100755
index 00000000..ccfc4895
--- /dev/null
+++ b/theories7/Lists/Streams.v
@@ -0,0 +1,170 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Streams.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+Set Implicit Arguments.
+
+(** Streams *)
+
+Section Streams.
+
+Variable A : Set.
+
+CoInductive Set Stream   := Cons : A->Stream->Stream.
+
+
+Definition hd  := 
+  [x:Stream] Cases x of (Cons a _) => a end.
+
+Definition tl  := 
+  [x:Stream] Cases x of (Cons _ s) => s end.
+
+
+Fixpoint Str_nth_tl [n:nat] : Stream->Stream := 
+  [s:Stream] Cases n of
+	          O    => s
+		|(S m) => (Str_nth_tl m (tl s))
+	    end.
+
+Definition Str_nth : nat->Stream->A := [n:nat][s:Stream](hd (Str_nth_tl n s)).
+
+
+Lemma unfold_Stream :(x:Stream)x=(Cases x of (Cons a s) => (Cons a s) end). 
+Proof.
+  Intro x.
+  Case x.
+  Trivial.
+Qed.
+
+Lemma tl_nth_tl : (n:nat)(s:Stream)(tl (Str_nth_tl n s))=(Str_nth_tl n (tl s)).
+Proof.
+  Induction n; Simpl; Auto.
+Qed.
+Hints Resolve tl_nth_tl : datatypes v62.
+
+Lemma Str_nth_tl_plus 
+: (n,m:nat)(s:Stream)(Str_nth_tl n (Str_nth_tl m s))=(Str_nth_tl (plus n m) s).
+Induction n; Simpl; Intros; Auto with datatypes.
+Rewrite <- H.
+Rewrite tl_nth_tl; Trivial with datatypes.
+Qed.
+
+Lemma Str_nth_plus 
+  : (n,m:nat)(s:Stream)(Str_nth n (Str_nth_tl m s))=(Str_nth (plus n m) s).
+Intros; Unfold Str_nth; Rewrite Str_nth_tl_plus; Trivial with datatypes.
+Qed.
+
+(** Extensional Equality between two streams  *)
+
+CoInductive EqSt  : Stream->Stream->Prop := 
+	    eqst : (s1,s2:Stream)
+		   ((hd s1)=(hd s2))->
+		   (EqSt (tl s1) (tl s2))
+                    ->(EqSt s1 s2).
+
+(** A coinduction principle *)
+
+Tactic Definition CoInduction proof := 
+  Cofix proof; Intros; Constructor;
+    [Clear proof | Try (Apply proof;Clear proof)].
+
+
+(** Extensional equality is an equivalence relation *)
+
+Theorem  EqSt_reflex : (s:Stream)(EqSt s s).
+CoInduction EqSt_reflex.
+Reflexivity.
+Qed.
+
+Theorem sym_EqSt : 
+ (s1:Stream)(s2:Stream)(EqSt s1 s2)->(EqSt s2 s1).
+(CoInduction Eq_sym).
+Case H;Intros;Symmetry;Assumption.
+Case H;Intros;Assumption.
+Qed.
+
+
+Theorem trans_EqSt : 
+ (s1,s2,s3:Stream)(EqSt s1 s2)->(EqSt s2 s3)->(EqSt s1 s3).
+(CoInduction Eq_trans).
+Transitivity (hd s2).
+Case H; Intros; Assumption.
+Case H0; Intros; Assumption.
+Apply (Eq_trans (tl s1) (tl s2) (tl s3)).
+Case H;  Trivial with datatypes.
+Case H0; Trivial with datatypes.
+Qed.
+
+(** The definition given is equivalent to require the elements at each
+    position to be equal *)
+
+Theorem eqst_ntheq :
+  (n:nat)(s1,s2:Stream)(EqSt s1 s2)->(Str_nth n s1)=(Str_nth n s2).
+Unfold Str_nth; Induction n.
+Intros s1 s2 H; Case H; Trivial with datatypes.
+Intros m hypind.
+Simpl.
+Intros s1 s2 H.
+Apply hypind.
+Case H; Trivial with datatypes.
+Qed.
+
+Theorem ntheq_eqst : 
+  (s1,s2:Stream)((n:nat)(Str_nth n s1)=(Str_nth n s2))->(EqSt s1 s2).
+(CoInduction Equiv2).
+Apply (H O).
+Intros n; Apply (H (S n)).
+Qed.
+
+Section Stream_Properties.
+
+Variable P : Stream->Prop.
+
+(*i
+Inductive Exists : Stream -> Prop :=
+  | Here    : forall x:Stream, P x -> Exists x
+  | Further : forall x:Stream, ~ P x -> Exists (tl x) -> Exists x.
+i*)
+
+Inductive   Exists :  Stream -> Prop :=
+   Here    : (x:Stream)(P x) ->(Exists x) |
+   Further : (x:Stream)(Exists (tl x))->(Exists x).
+
+CoInductive ForAll : Stream  -> Prop :=
+    forall : (x:Stream)(P x)->(ForAll (tl x))->(ForAll x).
+
+
+Section Co_Induction_ForAll.
+Variable   Inv        :  Stream -> Prop.
+Hypothesis InvThenP   : (x:Stream)(Inv x)->(P x).
+Hypothesis InvIsStable: (x:Stream)(Inv x)->(Inv (tl x)).
+
+Theorem ForAll_coind : (x:Stream)(Inv x)->(ForAll x).
+(CoInduction ForAll_coind);Auto.
+Qed.
+End Co_Induction_ForAll.
+
+End Stream_Properties.
+
+End Streams.
+
+Section Map.
+Variables A,B : Set.
+Variable  f   : A->B.
+CoFixpoint map : (Stream A)->(Stream B) :=
+ [s:(Stream A)](Cons (f (hd s)) (map (tl s))).
+End Map.
+
+Section Constant_Stream.
+Variable A : Set.
+Variable a : A.
+CoFixpoint const : (Stream A) := (Cons a const).
+End Constant_Stream.
+
+Unset Implicit Arguments.
diff --git a/theories7/Lists/TheoryList.v b/theories7/Lists/TheoryList.v
new file mode 100755
index 00000000..f7adda70
--- /dev/null
+++ b/theories7/Lists/TheoryList.v
@@ -0,0 +1,386 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: TheoryList.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Some programs and results about lists following CAML Manual *)
+
+Require Export PolyList.
+Set Implicit Arguments.
+Chapter Lists.
+
+Variable  A : Set.
+
+(**********************)
+(** The null function *)
+(**********************)
+
+Definition Isnil : (list A) -> Prop := [l:(list A)](nil A)=l.
+
+Lemma Isnil_nil : (Isnil (nil A)).
+Red; Auto.
+Qed.
+Hints Resolve Isnil_nil.
+
+Lemma not_Isnil_cons : (a:A)(l:(list A))~(Isnil (cons a l)).
+Unfold Isnil.
+Intros; Discriminate.
+Qed.
+
+Hints Resolve Isnil_nil not_Isnil_cons.
+
+Lemma Isnil_dec : (l:(list A)){(Isnil l)}+{~(Isnil l)}.
+Intro l; Case l;Auto.
+(*
+Realizer (fun l => match l with
+  | nil => true
+  | _ => false
+  end).
+*)
+Qed.
+
+(************************)
+(** The Uncons function *)
+(************************)
+
+Lemma Uncons : (l:(list A)){a : A & { m: (list A) | (cons a m)=l}}+{Isnil l}.
+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 : (l:(list A)){a : A | (EX m:(list A) |(cons a m)=l)}+{Isnil l}.
+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 : (l:(list A)){m:(list A)| (EX a:A |(cons a m)=l)
+                         \/ ((Isnil l) /\ (Isnil m)) }.
+Intro l; Case l.
+Exists (nil 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)] : nat -> nat 
+  :=  [n:nat] Cases l of
+                  nil => n
+              | (cons _ m) => (Length_l m (S n))
+	     end.
+
+(* A tail recursive version *)
+Lemma Length_l_pf : (l:(list A))(n:nat){m:nat|(plus n (length l))=m}.
+NewInduction l as [|a m lrec].
+Intro n; Exists n; Simpl; Auto.
+Intro n; Elim (lrec (S n)); Simpl; Intros.
+Exists x; Transitivity (S (plus n (length m))); Auto.
+(*
+Realizer Length_l.
+*)
+Qed.
+
+Lemma Length : (l:(list A)){m:nat|(length l)=m}.
+Intro l. Apply (Length_l_pf l O).
+(*
+Realizer (fun l -> Length_l_pf l O).
+*)
+Qed.
+
+(*******************************)
+(** Members of lists           *)
+(*******************************)
+Inductive In_spec [a:A] : (list A) -> Prop := 
+   | in_hd : (l:(list A))(In_spec a (cons a l))
+   | in_tl : (l:(list A))(b:A)(In a l)->(In_spec a (cons b l)).
+Hints Resolve in_hd in_tl.
+Hints Unfold  In.
+Hints Resolve in_cons.
+
+Theorem In_In_spec : (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.
+
+Inductive AllS [P:A->Prop] : (list A) -> Prop 
+   := allS_nil : (AllS P (nil A))
+   | allS_cons : (a:A)(l:(list A))(P a)->(AllS P l)->(AllS P (cons a l)).
+Hints Resolve allS_nil allS_cons.
+
+Hypothesis eqA_dec : (a,b:A){a=b}+{~a=b}.
+
+Fixpoint mem [a:A; l:(list A)] : bool :=
+  Cases l of
+    nil => false
+  | (cons b m) => if (eqA_dec a b) then [H]true else [H](mem a m)
+  end.
+
+Hints Unfold  In.
+Lemma Mem : (a:A)(l:(list A)){(In a l)}+{(AllS [b:A]~b=a l)}.
+Intros a l.
+NewInduction l.
+Auto.
+Elim (eqA_dec a a0).
+Auto.
+Simpl. Elim IHl; Auto.
+(*
+Realizer mem.
+*)
+Qed.
+
+(*********************************)
+(** Index of elements            *)
+(*********************************)
+
+Require Le.
+Require Lt.
+
+Inductive nth_spec : (list A)->nat->A->Prop :=
+  nth_spec_O : (a:A)(l:(list A))(nth_spec (cons a l) (S O) a)
+| nth_spec_S : (n:nat)(a,b:A)(l:(list A))
+           (nth_spec l n a)->(nth_spec (cons b l) (S n) a).
+Hints Resolve nth_spec_O nth_spec_S.
+
+Inductive fst_nth_spec : (list A)->nat->A->Prop :=
+  fst_nth_O : (a:A)(l:(list A))(fst_nth_spec (cons a l) (S O) a)
+| fst_nth_S : (n:nat)(a,b:A)(l:(list A))(~a=b)->
+           (fst_nth_spec l n a)->(fst_nth_spec (cons b l) (S n) a).
+Hints Resolve fst_nth_O fst_nth_S.
+
+Lemma fst_nth_nth : (l:(list A))(n:nat)(a:A)(fst_nth_spec l n a)->(nth_spec l n a).
+NewInduction 1; Auto.
+Qed.
+Hints Immediate fst_nth_nth.
+
+Lemma nth_lt_O : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(lt O n).
+NewInduction 1; Auto.
+Qed.
+
+Lemma nth_le_length : (l:(list A))(n:nat)(a:A)(nth_spec l n a)->(le n (length l)).
+NewInduction 1; Simpl; Auto with arith.
+Qed.
+
+Fixpoint Nth_func [l:(list A)] : nat -> (Exc A) 
+  := [n:nat] Cases  l  n  of 
+               (cons a _)  (S O)       => (value A a) 
+             | (cons _ l') (S (S p)) => (Nth_func l' (S p))
+             |  _ _      => Error
+            end.
+
+Lemma Nth : (l:(list A))(n:nat)
+            {a:A|(nth_spec l n a)}+{(n=O)\/(lt (length l) n)}.
+NewInduction l as [|a l IHl].
+Intro n; Case n; Simpl; Auto with arith.
+Intro n; NewDestruct n as [|[|n1]]; Simpl; Auto.
+Left; Exists a; Auto.
+NewDestruct (IHl (S n1)) as [[b]|o].
+Left; Exists b; Auto.
+Right; NewDestruct o.
+Absurd (S n1)=O; Auto.
+Auto with arith.
+(*
+Realizer Nth_func.
+*)
+Qed.
+
+Lemma Item : (l:(list A))(n:nat){a:A|(nth_spec l (S n) a)}+{(le (length l) n)}.
+Intros l n; Case (Nth l (S n)); Intro.
+Case s; Intro a; Left; Exists a; Auto.
+Right; Case o; Intro.
+Absurd (S n)=O; Auto.
+Auto with arith.
+Qed.
+
+Require Minus.
+Require DecBool.
+
+Fixpoint index_p [a:A;l:(list A)] : nat -> (Exc nat) := 
+   Cases l of nil => [p]Error
+     | (cons b m) => [p](ifdec (eqA_dec a b) (Value p) (index_p a m (S p)))
+   end.
+
+Lemma Index_p : (a:A)(l:(list A))(p:nat)
+     {n:nat|(fst_nth_spec l (minus (S n) p) a)}+{(AllS [b:A]~a=b l)}.
+NewInduction l as [|b m irec].
+Auto.
+Intro p.
+NewDestruct (eqA_dec a b) as [e|e].
+Left; Exists p.
+NewDestruct e; Elim minus_Sn_m; Trivial; Elim minus_n_n; Auto with arith.
+NewDestruct (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 : (a:A)(l:(list A))
+     {n:nat|(fst_nth_spec l n a)}+{(AllS [b:A]~a=b l)}.
+
+Intros a l; Case (Index_p a l (S O)); 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.
+Variable R,P : A -> Prop.
+
+Inductive InR : (list A) -> Prop 
+   := inR_hd : (a:A)(l:(list A))(R a)->(InR (cons a l))
+   | inR_tl : (a:A)(l:(list A))(InR l)->(InR (cons a l)).
+Hints Resolve inR_hd inR_tl.
+
+Definition InR_inv := 
+       [l:(list A)]Cases l of 
+                   nil => False 
+                | (cons b m) => (R b)\/(InR m) 
+               end.
+
+Lemma InR_INV : (l:(list A))(InR l)->(InR_inv l).
+NewInduction 1; Simpl; Auto.
+Qed.
+
+Lemma InR_cons_inv : (a:A)(l:(list A))(InR (cons a l))->((R a)\/(InR l)).
+Intros a l H; Exact (InR_INV H).
+Qed.
+
+Lemma InR_or_app : (l,m:(list A))((InR l)\/(InR m))->(InR (app l m)).
+Intros l m [|].
+NewInduction 1; Simpl; Auto.
+Intro. NewInduction l; Simpl; Auto.
+Qed.
+
+Lemma InR_app_or : (l,m:(list A))(InR (app l m))->((InR l)\/(InR m)).
+Intros l m; Elim l; Simpl; Auto.
+Intros b l' Hrec IAc; Elim (InR_cons_inv IAc);Auto.
+Intros; Elim Hrec; Auto.
+Qed.
+
+Hypothesis RS_dec : (a:A){(R a)}+{(P a)}.
+
+Fixpoint find [l:(list A)] : (Exc A) := 
+	Cases l of nil => Error
+                | (cons a m) => (ifdec (RS_dec a) (Value a) (find m))
+        end.
+
+Lemma Find : (l:(list A)){a:A | (In a l) & (R a)}+{(AllS P l)}.
+NewInduction l as [|a m [[b H1 H2]|H]]; Auto.
+Left; Exists b; Auto.
+NewDestruct (RS_dec a).
+Left; Exists a; Auto.
+Auto.
+(*
+Realizer find.
+*)
+Qed.
+
+Variable B : Set.
+Variable T : A -> B -> Prop.
+
+Variable TS_dec : (a:A){c:B| (T a c)}+{(P a)}.
+
+Fixpoint try_find [l:(list A)] : (Exc B) :=
+   Cases l of
+     nil => Error
+   | (cons a l1) =>
+	   Cases (TS_dec a) of
+	     (inleft (exist c _)) => (Value c)
+	   | (inright _) => (try_find l1)
+	   end
+   end.
+
+Lemma Try_find : (l:(list A)){c:B|(EX a:A |(In a l) & (T a c))}+{(AllS P l)}.
+NewInduction l as [|a m [[b H1]|H]].
+Auto.
+Left; Exists b; NewDestruct H1 as [a' H2 H3]; Exists a'; Auto.
+NewDestruct (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 : Set.
+Fixpoint assoc [a:A;l:(list A*B)] : (Exc B) :=
+    Cases l of        nil => Error
+        | (cons (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 A*B))
+    | allS_assoc_cons : (a:A)(b:B)(l:(list A*B))
+        (P a)->(AllS_assoc P l)->(AllS_assoc P (cons (a,b) l)).
+
+Hints 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 : (a:A)(l:(list A*B))(B+{(AllS_assoc [a':A]~(a=a') l)}).
+NewInduction l as [|[a' b] m assrec]. Auto.
+NewDestruct (eqA_dec a a').
+Left; Exact b.
+NewDestruct assrec as [b'|].
+Left; Exact b'.
+Right; Auto.
+(*
+Realizer assoc.
+*)
+Qed.
+
+End Assoc_sec.
+
+End Lists.
+
+Hints Resolve Isnil_nil not_Isnil_cons in_hd in_tl in_cons allS_nil allS_cons 
+ : datatypes.
+Hints Immediate fst_nth_nth : datatypes.
+
diff --git a/theories7/Logic/Berardi.v b/theories7/Logic/Berardi.v
new file mode 100644
index 00000000..db9007ec
--- /dev/null
+++ b/theories7/Logic/Berardi.v
@@ -0,0 +1,170 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Berardi.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** This file formalizes Berardi's paradox which says that in
+   the calculus of constructions, excluded middle (EM) and axiom of
+   choice (AC) implie proof irrelevenace (PI).
+   Here, the axiom of choice is not necessary because of the use
+   of inductive types.
+<<
+@article{Barbanera-Berardi:JFP96,
+   author    = {F. Barbanera and S. Berardi},
+   title     = {Proof-irrelevance out of Excluded-middle and Choice
+                in the Calculus of Constructions},
+   journal   = {Journal of Functional Programming},
+   year      = {1996},
+   volume    = {6},
+   number    = {3},
+   pages     = {519-525}
+}
+>> *)
+
+Set Implicit Arguments.
+
+Section Berardis_paradox.
+
+(** Excluded middle *)
+Hypothesis EM : (P:Prop) P \/ ~P.
+
+(** Conditional on any proposition. *)
+Definition IFProp := [P,B:Prop][e1,e2:P]
+  Cases (EM B) of
+    (or_introl _) => e1
+  | (or_intror _) => e2
+  end.
+
+(** Axiom of choice applied to disjunction.
+    Provable in Coq because of dependent elimination. *)
+Lemma AC_IF : (P,B:Prop)(e1,e2:P)(Q:P->Prop)
+  ( B -> (Q e1))->
+  (~B -> (Q e2))->
+  (Q (IFProp B e1 e2)).
+Proof.
+Intros P B e1 e2 Q p1 p2.
+Unfold IFProp.
+Case (EM B); Assumption.
+Qed.
+
+
+(** We assume a type with two elements. They play the role of booleans.
+    The main theorem under the current assumptions is that [T=F] *)
+Variable Bool: Prop.
+Variable T: Bool.
+Variable F: Bool.
+
+(** The powerset operator *)
+Definition pow [P:Prop] :=P->Bool.
+
+
+(** A piece of theory about retracts *)
+Section Retracts.
+
+Variable A,B: Prop.
+
+Record retract : Prop := {
+    i: A->B;
+    j: B->A;
+    inv: (a:A)(j (i a))==a
+  }.
+
+Record retract_cond : Prop := {
+    i2: A->B;
+    j2: B->A;
+    inv2: retract -> (a:A)(j2 (i2 a))==a
+  }.
+
+
+(** The dependent elimination above implies the axiom of choice: *)
+Lemma AC: (r:retract_cond) retract -> (a:A)((j2 r) ((i2 r) a))==a.
+Proof.
+Intros r.
+Case r; Simpl.
+Trivial.
+Qed.
+
+End Retracts.
+
+(** This lemma is basically a commutation of implication and existential
+    quantification:  (EX x | A -> P(x))  <=> (A -> EX x | P(x))
+    which is provable in classical logic ( => is already provable in
+    intuitionnistic logic). *)
+
+Lemma L1 : (A,B:Prop)(retract_cond (pow A) (pow B)).
+Proof.
+Intros A B.
+Elim (EM (retract (pow A) (pow B))).
+Intros (f0, g0, e).
+Exists f0 g0.
+Trivial.
+
+Intros hf.
+Exists ([x:(pow A); y:B]F) ([x:(pow B); y:A]F).
+Intros; Elim hf; Auto.
+Qed.
+
+
+(** The paradoxical set *)
+Definition U := (P:Prop)(pow P).
+
+(** Bijection between [U] and [(pow U)] *)
+Definition f : U -> (pow U) :=
+  [u](u U).
+
+Definition g : (pow U) -> U :=
+  [h,X]
+    let lX = (j2 (L1 X U)) in
+    let rU = (i2 (L1 U U)) in
+    (lX (rU h)).
+
+(** We deduce that the powerset of [U] is a retract of [U].
+    This lemma is stated in Berardi's article, but is not used
+    afterwards. *)
+Lemma retract_pow_U_U : (retract (pow U) U).
+Proof.
+Exists g f.
+Intro a.
+Unfold f g; Simpl.
+Apply AC.
+Exists ([x:(pow U)]x) ([x:(pow U)]x).
+Trivial.
+Qed.
+
+(** Encoding of Russel's paradox *)
+
+(** The boolean negation. *)
+Definition Not_b := [b:Bool](IFProp b==T F T).
+
+(** the set of elements not belonging to itself *)
+Definition R : U := (g ([u:U](Not_b (u U u)))).
+
+
+Lemma not_has_fixpoint : (R R)==(Not_b (R R)).
+Proof.
+Unfold 1 R.
+Unfold g.
+Rewrite AC with r:=(L1 U U) a:=[u:U](Not_b (u U u)).
+Trivial.
+Exists ([x:(pow U)]x) ([x:(pow U)]x); Trivial.
+Qed.
+
+
+Theorem classical_proof_irrelevence : T==F.
+Proof.
+Generalize not_has_fixpoint.
+Unfold Not_b.
+Apply AC_IF.
+Intros is_true is_false.
+Elim is_true; Elim is_false; Trivial.
+
+Intros not_true is_true.
+Elim not_true; Trivial.
+Qed.
+
+End Berardis_paradox.
diff --git a/theories7/Logic/ChoiceFacts.v b/theories7/Logic/ChoiceFacts.v
new file mode 100644
index 00000000..5b7e002a
--- /dev/null
+++ b/theories7/Logic/ChoiceFacts.v
@@ -0,0 +1,134 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ChoiceFacts.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(* We show that the functional formulation of the axiom of Choice
+   (usual formulation in type theory) is equivalent to its relational
+   formulation (only formulation of set theory) + the axiom of
+   (parametric) definite description (aka axiom of unique choice) *)
+
+(* This shows that the axiom of choice can be assumed (under its
+   relational formulation) without known inconsistency with classical logic,
+   though definite description conflicts with classical logic *)
+
+Definition RelationalChoice :=
+ (A:Type;B:Type;R: A->B->Prop) 
+  ((x:A)(EX y:B|(R x y)))
+   -> (EXT R':A->B->Prop | 
+         ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
+
+Definition FunctionalChoice :=
+ (A:Type;B:Type;R: A->B->Prop)
+  ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
+
+Definition ParamDefiniteDescription :=
+ (A:Type;B:Type;R: A->B->Prop)
+  ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
+   -> (EX f:A->B | (x:A)(R x (f x))).
+
+Lemma description_rel_choice_imp_funct_choice : 
+  ParamDefiniteDescription->RelationalChoice->FunctionalChoice.
+Intros Descr RelCh.
+Red; Intros A B R H.
+NewDestruct (RelCh A B R H) as [R' H0].
+NewDestruct (Descr A B R') as [f H1].
+Intro x.
+Elim (H0 x); Intros y [H2 [H3 H4]]; Exists y; Split; [Exact H3 | Exact H4].
+Exists f; Intro x.
+Elim (H0 x); Intros y [H2 [H3 H4]].
+Rewrite <- (H4 (f x) (H1 x)).
+Exact H2.
+Qed.
+
+Lemma funct_choice_imp_rel_choice : 
+  FunctionalChoice->RelationalChoice.
+Intros FunCh.
+Red; Intros A B R H.
+NewDestruct (FunCh A B R H) as [f H0].
+Exists [x,y]y=(f x).
+Intro x; Exists (f x);
+Split; [Apply H0| Split;[Reflexivity| Intros y H1; Symmetry; Exact H1]].
+Qed.
+
+Lemma funct_choice_imp_description : 
+  FunctionalChoice->ParamDefiniteDescription.
+Intros FunCh.
+Red; Intros A B R H.
+NewDestruct (FunCh A B R) as [f H0].
+(* 1 *)
+Intro x.
+Elim (H x); Intros y [H0 H1].
+Exists y; Exact H0.
+(* 2 *)
+Exists f; Exact H0.
+Qed.
+
+Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
+  FunctionalChoice <-> RelationalChoice /\ ParamDefiniteDescription.
+Split.
+Intro H; Split; [
+  Exact (funct_choice_imp_rel_choice H)
+ | Exact (funct_choice_imp_description H)].
+Intros [H H0]; Exact (description_rel_choice_imp_funct_choice H0 H).
+Qed.
+
+(* We show that the guarded relational formulation of the axiom of Choice
+   comes from the non guarded formulation in presence either of the
+   independance of premises or proof-irrelevance *)
+
+Definition GuardedRelationalChoice :=
+ (A:Type;B:Type;P:A->Prop;R: A->B->Prop) 
+  ((x:A)(P x)->(EX y:B|(R x y)))
+   -> (EXT R':A->B->Prop | 
+        ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
+
+Definition ProofIrrelevance := (A:Prop)(a1,a2:A) a1==a2.
+
+Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice : 
+  RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
+Proof.
+Intros rel_choice proof_irrel.
+Red; Intros A B P R H.
+NewDestruct (rel_choice ? ? [x:(sigT ? P);y:B](R (projT1 ? ? x) y)) as [R' H0].
+Intros [x HPx].
+NewDestruct (H x HPx) as [y HRxy].
+Exists y; Exact HRxy.
+Pose R'':=[x:A;y:B](EXT H:(P x) | (R' (existT ? P x H) y)).
+Exists R''; Intros x HPx.
+NewDestruct (H0 (existT ? P x HPx)) as [y [HRxy [HR'xy Huniq]]].
+Exists y. Split.
+  Exact HRxy.
+  Split.
+    Red; Exists HPx; Exact HR'xy.
+    Intros y' HR''xy'.
+      Apply Huniq.
+      Unfold R'' in HR''xy'.
+      NewDestruct HR''xy' as [H'Px HR'xy'].
+      Rewrite proof_irrel with a1:=HPx a2:=H'Px.
+      Exact HR'xy'.
+Qed.
+
+Definition IndependenceOfPremises :=
+ (A:Type)(P:A->Prop)(Q:Prop)(Q->(EXT x|(P x)))->(EXT x|Q->(P x)).
+
+Lemma rel_choice_indep_of_premises_imp_guarded_rel_choice :
+  RelationalChoice -> IndependenceOfPremises -> GuardedRelationalChoice.
+Proof.
+Intros RelCh IndPrem.
+Red; Intros A B P R H.
+NewDestruct (RelCh A B [x,y](P x)->(R x y)) as [R' H0].
+  Intro x. Apply IndPrem.
+    Apply H.
+  Exists R'.
+  Intros x HPx.
+    NewDestruct (H0 x) as [y [H1 H2]].
+    Exists y. Split. 
+      Apply (H1 HPx).
+      Exact H2.
+Qed.
diff --git a/theories7/Logic/Classical.v b/theories7/Logic/Classical.v
new file mode 100755
index 00000000..8d7fe1d1
--- /dev/null
+++ b/theories7/Logic/Classical.v
@@ -0,0 +1,14 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Classical.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Classical Logic *)
+
+Require Export Classical_Prop.
+Require Export Classical_Pred_Type.
diff --git a/theories7/Logic/ClassicalChoice.v b/theories7/Logic/ClassicalChoice.v
new file mode 100644
index 00000000..5419e958
--- /dev/null
+++ b/theories7/Logic/ClassicalChoice.v
@@ -0,0 +1,31 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ClassicalChoice.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** This file provides classical logic and functional choice *)
+
+(** This file extends ClassicalDescription.v with the axiom of choice.
+    As ClassicalDescription.v, it implies the double-negation of
+    excluded-middle in Set and implies a strongly classical
+    world. Especially it conflicts with impredicativity of Set, knowing
+    that true<>false in Set.
+*)
+
+Require Export ClassicalDescription.
+Require Export RelationalChoice.
+Require ChoiceFacts.
+
+Theorem choice : 
+ (A:Type;B:Type;R: A->B->Prop)
+  ((x:A)(EX y:B|(R x y))) -> (EX f:A->B | (x:A)(R x (f x))).
+Proof.
+Apply description_rel_choice_imp_funct_choice.
+Exact description.
+Exact relational_choice.
+Qed.
diff --git a/theories7/Logic/ClassicalDescription.v b/theories7/Logic/ClassicalDescription.v
new file mode 100644
index 00000000..85700c22
--- /dev/null
+++ b/theories7/Logic/ClassicalDescription.v
@@ -0,0 +1,76 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ClassicalDescription.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** This file provides classical logic and definite description *)
+
+(** Classical logic and definite description, as shown in [1],
+    implies the double-negation of excluded-middle in Set, hence it
+    implies a strongly classical world. Especially it conflicts with
+    impredicativity of Set, knowing that true<>false in Set.
+
+    [1] Laurent Chicli, Loïc Pottier, Carlos Simpson, Mathematical
+    Quotients and Quotient Types in Coq, Proceedings of TYPES 2002,
+    Lecture Notes in Computer Science 2646, Springer Verlag.
+*)
+
+Require Export Classical.
+
+Axiom dependent_description :
+  (A:Type;B:A->Type;R: (x:A)(B x)->Prop)
+  ((x:A)(EX y:(B x)|(R x y)/\ ((y':(B x))(R x y') -> y=y')))
+   -> (EX f:(x:A)(B x) | (x:A)(R x (f x))).
+
+(** Principle of definite descriptions (aka axiom of unique choice) *)
+
+Theorem description :
+  (A:Type;B:Type;R: A->B->Prop)
+  ((x:A)(EX y:B|(R x y)/\ ((y':B)(R x y') -> y=y')))
+   -> (EX f:A->B | (x:A)(R x (f x))).
+Proof.
+Intros A B.
+Apply (dependent_description A [_]B).
+Qed.
+
+(** The followig proof comes from [1] *)
+
+Theorem classic_set : (((P:Prop){P}+{~P}) -> False) -> False.
+Proof.
+Intro HnotEM.
+Pose R:=[A,b]A/\true=b \/ ~A/\false=b.
+Assert H:(EX f:Prop->bool|(A:Prop)(R A (f A))).
+Apply description.
+Intro A.
+NewDestruct (classic A) as [Ha|Hnota].
+  Exists true; Split.
+    Left; Split; [Assumption|Reflexivity].
+    Intros y [[_ Hy]|[Hna _]].
+      Assumption.
+      Contradiction.
+  Exists false; Split.
+    Right; Split; [Assumption|Reflexivity].
+    Intros y [[Ha _]|[_ Hy]].
+      Contradiction.
+      Assumption.
+NewDestruct H as [f Hf].
+Apply HnotEM.
+Intro P.
+Assert HfP := (Hf P).
+(* Elimination from Hf to Set is not allowed but from f to Set yes ! *)
+NewDestruct (f P).
+  Left.
+  NewDestruct HfP as [[Ha _]|[_ Hfalse]].
+    Assumption.
+    Discriminate.
+  Right.
+  NewDestruct HfP as [[_ Hfalse]|[Hna _]].
+    Discriminate.
+    Assumption.
+Qed.
+ 
diff --git a/theories7/Logic/ClassicalFacts.v b/theories7/Logic/ClassicalFacts.v
new file mode 100644
index 00000000..1d37652e
--- /dev/null
+++ b/theories7/Logic/ClassicalFacts.v
@@ -0,0 +1,214 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ClassicalFacts.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Some facts and definitions about classical logic *)
+
+(** [prop_degeneracy] (also referred as propositional completeness) *)
+(*  asserts (up to consistency) that there are only two distinct formulas *)
+Definition prop_degeneracy := (A:Prop) A==True \/ A==False.
+
+(** [prop_extensionality] asserts equivalent formulas are equal *)
+Definition prop_extensionality := (A,B:Prop) (A<->B) -> A==B.
+
+(** [excluded_middle] asserts we can reason by case on the truth *)
+(*  or falsity of any formula *)
+Definition excluded_middle := (A:Prop) A \/ ~A.
+
+(** [proof_irrelevance] asserts equality of all proofs of a given formula *)
+Definition proof_irrelevance := (A:Prop)(a1,a2:A) a1==a2.
+
+(** We show [prop_degeneracy <-> (prop_extensionality /\ excluded_middle)] *)
+
+Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality.
+Proof.
+Intros H A B (Hab,Hba).
+NewDestruct (H A); NewDestruct (H B).
+  Rewrite H1; Exact H0.
+  Absurd B.
+    Rewrite H1; Exact [H]H.
+    Apply Hab; Rewrite H0; Exact I.
+  Absurd A.
+    Rewrite H0; Exact [H]H.
+    Apply Hba; Rewrite H1; Exact I.
+  Rewrite H1; Exact H0.
+Qed.
+
+Lemma prop_degen_em : prop_degeneracy -> excluded_middle.
+Proof.
+Intros H A.
+NewDestruct (H A).
+  Left; Rewrite H0; Exact I.
+  Right; Rewrite H0; Exact [x]x.
+Qed.
+
+Lemma prop_ext_em_degen :
+   prop_extensionality -> excluded_middle -> prop_degeneracy.
+Proof.
+Intros Ext EM A.
+NewDestruct (EM A).
+  Left; Apply (Ext A True); Split; [Exact [_]I | Exact [_]H].
+  Right; Apply (Ext A False); Split; [Exact H | Apply False_ind].
+Qed.
+
+(** We successively show that:
+
+   [prop_extensionality]
+     implies equality of [A] and [A->A] for inhabited [A], which 
+     implies the existence of a (trivial) retract from [A->A] to [A]
+        (just take the identity), which
+     implies the existence of a fixpoint operator in [A]
+        (e.g. take the Y combinator of lambda-calculus)
+*)
+
+Definition inhabited [A:Prop] := A.
+
+Lemma prop_ext_A_eq_A_imp_A :
+  prop_extensionality->(A:Prop)(inhabited A)->(A->A)==A.
+Proof.
+Intros Ext A a.
+Apply (Ext A->A A); Split; [ Exact [_]a | Exact [_;_]a ].
+Qed.
+
+Record retract [A,B:Prop] : Prop := {
+  f1: A->B;
+  f2: B->A;
+  f1_o_f2: (x:B)(f1 (f2 x))==x
+}.
+
+Lemma prop_ext_retract_A_A_imp_A :
+  prop_extensionality->(A:Prop)(inhabited A)->(retract A A->A).
+Proof.
+Intros Ext A a.
+Rewrite -> (prop_ext_A_eq_A_imp_A Ext A a).
+Exists [x:A]x [x:A]x.
+Reflexivity.
+Qed.
+
+Record has_fixpoint [A:Prop] : Prop := {
+  F : (A->A)->A;
+  fix : (f:A->A)(F f)==(f (F f))
+}.
+
+Lemma ext_prop_fixpoint :
+  prop_extensionality->(A:Prop)(inhabited A)->(has_fixpoint A).
+Proof.
+Intros Ext A a.
+Case (prop_ext_retract_A_A_imp_A Ext A a); Intros g1 g2 g1_o_g2.
+Exists [f]([x:A](f (g1 x x)) (g2 [x](f (g1 x x)))).
+Intro f.
+Pattern 1 (g1 (g2 [x:A](f (g1 x x)))).
+Rewrite (g1_o_g2 [x:A](f (g1 x x))).
+Reflexivity.
+Qed.
+
+(** Assume we have booleans with the property that there is at most 2
+    booleans (which is equivalent to dependent case analysis). Consider
+    the fixpoint of the negation function: it is either true or false by
+    dependent case analysis, but also the opposite by fixpoint. Hence
+    proof-irrelevance.
+
+    We then map bool proof-irrelevance to all propositions.
+*)
+
+Section Proof_irrelevance_gen.
+
+Variable bool : Prop.
+Variable true : bool.
+Variable false : bool.
+Hypothesis bool_elim : (C:Prop)C->C->bool->C.
+Hypothesis bool_elim_redl : (C:Prop)(c1,c2:C)c1==(bool_elim C c1 c2 true).
+Hypothesis bool_elim_redr : (C:Prop)(c1,c2:C)c2==(bool_elim C c1 c2 false).
+Local bool_dep_induction := (P:bool->Prop)(P true)->(P false)->(b:bool)(P b).
+
+Lemma aux : prop_extensionality -> bool_dep_induction -> true==false.
+Proof.
+Intros Ext Ind.
+Case (ext_prop_fixpoint Ext bool true); Intros G Gfix.
+Pose neg := [b:bool](bool_elim bool false true b).
+Generalize (refl_eqT ? (G neg)).
+Pattern 1 (G neg).
+Apply Ind with b:=(G neg); Intro Heq.
+Rewrite (bool_elim_redl bool false true).
+Change true==(neg true); Rewrite -> Heq; Apply Gfix.
+Rewrite (bool_elim_redr bool false true).
+Change (neg false)==false; Rewrite -> Heq; Symmetry; Apply Gfix.
+Qed.
+
+Lemma ext_prop_dep_proof_irrel_gen :
+  prop_extensionality -> bool_dep_induction -> proof_irrelevance.
+Proof.
+Intros Ext Ind A a1 a2.
+Pose f := [b:bool](bool_elim A a1 a2 b).
+Rewrite (bool_elim_redl A a1 a2).
+Change (f true)==a2.
+Rewrite (bool_elim_redr A a1 a2).
+Change (f true)==(f false).
+Rewrite (aux Ext Ind).
+Reflexivity.
+Qed.
+
+End Proof_irrelevance_gen.
+
+(** In the pure Calculus of Constructions, we can define the boolean
+    proposition bool = (C:Prop)C->C->C but we cannot prove that it has at
+    most 2 elements.
+*)
+
+Section Proof_irrelevance_CC.
+
+Definition BoolP  := (C:Prop)C->C->C.
+Definition TrueP  := [C][c1,c2]c1 : BoolP.
+Definition FalseP := [C][c1,c2]c2 : BoolP.
+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)
+  := [C;c1,c2](refl_eqT C c1).
+Definition BoolP_elim_redr : (C:Prop)(c1,c2:C)c2==(BoolP_elim C c1 c2 FalseP)
+  := [C;c1,c2](refl_eqT C c2).
+
+Definition BoolP_dep_induction := 
+ (P:BoolP->Prop)(P TrueP)->(P FalseP)->(b:BoolP)(P b).
+
+Lemma ext_prop_dep_proof_irrel_cc :
+  prop_extensionality -> BoolP_dep_induction -> proof_irrelevance.
+Proof (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim
+         BoolP_elim_redl BoolP_elim_redr).
+
+End Proof_irrelevance_CC.
+
+(** In the Calculus of Inductive Constructions, inductively defined booleans
+    enjoy dependent case analysis, hence directly proof-irrelevance from
+    propositional extensionality.
+*)
+
+Section Proof_irrelevance_CIC.
+
+Inductive boolP : Prop := trueP : boolP | falseP : boolP.
+Definition boolP_elim_redl : (C:Prop)(c1,c2:C)c1==(boolP_ind C c1 c2 trueP)
+  := [C;c1,c2](refl_eqT C c1).
+Definition boolP_elim_redr : (C:Prop)(c1,c2:C)c2==(boolP_ind C c1 c2 falseP)
+  := [C;c1,c2](refl_eqT C c2).
+Scheme boolP_indd := Induction for boolP Sort Prop.
+
+Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
+Proof [pe](ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind
+         boolP_elim_redl boolP_elim_redr pe boolP_indd).
+
+End Proof_irrelevance_CIC.
+
+(** Can we state proof irrelevance from propositional degeneracy
+  (i.e. propositional extensionality + excluded middle) without
+  dependent case analysis ?
+
+  Conjecture: it seems possible to build a model of CC interpreting
+  all non-empty types by the set of all lambda-terms. Such a model would
+  satisfy propositional degeneracy without satisfying proof-irrelevance
+  (nor dependent case analysis). This would imply that the previous
+  results cannot be refined.
+*)
diff --git a/theories7/Logic/Classical_Pred_Set.v b/theories7/Logic/Classical_Pred_Set.v
new file mode 100755
index 00000000..b1c26e6d
--- /dev/null
+++ b/theories7/Logic/Classical_Pred_Set.v
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Classical_Pred_Set.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Classical Predicate Logic on Set*)
+
+Require Classical_Prop.
+
+Section Generic.
+Variable U: Set.
+
+(** de Morgan laws for quantifiers *)
+
+Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EX n:U | ~(P n)).
+Proof.
+Unfold not; Intros P notall.
+Apply NNPP; Unfold not.
+Intro abs.
+Cut ((n:U)(P n)); Auto.
+Intro n; Apply NNPP.
+Unfold not; Intros.
+Apply abs; Exists n; Trivial.
+Qed.
+
+Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EX n:U |(P n)).
+Proof.
+Intros P H.
+Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
+Apply NNPP; Trivial.
+Qed.
+
+Lemma not_ex_all_not : (P:U->Prop) (~(EX n:U |(P n))) -> (n:U)~(P n).
+Proof.
+Unfold not; Intros P notex n abs.
+Apply notex.
+Exists n; Trivial.
+Qed. 
+
+Lemma not_ex_not_all : (P:U->Prop)(~(EX n:U | ~(P n))) -> (n:U)(P n).
+Proof.
+Intros P H n.
+Apply NNPP.
+Red; Intro K; Apply H; Exists n; Trivial.
+Qed.
+
+Lemma ex_not_not_all : (P:U->Prop) (EX n:U | ~(P n)) -> ~(n:U)(P n).
+Proof.
+Unfold not; Intros P exnot allP.
+Elim exnot; Auto.
+Qed.
+
+Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EX n:U |(P n)).
+Proof.
+Unfold not; Intros P allnot exP; Elim exP; Intros n p.
+Apply allnot with n; Auto.
+Qed.
+
+End Generic.
diff --git a/theories7/Logic/Classical_Pred_Type.v b/theories7/Logic/Classical_Pred_Type.v
new file mode 100755
index 00000000..69175ec7
--- /dev/null
+++ b/theories7/Logic/Classical_Pred_Type.v
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Classical_Pred_Type.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Classical Predicate Logic on Type *)
+
+Require Classical_Prop.
+
+Section Generic.
+Variable U: Type.
+
+(** de Morgan laws for quantifiers *)
+
+Lemma not_all_ex_not : (P:U->Prop)(~(n:U)(P n)) -> (EXT n:U | ~(P n)).
+Proof.
+Unfold not; Intros P notall.
+Apply NNPP; Unfold not.
+Intro abs.
+Cut ((n:U)(P n)); Auto.
+Intro n; Apply NNPP.
+Unfold not; Intros.
+Apply abs; Exists n; Trivial.
+Qed.
+
+Lemma not_all_not_ex : (P:U->Prop)(~(n:U)~(P n)) -> (EXT n:U | (P n)).
+Proof.
+Intros P H.
+Elim (not_all_ex_not [n:U]~(P n) H); Intros n Pn; Exists n.
+Apply NNPP; Trivial.
+Qed.
+
+Lemma not_ex_all_not : (P:U->Prop)(~(EXT n:U | (P n))) -> (n:U)~(P n).
+Proof.
+Unfold not; Intros P notex n abs.
+Apply notex.
+Exists n; Trivial.
+Qed. 
+
+Lemma not_ex_not_all : (P:U->Prop)(~(EXT n:U | ~(P n))) -> (n:U)(P n).
+Proof.
+Intros P H n.
+Apply NNPP.
+Red; Intro K; Apply H; Exists n; Trivial.
+Qed.
+
+Lemma ex_not_not_all : (P:U->Prop) (EXT n:U | ~(P n)) -> ~(n:U)(P n).
+Proof.
+Unfold not; Intros P exnot allP.
+Elim exnot; Auto.
+Qed.
+
+Lemma all_not_not_ex : (P:U->Prop) ((n:U)~(P n)) -> ~(EXT n:U | (P n)).
+Proof.
+Unfold not; Intros P allnot exP; Elim exP; Intros n p.
+Apply allnot with n; Auto.
+Qed.
+
+End Generic.
diff --git a/theories7/Logic/Classical_Prop.v b/theories7/Logic/Classical_Prop.v
new file mode 100755
index 00000000..1dc7ec57
--- /dev/null
+++ b/theories7/Logic/Classical_Prop.v
@@ -0,0 +1,85 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Classical_Prop.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Classical Propositional Logic *)
+
+Require ProofIrrelevance.
+
+Hints Unfold not : core.
+
+Axiom classic: (P:Prop)(P \/ ~(P)).
+
+Lemma NNPP : (p:Prop)~(~(p))->p.
+Proof.
+Unfold not; Intros; Elim (classic p); Auto.
+Intro NP; Elim (H NP).
+Qed.
+
+Lemma not_imply_elim : (P,Q:Prop)~(P->Q)->P.
+Proof.
+Intros; Apply NNPP; Red.
+Intro; Apply H; Intro; Absurd P; Trivial.
+Qed.
+
+Lemma not_imply_elim2 : (P,Q:Prop)~(P->Q) -> ~Q.
+Proof.
+Intros; Elim (classic Q); Auto.
+Qed.
+
+Lemma imply_to_or : (P,Q:Prop)(P->Q) -> ~P \/ Q.
+Proof.
+Intros; Elim (classic P); Auto.
+Qed.
+
+Lemma imply_to_and : (P,Q:Prop)~(P->Q) -> P /\ ~Q.
+Proof.
+Intros; Split.
+Apply not_imply_elim with Q;  Trivial.
+Apply not_imply_elim2 with P; Trivial.
+Qed.
+
+Lemma or_to_imply : (P,Q:Prop)(~P \/ Q) -> P->Q.
+Proof.
+Induction 1; Auto.
+Intros H1 H2; Elim (H1 H2).
+Qed.
+
+Lemma not_and_or : (P,Q:Prop)~(P/\Q)-> ~P \/ ~Q.
+Proof.
+Intros; Elim (classic P); Auto.
+Qed.
+
+Lemma or_not_and : (P,Q:Prop)(~P \/ ~Q) -> ~(P/\Q).
+Proof.
+Induction 1; Red; Induction 2; Auto.
+Qed.
+
+Lemma not_or_and : (P,Q:Prop)~(P\/Q)-> ~P /\ ~Q.
+Proof.
+Intros; Elim (classic P); Auto.
+Qed.
+
+Lemma and_not_or : (P,Q:Prop)(~P /\ ~Q) -> ~(P\/Q).
+Proof.
+Induction 1; Red; Induction 3; Trivial.
+Qed.
+
+Lemma imply_and_or: (P,Q:Prop)(P->Q) -> P \/ Q -> Q.
+Proof.
+Induction 2; Trivial.
+Qed.
+
+Lemma imply_and_or2: (P,Q,R:Prop)(P->Q) -> P \/ R -> Q \/ R.
+Proof.
+Induction 2; Auto.
+Qed.
+
+Lemma proof_irrelevance: (P:Prop)(p1,p2:P)p1==p2.
+Proof (proof_irrelevance_cci classic).
diff --git a/theories7/Logic/Classical_Type.v b/theories7/Logic/Classical_Type.v
new file mode 100755
index 00000000..e34170cd
--- /dev/null
+++ b/theories7/Logic/Classical_Type.v
@@ -0,0 +1,14 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Classical_Type.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** Classical Logic for Type *)
+
+Require Export Classical_Prop.
+Require Export Classical_Pred_Type.
diff --git a/theories7/Logic/Decidable.v b/theories7/Logic/Decidable.v
new file mode 100644
index 00000000..537b5e88
--- /dev/null
+++ b/theories7/Logic/Decidable.v
@@ -0,0 +1,58 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i 	$Id: Decidable.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $	 i*)
+
+(** Properties of decidable propositions *)
+
+Definition decidable := [P:Prop] P \/ ~P.
+
+Theorem dec_not_not : (P:Prop)(decidable P) -> (~P -> False) -> P.
+Unfold decidable; Tauto. 
+Qed.
+
+Theorem dec_True: (decidable True).
+Unfold decidable; Auto.
+Qed.
+
+Theorem dec_False: (decidable False).
+Unfold decidable not; Auto.
+Qed.
+
+Theorem dec_or: (A,B:Prop)(decidable A) -> (decidable B) -> (decidable (A\/B)).
+Unfold decidable; Tauto. 
+Qed.
+
+Theorem dec_and: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A/\B)).
+Unfold decidable; Tauto. 
+Qed.
+
+Theorem dec_not: (A:Prop)(decidable A) -> (decidable ~A).
+Unfold decidable; Tauto. 
+Qed.
+
+Theorem dec_imp: (A,B:Prop)(decidable A) -> (decidable B) ->(decidable (A->B)).
+Unfold decidable; Tauto. 
+Qed.
+
+Theorem not_not : (P:Prop)(decidable P) -> (~(~P)) -> P.
+Unfold decidable; Tauto. Qed.
+
+Theorem not_or : (A,B:Prop) ~(A\/B) -> ~A /\ ~B.
+Tauto. Qed.
+
+Theorem not_and : (A,B:Prop) (decidable A) -> ~(A/\B) -> ~A \/ ~B.
+Unfold decidable; Tauto. Qed.
+
+Theorem not_imp : (A,B:Prop) (decidable A) -> ~(A -> B) -> A /\ ~B.
+Unfold decidable;Tauto.
+Qed.
+
+Theorem imp_simp : (A,B:Prop) (decidable A) -> (A -> B) -> ~A \/ B.
+Unfold decidable; Tauto.
+Qed.
+
diff --git a/theories7/Logic/Diaconescu.v b/theories7/Logic/Diaconescu.v
new file mode 100644
index 00000000..9f5f91a0
--- /dev/null
+++ b/theories7/Logic/Diaconescu.v
@@ -0,0 +1,133 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Diaconescu.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(* R. Diaconescu [Diaconescu] showed that the Axiom of Choice in Set Theory
+   entails Excluded-Middle; S. Lacas and B. Werner [LacasWerner]
+   adapted the proof to show that the axiom of choice in equivalence
+   classes entails Excluded-Middle in Type Theory.
+
+   This is an adaptatation of the proof by Hugo Herbelin to show that
+   the relational form of the Axiom of Choice + Extensionality for
+   predicates entails Excluded-Middle
+
+   [Diaconescu] R. Diaconescu, Axiom of Choice and Complementation, in
+   Proceedings of AMS, vol 51, pp 176-178, 1975.
+
+   [LacasWerner] S. Lacas, B Werner, Which Choices imply the excluded middle?,
+   preprint, 1999.
+
+*)
+
+Section PredExt_GuardRelChoice_imp_EM.
+
+(* The axiom of extensionality for predicates *)
+
+Definition PredicateExtensionality :=
+   (P,Q:bool->Prop)((b:bool)(P b)<->(Q b))->P==Q.
+
+(* From predicate extensionality we get propositional extensionality
+   hence proof-irrelevance *)
+
+Require ClassicalFacts.
+
+Variable pred_extensionality : PredicateExtensionality.
+  
+Lemma prop_ext : (A,B:Prop) (A<->B) -> A==B.
+Proof.
+  Intros A B H.
+  Change ([_]A true)==([_]B true).
+  Rewrite pred_extensionality with P:=[_:bool]A Q:=[_:bool]B.
+    Reflexivity.
+    Intros _; Exact H.
+Qed.
+
+Lemma proof_irrel : (A:Prop)(a1,a2:A) a1==a2.
+Proof.
+  Apply (ext_prop_dep_proof_irrel_cic prop_ext).
+Qed.
+
+(* From proof-irrelevance and relational choice, we get guarded
+   relational choice *)
+
+Require ChoiceFacts.
+
+Variable rel_choice : RelationalChoice.
+
+Lemma guarded_rel_choice :
+  (A:Type)(B:Type)(P:A->Prop)(R:A->B->Prop)
+  ((x:A)(P x)->(EX y:B|(R x y)))->
+    (EXT R':A->B->Prop | 
+      ((x:A)(P x)->(EX y:B|(R x y)/\(R' x y)/\ ((y':B)(R' x y') -> y=y')))).
+Proof.
+  Exact
+    (rel_choice_and_proof_irrel_imp_guarded_rel_choice rel_choice proof_irrel).
+Qed.
+
+(* The form of choice we need: there is a functional relation which chooses
+   an element in any non empty subset of bool *)
+
+Require Bool.
+
+Lemma AC :
+  (EXT R:(bool->Prop)->bool->Prop |
+     (P:bool->Prop)(EX b : bool | (P b))->
+        (EX b : bool | (P b) /\ (R P b) /\ ((b':bool)(R P b')->b=b'))).
+Proof.
+  Apply guarded_rel_choice with
+    P:= [Q:bool->Prop](EX y | (Q y)) R:=[Q:bool->Prop;y:bool](Q y).
+  Exact [_;H]H.
+Qed.
+
+(* The proof of the excluded middle *)
+(* Remark: P could have been in Set or Type *)
+
+Theorem pred_ext_and_rel_choice_imp_EM : (P:Prop)P\/~P.
+Proof.
+Intro P.
+
+(* first we exhibit the choice functional relation R *)
+NewDestruct AC as [R H].
+
+Pose class_of_true := [b]b=true\/P.
+Pose class_of_false := [b]b=false\/P.
+
+(* the actual "decision": is (R class_of_true) = true or false? *)
+NewDestruct (H class_of_true) as [b0 [H0 [H0' H0'']]].
+Exists true; Left; Reflexivity.
+NewDestruct H0.
+
+(* the actual "decision": is (R class_of_false) = true or false? *)
+NewDestruct (H class_of_false) as [b1 [H1 [H1' H1'']]].
+Exists false; Left; Reflexivity.
+NewDestruct H1.
+
+(* case where P is false: (R class_of_true)=true /\ (R class_of_false)=false *)
+Right.
+Intro HP.
+Assert Hequiv:(b:bool)(class_of_true b)<->(class_of_false b).
+Intro b; Split.
+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.
+Rewrite <- H0.
+Rewrite <- H1.
+Rewrite <- H0''. Reflexivity.
+Rewrite Heq.
+Assumption.
+
+(* cases where P is true *)
+Left; Assumption.
+Left; Assumption.
+
+Qed.
+
+End PredExt_GuardRelChoice_imp_EM.
diff --git a/theories7/Logic/Eqdep.v b/theories7/Logic/Eqdep.v
new file mode 100755
index 00000000..fc2dfe52
--- /dev/null
+++ b/theories7/Logic/Eqdep.v
@@ -0,0 +1,183 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Eqdep.v,v 1.2.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** This file defines dependent equality and shows its equivalence with
+    equality on dependent pairs (inhabiting sigma-types). It axiomatizes
+    the invariance by substitution of reflexive equality proofs and 
+    shows the equivalence between the 4 following statements
+
+    - Invariance by Substitution of Reflexive Equality Proofs.
+    - Injectivity of Dependent Equality
+    - Uniqueness of Identity Proofs
+    - Uniqueness of Reflexive Identity Proofs
+    - Streicher's Axiom K
+
+  These statements are independent of the calculus of constructions [2].
+
+  References:
+
+  [1] T. Streicher, Semantical Investigations into Intensional Type Theory,
+      Habilitationsschrift, LMU München, 1993.
+  [2] M. Hofmann, T. Streicher, The groupoid interpretation of type theory,
+      Proceedings of the meeting Twenty-five years of constructive
+      type theory, Venice, Oxford University Press, 1998
+*)
+
+Section Dependent_Equality.
+
+Variable U : Type.
+Variable P : U->Type.
+
+(** Dependent equality *)
+
+Inductive eq_dep [p:U;x:(P p)] : (q:U)(P q)->Prop :=
+   eq_dep_intro : (eq_dep p x p x).
+Hint constr_eq_dep : core v62 := Constructors eq_dep.
+
+Lemma eq_dep_sym : (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep q y p x).
+Proof.
+NewDestruct 1; Auto.
+Qed.
+Hints Immediate eq_dep_sym : core v62.
+
+Lemma eq_dep_trans : (p,q,r:U)(x:(P p))(y:(P q))(z:(P r))
+     (eq_dep p x q y)->(eq_dep q y r z)->(eq_dep p x r z).
+Proof.
+NewDestruct 1; Auto.
+Qed.
+
+Inductive eq_dep1 [p:U;x:(P p);q:U;y:(P q)] : Prop :=
+   eq_dep1_intro : (h:q=p)
+                  (x=(eq_rect U q P y p h))->(eq_dep1 p x q y).
+
+Scheme eq_indd := Induction for eq Sort Prop.
+
+Lemma eq_dep1_dep :
+      (p:U)(x:(P p))(q:U)(y:(P q))(eq_dep1 p x q y)->(eq_dep p x q y).
+Proof.
+NewDestruct 1 as [eq_qp H].
+NewDestruct eq_qp using eq_indd.
+Rewrite H.
+Apply eq_dep_intro.
+Qed.
+
+Lemma eq_dep_dep1 : 
+  (p,q:U)(x:(P p))(y:(P q))(eq_dep p x q y)->(eq_dep1 p x q y).
+Proof.
+NewDestruct 1.
+Apply eq_dep1_intro with (refl_equal U p).
+Simpl; Trivial.
+Qed.
+
+(** Invariance by Substitution of Reflexive Equality Proofs *)
+
+Axiom eq_rect_eq : (p:U)(Q:U->Type)(x:(Q p))(h:p=p)
+                  x=(eq_rect U p Q x p h).
+
+(** Injectivity of Dependent Equality is a consequence of *)
+(** Invariance by Substitution of Reflexive Equality Proof *)
+
+Lemma eq_dep1_eq : (p:U)(x,y:(P p))(eq_dep1 p x p y)->x=y.
+Proof.
+Destruct 1; Intro.
+Rewrite <- eq_rect_eq; Auto.
+Qed.
+
+Lemma eq_dep_eq : (p:U)(x,y:(P p))(eq_dep p x p y)->x=y.
+Proof.
+Intros; Apply eq_dep1_eq; Apply eq_dep_dep1; Trivial.
+Qed.
+
+End Dependent_Equality.
+
+(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
+(** Injectivity of Dependent Equality *)
+
+Lemma UIP : (U:Type)(x,y:U)(p1,p2:x=y)p1=p2.
+Proof.
+Intros; Apply eq_dep_eq with P:=[y]x=y.
+Elim p2 using eq_indd.
+Elim p1 using eq_indd.
+Apply eq_dep_intro.
+Qed.
+
+(** Uniqueness of Reflexive Identity Proofs is a direct instance of UIP *)
+
+Lemma UIP_refl : (U:Type)(x:U)(p:x=x)p=(refl_equal U x).
+Proof.
+Intros; Apply UIP.
+Qed.
+
+(** Streicher axiom K is a direct consequence of Uniqueness of
+    Reflexive Identity Proofs *)
+
+Lemma Streicher_K : (U:Type)(x:U)(P:x=x->Prop)
+  (P (refl_equal ? x))->(p:x=x)(P p).
+Proof.
+Intros; Rewrite UIP_refl; Assumption.
+Qed.
+
+(** We finally recover eq_rec_eq (alternatively eq_rect_eq) from K *)
+
+Lemma eq_rec_eq : (U:Type)(P:U->Set)(p:U)(x:(P p))(h:p=p)
+  x=(eq_rec U p P x p h).
+Proof.
+Intros.
+Apply Streicher_K with p:=h.
+Reflexivity.
+Qed.
+
+(** Dependent equality is equivalent to equality on dependent pairs *)
+
+Lemma equiv_eqex_eqdep : (U:Set)(P:U->Set)(p,q:U)(x:(P p))(y:(P q)) 
+    (existS U P p x)=(existS U P q y) <-> (eq_dep U P p x q y).
+Proof.
+Split. 
+(* -> *)
+Intro H.
+Change p with   (projS1 U P (existS U P p x)).
+Change 2 x with (projS2 U P (existS U P p x)).
+Rewrite H.
+Apply eq_dep_intro.
+(* <- *)
+NewDestruct 1; Reflexivity.
+Qed.
+
+(** UIP implies the injectivity of equality on dependent pairs *)
+
+Lemma inj_pair2: (U:Set)(P:U->Set)(p:U)(x,y:(P p))
+    (existS U P p x)=(existS U P p y)-> x=y.
+Proof.
+Intros.
+Apply (eq_dep_eq U P).
+Generalize (equiv_eqex_eqdep U P p p x y) .
+Induction 1.
+Intros.
+Auto.
+Qed.
+
+(** UIP implies the injectivity of equality on dependent pairs *)
+
+Lemma inj_pairT2: (U:Type)(P:U->Type)(p:U)(x,y:(P p))
+    (existT U P p x)=(existT U P p y)-> x=y.
+Proof.
+Intros.
+Apply (eq_dep_eq U P).
+Change 1 p with (projT1 U P (existT U P p x)).
+Change 2 x with (projT2 U P (existT U P p x)).
+Rewrite H.
+Apply eq_dep_intro.
+Qed.
+
+(** The main results to be exported *)
+
+Hints Resolve eq_dep_intro eq_dep_eq : core v62.
+Hints Immediate eq_dep_sym : core v62.
+Hints Resolve inj_pair2 inj_pairT2 : core.
diff --git a/theories7/Logic/Eqdep_dec.v b/theories7/Logic/Eqdep_dec.v
new file mode 100644
index 00000000..959395e3
--- /dev/null
+++ b/theories7/Logic/Eqdep_dec.v
@@ -0,0 +1,149 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Eqdep_dec.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** We prove that there is only one proof of [x=x], i.e [(refl_equal ? 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.
+
+   Author:   Thomas Kleymann |<tms@dcs.ed.ac.uk>| in Lego
+             adapted to Coq by B. Barras
+
+   Credit:   Proofs up to [K_dec] follows an outline by Michael Hedberg
+*)
+
+
+(** We need some dependent elimination schemes *)
+
+Set Implicit Arguments.
+
+  (** Bijection between [eq] and [eqT] *)
+  Definition eq2eqT: (A:Set)(x,y:A)x=y->x==y :=
+    [A,x,_,eqxy]<[y:A]x==y>Cases eqxy of refl_equal => (refl_eqT ? x) end.
+
+  Definition eqT2eq: (A:Set)(x,y:A)x==y->x=y :=
+    [A,x,_,eqTxy]<[y:A]x=y>Cases eqTxy of refl_eqT => (refl_equal ? x) end.
+
+  Lemma eq_eqT_bij: (A:Set)(x,y:A)(p:x=y)p==(eqT2eq (eq2eqT p)).
+Intros.
+Case p; Reflexivity.
+Qed.
+
+  Lemma eqT_eq_bij: (A:Set)(x,y:A)(p:x==y)p==(eq2eqT (eqT2eq p)).
+Intros.
+Case p; Reflexivity.
+Qed.
+
+
+Section DecidableEqDep.
+
+  Variable A: Type.
+
+  Local comp [x,y,y':A]: x==y->x==y'->y==y' :=
+    [eq1,eq2](eqT_ind ? ? [a]a==y' eq2 ? eq1).
+
+  Remark trans_sym_eqT: (x,y:A)(u:x==y)(comp u u)==(refl_eqT ? y).
+Intros.
+Case u; Trivial.
+Qed.
+
+
+
+  Variable eq_dec: (x,y:A) x==y \/ ~x==y.
+
+  Variable x: A.
+
+
+  Local nu [y:A]: x==y->x==y :=
+    [u]Cases (eq_dec x y) of
+       (or_introl eqxy)  => eqxy
+     | (or_intror neqxy) => (False_ind ? (neqxy u))
+     end.
+
+  Local nu_constant : (y:A)(u,v:x==y) (nu u)==(nu v).
+Intros.
+Unfold nu.
+Case (eq_dec x y); Intros.
+Reflexivity.
+
+Case n; Trivial.
+Qed.
+
+
+  Local nu_inv [y:A]: x==y->x==y := [v](comp (nu (refl_eqT ? x)) v).
+
+
+  Remark nu_left_inv : (y:A)(u:x==y) (nu_inv (nu u))==u.
+Intros.
+Case u; Unfold nu_inv.
+Apply trans_sym_eqT.
+Qed.
+
+
+  Theorem eq_proofs_unicity: (y:A)(p1,p2:x==y) p1==p2.
+Intros.
+Elim nu_left_inv with u:=p1.
+Elim nu_left_inv with u:=p2.
+Elim nu_constant with y p1 p2.
+Reflexivity.
+Qed.
+
+  Theorem K_dec: (P:x==x->Prop)(P (refl_eqT ? x)) -> (p:x==x)(P p).
+Intros.
+Elim eq_proofs_unicity with x (refl_eqT ? x) p.
+Trivial.
+Qed.
+
+
+  (** The corollary *)
+
+  Local proj: (P:A->Prop)(ExT P)->(P x)->(P x) :=
+    [P,exP,def]Cases exP of
+      (exT_intro x' prf) =>
+        Cases (eq_dec x' x) of
+          (or_introl eqprf) => (eqT_ind ? x' P prf x eqprf)
+        | _ => def
+        end
+      end.
+
+
+  Theorem inj_right_pair: (P:A->Prop)(y,y':(P x))
+    (exT_intro ? P x y)==(exT_intro ? P x y') -> y==y'.
+Intros.
+Cut (proj (exT_intro A P x y) y)==(proj (exT_intro A P x y') y).
+Simpl.
+Case (eq_dec x x).
+Intro e.
+Elim e using K_dec; Trivial.
+
+Intros.
+Case n; Trivial.
+
+Case H.
+Reflexivity.
+Qed.
+
+End DecidableEqDep.
+
+  (** We deduce the [K] axiom for (decidable) Set *)
+  Theorem K_dec_set: (A:Set)((x,y:A){x=y}+{~x=y})
+                       ->(x:A)(P: x=x->Prop)(P (refl_equal ? x))
+                         ->(p:x=x)(P p).
+Intros.
+Rewrite eq_eqT_bij.
+Elim (eq2eqT p) using K_dec.
+Intros.
+Case (H x0 y); Intros.
+Elim e; Left ; Reflexivity.
+
+Right ; Red; Intro neq; Apply n; Elim neq; Reflexivity.
+
+Trivial.
+Qed.
diff --git a/theories7/Logic/Hurkens.v b/theories7/Logic/Hurkens.v
new file mode 100644
index 00000000..066e51aa
--- /dev/null
+++ b/theories7/Logic/Hurkens.v
@@ -0,0 +1,79 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*                              Hurkens.v                               *)
+(************************************************************************)
+
+(** This is Hurkens paradox [Hurkens] in system U-, adapted by Herman
+    Geuvers [Geuvers] to show the inconsistency in the pure calculus of
+    constructions of a retract from Prop into a small type.
+
+    References:
+
+    - [Hurkens] A. J. Hurkens, "A simplification of Girard's paradox",
+      Proceedings of the 2nd international conference Typed Lambda-Calculi
+      and Applications (TLCA'95), 1995.
+
+    - [Geuvers] "Inconsistency of Classical Logic in Type Theory", 2001
+      (see www.cs.kun.nl/~herman/note.ps.gz).
+*)
+
+Section Paradox.
+
+Variable bool : Prop.
+Variable p2b : Prop -> bool.
+Variable b2p : bool -> Prop.
+Hypothesis p2p1 : (A:Prop)(b2p (p2b A))->A.
+Hypothesis p2p2 : (A:Prop)A->(b2p (p2b A)).
+Variable B:Prop.
+
+Definition V := (A:Prop)((A->bool)->(A->bool))->(A->bool).
+Definition U := V->bool.
+Definition sb : V -> V := [z][A;r;a](r (z A r) a).
+Definition le : (U->bool)->(U->bool) := [i][x](x [A;r;a](i [v](sb v A r a))).
+Definition induct : (U->bool)->Prop := [i](x:U)(b2p (le i x))->(b2p (i x)).
+Definition WF : U := [z](p2b (induct (z U le))).
+Definition I : U->Prop :=
+  [x]((i:U->bool)(b2p (le i x))->(b2p (i [v](sb v U le x))))->B.
+
+Lemma Omega : (i:U->bool)(induct i)->(b2p (i WF)).
+Proof.
+Intros i y.
+Apply y.
+Unfold le WF induct.
+Apply p2p2.
+Intros x H0.
+Apply y.
+Exact H0.
+Qed.
+
+Lemma lemma1 : (induct [u](p2b (I u))).
+Proof.
+Unfold induct.
+Intros x p.
+Apply (p2p2 (I x)).
+Intro q.
+Apply (p2p1 (I [v:V](sb v U le x)) (q [u](p2b (I u)) p)).
+Intro i.
+Apply q with i:=[y:?](i [v:V](sb v U le y)).
+Qed.
+
+Lemma lemma2 : ((i:U->bool)(induct i)->(b2p (i WF)))->B.
+Proof.
+Intro x.
+Apply (p2p1 (I WF) (x [u](p2b (I u)) lemma1)).
+Intros i H0.
+Apply (x [y](i [v](sb v U le y))).
+Apply (p2p1 ? H0).
+Qed.
+
+Theorem paradox : B.
+Proof.
+Exact (lemma2 Omega).
+Qed.
+
+End Paradox.
diff --git a/theories7/Logic/JMeq.v b/theories7/Logic/JMeq.v
new file mode 100644
index 00000000..38dfa5e6
--- /dev/null
+++ b/theories7/Logic/JMeq.v
@@ -0,0 +1,64 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: JMeq.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(** John Major's Equality as proposed by C. Mc Bride *)
+
+Set Implicit Arguments.
+
+Inductive JMeq [A:Set;x:A] : (B:Set)B->Prop := 
+	JMeq_refl : (JMeq x x).
+Reset JMeq_ind.
+
+Hints Resolve JMeq_refl.
+
+Lemma sym_JMeq : (A,B:Set)(x:A)(y:B)(JMeq x y)->(JMeq y x).
+NewDestruct 1; Trivial.
+Qed.
+
+Hints Immediate sym_JMeq.
+
+Lemma trans_JMeq : (A,B,C:Set)(x:A)(y:B)(z:C)
+	(JMeq x y)->(JMeq y z)->(JMeq x z).
+NewDestruct 1; Trivial.
+Qed.
+
+Axiom JMeq_eq : (A:Set)(x,y:A)(JMeq x y)->(x=y).
+
+Lemma JMeq_ind : (A:Set)(x,y:A)(P:A->Prop)(P x)->(JMeq x y)->(P y).
+Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
+Qed.
+
+Lemma JMeq_rec : (A:Set)(x,y:A)(P:A->Set)(P x)->(JMeq x y)->(P y).
+Intros A x y P H H'; Case JMeq_eq with 1:=H'; Trivial.
+Qed.
+
+Lemma JMeq_ind_r : (A:Set)(x,y:A)(P:A->Prop)(P y)->(JMeq x y)->(P x).
+Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
+Qed.
+
+Lemma JMeq_rec_r : (A:Set)(x,y:A)(P:A->Set)(P y)->(JMeq x y)->(P x).
+Intros A x y P H H'; Case JMeq_eq with 1:=(sym_JMeq H'); Trivial.
+Qed.
+
+(** [JMeq] is equivalent to [(eq_dep Set [X]X)] *)
+
+Require Eqdep.
+
+Lemma JMeq_eq_dep : (A,B:Set)(x:A)(y:B)(JMeq x y)->(eq_dep Set [X]X A x B y).
+Proof.
+NewDestruct 1.
+Apply eq_dep_intro.
+Qed.
+
+Lemma eq_dep_JMeq : (A,B:Set)(x:A)(y:B)(eq_dep Set [X]X A x B y)->(JMeq x y).
+Proof.
+NewDestruct 1.
+Apply JMeq_refl. 
+Qed.
diff --git a/theories7/Logic/ProofIrrelevance.v b/theories7/Logic/ProofIrrelevance.v
new file mode 100644
index 00000000..3f031ff7
--- /dev/null
+++ b/theories7/Logic/ProofIrrelevance.v
@@ -0,0 +1,113 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(** This is a proof in the pure Calculus of Construction that
+    classical logic in Prop + dependent elimination of disjunction entails
+    proof-irrelevance.
+
+    Since, dependent elimination is derivable in the Calculus of
+    Inductive Constructions (CCI), we get proof-irrelevance from classical
+    logic in the CCI.
+
+    Reference:
+
+    - [Coquand] T. Coquand, "Metamathematical Investigations of a
+      Calculus of Constructions", Proceedings of Logic in Computer Science
+      (LICS'90), 1990.
+
+    Proof skeleton: classical logic + dependent elimination of
+    disjunction + discrimination of proofs implies the existence of a
+    retract from Prop into bool, hence inconsistency by encoding any
+    paradox of system U- (e.g. Hurkens' paradox).
+*)
+
+Require Hurkens.
+
+Section Proof_irrelevance_CC.
+
+Variable or : Prop -> Prop -> Prop.
+Variable or_introl : (A,B:Prop)A->(or A B).
+Variable or_intror : (A,B:Prop)B->(or A B).
+Hypothesis or_elim : (A,B:Prop)(C:Prop)(A->C)->(B->C)->(or A B)->C.
+Hypothesis or_elim_redl :
+  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
+  (f a)==(or_elim A B C f g (or_introl A B a)).
+Hypothesis or_elim_redr :
+  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
+  (g b)==(or_elim A B C f g (or_intror A B b)).
+Hypothesis or_dep_elim :
+ (A,B:Prop)(P:(or A B)->Prop)
+ ((a:A)(P (or_introl A B a))) ->
+ ((b:B)(P (or_intror A B b))) -> (b:(or A B))(P b).
+
+Hypothesis em : (A:Prop)(or A ~A).
+Variable B : Prop.
+Variable b1,b2 : B.
+
+(** [p2b] and [b2p] form a retract if [~b1==b2] *)
+
+Definition p2b [A] := (or_elim A ~A B [_]b1 [_]b2 (em A)).
+Definition b2p [b] := b1==b.
+
+Lemma p2p1 : (A:Prop) A -> (b2p (p2b A)).
+Proof.
+  Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
+  Apply (or_elim_redl A ~A B [_]b1 [_]b2).
+  NewDestruct (b H).
+Qed.
+Lemma p2p2 :  ~b1==b2->(A:Prop) (b2p (p2b A)) -> A.
+Proof.
+  Intro not_eq_b1_b2.
+  Unfold p2b; Intro A; Apply or_dep_elim with b:=(em A); Unfold b2p; Intros.
+  Assumption.
+  NewDestruct not_eq_b1_b2.
+  Rewrite <- (or_elim_redr A ~A B [_]b1 [_]b2) in H.
+  Assumption.
+Qed.
+
+(** Using excluded-middle a second time, we get proof-irrelevance *)
+
+Theorem proof_irrelevance_cc : b1==b2.
+Proof.
+  Refine (or_elim ? ? ? ? ? (em b1==b2));Intro H.
+    Trivial.
+  Apply (paradox B p2b b2p (p2p2 H) p2p1).
+Qed.
+
+End Proof_irrelevance_CC.
+
+
+(** The Calculus of Inductive Constructions (CCI) enjoys dependent
+    elimination, hence classical logic in CCI entails proof-irrelevance.
+*)
+
+Section Proof_irrelevance_CCI.
+
+Hypothesis em : (A:Prop) A \/ ~A.
+
+Definition or_elim_redl :
+  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(a:A)
+  (f a)==(or_ind A B C f g (or_introl A B a))
+  := [A,B,C;f;g;a](refl_eqT C (f a)).
+Definition or_elim_redr :
+  (A,B:Prop)(C:Prop)(f:A->C)(g:B->C)(b:B)
+  (g b)==(or_ind A B C f g (or_intror A B b))
+  := [A,B,C;f;g;b](refl_eqT C (g b)).
+Scheme or_indd := Induction for or Sort Prop.
+
+Theorem proof_irrelevance_cci : (B:Prop)(b1,b2:B)b1==b2.
+Proof
+  (proof_irrelevance_cc or or_introl or_intror or_ind
+     or_elim_redl or_elim_redr or_indd em).
+
+End Proof_irrelevance_CCI.
+
+(** Remark: in CCI, [bool] can be taken in [Set] as well in the
+    paradox and since [~true=false] for [true] and [false] in
+    [bool], we get the inconsistency of [em : (A:Prop){A}+{~A}] in CCI
+*)
diff --git a/theories7/Logic/RelationalChoice.v b/theories7/Logic/RelationalChoice.v
new file mode 100644
index 00000000..e61f3582
--- /dev/null
+++ b/theories7/Logic/RelationalChoice.v
@@ -0,0 +1,17 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: RelationalChoice.v,v 1.1.2.1 2004/07/16 19:31:29 herbelin Exp $ i*)
+
+(* This file axiomatizes the relational form of the axiom of choice *)
+
+Axiom relational_choice :
+ (A:Type;B:Type;R: A->B->Prop) 
+  ((x:A)(EX y:B|(R x y)))
+   -> (EXT R':A->B->Prop | 
+         ((x:A)(EX y:B|(R x y)/\(R' x y)/\ ((y':B) (R' x y') -> y=y')))).
diff --git a/theories7/NArith/BinNat.v b/theories7/NArith/BinNat.v
new file mode 100644
index 00000000..5e04e22e
--- /dev/null
+++ b/theories7/NArith/BinNat.v
@@ -0,0 +1,205 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: BinNat.v,v 1.1.2.1 2004/07/16 19:31:30 herbelin Exp $ i*)
+
+Require BinPos.
+
+(**********************************************************************)
+(** Binary natural numbers *)
+
+Inductive entier: Set := Nul : entier | Pos : positive -> entier.
+
+(** Declare binding key for scope positive_scope *)
+
+Delimits Scope N_scope with N.
+
+(** Automatically open scope N_scope for the constructors of N *)
+
+Bind Scope N_scope with entier.
+Arguments Scope Pos [ N_scope ].
+
+Open Local Scope N_scope.
+
+(** Operation x -> 2*x+1 *)
+
+Definition Un_suivi_de := [x]
+  Cases x of Nul => (Pos xH) | (Pos p) => (Pos (xI p)) end.
+
+(** Operation x -> 2*x *)
+
+Definition Zero_suivi_de :=
+  [n] Cases n of Nul => Nul | (Pos p) => (Pos (xO p)) end.
+
+(** Successor *)
+
+Definition Nsucc :=
+  [n] Cases n of Nul => (Pos xH) | (Pos p) => (Pos (add_un p)) end.
+
+(** Addition *)
+
+Definition Nplus := [n,m]
+  Cases n m of
+  | Nul     _       => m
+  | _       Nul     => n
+  | (Pos p) (Pos q) => (Pos (add p q))
+  end.
+
+V8Infix "+" Nplus : N_scope.
+
+(** Multiplication *)
+
+Definition Nmult := [n,m]
+  Cases n m of
+  | Nul     _       => Nul
+  | _       Nul     => Nul
+  | (Pos p) (Pos q) => (Pos (times p q))
+  end.
+
+V8Infix "*" Nmult : N_scope.
+
+(** Order *)
+
+Definition Ncompare := [n,m]
+  Cases n m of
+  | Nul      Nul      => EGAL
+  | Nul      (Pos m') => INFERIEUR
+  | (Pos n') Nul      => SUPERIEUR
+  | (Pos n') (Pos m') => (compare n' m' EGAL)
+  end.
+
+V8Infix "?=" Ncompare (at level 70, no associativity) : N_scope.
+
+(** Peano induction on binary natural numbers *)
+
+Theorem Nind : (P:(entier ->Prop))
+  (P Nul) ->((n:entier)(P n) ->(P (Nsucc n))) ->(n:entier)(P n).
+Proof.
+NewDestruct n.
+  Assumption.
+  Apply Pind with P := [p](P (Pos p)).
+Exact (H0 Nul H).
+Intro p'; Exact (H0 (Pos p')).
+Qed.
+
+(** Properties of addition *)
+
+Theorem Nplus_0_l : (n:entier)(Nplus Nul n)=n.
+Proof.
+Reflexivity.
+Qed.
+
+Theorem Nplus_0_r : (n:entier)(Nplus n Nul)=n.
+Proof.
+NewDestruct n; Reflexivity.
+Qed.
+
+Theorem Nplus_comm : (n,m:entier)(Nplus n m)=(Nplus m n).
+Proof.
+Intros.
+NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
+Rewrite add_sym; Reflexivity.
+Qed.
+
+Theorem Nplus_assoc : 
+  (n,m,p:entier)(Nplus n (Nplus m p))=(Nplus (Nplus n m) p).
+Proof.
+Intros.
+NewDestruct n; Try Reflexivity.
+NewDestruct m; Try Reflexivity.
+NewDestruct p; Try Reflexivity.
+Simpl; Rewrite add_assoc; Reflexivity.
+Qed.
+
+Theorem Nplus_succ : (n,m:entier)(Nplus (Nsucc n) m)=(Nsucc (Nplus n m)).
+Proof.
+NewDestruct n; NewDestruct m.
+  Simpl; Reflexivity.
+  Unfold Nsucc Nplus; Rewrite <- ZL12bis; Reflexivity.
+  Simpl; Reflexivity.
+  Simpl; Rewrite ZL14bis; Reflexivity.
+Qed.
+
+Theorem Nsucc_inj : (n,m:entier)(Nsucc n)=(Nsucc m)->n=m.
+Proof.
+NewDestruct n; NewDestruct m; Simpl; Intro H; 
+  Reflexivity Orelse Injection H; Clear H; Intro H.
+  Symmetry in H; Contradiction add_un_not_un with p.
+  Contradiction add_un_not_un with p.
+  Rewrite add_un_inj with 1:=H; Reflexivity.
+Qed.
+
+Theorem Nplus_reg_l : (n,m,p:entier)(Nplus n m)=(Nplus n p)->m=p.
+Proof.
+Intro n; Pattern n; Apply Nind; Clear n; Simpl.
+  Trivial.
+  Intros n IHn m p H0; Do 2 Rewrite Nplus_succ in H0.
+  Apply IHn; Apply Nsucc_inj; Assumption.
+Qed.
+
+(** Properties of multiplication *)
+
+Theorem Nmult_1_l : (n:entier)(Nmult (Pos xH) n)=n.
+Proof.
+NewDestruct n; Reflexivity.
+Qed.
+
+Theorem Nmult_1_r : (n:entier)(Nmult n (Pos xH))=n.
+Proof.
+NewDestruct n; Simpl; Try Reflexivity.
+Rewrite times_x_1; Reflexivity.
+Qed.
+
+Theorem Nmult_comm : (n,m:entier)(Nmult n m)=(Nmult m n).
+Proof.
+Intros.
+NewDestruct n; NewDestruct m; Simpl; Try Reflexivity.
+Rewrite times_sym; Reflexivity.
+Qed.
+
+Theorem Nmult_assoc : 
+  (n,m,p:entier)(Nmult n (Nmult m p))=(Nmult (Nmult n m) p).
+Proof.
+Intros.
+NewDestruct n; Try Reflexivity.
+NewDestruct m; Try Reflexivity.
+NewDestruct p; Try Reflexivity.
+Simpl; Rewrite times_assoc; Reflexivity.
+Qed.
+
+Theorem Nmult_plus_distr_r :
+  (n,m,p:entier)(Nmult (Nplus n m) p)=(Nplus (Nmult n p) (Nmult m p)).
+Proof.
+Intros.
+NewDestruct n; Try Reflexivity.
+NewDestruct m; NewDestruct p; Try Reflexivity.
+Simpl; Rewrite times_add_distr_l; Reflexivity.
+Qed.
+
+Theorem Nmult_reg_r : (n,m,p:entier) ~p=Nul->(Nmult n p)=(Nmult m p) -> n=m.
+Proof.
+NewDestruct p; Intros Hp H.
+Contradiction Hp; Reflexivity.
+NewDestruct n; NewDestruct m; Reflexivity Orelse Try Discriminate H.
+Injection H; Clear H; Intro H; Rewrite simpl_times_r with 1:=H; Reflexivity.
+Qed. 
+
+Theorem Nmult_0_l : (n:entier) (Nmult Nul n) = Nul.
+Proof.
+Reflexivity.
+Qed.
+
+(** Properties of comparison *)
+
+Theorem Ncompare_Eq_eq : (n,m:entier) (Ncompare n m) = EGAL -> n = m.
+Proof.
+NewDestruct n as [|n]; NewDestruct m as [|m]; Simpl; Intro H;
+  Reflexivity Orelse Try Discriminate H.
+  Rewrite (compare_convert_EGAL n m H); Reflexivity.
+Qed.
+
diff --git a/theories7/NArith/BinPos.v b/theories7/NArith/BinPos.v
new file mode 100644
index 00000000..ae61587d
--- /dev/null
+++ b/theories7/NArith/BinPos.v
@@ -0,0 +1,894 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: BinPos.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+(**********************************************************************)
+(** 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 *)
+
+Delimits 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 ].
+
+(** Successor *)
+
+Fixpoint add_un [x:positive]:positive :=
+  Cases x of
+    (xI x') => (xO (add_un x'))
+  | (xO x') => (xI x')
+  | xH => (xO xH)
+  end.
+
+(** Addition *)
+
+Fixpoint add [x:positive]:positive -> positive := [y:positive]
+  Cases x y of
+  | (xI x') (xI y') => (xO (add_carry x' y'))
+  | (xI x') (xO y') => (xI (add x' y'))
+  | (xI x') xH      => (xO (add_un x'))
+  | (xO x') (xI y') => (xI (add x' y'))
+  | (xO x') (xO y') => (xO (add x' y'))
+  | (xO x') xH      => (xI x')
+  | xH      (xI y') => (xO (add_un y'))
+  | xH      (xO y') => (xI y')
+  | xH      xH      => (xO xH)
+  end
+with add_carry [x:positive]:positive -> positive := [y:positive]
+  Cases x y of
+  | (xI x') (xI y') => (xI (add_carry x' y'))
+  | (xI x') (xO y') => (xO (add_carry x' y'))
+  | (xI x') xH      => (xI (add_un x'))
+  | (xO x') (xI y') => (xO (add_carry x' y'))
+  | (xO x') (xO y') => (xI (add x' y'))
+  | (xO x') xH      => (xO (add_un x'))
+  | xH      (xI y') => (xI (add_un y'))
+  | xH      (xO y') => (xO (add_un y'))
+  | xH      xH      => (xI xH)
+  end.
+
+V7only [Notation "x + y" := (add x y) : positive_scope.].
+V8Infix "+" add : positive_scope.
+
+Open Local Scope positive_scope.
+
+(** From binary positive numbers to Peano natural numbers *)
+
+Fixpoint positive_to_nat [x:positive]:nat -> nat :=
+  [pow2:nat]
+   Cases x of
+     (xI x') => (plus pow2 (positive_to_nat x' (plus pow2 pow2)))
+   | (xO x') => (positive_to_nat x' (plus pow2 pow2))
+   | xH      => pow2
+   end.
+
+Definition convert := [x:positive] (positive_to_nat x (S O)).
+
+(** From Peano natural numbers to binary positive numbers *)
+
+Fixpoint anti_convert [n:nat]: positive :=
+   Cases n of
+                O => xH
+             | (S x') => (add_un (anti_convert x'))
+             end.
+
+(** Operation x -> 2*x-1 *)
+
+Fixpoint double_moins_un [x:positive]:positive :=
+  Cases x of
+      (xI x') => (xI (xO x'))
+    | (xO x') => (xI (double_moins_un x'))
+    | xH => xH
+    end.
+
+(** Predecessor *)
+
+Definition sub_un := [x:positive]
+   Cases x of
+             (xI x') => (xO x')
+           | (xO x') => (double_moins_un x')
+           | xH => xH
+           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 Un_suivi_de_mask := [x:positive_mask]
+  Cases x of IsNul => (IsPos xH) | IsNeg => IsNeg | (IsPos p) => (IsPos (xI p)) end.
+
+(** Operation x -> 2*x *)
+
+Definition Zero_suivi_de_mask := [x:positive_mask]
+  Cases x of IsNul => IsNul | IsNeg => IsNeg | (IsPos p) => (IsPos (xO p)) end.
+
+(** Operation x -> 2*x-2 *)
+
+Definition double_moins_deux :=
+  [x:positive] Cases x of
+           (xI x') => (IsPos (xO (xO x')))
+         | (xO x') => (IsPos (xO (double_moins_un x')))
+         | xH => IsNul
+         end.
+
+(** Subtraction of binary positive numbers into a positive numbers mask *)
+
+Fixpoint sub_pos[x,y:positive]:positive_mask :=
+  Cases x y of
+  | (xI x') (xI y') => (Zero_suivi_de_mask (sub_pos x' y'))
+  | (xI x') (xO y') => (Un_suivi_de_mask (sub_pos x' y'))
+  | (xI x') xH      => (IsPos (xO x'))
+  | (xO x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
+  | (xO x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
+  | (xO x') xH      => (IsPos (double_moins_un x'))
+  | xH      xH      => IsNul
+  | xH      _       => IsNeg
+  end
+with sub_neg [x,y:positive]:positive_mask :=
+  Cases x y of
+    (xI x') (xI y') => (Un_suivi_de_mask (sub_neg x' y'))
+  | (xI x') (xO y') => (Zero_suivi_de_mask (sub_pos x' y'))
+  | (xI x') xH      => (IsPos (double_moins_un x'))
+  | (xO x') (xI y') => (Zero_suivi_de_mask (sub_neg x' y'))
+  | (xO x') (xO y') => (Un_suivi_de_mask (sub_neg x' y'))
+  | (xO x') xH      => (double_moins_deux x')
+  | xH      _       => IsNeg
+  end.
+
+(** Subtraction of binary positive numbers x and y, returns 1 if x<=y *)
+
+Definition true_sub := [x,y:positive] 
+  Cases (sub_pos x y) of (IsPos z) => z | _ => xH  end.
+
+V8Infix "-" true_sub : positive_scope.
+
+(** Multiplication on binary positive numbers *)
+
+Fixpoint times [x:positive] : positive -> positive:=
+  [y:positive]
+  Cases x of
+    (xI x') => (add y (xO (times x' y)))
+  | (xO x') => (xO (times x' y))
+  | xH => y
+  end.
+
+V8Infix "*" times : positive_scope.
+
+(** Division by 2 rounded below but for 1 *)
+
+Definition Zdiv2_pos :=
+  [z:positive]Cases z of xH => xH
+                       | (xO p) => p
+		       | (xI p) => p
+		      end.
+
+V8Infix "/" Zdiv2_pos : positive_scope.
+
+(** Comparison on binary positive numbers *)
+
+Fixpoint compare [x,y:positive]: relation -> relation :=
+  [r:relation] 
+  Cases x y of
+  | (xI x') (xI y') => (compare x' y' r)
+  | (xI x') (xO y') => (compare x' y' SUPERIEUR)
+  | (xI x')  xH     => SUPERIEUR
+  | (xO x') (xI y') => (compare x' y' INFERIEUR)
+  | (xO x') (xO y') => (compare x' y' r)
+  | (xO x')  xH     => SUPERIEUR
+  | xH      (xI y') => INFERIEUR
+  | xH      (xO y') => INFERIEUR
+  | xH       xH     => r
+  end.
+
+V8Infix "?=" compare (at level 70, no associativity) : positive_scope.
+
+(**********************************************************************)
+(** Miscellaneous properties of binary positive numbers *)
+
+Lemma ZL11: (x:positive) (x=xH) \/ ~(x=xH).
+Proof.
+Intros x;Case x;Intros; (Left;Reflexivity) Orelse (Right;Discriminate).
+Qed.
+
+(**********************************************************************)
+(** Properties of successor on binary positive numbers *)
+
+(** Specification of [xI] in term of [Psucc] and [xO] *)
+
+Lemma xI_add_un_xO : (x:positive)(xI x) = (add_un (xO x)).
+Proof.
+Reflexivity.
+Qed.
+
+Lemma add_un_discr : (x:positive)x<>(add_un x).
+Proof.
+Intro x; NewDestruct x; Discriminate.
+Qed.
+
+(** Successor and double *)
+
+Lemma is_double_moins_un : (x:positive) (add_un (double_moins_un x)) = (xO x).
+Proof.
+Intro x; NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
+Qed.
+
+Lemma double_moins_un_add_un_xI : 
+ (x:positive)(double_moins_un (add_un x))=(xI x).
+Proof.
+Intro x;NewInduction x as [x IHx|x|]; Simpl; Try Rewrite IHx; Reflexivity.
+Qed.
+
+Lemma ZL1: (y:positive)(xO (add_un y)) = (add_un (add_un (xO y))).
+Proof.
+Intro y; Induction y; Simpl; Auto.
+Qed.
+
+Lemma double_moins_un_xO_discr : (x:positive)(double_moins_un x)<>(xO x).
+Proof.
+Intro x; NewDestruct x; Discriminate.
+Qed.
+
+(** Successor and predecessor *)
+
+Lemma add_un_not_un : (x:positive) (add_un x) <> xH.
+Proof.
+Intro x; NewDestruct x as [x|x|]; Discriminate.
+Qed.
+
+Lemma sub_add_one : (x:positive) (sub_un (add_un x)) = x.
+Proof.
+(Intro x; NewDestruct x as [p|p|]; [Idtac | Idtac | Simpl;Auto]);
+(NewInduction p as [p IHp||]; [Idtac | Reflexivity | Reflexivity ]);
+Simpl; Simpl in IHp; Try Rewrite <- IHp; Reflexivity.
+Qed.
+
+Lemma add_sub_one : (x:positive) (x=xH) \/ (add_un (sub_un x)) = x.
+Proof.
+Intro x; Induction x; [
+  Simpl; Auto
+| Simpl; Intros;Right;Apply is_double_moins_un
+| Auto ].
+Qed.
+
+(** Injectivity of successor *)
+
+Lemma add_un_inj : (x,y:positive) (add_un x)=(add_un y) -> x=y.
+Proof.
+Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; 
+  Intro H; Discriminate H Orelse Try (Injection H; Clear H; Intro H).
+Rewrite (IHx y H); Reflexivity.
+Absurd (add_un x)=xH; [ Apply add_un_not_un | Assumption ].
+Apply f_equal with 1:=H; Assumption.
+Absurd (add_un y)=xH; [ Apply add_un_not_un | Symmetry; Assumption ].
+Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Properties of addition on binary positive numbers *)
+
+(** Specification of [Psucc] in term of [Pplus] *)
+
+Lemma ZL12: (q:positive) (add_un q) = (add q xH).
+Proof.
+Intro q; NewDestruct q; Reflexivity.
+Qed.
+
+Lemma ZL12bis: (q:positive) (add_un q) = (add xH q).
+Proof.
+Intro q; NewDestruct q; Reflexivity.
+Qed.
+
+(** Specification of [Pplus_carry] *)
+
+Theorem ZL13: (x,y:positive)(add_carry x y) = (add_un (add x y)).
+Proof.
+(Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto);
+  Rewrite IHp; Auto.
+Qed.
+
+(** Commutativity *)
+
+Theorem add_sym : (x,y:positive) (add x y) = (add y x).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto;
+  Try Do 2 Rewrite ZL13; Rewrite IHp;Auto.
+Qed. 
+
+(** Permutation of [Pplus] and [Psucc] *)
+
+Theorem ZL14: (x,y:positive)(add x (add_un y)) = (add_un (add x y)).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|];Intro y; NewDestruct y;Simpl;Auto; [
+  Rewrite ZL13; Rewrite IHp; Auto
+| Rewrite ZL13; Auto
+| NewDestruct p;Simpl;Auto
+| Rewrite IHp;Auto
+| NewDestruct p;Simpl;Auto ].
+Qed.
+
+Theorem ZL14bis: (x,y:positive)(add (add_un x) y) = (add_un (add x y)).
+Proof.
+Intros x y; Rewrite add_sym; Rewrite add_sym with x:=x; Apply ZL14.
+Qed.
+
+Theorem ZL15: (q,z:positive) ~z=xH -> (add_carry q (sub_un z)) = (add q z).
+Proof.
+Intros q z H; Elim (add_sub_one z); [
+  Intro;Absurd z=xH;Auto
+| Intros E;Pattern 2 z ;Rewrite <- E; Rewrite ZL14; Rewrite ZL13; Trivial ].
+Qed. 
+
+(** No neutral for addition on strictly positive numbers *)
+
+Lemma add_no_neutral : (x,y:positive) ~(add y x)=x.
+Proof.
+Intro x;NewInduction x; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H;
+  Discriminate H Orelse Injection H; Clear H; Intro H; Apply (IHx y H).
+Qed.
+
+Lemma add_carry_not_add_un : (x,y:positive) ~(add_carry y x)=(add_un x).
+Proof.
+Intros x y H; Absurd (add y x)=x; 
+      [ Apply add_no_neutral
+      | Apply add_un_inj; Rewrite <- ZL13; Assumption ].
+Qed.
+
+(** Simplification *)
+
+Lemma add_carry_add :
+  (x,y,z,t:positive) (add_carry x z)=(add_carry y t) -> (add x z)=(add y t).
+Proof.
+Intros x y z t H; Apply add_un_inj; Do 2 Rewrite <- ZL13; Assumption.
+Qed.
+
+Lemma simpl_add_r : (x,y,z:positive) (add x z)=(add y z) -> x=y.
+Proof.
+Intros x y z; Generalize x y; Clear x y.
+NewInduction z as [z|z|].
+  NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; 
+  Discriminate H Orelse Try (Injection H; Clear H; Intro H).
+    Rewrite IHz with 1:=(add_carry_add ? ? ? ? H); Reflexivity.
+    Absurd (add_carry x z)=(add_un z);
+      [ Apply add_carry_not_add_un | Assumption ].
+    Rewrite IHz with 1:=H; Reflexivity.
+    Symmetry in H; Absurd (add_carry y z)=(add_un z);
+      [ Apply add_carry_not_add_un | Assumption ].
+    Reflexivity.
+  NewDestruct x as [x|x|]; Intro y; NewDestruct y as [y|y|]; Simpl; Intro H; 
+  Discriminate H Orelse Try (Injection H; Clear H; Intro H).
+    Rewrite IHz with 1:=H; Reflexivity.
+    Absurd (add x z)=z; [ Apply add_no_neutral | Assumption ].
+    Rewrite IHz with 1:=H; Reflexivity.
+    Symmetry in H; Absurd y+z=z; [ Apply add_no_neutral | Assumption ].
+    Reflexivity.
+  Intros H x y; Apply add_un_inj; Do 2 Rewrite ZL12; Assumption.
+Qed.
+
+Lemma simpl_add_l : (x,y,z:positive) (add x y)=(add x z) -> y=z.
+Proof.
+Intros x y z H;Apply simpl_add_r with z:=x; 
+  Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Assumption.
+Qed.
+
+Lemma simpl_add_carry_r :
+ (x,y,z:positive) (add_carry x z)=(add_carry y z) -> x=y.
+Proof.
+Intros x y z H; Apply simpl_add_r with z:=z; Apply add_carry_add; Assumption.
+Qed.
+
+Lemma simpl_add_carry_l :
+  (x,y,z:positive) (add_carry x y)=(add_carry x z) -> y=z.
+Proof.
+Intros x y z H;Apply simpl_add_r with z:=x; 
+Rewrite add_sym with x:=z; Rewrite add_sym with x:=y; Apply add_carry_add; 
+Assumption.
+Qed.
+
+(** Addition on positive is associative *)
+
+Theorem add_assoc: (x,y,z:positive)(add x (add y z)) = (add (add x y) z).
+Proof.
+Intros x y; Generalize x; Clear x.
+NewInduction y as [y|y|]; Intro x.
+  NewDestruct x as [x|x|]; 
+    Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
+    Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
+    Repeat Apply f_equal with A:=positive; Apply IHy.
+  NewDestruct x as [x|x|]; 
+    Intro z; NewDestruct z as [z|z|]; Simpl; Repeat Rewrite ZL13;
+    Repeat Rewrite ZL14; Repeat Rewrite ZL14bis; Reflexivity Orelse
+    Repeat Apply f_equal with A:=positive; Apply IHy.
+  Intro z; Rewrite add_sym with x:=xH; Do 2 Rewrite <- ZL12; Rewrite ZL14bis; Rewrite ZL14; Reflexivity.
+Qed.
+
+(** Commutation of addition with the double of a positive number *)
+
+Lemma add_xI_double_moins_un :
+  (p,q:positive)(xO (add p q)) = (add (xI p) (double_moins_un q)).
+Proof.
+Intros; Change (xI p) with (add (xO p) xH).
+Rewrite <- add_assoc; Rewrite <- ZL12bis; Rewrite is_double_moins_un.
+Reflexivity.
+Qed.
+
+Lemma add_xO_double_moins_un :
+ (p,q:positive) (double_moins_un (add p q)) = (add (xO p) (double_moins_un q)).
+Proof.
+NewInduction p as [p IHp|p IHp|]; NewDestruct q as [q|q|];
+ Simpl; Try Rewrite ZL13; Try Rewrite double_moins_un_add_un_xI;
+ Try Rewrite IHp; Try Rewrite add_xI_double_moins_un; Try Reflexivity.
+ Rewrite <- is_double_moins_un; Rewrite ZL12bis; Reflexivity. 
+Qed.
+
+(** Misc *)
+
+Lemma add_x_x : (x:positive) (add x x) = (xO x).
+Proof.
+Intro x;NewInduction x; Simpl; Try Rewrite ZL13; Try Rewrite IHx; Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Peano induction on binary positive positive numbers *)
+
+Fixpoint plus_iter [x:positive] : positive -> positive := 
+  [y]Cases x of 
+  | xH => (add_un y)
+  | (xO x) => (plus_iter x (plus_iter x y))
+  | (xI x) => (plus_iter x (plus_iter x (add_un y)))
+  end.
+
+Lemma plus_iter_add : (x,y:positive)(plus_iter x y)=(add x y).
+Proof.
+Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; Simpl;
+  Reflexivity Orelse Do 2 Rewrite IHp; Rewrite add_assoc; Rewrite add_x_x;
+  Try Reflexivity.
+Rewrite ZL13; Rewrite <- ZL14; Reflexivity.
+Rewrite ZL12; Reflexivity.
+Qed.
+
+Lemma plus_iter_xO : (x:positive)(plus_iter x x)=(xO x).
+Proof.
+Intro; Rewrite <- add_x_x; Apply plus_iter_add.
+Qed.
+
+Lemma plus_iter_xI : (x:positive)(add_un (plus_iter x x))=(xI x).
+Proof.
+Intro; Rewrite xI_add_un_xO; Rewrite <- add_x_x; 
+  Apply (f_equal positive); Apply plus_iter_add.
+Qed.
+
+Lemma iterate_add : (P:(positive->Type))
+  ((n:positive)(P n) ->(P (add_un n)))->(p,n:positive)(P n) ->
+  (P (plus_iter p n)).
+Proof.
+Intros P H; NewInduction p; Simpl; Intros.
+Apply IHp; Apply IHp; Apply H; Assumption.
+Apply IHp; Apply IHp; Assumption.
+Apply H; Assumption.
+Defined.
+
+(** Peano induction *)
+
+Theorem Pind : (P:(positive->Prop))
+  (P xH) ->((n:positive)(P n) ->(P (add_un n))) ->(n:positive)(P n).
+Proof.
+Intros P H1 Hsucc n; NewInduction n.
+Rewrite <- plus_iter_xI; Apply Hsucc; Apply iterate_add; Assumption.
+Rewrite <- plus_iter_xO; Apply iterate_add; Assumption.
+Assumption.
+Qed.
+
+(** Peano recursion *)
+
+Definition Prec : (A:Set)A->(positive->A->A)->positive->A :=
+  [A;a;f]Fix Prec { Prec [p:positive] : A :=
+  Cases p of
+  | xH => a
+  | (xO p) => (iterate_add [_]A f p p (Prec p))
+  | (xI p) => (f (plus_iter p p) (iterate_add [_]A f p p (Prec p)))
+  end}.
+
+(** Peano case analysis *)
+
+Theorem Pcase : (P:(positive->Prop))
+  (P xH) ->((n:positive)(P (add_un n))) ->(n:positive)(P n).
+Proof.
+Intros; Apply Pind; Auto.
+Qed.
+
+Check
+ let fact = (Prec positive xH [p;r](times (add_un p) r)) in
+ let seven = (xI (xI xH)) in
+ let five_thousand_forty= (xO(xO(xO(xO(xI(xI(xO(xI(xI(xI(xO(xO xH))))))))))))
+ in ((refl_equal ? ?) :: (fact seven) = five_thousand_forty).
+
+(**********************************************************************)
+(** Properties of multiplication on binary positive numbers *)
+
+(** One is right neutral for multiplication *)
+
+Lemma times_x_1 : (x:positive) (times x xH) = x.
+Proof.
+Intro x;NewInduction x; Simpl.
+  Rewrite IHx; Reflexivity.
+  Rewrite IHx; Reflexivity.
+  Reflexivity.
+Qed.
+
+(** Right reduction properties for multiplication *)
+
+Lemma times_x_double : (x,y:positive) (times x (xO y)) = (xO (times x y)).
+Proof.
+Intros x y; NewInduction x; Simpl.
+  Rewrite IHx; Reflexivity.
+  Rewrite IHx; Reflexivity.
+  Reflexivity.
+Qed.
+
+Lemma times_x_double_plus_one :
+ (x,y:positive) (times x (xI y)) = (add x (xO (times x y))).
+Proof.
+Intros x y; NewInduction x; Simpl.
+  Rewrite IHx; Do 2 Rewrite add_assoc; Rewrite add_sym with x:=y; Reflexivity.
+  Rewrite IHx; Reflexivity.
+  Reflexivity.
+Qed.
+
+(** Commutativity of multiplication *)
+
+Theorem times_sym : (x,y:positive) (times x y) = (times y x).
+Proof.
+Intros x y; NewInduction y; Simpl.
+  Rewrite <- IHy; Apply times_x_double_plus_one.
+  Rewrite <- IHy; Apply times_x_double.
+  Apply times_x_1.
+Qed.
+
+(** Distributivity of multiplication over addition *)
+
+Theorem times_add_distr:
+  (x,y,z:positive) (times x (add y z)) = (add (times x y) (times x z)).
+Proof.
+Intros x y z; NewInduction x; Simpl.
+  Rewrite IHx; Rewrite <- add_assoc with y := (xO (times x y));
+    Rewrite -> add_assoc with x := (xO (times x y));
+    Rewrite -> add_sym with x := (xO (times x y));
+    Rewrite <- add_assoc with y := (xO (times x y));
+    Rewrite -> add_assoc with y := z; Reflexivity.
+  Rewrite IHx; Reflexivity.
+  Reflexivity.
+Qed.
+
+Theorem times_add_distr_l:
+  (x,y,z:positive) (times (add x y) z) = (add (times x z) (times y z)).
+Proof.
+Intros x y z; Do 3 Rewrite times_sym with y:=z; Apply times_add_distr.
+Qed.
+
+(** Associativity of multiplication *)
+
+Theorem times_assoc :
+  ((x,y,z:positive) (times x (times y z))= (times (times x y) z)).
+Proof.
+Intro x;NewInduction x as [x|x|]; Simpl; Intros y z.
+  Rewrite IHx; Rewrite times_add_distr_l; Reflexivity.
+  Rewrite IHx; Reflexivity.
+  Reflexivity.
+Qed.
+
+(** Parity properties of multiplication *)
+
+Lemma times_discr_xO_xI : 
+  (x,y,z:positive)(times (xI x) z)<>(times (xO y) z).
+Proof.
+Intros x y z; NewInduction z as [|z IHz|]; Try Discriminate.
+Intro H; Apply IHz; Clear IHz.
+Do 2 Rewrite times_x_double in H.
+Injection H; Clear H; Intro H; Exact H.
+Qed.
+
+Lemma times_discr_xO : (x,y:positive)(times (xO x) y)<>y.
+Proof.
+Intros x y; NewInduction y; Try Discriminate.
+Rewrite times_x_double; Injection; Assumption.
+Qed.
+
+(** Simplification properties of multiplication *)
+
+Theorem simpl_times_r : (x,y,z:positive) (times x z)=(times y z) -> x=y.
+Proof.
+Intro x;NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|]; Intros z H;
+    Reflexivity Orelse Apply (f_equal positive) Orelse Apply False_ind.
+  Simpl in H; Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double;
+    Apply simpl_add_l with 1 := H.
+  Apply times_discr_xO_xI with 1 := H.
+  Simpl in H; Rewrite add_sym in H; Apply add_no_neutral with 1 := H.
+  Symmetry in H; Apply times_discr_xO_xI with 1 := H.
+  Apply IHp with (xO z); Simpl; Do 2 Rewrite times_x_double; Assumption.
+  Apply times_discr_xO with 1:=H.
+  Simpl in H; Symmetry in H; Rewrite add_sym in H; 
+    Apply add_no_neutral with 1 := H.
+  Symmetry in H; Apply times_discr_xO with 1:=H.
+Qed.
+
+Theorem simpl_times_l : (x,y,z:positive) (times z x)=(times z y) -> x=y.
+Proof.
+Intros x y z H; Apply simpl_times_r with z:=z.
+Rewrite times_sym with x:=x; Rewrite times_sym with x:=y; Assumption.
+Qed.
+
+(** Inversion of multiplication *)
+
+Lemma times_one_inversion_l : (x,y:positive) (times x y)=xH -> x=xH.
+Proof.
+Intros x y; NewDestruct x; Simpl.
+ NewDestruct y; Intro; Discriminate.
+ Intro; Discriminate.
+ Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Properties of comparison on binary positive numbers *)
+
+Theorem compare_convert1 : 
+ (x,y:positive) 
+  ~(compare x y SUPERIEUR) = EGAL /\ ~(compare x y INFERIEUR) = EGAL.
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y as [q|q|];
+  Split;Simpl;Auto;
+  Discriminate Orelse (Elim (IHp q); Auto).
+Qed.
+
+Theorem compare_convert_EGAL : (x,y:positive) (compare x y EGAL) = EGAL -> x=y.
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|]; 
+  Intro y; NewDestruct y as [q|q|];Simpl;Auto; Intro H; [
+  Rewrite (IHp q); Trivial
+| Absurd (compare p q SUPERIEUR)=EGAL ;
+   [ Elim (compare_convert1 p q);Auto | Assumption ]
+| Discriminate H
+| Absurd (compare p q INFERIEUR) = EGAL; 
+    [ Elim (compare_convert1 p q);Auto | Assumption ]
+| Rewrite (IHp q);Auto 
+| Discriminate H
+| Discriminate H
+| Discriminate H ].
+Qed.
+
+Lemma ZLSI:
+ (x,y:positive) (compare x y SUPERIEUR) = INFERIEUR -> 
+                (compare x y EGAL) = INFERIEUR.
+Proof.
+Intro x; Induction x;Intro y; Induction y;Simpl;Auto; 
+  Discriminate Orelse Intros H;Discriminate H.
+Qed.
+
+Lemma ZLIS:
+ (x,y:positive) (compare x y INFERIEUR) = SUPERIEUR -> 
+                (compare x y EGAL) = SUPERIEUR.
+Proof.
+Intro x; Induction x;Intro y; Induction y;Simpl;Auto; 
+  Discriminate Orelse Intros H;Discriminate H.
+Qed.
+
+Lemma ZLII:
+ (x,y:positive) (compare x y INFERIEUR) = INFERIEUR ->
+                (compare x y EGAL) = INFERIEUR \/ x = y.
+Proof.
+(Intro x; NewInduction x as [p IHp|p IHp|];
+ Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
+ Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
+ Auto.
+Qed.
+
+Lemma ZLSS:
+ (x,y:positive) (compare x y SUPERIEUR) = SUPERIEUR ->
+                (compare x y EGAL) = SUPERIEUR \/ x = y.
+Proof.
+(Intro x; NewInduction x as [p IHp|p IHp|];
+ Intro y; NewDestruct y as [q|q|];Simpl;Auto;Try Discriminate);
+ Intro H2; Elim (IHp q H2);Auto; Intros E;Rewrite E;
+ Auto.
+Qed.
+
+Lemma Dcompare : (r:relation) r=EGAL \/ r = INFERIEUR \/ r = SUPERIEUR.
+Proof.
+Induction r; Auto. 
+Qed.
+
+Tactic Definition ElimPcompare c1 c2:=
+  Elim (Dcompare (compare c1 c2 EGAL)); [ Idtac | 
+     Let x = FreshId "H" In Intro x; Case x; Clear x ].
+
+Theorem convert_compare_EGAL: (x:positive)(compare x x EGAL)=EGAL.
+Intro x; Induction x; Auto.
+Qed.
+
+Lemma Pcompare_antisym :
+  (x,y:positive)(r:relation) (Op (compare x y r)) = (compare y x (Op r)).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|]; Intro y; NewDestruct y; 
+Intro r; Reflexivity Orelse (Symmetry; Assumption) Orelse Discriminate H
+Orelse Simpl; Apply IHp Orelse Try Rewrite IHp; Try Reflexivity.
+Qed.
+
+Lemma ZC1:
+  (x,y:positive)(compare x y EGAL)=SUPERIEUR -> (compare y x EGAL)=INFERIEUR.
+Proof.
+Intros; Change EGAL with (Op EGAL).
+Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+Qed.
+
+Lemma ZC2:
+  (x,y:positive)(compare x y EGAL)=INFERIEUR -> (compare y x EGAL)=SUPERIEUR.
+Proof.
+Intros; Change EGAL with (Op EGAL).
+Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+Qed.
+
+Lemma ZC3: (x,y:positive)(compare x y EGAL)=EGAL -> (compare y x EGAL)=EGAL.
+Proof.
+Intros; Change EGAL with (Op EGAL).
+Rewrite <- Pcompare_antisym; Rewrite H; Reflexivity.
+Qed.
+
+Lemma ZC4: (x,y:positive) (compare x y EGAL) = (Op (compare y x EGAL)).
+Proof.
+Intros; Change 1 EGAL with (Op EGAL).
+Symmetry; Apply Pcompare_antisym.
+Qed.
+
+(**********************************************************************)
+(** Properties of subtraction on binary positive numbers *)
+
+Lemma ZS: (p:positive_mask) (Zero_suivi_de_mask p) = IsNul -> p = IsNul.
+Proof.
+NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
+Qed.
+
+Lemma US: (p:positive_mask) ~(Un_suivi_de_mask p)=IsNul.
+Proof.
+Induction p; Intros; Discriminate.
+Qed.
+
+Lemma USH: (p:positive_mask) (Un_suivi_de_mask p) = (IsPos xH) -> p = IsNul.
+Proof.
+NewDestruct p; Simpl; [ Trivial | Discriminate 1 | Discriminate 1 ].
+Qed.
+
+Lemma ZSH: (p:positive_mask) ~(Zero_suivi_de_mask p)= (IsPos xH).
+Proof.
+Induction p; Intros; Discriminate.
+Qed.
+
+Theorem sub_pos_x_x : (x:positive) (sub_pos x x) = IsNul.
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|]; [
+  Simpl; Rewrite IHp;Simpl; Trivial
+| Simpl; Rewrite IHp;Auto
+| Auto ].
+Qed.
+
+Lemma ZL10: (x,y:positive)
+ (sub_pos x y) = (IsPos xH) -> (sub_neg x y) = IsNul.
+Proof.
+Intro x; NewInduction x as [p|p|]; Intro y; NewDestruct y as [q|q|]; Simpl; 
+  Intro H; Try Discriminate H; [
+  Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH);
+   [ Apply ZSH | Assumption ]
+| Assert Heq : (sub_pos p q)=IsNul;
+   [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
+| Assert Heq : (sub_neg p q)=IsNul;
+   [ Apply USH;Assumption | Rewrite Heq; Reflexivity ]
+| Absurd (Zero_suivi_de_mask (sub_pos p q))=(IsPos xH); 
+   [ Apply ZSH | Assumption ]
+| NewDestruct p; Simpl; [ Discriminate H | Discriminate H | Reflexivity ] ].
+Qed.
+
+(** Properties of subtraction valid only for x>y *)
+
+Lemma sub_pos_SUPERIEUR:
+  (x,y:positive)(compare x y EGAL)=SUPERIEUR -> 
+    (EX h:positive | (sub_pos x y) = (IsPos h) /\ (add y h) = x /\
+                     (h = xH \/ (sub_neg x y) = (IsPos (sub_un h)))).
+Proof.
+Intro x;NewInduction x as [p|p|];Intro y; NewDestruct y as [q|q|]; Simpl; Intro H;
+  Try Discriminate H.
+  NewDestruct (IHp q H) as [z [H4 [H6 H7]]]; Exists (xO z); Split.
+    Rewrite H4; Reflexivity.
+    Split.
+      Simpl; Rewrite H6; Reflexivity.
+      Right; Clear H6; NewDestruct (ZL11 z) as [H8|H8]; [
+        Rewrite H8; Rewrite H8 in H4;
+        Rewrite ZL10; [ Reflexivity | Assumption ]
+      | Clear H4; NewDestruct H7 as [H9|H9]; [
+          Absurd z=xH; Assumption
+        | Rewrite H9; Clear H9; NewDestruct z; 
+            [ Reflexivity | Reflexivity | Absurd xH=xH; Trivial ]]].
+  Case ZLSS with 1:=H; [
+    Intros H3;Elim (IHp q H3); Intros z H4; Exists (xI z);
+    Elim H4;Intros H5 H6;Elim H6;Intros H7 H8; Split; [
+      Simpl;Rewrite H5;Auto
+    | Split; [
+        Simpl; Rewrite H7; Trivial
+      | Right;
+        Change (Zero_suivi_de_mask (sub_pos p q))=(IsPos (sub_un (xI z)));
+        Rewrite H5; Auto ]]
+  | Intros H3; Exists xH; Rewrite H3; Split; [
+      Simpl; Rewrite sub_pos_x_x; Auto
+    | Split; Auto ]].
+  Exists (xO p); Auto.
+  NewDestruct (IHp q) as [z [H4 [H6 H7]]].
+    Apply ZLIS; Assumption.
+    NewDestruct (ZL11 z) as [vZ|]; [
+      Exists xH; Split; [
+        Rewrite ZL10; [ Reflexivity | Rewrite vZ in H4;Assumption ]
+      | Split; [
+          Simpl; Rewrite ZL12; Rewrite <- vZ; Rewrite H6; Trivial
+        | Auto ]]
+    | Exists (xI (sub_un z)); NewDestruct H7 as [|H8];[
+        Absurd z=xH;Assumption
+      | Split; [
+          Rewrite H8; Trivial
+        | Split; [ Simpl; Rewrite ZL15; [
+              Rewrite H6;Trivial
+            | Assumption ]
+          | Right; Rewrite H8; Reflexivity]]]].
+  NewDestruct (IHp q H) as [z [H4 [H6 H7]]].
+  Exists (xO z); Split; [
+    Rewrite H4;Auto
+  | Split; [
+      Simpl;Rewrite H6;Reflexivity
+    | Right; 
+      Change (Un_suivi_de_mask (sub_neg p q))=(IsPos (double_moins_un z));
+      NewDestruct (ZL11 z) as [H8|H8]; [
+        Rewrite H8; Simpl;
+        Assert H9:(sub_neg p q)=IsNul;[
+          Apply ZL10;Rewrite <- H8;Assumption
+        | Rewrite H9;Reflexivity ]
+      | NewDestruct H7 as [H9|H9]; [
+          Absurd z=xH;Auto
+        | Rewrite H9; NewDestruct z; Simpl; 
+            [ Reflexivity
+            | Reflexivity
+            | Absurd xH=xH; [Assumption | Reflexivity]]]]]].
+  Exists (double_moins_un p); Split; [
+    Reflexivity
+  | Clear IHp; Split; [
+      NewDestruct p; Simpl; [
+        Reflexivity
+      | Rewrite is_double_moins_un; Reflexivity
+      | Reflexivity ]
+    | NewDestruct p; [Right|Right|Left]; Reflexivity ]].
+Qed.
+
+Theorem sub_add: 
+(x,y:positive) (compare x y EGAL) = SUPERIEUR -> (add y (true_sub x y)) = x.
+Proof.
+Intros x y H;Elim sub_pos_SUPERIEUR with 1:=H;
+Intros z H1;Elim H1;Intros H2 H3; Elim H3;Intros H4 H5; 
+Unfold true_sub ;Rewrite H2; Exact H4.
+Qed.
+
diff --git a/theories7/NArith/NArith.v b/theories7/NArith/NArith.v
new file mode 100644
index 00000000..d924ae2e
--- /dev/null
+++ b/theories7/NArith/NArith.v
@@ -0,0 +1,14 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: NArith.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ *)
+
+(** Library for binary natural numbers *)
+
+Require Export BinPos.
+Require Export BinNat.
diff --git a/theories7/NArith/Pnat.v b/theories7/NArith/Pnat.v
new file mode 100644
index 00000000..d62661ed
--- /dev/null
+++ b/theories7/NArith/Pnat.v
@@ -0,0 +1,472 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Pnat.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require BinPos.
+
+(**********************************************************************)
+(** Properties of the injection from binary positive numbers to Peano 
+    natural numbers *)
+
+(** Original development by Pierre Crégut, CNET, Lannion, France *)
+
+Require Le.
+Require Lt.
+Require Gt.
+Require Plus.
+Require Mult.
+Require Minus.
+
+(** [nat_of_P] is a morphism for addition *)
+
+Lemma convert_add_un :
+  (x:positive)(m:nat)
+    (positive_to_nat (add_un x) m) = (plus m (positive_to_nat x m)).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|]; Simpl; Auto; Intro m; Rewrite IHp;
+Rewrite plus_assoc_l; Trivial.
+Qed.
+
+Lemma cvt_add_un :
+  (p:positive) (convert (add_un p)) = (S (convert p)).
+Proof.
+  Intro; Change (S (convert p)) with (plus (S O) (convert p));
+  Unfold convert; Apply convert_add_un.
+Qed.
+
+Theorem convert_add_carry :
+  (x,y:positive)(m:nat)
+    (positive_to_nat (add_carry x y) m) =
+    (plus m (positive_to_nat (add x y) m)).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|];
+  Intro y; NewDestruct y; Simpl; Auto with arith; Intro m; [
+  Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
+| Rewrite IHp; Rewrite plus_assoc_l; Trivial with arith
+| Rewrite convert_add_un; Rewrite plus_assoc_l; Trivial with arith
+| Rewrite convert_add_un; Apply plus_assoc_r ].
+Qed.
+
+Theorem cvt_carry :
+  (x,y:positive)(convert (add_carry x y)) = (S (convert (add x y))).
+Proof.
+Intros;Unfold convert; Rewrite convert_add_carry; Simpl; Trivial with arith.
+Qed.
+
+Theorem add_verif :
+  (x,y:positive)(m:nat)
+    (positive_to_nat (add x y) m) = 
+    (plus (positive_to_nat x m) (positive_to_nat y m)).
+Proof.
+Intro x; NewInduction x as [p IHp|p IHp|];
+  Intro y; NewDestruct y;Simpl;Auto with arith; [
+  Intros m;Rewrite convert_add_carry; Rewrite IHp; 
+  Rewrite plus_assoc_r; Rewrite plus_assoc_r; 
+  Rewrite (plus_permute m (positive_to_nat p (plus m m))); Trivial with arith
+| Intros m; Rewrite IHp; Apply plus_assoc_l
+| Intros m; Rewrite convert_add_un; 
+  Rewrite (plus_sym (plus m (positive_to_nat p (plus m m))));
+  Apply plus_assoc_r
+| Intros m; Rewrite IHp; Apply plus_permute
+| Intros m; Rewrite convert_add_un; Apply plus_assoc_r ].
+Qed.
+
+Theorem convert_add:
+  (x,y:positive) (convert (add x y)) = (plus (convert x) (convert y)).
+Proof.
+Intros x y; Exact (add_verif x y (S O)).
+Qed.
+
+(** [Pmult_nat] is a morphism for addition *)
+
+Lemma ZL2:
+  (y:positive)(m:nat)
+    (positive_to_nat y (plus m m)) =
+              (plus (positive_to_nat y m) (positive_to_nat y m)).
+Proof.
+Intro y; NewInduction y as [p H|p H|]; Intro m; [
+  Simpl; Rewrite H; Rewrite plus_assoc_r; 
+  Rewrite (plus_permute m (positive_to_nat p (plus m m)));
+  Rewrite plus_assoc_r; Auto with arith
+| Simpl; Rewrite H; Auto with arith
+| Simpl; Trivial with arith ].
+Qed.
+
+Lemma ZL6:
+  (p:positive) (positive_to_nat p (S (S O))) = (plus (convert p) (convert p)).
+Proof.
+Intro p;Change (2) with (plus (S O) (S O)); Rewrite ZL2; Trivial.
+Qed.
+ 
+(** [nat_of_P] is a morphism for multiplication *)
+
+Theorem times_convert :
+  (x,y:positive) (convert (times x y)) = (mult (convert x) (convert y)).
+Proof.
+Intros x y; NewInduction x as [ x' H | x' H | ]; [
+  Change (times (xI x') y) with (add y (xO (times x' y))); Rewrite convert_add;
+  Unfold 2 3 convert; Simpl; Do 2 Rewrite ZL6; Rewrite H;
+  Rewrite -> mult_plus_distr; Reflexivity
+| Unfold 1 2 convert; Simpl; Do 2 Rewrite ZL6;
+  Rewrite H; Rewrite mult_plus_distr; Reflexivity
+| Simpl; Rewrite <- plus_n_O; Reflexivity ].
+Qed.
+V7only [
+  Comments "Compatibility with the old version of times and times_convert".
+  Syntactic Definition times1 :=
+    [x:positive;_:positive->positive;y:positive](times x y).
+  Syntactic Definition times1_convert :=
+    [x,y:positive;_:positive->positive](times_convert x y).
+].
+
+(** [nat_of_P] maps to the strictly positive subset of [nat] *)
+
+Lemma ZL4: (y:positive) (EX h:nat |(convert y)=(S h)).
+Proof.
+Intro y; NewInduction y as [p H|p H|]; [
+  NewDestruct H as [x H1]; Exists (plus (S x) (S x));
+  Unfold convert ;Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2; Unfold convert in H1;
+  Rewrite H1; Auto with arith
+| NewDestruct H as [x H2]; Exists (plus x (S x)); Unfold convert;
+  Simpl; Change (2) with (plus (1) (1)); Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
+| Exists O ;Auto with arith ].
+Qed.
+
+(** Extra lemmas on [lt] on Peano natural numbers *)
+
+Lemma ZL7:
+  (m,n:nat) (lt m n) -> (lt (plus m m) (plus n n)).
+Proof.
+Intros m n H; Apply lt_trans with m:=(plus m n); [
+  Apply lt_reg_l with 1:=H
+| Rewrite (plus_sym m n); Apply lt_reg_l with 1:=H ].
+Qed.
+
+Lemma ZL8:
+  (m,n:nat) (lt m n) -> (lt (S (plus m m)) (plus n n)).
+Proof.
+Intros m n H; Apply le_lt_trans with m:=(plus m n); [
+  Change (lt (plus m m) (plus m n)) ; Apply lt_reg_l with 1:=H
+| Rewrite (plus_sym m n); Apply lt_reg_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 compare_convert_INFERIEUR : 
+  (x,y:positive) (compare x y EGAL) = INFERIEUR -> 
+    (lt (convert x) (convert y)).
+Proof.
+Intro x; NewInduction x as [p H|p H|];Intro y; NewDestruct y as [q|q|];
+  Intro H2; [
+  Unfold convert ;Simpl; Apply lt_n_S; 
+  Do 2 Rewrite ZL6; Apply ZL7; Apply H; Simpl in H2; Assumption
+| Unfold convert ;Simpl; Do 2 Rewrite ZL6; 
+  Apply ZL8; Apply H;Simpl in H2; Apply ZLSI;Assumption
+| Simpl; Discriminate H2
+| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
+  Elim (ZLII p q H2); [
+    Intros H3;Apply lt_S;Apply ZL7; Apply H;Apply H3
+  | Intros E;Rewrite E;Apply lt_n_Sn]
+| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
+  Apply ZL7;Apply H;Assumption
+| Simpl; Discriminate H2
+| Unfold convert ;Simpl; Apply lt_n_S; Rewrite ZL6;
+  Elim (ZL4 q);Intros h H3; Rewrite H3;Simpl; Apply lt_O_Sn
+| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 q);Intros h H3;
+  Rewrite H3; Simpl; Rewrite <- plus_n_Sm; Apply lt_n_S; Apply lt_O_Sn
+| Simpl; 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 compare_convert_SUPERIEUR : 
+  (x,y:positive) (compare x y EGAL)=SUPERIEUR -> (gt (convert x) (convert y)).
+Proof.
+Unfold gt; Intro x; NewInduction x as [p H|p H|];
+  Intro y; NewDestruct y as [q|q|]; Intro H2; [
+  Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
+  Apply lt_n_S; Apply ZL7; Apply H;Assumption
+| Simpl; Unfold convert ;Simpl; Do 2 Rewrite ZL6;
+  Elim (ZLSS p q H2); [
+    Intros H3;Apply lt_S;Apply ZL7;Apply H;Assumption
+  | Intros E;Rewrite E;Apply lt_n_Sn]
+| Unfold convert ;Simpl; Rewrite ZL6;Elim (ZL4 p);
+  Intros h H3;Rewrite H3;Simpl; Apply lt_n_S; Apply lt_O_Sn
+| Simpl;Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
+  Apply ZL8; Apply H; Apply ZLIS; Assumption
+| Simpl; Unfold convert ;Simpl;Do 2 Rewrite ZL6; 
+  Apply ZL7;Apply H;Assumption
+| Unfold convert ;Simpl; Rewrite ZL6; Elim (ZL4 p);
+  Intros h H3;Rewrite H3;Simpl; Rewrite <- plus_n_Sm;Apply lt_n_S;
+  Apply lt_O_Sn
+| Simpl; Discriminate H2
+| Simpl; Discriminate H2
+| Simpl; Discriminate H2 ].
+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 convert_compare_INFERIEUR : 
+  (x,y:positive)(lt (convert x) (convert y)) -> (compare x y EGAL) = INFERIEUR.
+Proof.
+Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
+  Intros E; Rewrite (compare_convert_EGAL x y E); 
+  Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
+| Intros H;Elim H; [
+    Auto
+  | Intros H1 H2; Absurd (lt (convert x) (convert y)); [
+      Apply lt_not_sym; Change (gt (convert x) (convert y)); 
+      Apply compare_convert_SUPERIEUR; Assumption
+    | Assumption ]]].
+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 convert_compare_SUPERIEUR : 
+  (x,y:positive)(gt (convert x) (convert y)) -> (compare x y EGAL) = SUPERIEUR.
+Proof.
+Intros x y; Unfold gt; Elim (Dcompare (compare x y EGAL)); [
+  Intros E; Rewrite (compare_convert_EGAL x y E); 
+  Intros H;Absurd (lt (convert y) (convert y)); [ Apply lt_n_n | Assumption ]
+| Intros H;Elim H; [
+    Intros H1 H2; Absurd (lt (convert y) (convert x)); [
+      Apply lt_not_sym; Apply compare_convert_INFERIEUR; Assumption
+    | Assumption ]
+  | Auto]].
+Qed.
+
+(** [nat_of_P] is strictly positive *)
+
+Lemma compare_positive_to_nat_O : 
+	(p:positive)(m:nat)(le m (positive_to_nat p m)).
+NewInduction p; Simpl; Auto with arith.
+Intro m; Apply le_trans with (plus m m);  Auto with arith.
+Qed.
+
+Lemma compare_convert_O : (p:positive)(lt O (convert p)).
+Intro; Unfold convert; Apply lt_le_trans with (S O); Auto with arith.
+Apply compare_positive_to_nat_O.
+Qed.
+
+(** Pmult_nat permutes with multiplication *)
+
+Lemma positive_to_nat_mult : (p:positive) (n,m:nat)
+    (positive_to_nat p (mult m n))=(mult m (positive_to_nat p n)).
+Proof.
+  Induction p. Intros. Simpl. Rewrite mult_plus_distr_r. Rewrite <- (mult_plus_distr_r m n n).
+  Rewrite (H (plus n n) m). Reflexivity.
+  Intros. Simpl. Rewrite <- (mult_plus_distr_r m n n). Apply H.
+  Trivial.
+Qed.
+
+Lemma positive_to_nat_2 : (p:positive)
+    (positive_to_nat p (2))=(mult (2) (positive_to_nat p (1))).
+Proof.
+  Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
+Qed.
+
+Lemma positive_to_nat_4 : (p:positive)
+    (positive_to_nat p (4))=(mult (2) (positive_to_nat p (2))).
+Proof.
+  Intros. Rewrite <- positive_to_nat_mult. Reflexivity.
+Qed.
+
+(** Mapping of xH, xO and xI through [nat_of_P] *)
+
+Lemma convert_xH : (convert xH)=(1).
+Proof.
+  Reflexivity.
+Qed.
+
+Lemma convert_xO : (p:positive) (convert (xO p))=(mult (2) (convert p)).
+Proof.
+  Induction p. Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2.
+  Rewrite positive_to_nat_4. Rewrite H. Simpl. Rewrite <- plus_Snm_nSm. Reflexivity.
+  Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
+  Rewrite H. Reflexivity.
+  Reflexivity.
+Qed.
+
+Lemma convert_xI : (p:positive) (convert (xI p))=(S (mult (2) (convert p))).
+Proof.
+  Induction p. Unfold convert. Simpl. Intro p0. Intro. Rewrite positive_to_nat_2.
+  Rewrite positive_to_nat_4; Injection H; Intro H1; Rewrite H1; Rewrite <- plus_Snm_nSm; Reflexivity.
+  Unfold convert. Simpl. Intros. Rewrite positive_to_nat_2. Rewrite positive_to_nat_4.
+  Injection H; Intro H1; Rewrite H1; Reflexivity.
+  Reflexivity.
+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 bij1 : (m:nat) (convert (anti_convert m)) = (S m).
+Proof.
+Intro m; NewInduction m as [|n H]; [
+  Reflexivity
+| Simpl; Rewrite cvt_add_un; Rewrite H; Auto ].
+Qed.
+
+(** Miscellaneous lemmas on [P_of_succ_nat] *)
+
+Lemma ZL3: (x:nat) (add_un (anti_convert (plus x x))) =  (xO (anti_convert x)).
+Proof.
+Intro x; NewInduction x as [|n H]; [
+  Simpl; Auto with arith
+| Simpl; Rewrite  plus_sym; Simpl; Rewrite  H; Rewrite  ZL1;Auto with arith].
+Qed.
+
+Lemma ZL5: (x:nat) (anti_convert (plus (S x) (S x))) =  (xI (anti_convert x)).
+Proof.
+Intro x; NewInduction x 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 bij2 : (x:positive) (anti_convert (convert x)) = (add_un x).
+Proof.
+Intro x; NewInduction x as [p H|p H|]; [
+  Simpl; Rewrite <- H; Change (2) with (plus (1) (1));
+  Rewrite ZL2; Elim (ZL4 p); 
+  Unfold convert; Intros n H1;Rewrite H1; Rewrite ZL3; Auto with arith
+| Unfold convert ;Simpl; Change (2) with (plus (1) (1));
+  Rewrite ZL2;
+  Rewrite <- (sub_add_one
+               (anti_convert
+                 (plus (positive_to_nat p (S O)) (positive_to_nat p (S O)))));
+  Rewrite <- (sub_add_one (xI p));
+  Simpl;Rewrite <- H;Elim (ZL4 p); Unfold convert ;Intros n H1;Rewrite H1;
+  Rewrite ZL5; Simpl; Trivial with arith
+| Unfold convert; Simpl; Auto with arith ].
+Qed.
+
+(** Composition of [nat_of_P], [P_of_succ_nat] and [Ppred] is identity
+    on [positive] *)
+
+Theorem bij3: (x:positive)(sub_un (anti_convert (convert x))) = x.
+Proof.
+Intros x; Rewrite bij2; Rewrite sub_add_one; Trivial with arith.
+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 true_sub_convert:
+  (x,y:positive) (compare x y EGAL) = SUPERIEUR -> 
+     (convert (true_sub x y)) = (minus (convert x) (convert y)).
+Proof.
+Intros x y H; Apply plus_reg_l with (convert y);
+Rewrite le_plus_minus_r; [
+  Rewrite <- convert_add; Rewrite sub_add; Auto with arith
+| Apply lt_le_weak; Exact (compare_convert_SUPERIEUR x y H)].
+Qed.
+
+(** [nat_of_P] is injective *)
+
+Lemma convert_intro : (x,y:positive)(convert x)=(convert y) -> x=y.
+Proof.
+Intros x y H;Rewrite <- (bij3 x);Rewrite <- (bij3 y); Rewrite H; Trivial with arith.
+Qed.
+
+Lemma ZL16: (p,q:positive)(lt (minus (convert p) (convert q)) (convert p)).
+Proof.
+Intros p q; Elim (ZL4 p);Elim (ZL4 q); Intros h H1 i H2; 
+Rewrite H1;Rewrite H2; Simpl;Unfold lt; Apply le_n_S; Apply le_minus.
+Qed.
+
+Lemma ZL17: (p,q:positive)(lt (convert p) (convert (add p q))).
+Proof.
+Intros p q; Rewrite convert_add;Unfold lt;Elim (ZL4 q); Intros k H;Rewrite H;
+Rewrite plus_sym;Simpl; Apply le_n_S; Apply le_plus_r.
+Qed.
+
+(** Comparison and subtraction *)
+
+Lemma compare_true_sub_right :
+  (p,q,z:positive)
+  (compare q p EGAL)=INFERIEUR->
+  (compare z p EGAL)=SUPERIEUR->
+  (compare z q EGAL)=SUPERIEUR->
+  (compare (true_sub z p) (true_sub z q) EGAL)=INFERIEUR.
+Proof.
+Intros; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
+  Rewrite true_sub_convert; [
+    Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
+      Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
+        Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
+          Rewrite (plus_sym (convert p)); Apply lt_reg_l;
+          Apply compare_convert_INFERIEUR; Assumption 
+        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
+          Apply ZC1; Assumption ]
+      | Apply lt_le_weak;Apply compare_convert_INFERIEUR;
+        Apply ZC1; Assumption ]
+    | Assumption ]
+  | Assumption ].
+Qed.
+
+Lemma compare_true_sub_left :
+  (p,q,z:positive)
+  (compare q p EGAL)=INFERIEUR->
+  (compare p z EGAL)=SUPERIEUR->
+  (compare q z EGAL)=SUPERIEUR->
+  (compare (true_sub q z) (true_sub p z) EGAL)=INFERIEUR.
+Proof.
+Intros p q z; Intros; 
+  Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
+  Rewrite true_sub_convert; [
+    Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
+    Rewrite le_plus_minus_r; [
+      Rewrite le_plus_minus_r; [
+        Apply compare_convert_INFERIEUR;Assumption
+      | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
+    | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; Assumption]
+  | Assumption]
+| Assumption].
+Qed.
+
+(** Distributivity of multiplication over subtraction *)
+
+Theorem times_true_sub_distr:
+  (x,y,z:positive) (compare y z EGAL) = SUPERIEUR -> 
+      (times x (true_sub y z)) = (true_sub (times x y) (times x z)).
+Proof.
+Intros x y z H; Apply convert_intro;
+Rewrite times_convert; Rewrite true_sub_convert; [
+  Rewrite true_sub_convert; [
+    Do 2 Rewrite times_convert;
+    Do 3 Rewrite (mult_sym (convert x));Apply mult_minus_distr
+  | Apply convert_compare_SUPERIEUR; Do 2 Rewrite times_convert; 
+    Unfold gt; Elim (ZL4 x);Intros h H1;Rewrite H1; Apply lt_mult_left;
+    Exact (compare_convert_SUPERIEUR y z H) ]
+| Assumption ].
+Qed.
+
diff --git a/theories7/Reals/Alembert.v b/theories7/Reals/Alembert.v
new file mode 100644
index 00000000..702daffc
--- /dev/null
+++ b/theories7/Reals/Alembert.v
@@ -0,0 +1,549 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Alembert.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require SeqProp.
+Require PartSum.
+Require Max.
+
+Open Local Scope R_scope.
+
+(***************************************************)
+(* Various versions of the criterion of D'Alembert *)
+(***************************************************)
+
+Lemma Alembert_C1 : (An:nat->R) ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros An H H0.
+Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intro; Apply X.
+Apply complet.
+Unfold Un_cv in H0; Unfold bound; Cut ``0</2``; [Intro | Apply Rlt_Rinv; Sup0].
+Elim (H0 ``/2`` H1); Intros.
+Exists ``(sum_f_R0 An x)+2*(An (S x))``.
+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 (Rplus (sum_f_R0 An x1) (sum_f_R0 [i:nat](An (plus (S x1) i)) (minus x (S x1)))).
+Pattern 1 (sum_f_R0 An x1); Rewrite <- Rplus_Or; Rewrite Rplus_assoc; Apply Rle_compatibility.
+Left; Apply gt0_plus_gt0_is_gt0.
+Apply tech1; Intros; Apply H.
+Apply Rmult_lt_pos; [Sup0 | Apply H].
+Symmetry; Apply tech2; Assumption.
+Rewrite b; Pattern 1 (sum_f_R0 An x); Rewrite <- Rplus_Or; Apply Rle_compatibility.
+Left; Apply Rmult_lt_pos; [Sup0 | Apply H].
+Replace (sum_f_R0 An x1) with (Rplus (sum_f_R0 An x) (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x)))).
+Apply Rle_compatibility.
+Cut (Rle (sum_f_R0 [i:nat](An (plus (S x) i)) (minus x1 (S x))) (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x))))).
+Intro; Apply Rle_trans with (Rmult (An (S x)) (sum_f_R0 [i:nat](pow ``/2`` i) (minus x1 (S x)))).
+Assumption.
+Rewrite <- (Rmult_sym (An (S x))); Apply Rle_monotony.
+Left; Apply H.
+Rewrite tech3.
+Replace ``1-/2`` with ``/2``.
+Unfold Rdiv; Rewrite Rinv_Rinv.
+Pattern 3 ``2``; Rewrite <- Rmult_1r; Rewrite <- (Rmult_sym ``2``); Apply Rle_monotony.
+Left; Sup0.
+Left; Apply Rlt_anti_compatibility with ``(pow (/2) (S (minus x1 (S x))))``.
+Replace ``(pow (/2) (S (minus x1 (S x))))+(1-(pow (/2) (S (minus x1 (S x)))))`` with R1; [Idtac | Ring].
+Rewrite <- (Rplus_sym ``1``); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Apply pow_lt; Apply Rlt_Rinv; Sup0.
+DiscrR.
+Apply r_Rmult_mult with ``2``.
+Rewrite Rminus_distr; Rewrite <- Rinv_r_sym.
+Ring.
+DiscrR.
+DiscrR.
+Pattern 3 R1; Replace R1 with ``/1``; [Apply tech7; DiscrR | Apply Rinv_R1].
+Replace (An (S x)) with (An (plus (S x) O)).
+Apply (tech6 [i:nat](An (plus (S x) i)) ``/2``).
+Left; Apply Rlt_Rinv; Sup0.
+Intro; Cut (n:nat)(ge n x)->``(An (S n))</2*(An n)``.
+Intro; Replace (plus (S x) (S i)) with (S (plus (S x) i)).
+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 Rlt_monotony_contra with ``/(An n)``.
+Apply Rlt_Rinv; Apply H.
+Do 2 Rewrite (Rmult_sym ``/(An n)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-0))``.
+Apply H2; Assumption.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_right.
+Unfold Rdiv; Reflexivity.
+Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply H].
+Red; Intro; Assert H8 := (H n); Rewrite H7 in H8; Elim (Rlt_antirefl ? H8).
+Replace (plus (S x) O) with (S x); [Reflexivity | Ring].
+Symmetry; Apply tech2; Assumption.
+Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
+Intro; Elim X; Intros.
+Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
+Qed.
+
+Lemma Alembert_C2 : (An:nat->R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) R0) -> (SigT R  [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros.
+Pose Vn := [i:nat]``(2*(Rabsolu (An i))+(An i))/2``.
+Pose Wn := [i:nat]``(2*(Rabsolu (An i))-(An i))/2``.
+Cut (n:nat)``0<(Vn n)``.
+Intro; Cut (n:nat)``0<(Wn n)``.
+Intro; Cut (Un_cv [n:nat](Rabsolu ``(Vn (S n))/(Vn n)``) ``0``).
+Intro; Cut (Un_cv [n:nat](Rabsolu ``(Wn (S n))/(Wn n)``) ``0``).
+Intro; Assert H5 := (Alembert_C1 Vn H1 H3).
+Assert H6 := (Alembert_C1 Wn H2 H4).
+Elim H5; Intros.
+Elim H6; Intros.
+Apply Specif.existT with ``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.
+Pose N := (max x1 x2).
+Exists N; Intros; Replace (sum_f_R0 An n) with (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)).
+Unfold R_dist; Replace (Rminus (Rminus (sum_f_R0 Vn n) (sum_f_R0 Wn n)) (Rminus x x0)) with (Rplus (Rminus (sum_f_R0 Vn n) x) (Ropp (Rminus (sum_f_R0 Wn n) x0))); [Idtac | Ring]; Apply Rle_lt_trans with (Rplus (Rabsolu (Rminus (sum_f_R0 Vn n) x)) (Rabsolu (Ropp (Rminus (sum_f_R0 Wn n) x0)))).
+Apply Rabsolu_triang.
+Rewrite Rabsolu_Ropp; Apply Rlt_le_trans with ``eps/2+eps/2``.
+Apply Rplus_lt.
+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_sym ``/2``); Apply r_Rmult_mult with ``2``.
+Rewrite Rminus_distr; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Ring.
+DiscrR.
+DiscrR.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Cut (n:nat)``/2*(Rabsolu (An n))<=(Wn n)<=(3*/2)*(Rabsolu (An n))``.
+Intro; Cut (n:nat)``/(Wn n)<=2*/(Rabsolu (An n))``.
+Intro; Cut (n:nat)``(Wn (S n))/(Wn n)<=3*(Rabsolu (An (S n))/(An n))``.
+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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11; Rewrite Rabsolu_Rabsolu in H11; Rewrite Rabsolu_right.
+Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
+Apply H6.
+Apply Rlt_monotony_contra with ``/3``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H11; Exact H11.
+Left; Change ``0<(Wn (S n))/(Wn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply H2.
+Apply Rlt_Rinv; Apply H2.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Intro; Unfold Rdiv; Rewrite Rabsolu_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*/(Rabsolu (An n))``.
+Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply H2.
+Apply H5.
+Rewrite Rabsolu_Rinv.
+Replace ``(Wn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Wn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
+Left; Apply Rmult_lt_pos.
+Sup0.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
+Elim (H4 (S n)); Intros; Assumption.
+Apply H.
+Intro; Apply Rle_monotony_contra with (Wn n).
+Apply H2.
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with (Rabsolu (An n)).
+Apply Rabsolu_pos_lt; Apply H.
+Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Wn n)*(2*/(Rabsolu (An n))))`` with ``2*(Wn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Elim (H4 n); Intros; Assumption.
+DiscrR.
+Apply Rabsolu_no_R0; Apply H.
+Red; Intro; Assert H6 := (H2 n); Rewrite H5 in H6; Elim (Rlt_antirefl ? H6).
+Intro; Split.
+Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Sup0.
+Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Unfold Rminus; Rewrite Rplus_assoc; Apply Rle_compatibility.
+Apply Rle_anti_compatibility with (An n).
+Rewrite Rplus_Or; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_Rabsolu.
+Unfold Wn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Sup0.
+Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Cut (n:nat)``/2*(Rabsolu (An n))<=(Vn n)<=(3*/2)*(Rabsolu (An n))``.
+Intro; Cut (n:nat)``/(Vn n)<=2*/(Rabsolu (An n))``.
+Intro; Cut (n:nat)``(Vn (S n))/(Vn n)<=3*(Rabsolu (An (S n))/(An n))``.
+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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold R_dist in H10; Unfold Rminus in H10; Rewrite Ropp_O in H10; Rewrite Rplus_Or in H10; Rewrite Rabsolu_Rabsolu in H10; Rewrite Rabsolu_right.
+Apply Rle_lt_trans with ``3*(Rabsolu ((An (S n))/(An n)))``.
+Apply H5.
+Apply Rlt_monotony_contra with ``/3``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H10; Exact H10.
+Left; Change ``0<(Vn (S n))/(Vn n)``; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply H1.
+Apply Rlt_Rinv; Apply H1.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Intro; Unfold Rdiv; Rewrite Rabsolu_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*/(Rabsolu (An n))``.
+Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply H1.
+Apply H4.
+Rewrite Rabsolu_Rinv.
+Replace ``(Vn (S n))*2*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*(Vn (S n))``; [Idtac | Ring]; Replace ``2*(3*/2)*(Rabsolu (An (S n)))*/(Rabsolu (An n))`` with ``(2*/(Rabsolu (An n)))*((3*/2)*(Rabsolu (An (S n))))``; [Idtac | Ring]; Apply Rle_monotony.
+Left; Apply Rmult_lt_pos.
+Sup0.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply H.
+Elim (H3 (S n)); Intros; Assumption.
+Apply H.
+Intro; Apply Rle_monotony_contra with (Vn n).
+Apply H1.
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with (Rabsolu (An n)).
+Apply Rabsolu_pos_lt; Apply H.
+Rewrite Rmult_1r; Replace ``(Rabsolu (An n))*((Vn n)*(2*/(Rabsolu (An n))))`` with ``2*(Vn n)*((Rabsolu (An n))*/(Rabsolu (An n)))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Apply Rle_monotony_contra with ``/2``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Elim (H3 n); Intros; Assumption.
+DiscrR.
+Apply Rabsolu_no_R0; Apply H.
+Red; Intro; Assert H5 := (H1 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
+Intro; Split.
+Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Sup0.
+Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Rewrite double; Rewrite Rplus_assoc; Apply Rle_compatibility.
+Apply Rle_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Rewrite <- (Rplus_sym (An n)); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Unfold Vn; Unfold Rdiv; Repeat Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Sup0.
+Unfold Rminus; Rewrite double; Replace ``3*(Rabsolu (An n))`` with ``(Rabsolu (An n))+(Rabsolu (An n))+(Rabsolu (An n))``; [Idtac | Ring]; Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility; Apply Rle_Rabsolu.
+Intro; Unfold Wn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
+Apply Rlt_Rinv; Sup0.
+Apply Rlt_anti_compatibility with (An n); Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym (An n)); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
+Apply Rle_Rabsolu.
+Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
+Intro; Unfold Vn; Unfold Rdiv; Rewrite <- (Rmult_Or ``/2``); Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
+Apply Rlt_Rinv; Sup0.
+Apply Rlt_anti_compatibility with ``-(An n)``; Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym ``-(An n)``); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply Rle_lt_trans with (Rabsolu (An n)).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Rewrite double; Pattern 1 (Rabsolu (An n)); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rabsolu_pos_lt; Apply H.
+Qed.
+
+Lemma AlembertC3_step1 : (An:nat->R;x:R) ``x<>0`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
+Intros; Pose Bn := [i:nat]``(An i)*(pow x i)``.
+Cut (n:nat)``(Bn n)<>0``.
+Intro; Cut (Un_cv [n:nat](Rabsolu ``(Bn (S n))/(Bn n)``) ``0``).
+Intro; Assert H4 := (Alembert_C2 Bn H2 H3).
+Elim H4; Intros.
+Apply Specif.existT with x0; Unfold Bn in p; Apply tech12; Assumption.
+Unfold Un_cv; Intros; Unfold Un_cv in H1; Cut ``0<eps/(Rabsolu x)``.
+Intro; Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
+Exists x0; Intros; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Bn; Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
+Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Rewrite <- (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H5; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``(R_dist (Rabsolu ((An (S n))*/(An n))) 0)``.
+Apply H5; Assumption.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Unfold Rdiv; Reflexivity.
+Apply Rabsolu_no_R0; Assumption.
+Replace (S n) with (plus n (1)); [Idtac | Ring]; Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
+Replace ``(An (plus n (S O)))*((pow x n)*(pow x (S O)))*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*(pow x (S O))*/(An n)*((pow x n)*/(pow x n))``; [Idtac | Ring]; Rewrite <- Rinv_r_sym.
+Simpl; Ring.
+Apply pow_nonzero; Assumption.
+Apply H0.
+Apply pow_nonzero; Assumption.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
+Intro; Unfold Bn; Apply prod_neq_R0; [Apply H0 | Apply pow_nonzero; Assumption].
+Qed.
+
+Lemma AlembertC3_step2 : (An:nat->R;x:R) ``x==0`` -> (SigT R [l:R](Pser An x l)).
+Intros; Apply Specif.existT with (An O).
+Unfold Pser; Unfold infinit_sum; Intros; Exists O; Intros; Replace (sum_f_R0 [n0:nat]``(An n0)*(pow x n0)`` n) with (An O).
+Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Induction n.
+Simpl; Ring.
+Rewrite tech5; Rewrite Hrecn; [Rewrite H; Simpl; Ring | Unfold ge; Apply le_O_n].
+Qed.
+
+(* An useful criterion of convergence for power series *)
+Theorem Alembert_C3 : (An:nat->R;x:R) ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) ``0``) -> (SigT R [l:R](Pser An x l)).
+Intros; Case (total_order_T x R0); Intro.
+Elim s; Intro.
+Cut ``x<>0``.
+Intro; Apply AlembertC3_step1; Assumption.
+Red; Intro; Rewrite H1 in a; Elim (Rlt_antirefl ? a).
+Apply AlembertC3_step2; Assumption.
+Cut ``x<>0``.
+Intro; Apply AlembertC3_step1; Assumption.
+Red; Intro; Rewrite H1 in r; Elim (Rlt_antirefl ? r).
+Qed.
+
+Lemma Alembert_C4 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``0<(An n)``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros An k Hyp H H0.
+Cut (sigTT R [l:R](is_lub (EUn [N:nat](sum_f_R0 An N)) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intro; Apply X.
+Apply complet.
+Assert H1 := (tech13 ? ? Hyp H0).
+Elim H1; Intros.
+Elim H2; Intros.
+Elim H4; Intros.
+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).
+Elim H8; Intros.
+Elim a; Intro.
+Replace (sum_f_R0 An x0) with (Rplus (sum_f_R0 An x2) (sum_f_R0 [i:nat](An (plus (S x2) i)) (minus x0 (S x2)))).
+Pattern 1 (sum_f_R0 An x2); Rewrite <- Rplus_Or.
+Rewrite Rplus_assoc; Apply Rle_compatibility.
+Left; Apply gt0_plus_gt0_is_gt0.
+Apply tech1.
+Intros; Apply H.
+Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
+Apply H.
+Symmetry; Apply tech2; Assumption.
+Rewrite b; Pattern 1 (sum_f_R0 An x0); Rewrite <- Rplus_Or; Apply Rle_compatibility.
+Left; Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
+Apply H.
+Replace (sum_f_R0 An x2) with (Rplus (sum_f_R0 An x0) (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0)))).
+Apply Rle_compatibility.
+Cut (Rle (sum_f_R0 [i:nat](An (plus (S x0) i)) (minus x2 (S x0))) (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0))))).
+Intro; Apply Rle_trans with (Rmult (An (S x0)) (sum_f_R0 [i:nat](pow x i) (minus x2 (S x0)))).
+Assumption.
+Rewrite <- (Rmult_sym (An (S x0))); Apply Rle_monotony.
+Left; Apply H.
+Rewrite tech3.
+Unfold Rdiv; Apply Rle_monotony_contra with ``1-x``.
+Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
+Replace ``x+(1-x)`` with R1; [Elim H3; Intros; Assumption | Ring].
+Do 2 Rewrite (Rmult_sym ``1-x``).
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Apply Rle_anti_compatibility with ``(pow x (S (minus x2 (S x0))))``.
+Replace ``(pow x (S (minus x2 (S x0))))+(1-(pow x (S (minus x2 (S x0)))))`` with R1; [Idtac | Ring].
+Rewrite <- (Rplus_sym R1); Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility.
+Left; Apply pow_lt.
+Apply Rle_lt_trans with k.
+Elim Hyp; Intros; Assumption.
+Elim H3; Intros; Assumption.
+Apply Rminus_eq_contra.
+Red; Intro.
+Elim H3; Intros.
+Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
+Red; Intro.
+Elim H3; Intros.
+Rewrite H10 in H12; Elim (Rlt_antirefl ? H12).
+Replace (An (S x0)) with (An (plus (S x0) O)).
+Apply (tech6 [i:nat](An (plus (S x0) i)) x).
+Left; Apply Rle_lt_trans with k.
+Elim Hyp; Intros; Assumption.
+Elim H3; Intros; Assumption.
+Intro.
+Cut (n:nat)(ge n x0)->``(An (S n))<x*(An n)``.
+Intro.
+Replace (plus (S x0) (S i)) with (S (plus (S x0) i)).
+Apply H9.
+Unfold ge.
+Apply tech8.
+  Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
+Intros.
+Apply Rlt_monotony_contra with ``/(An n)``.
+Apply Rlt_Rinv; Apply H.
+Do 2 Rewrite (Rmult_sym ``/(An n)``).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r.
+Replace ``(An (S n))*/(An n)`` with ``(Rabsolu ((An (S n))/(An n)))``.
+Apply H5; Assumption.
+Rewrite Rabsolu_right.
+Unfold Rdiv; Reflexivity.
+Left; Unfold Rdiv; Change ``0<(An (S n))*/(An n)``; Apply Rmult_lt_pos.
+Apply H.
+Apply Rlt_Rinv; Apply H.
+Red; Intro.
+Assert H11 := (H n).
+Rewrite H10 in H11; Elim (Rlt_antirefl ? H11).
+Replace (plus (S x0) O) with (S x0); [Reflexivity | Ring].
+Symmetry; Apply tech2; Assumption.
+Exists (sum_f_R0 An O); Unfold EUn; Exists O; Reflexivity.
+Intro; Elim X; Intros.
+Apply Specif.existT with x; Apply tech10; [Unfold Un_growing; Intro; Rewrite tech5; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply H | Apply p].
+Qed.
+
+Lemma Alembert_C5 : (An:nat->R;k:R) ``0<=k<1`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros.
+Cut (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (SigT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intro Hyp0; Apply Hyp0.
+Apply cv_cauchy_2.
+Apply cauchy_abs.
+Apply cv_cauchy_1.
+Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat](Rabsolu (An i)) N) l)).
+Intro Hyp; Apply Hyp.
+Apply (Alembert_C4 [i:nat](Rabsolu (An i)) k).
+Assumption.
+Intro; Apply Rabsolu_pos_lt; Apply H0.
+Unfold Un_cv.
+Unfold Un_cv in H1.
+Unfold Rdiv.
+Intros.
+Elim (H1 eps H2); Intros.
+Exists x; Intros.
+Rewrite <- Rabsolu_Rinv.
+Rewrite <- Rabsolu_mult.
+Rewrite Rabsolu_Rabsolu.
+Unfold Rdiv in H3; Apply H3; Assumption.
+Apply H0.
+Intro.
+Elim X; Intros.
+Apply existTT with x.
+Assumption.
+Intro.
+Elim X; Intros.
+Apply Specif.existT with x.
+Assumption.
+Qed.
+
+(* Convergence of power series in D(O,1/k) *)
+(*     k=0 is described in Alembert_C3     *)
+Lemma Alembert_C6 : (An:nat->R;x,k:R) ``0<k`` -> ((n:nat)``(An n)<>0``) -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> ``(Rabsolu x)</k`` -> (SigT R [l:R](Pser An x l)).
+Intros.
+Cut (SigT R [l:R](Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l)).
+Intro.
+Elim X; Intros.
+Apply Specif.existT with x0.
+Apply tech12; Assumption.
+Case (total_order_T x R0); Intro.
+Elim s; Intro.
+EApply Alembert_C5 with ``k*(Rabsolu x)``.
+Split.
+Unfold Rdiv; Apply Rmult_le_pos.
+Left; Assumption.
+Left; Apply Rabsolu_pos_lt.
+Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
+Apply Rlt_monotony_contra with ``/k``.
+Apply Rlt_Rinv; Assumption.
+Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite Rmult_1r; Assumption.
+Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
+Intro; Apply prod_neq_R0.
+Apply H0.
+Apply pow_nonzero.
+Red; Intro; Rewrite H3 in a; Elim (Rlt_antirefl ? a).
+Unfold Un_cv; Unfold Un_cv in H1.
+Intros.
+Cut ``0<eps/(Rabsolu x)``.
+Intro.
+Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
+Exists x0.
+Intros.
+Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
+Unfold R_dist.
+Rewrite Rabsolu_mult.
+Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
+Rewrite Rabsolu_mult.
+Rewrite Rabsolu_Rabsolu.
+Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
+Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite <- (Rmult_sym eps).
+Unfold R_dist in H5.
+Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
+Apply Rabsolu_no_R0.
+Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
+Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite pow_add.
+Simpl.
+Rewrite Rmult_1r.
+Rewrite Rinv_Rmult.
+Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Reflexivity.
+Apply pow_nonzero.
+Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
+Apply H0.
+Apply pow_nonzero.
+Red; Intro; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
+Unfold Rdiv; Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Red; Intro H7; Rewrite H7 in a; Elim (Rlt_antirefl ? a).
+Apply Specif.existT with (An O).
+Unfold Un_cv.
+Intros.
+Exists O.
+Intros.
+Unfold R_dist.
+Replace (sum_f_R0 [i:nat]``(An i)*(pow x i)`` n) with (An O).
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Induction n.
+Simpl; Ring.
+Rewrite tech5.
+Rewrite <- Hrecn.
+Rewrite b; Simpl; Ring.
+Unfold ge; Apply le_O_n.
+EApply Alembert_C5 with ``k*(Rabsolu x)``.
+Split.
+Unfold Rdiv; Apply Rmult_le_pos.
+Left; Assumption.
+Left; Apply Rabsolu_pos_lt.
+Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
+Apply Rlt_monotony_contra with ``/k``.
+Apply Rlt_Rinv; Assumption.
+Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite Rmult_1r; Assumption.
+Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
+Intro; Apply prod_neq_R0.
+Apply H0.
+Apply pow_nonzero.
+Red; Intro; Rewrite H3 in r; Elim (Rlt_antirefl ? r).
+Unfold Un_cv; Unfold Un_cv in H1.
+Intros.
+Cut ``0<eps/(Rabsolu x)``.
+Intro.
+Elim (H1 ``eps/(Rabsolu x)`` H4); Intros.
+Exists x0.
+Intros.
+Replace ``((An (S n))*(pow x (S n)))/((An n)*(pow x n))`` with ``(An (S n))/(An n)*x``.
+Unfold R_dist.
+Rewrite Rabsolu_mult.
+Replace ``(Rabsolu ((An (S n))/(An n)))*(Rabsolu x)-k*(Rabsolu x)`` with ``(Rabsolu x)*((Rabsolu ((An (S n))/(An n)))-k)``; [Idtac | Ring].
+Rewrite Rabsolu_mult.
+Rewrite Rabsolu_Rabsolu.
+Apply Rlt_monotony_contra with ``/(Rabsolu x)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
+Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite <- (Rmult_sym eps).
+Unfold R_dist in H5.
+Unfold Rdiv; Unfold Rdiv in H5; Apply H5; Assumption.
+Apply Rabsolu_no_R0.
+Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
+Unfold Rdiv; Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite pow_add.
+Simpl.
+Rewrite Rmult_1r.
+Rewrite Rinv_Rmult.
+Replace ``(An (plus n (S O)))*((pow x n)*x)*(/(An n)*/(pow x n))`` with ``(An (plus n (S O)))*/(An n)*x*((pow x n)*/(pow x n))``; [Idtac | Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Reflexivity.
+Apply pow_nonzero.
+Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
+Apply H0.
+Apply pow_nonzero.
+Red; Intro; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
+Unfold Rdiv; Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Red; Intro H7; Rewrite H7 in r; Elim (Rlt_antirefl ? r).
+Qed.
diff --git a/theories7/Reals/AltSeries.v b/theories7/Reals/AltSeries.v
new file mode 100644
index 00000000..af4b558a
--- /dev/null
+++ b/theories7/Reals/AltSeries.v
@@ -0,0 +1,362 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: AltSeries.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require SeqProp.
+Require PartSum.
+Require Max.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(**********)
+Definition tg_alt [Un:nat->R] : nat->R := [i:nat]``(pow (-1) i)*(Un i)``.
+Definition positivity_seq [Un:nat->R] : Prop := (n:nat)``0<=(Un n)``.
+
+Lemma CV_ALT_step0 : (Un:nat->R) (Un_decreasing Un) -> (Un_growing [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
+Intros; Unfold Un_growing; Intro.
+Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
+Intro; Rewrite H0.
+Do 4 Rewrite tech5; Repeat Rewrite Rplus_assoc; Apply Rle_compatibility.
+Pattern 1 (tg_alt Un (S (mult (S (S O)) n))); Rewrite <- Rplus_Or.
+Apply Rle_compatibility.
+Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
+Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S n))))``.
+Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S n))))+((Un (mult (S (S O)) (S n)))+ -1*(Un (S (mult (S (S O)) (S n)))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
+Apply H.
+Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
+Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
+Qed.
+
+Lemma CV_ALT_step1 : (Un:nat->R) (Un_decreasing Un) -> (Un_decreasing [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
+Intros; Unfold Un_decreasing; Intro.
+Cut (mult (S (S O)) (S n)) = (S (S (mult (2) n))).
+Intro; Rewrite H0; Do 2 Rewrite tech5; Repeat Rewrite Rplus_assoc.
+Pattern 2 (sum_f_R0 (tg_alt Un) (mult (S (S O)) n)); Rewrite <- Rplus_Or.
+Apply Rle_compatibility.
+Unfold tg_alt; Rewrite <- H0; Rewrite pow_1_odd; Rewrite pow_1_even; Rewrite Rmult_1l.
+Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) n)))``.
+Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) n)))+( -1*(Un (S (mult (S (S O)) n)))+(Un (mult (S (S O)) (S n))))`` with ``(Un (mult (S (S O)) (S n)))``; [Idtac | Ring].
+Rewrite H0; Apply H.
+Cut (n:nat) (S n)=(plus n (1)); [Intro | Intro; Ring].
+Rewrite (H0 n); Rewrite (H0 (S (mult (2) n))); Rewrite (H0 (mult (2) n)); Ring.
+Qed.
+
+(**********)
+Lemma CV_ALT_step2 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (2) N))) R0). 
+Intros; Induction N.
+Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
+Replace ``-1* -1*(Un (S (S O)))`` with (Un (S (S O))); [Idtac | Ring].
+Apply Rle_anti_compatibility with ``(Un (S O))``; Rewrite Rplus_Or.
+Replace ``(Un (S O))+ (-1*(Un (S O))+(Un (S (S O))))`` with (Un (S (S O))); [Apply H | Ring].
+Cut (S (mult (2) (S N))) = (S (S (S (mult (2) N)))).
+Intro; Rewrite H1; Do 2 Rewrite tech5.
+Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))).
+Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) N))); Rewrite <- Rplus_Or.
+Rewrite Rplus_assoc; Apply Rle_compatibility.
+Unfold tg_alt; Rewrite <- H1.
+Rewrite pow_1_odd.
+Cut (S (S (mult (2) (S N)))) = (mult (2) (S (S N))).
+Intro; Rewrite H2; Rewrite pow_1_even; Rewrite Rmult_1l; Rewrite <- H2.
+Apply Rle_anti_compatibility with ``(Un (S (mult (S (S O)) (S N))))``.
+Rewrite Rplus_Or; Replace ``(Un (S (mult (S (S O)) (S N))))+( -1*(Un (S (mult (S (S O)) (S N))))+(Un (S (S (mult (S (S O)) (S N))))))`` with ``(Un (S (S (mult (S (S O)) (S N)))))``; [Idtac | Ring].
+Apply H.
+Apply INR_eq; Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply HrecN.
+Apply INR_eq; Repeat Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Qed.
+
+(* A more general inequality *)
+Lemma CV_ALT_step3 : (Un:nat->R;N:nat) (Un_decreasing Un) -> (positivity_seq Un) -> (Rle (sum_f_R0 [i:nat](tg_alt Un (S i)) N) R0). 
+Intros; Induction N.
+Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1r.
+Apply Rle_anti_compatibility with (Un (S O)).
+Rewrite Rplus_Or; Replace ``(Un (S O))+ -1*(Un (S O))`` with R0; [Apply H0 | Ring].
+Assert H1 := (even_odd_cor N).
+Elim H1; Intros.
+Elim H2; Intro.
+Rewrite H3; Apply CV_ALT_step2; Assumption.
+Rewrite H3; Rewrite tech5.
+Apply Rle_trans with (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))).
+Pattern 2 (sum_f_R0 [i:nat](tg_alt Un (S i)) (S (mult (S (S O)) x))); Rewrite <- Rplus_Or.
+Apply Rle_compatibility.
+Unfold tg_alt; Simpl.
+Replace (plus x (plus x O)) with (mult (2) x); [Idtac | Ring].
+Rewrite pow_1_even.
+Replace `` -1*( -1*( -1*1))*(Un (S (S (S (mult (S (S O)) x)))))`` with ``-(Un (S (S (S (mult (S (S O)) x)))))``; [Idtac | Ring].
+Apply Rle_anti_compatibility with (Un (S (S (S (mult (S (S O)) x))))).
+Rewrite Rplus_Or; Rewrite Rplus_Ropp_r.
+Apply H0.
+Apply CV_ALT_step2; Assumption.
+Qed.
+
+(**********)
+Lemma CV_ALT_step4 : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (has_ub [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
+Intros; Unfold has_ub; Unfold bound.
+Exists ``(Un O)``.
+Unfold is_upper_bound; Intros; Elim H1; Intros.
+Rewrite H2; Rewrite decomp_sum.
+Replace (tg_alt Un O) with ``(Un O)``.
+Pattern 2 ``(Un O)``; Rewrite <- Rplus_Or.
+Apply Rle_compatibility.
+Apply CV_ALT_step3; Assumption.
+Unfold tg_alt; Simpl; Ring.
+Apply lt_O_Sn.
+Qed.
+
+(* This lemma gives an interesting result about alternated series *)
+Lemma CV_ALT : (Un:nat->R) (Un_decreasing Un) -> (positivity_seq Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
+Intros.
+Assert H2 := (CV_ALT_step0 ? H).
+Assert H3 := (CV_ALT_step4 ? H H0).
+Assert X := (growing_cv ? H2 H3).
+Elim X; Intros.
+Apply existTT with x.
+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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
+Elim (H1 ``eps/2`` H5); Intros N2 H6.
+Elim (p ``eps/2`` H5); Intros N1 H7.
+Pose N := (max (S (mult (2) N1)) N2).
+Exists N; Intros.
+Assert H9 := (even_odd_cor n).
+Elim H9; Intros P H10.
+Cut (le N1 P).
+Intro; Elim H10; Intro.
+Replace ``(sum_f_R0 (tg_alt Un) n)-x`` with ``((sum_f_R0 (tg_alt Un) (S n))-x)+(-(tg_alt Un (S n)))``.
+Apply Rle_lt_trans with ``(Rabsolu ((sum_f_R0 (tg_alt Un) (S n))-x))+(Rabsolu (-(tg_alt Un (S n))))``.
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Apply Rplus_lt.
+Rewrite H12; Apply H7; Assumption.
+Rewrite Rabsolu_Ropp; Unfold tg_alt; Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l; Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite <- (Rplus_Or (Un (S n))); Apply H6.
+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; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
+Rewrite RIneq.double.
+Pattern 1 eps; Rewrite <- (Rplus_Or eps); Apply Rlt_compatibility; Assumption.
+Elim H10; Intro; Apply le_double.
+Rewrite <- H11; Apply le_trans with N.
+Unfold N; Apply le_trans with (S (mult (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; Apply lt_le_trans with (S (mult (2) N1)).
+Apply lt_n_Sn.
+Apply le_max_l.
+Assumption.
+Qed.
+
+(************************************************)
+(*        Convergence of alternated series      *)
+(*                                              *)
+(*         Applications: PI, cos, sin           *)
+(************************************************)
+Theorem alternated_series : (Un:nat->R) (Un_decreasing Un) -> (Un_cv Un R0) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l)).
+Intros; Apply CV_ALT.
+Assumption.
+Unfold positivity_seq; Apply decreasing_ineq; Assumption.
+Assumption.
+Qed.
+
+Theorem alternated_series_ineq : (Un:nat->R;l:R;N:nat) (Un_decreasing Un) -> (Un_cv Un R0) -> (Un_cv [N:nat](sum_f_R0 (tg_alt Un) N) l) -> ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) N)))<=l<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) N))``.
+Intros.
+Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N)) l).
+Cut (Un_cv [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N))) l).
+Intros; Split.
+Apply (growing_ineq [N:nat](sum_f_R0 (tg_alt Un) (S (mult (2) N)))).
+Apply CV_ALT_step0; Assumption.
+Assumption.
+Apply (decreasing_ineq [N:nat](sum_f_R0 (tg_alt Un) (mult (2) N))).
+Apply CV_ALT_step1; Assumption.
+Assumption.
+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; Apply le_trans with (mult (2) n).
+Apply le_trans with n.
+Assumption.
+Assert H5 := (mult_O_le n (2)).
+Elim H5; Intro. 
+Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
+Assumption.
+Apply le_n_Sn.
+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; Apply le_trans with n.
+Assumption.
+Assert H5 := (mult_O_le n (2)).
+Elim H5; Intro. 
+Cut ~(O)=(2); [Intro; Elim H7; Symmetry; Assumption | Discriminate].
+Assumption.
+Qed.
+
+(************************************)
+(* Application : construction of PI *)
+(************************************)
+
+Definition PI_tg := [n:nat]``/(INR (plus (mult (S (S O)) n) (S O)))``.
+
+Lemma PI_tg_pos : (n:nat)``0<=(PI_tg n)``.
+Intro; Unfold PI_tg; Left; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Qed.
+
+Lemma PI_tg_decreasing : (Un_decreasing PI_tg).
+Unfold PI_tg Un_decreasing; Intro.
+Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
+Apply lt_INR_0.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with ``(INR (plus (mult (S (S O)) (S n)) (S O)))``.
+Apply lt_INR_0.
+Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
+Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) (S n)) (S O)))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Do 2 Rewrite Rmult_1r; Apply le_INR.
+Replace (plus (mult (2) (S n)) (1)) with (S (S (plus (mult (2) n) (1)))).
+Apply le_trans with (S (plus (mult (2) n) (1))); Apply le_n_Sn.
+Apply INR_eq; Do 2  Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
+Qed.
+
+Lemma PI_tg_cv : (Un_cv PI_tg R0).
+Unfold Un_cv; Unfold R_dist; Intros.
+Cut ``0<2*eps``; [Intro | Apply Rmult_lt_pos; [Sup0 | Assumption]].
+Assert H1 := (archimed ``/(2*eps)``).
+Cut (Zle `0` ``(up (/(2*eps)))``).
+Intro; Assert H3 := (IZN ``(up (/(2*eps)))`` H2).
+Elim H3; Intros N H4.
+Cut (lt O N).
+Intro; Exists N; Intros.
+Cut (lt O n).
+Intro; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_right.
+Unfold PI_tg; Apply Rlt_trans with ``/(INR (mult (S (S O)) n))``.
+Apply Rlt_monotony_contra with ``(INR (mult (S (S O)) n))``.
+Apply lt_INR_0.
+Replace (mult (2) n) with (plus n n); [Idtac | Ring].
+Apply lt_le_trans with n.
+Assumption.
+Apply le_plus_l.
+Rewrite <- Rinv_r_sym.
+Apply Rlt_monotony_contra with ``(INR (plus (mult (S (S O)) n) (S O)))``.
+Apply lt_INR_0.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Rewrite (Rmult_sym ``(INR (plus (mult (S (S O)) n) (S O)))``).
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Do 2 Rewrite Rmult_1r; Apply lt_INR.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_n_Sn | Ring].
+Apply not_O_INR; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Discriminate | Ring].
+Replace n with (S (pred n)).
+Apply not_O_INR; Discriminate.
+Symmetry; Apply S_pred with O.
+Assumption.
+Apply Rle_lt_trans with ``/(INR (mult (S (S O)) N))``.
+Apply Rle_monotony_contra with ``(INR (mult (S (S O)) N))``.
+Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with ``(INR (mult (S (S O)) n))``.
+Rewrite mult_INR; Apply Rmult_lt_pos; [Simpl; Sup0 | Apply lt_INR_0; Assumption].
+Rewrite (Rmult_sym (INR (mult (S (S O)) n))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Do 2 Rewrite Rmult_1r; Apply le_INR.
+Apply mult_le; Assumption.
+Replace n with (S (pred n)).
+Apply not_O_INR; Discriminate.
+Symmetry; Apply S_pred with O.
+Assumption.
+Replace N with (S (pred N)).
+Apply not_O_INR; Discriminate.
+Symmetry; Apply S_pred with O.
+Assumption.
+Rewrite mult_INR.
+Rewrite Rinv_Rmult.
+Replace (INR (S (S O))) with ``2``; [Idtac | Reflexivity].
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Idtac | DiscrR].
+Rewrite Rmult_1l; Apply Rlt_monotony_contra with (INR N).
+Apply lt_INR_0; Assumption.
+Rewrite <- Rinv_r_sym.
+Apply Rlt_monotony_contra with ``/(2*eps)``.
+Apply Rlt_Rinv; Assumption.
+Rewrite Rmult_1r; Replace ``/(2*eps)*((INR N)*(2*eps))`` with ``(INR N)*((2*eps)*/(2*eps))``; [Idtac | Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Replace (INR N) with (IZR (INZ N)).
+Rewrite <- H4.
+Elim H1; Intros; Assumption.
+Symmetry; Apply INR_IZR_INZ.
+Apply prod_neq_R0; [DiscrR | Red; Intro; Rewrite H8 in H; Elim (Rlt_antirefl ? H)].
+Apply not_O_INR.
+Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
+Replace (INR (S (S O))) with ``2``; [DiscrR | Reflexivity].
+Apply not_O_INR.
+Red; Intro; Rewrite H8 in H5; Elim (lt_n_n ? H5).
+Apply Rle_sym1; Apply PI_tg_pos.
+Apply lt_le_trans with N; Assumption.
+Elim H1; Intros H5 _.
+Assert H6 := (lt_eq_lt_dec O N).
+Elim H6; Intro.
+Elim a; Intro.
+Assumption.
+Rewrite <- b in H4.
+Rewrite H4 in H5.
+Simpl in H5.
+Cut ``0</(2*eps)``; [Intro | Apply Rlt_Rinv; Assumption].
+Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H7 H5)).
+Elim (lt_n_O ? b).
+Apply le_IZR.
+Simpl.
+Left; Apply Rlt_trans with ``/(2*eps)``.
+Apply Rlt_Rinv; Assumption.
+Elim H1; Intros; Assumption.
+Qed.
+
+Lemma exist_PI : (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 (tg_alt PI_tg) N) l)).
+Apply alternated_series.
+Apply PI_tg_decreasing.
+Apply PI_tg_cv.
+Qed.
+
+(* Now, PI is defined *)
+Definition PI : R := (Rmult ``4`` (Cases exist_PI of (existTT a b) => a end)).
+
+(* We can get an approximation of PI with the following inequality *)
+Lemma PI_ineq : (N:nat) ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) N)))<=PI/4<=(sum_f_R0 (tg_alt PI_tg) (mult (S (S O)) N))``.
+Intro; Apply alternated_series_ineq.
+Apply PI_tg_decreasing.
+Apply PI_tg_cv.
+Unfold PI; Case exist_PI; Intro.
+Replace ``(4*x)/4`` with x.
+Trivial.
+Unfold Rdiv; Rewrite (Rmult_sym ``4``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r; Reflexivity | DiscrR].
+Qed.
+
+Lemma PI_RGT_0 : ``0<PI``.
+Assert H := (PI_ineq O).
+Apply Rlt_monotony_contra with ``/4``.
+Apply Rlt_Rinv; Sup0.
+Rewrite Rmult_Or; Rewrite Rmult_sym.
+Elim H; Clear H; Intros H _.
+Unfold Rdiv in H; Apply Rlt_le_trans with ``(sum_f_R0 (tg_alt PI_tg) (S (mult (S (S O)) O)))``.
+Simpl; Unfold tg_alt; Simpl; Rewrite Rmult_1l; Rewrite Rmult_1r; Apply Rlt_anti_compatibility with ``(PI_tg (S O))``.
+Rewrite Rplus_Or; Replace ``(PI_tg (S O))+((PI_tg O)+ -1*(PI_tg (S O)))`` with ``(PI_tg O)``; [Unfold PI_tg | Ring].
+Simpl; Apply Rinv_lt.
+Rewrite Rmult_1l; Replace ``2+1`` with ``3``; [Sup0 | Ring].
+Rewrite Rplus_sym; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Sup0.
+Assumption.
+Qed.
diff --git a/theories7/Reals/ArithProp.v b/theories7/Reals/ArithProp.v
new file mode 100644
index 00000000..468675ca
--- /dev/null
+++ b/theories7/Reals/ArithProp.v
@@ -0,0 +1,134 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: ArithProp.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rbasic_fun.
+Require Even.
+Require Div2.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope Z_scope.
+Open Local Scope R_scope.
+
+Lemma minus_neq_O : (n,i:nat) (lt i n) -> ~(minus n i)=O.
+Intros; Red; Intro.
+Cut (n,m:nat) (le m n) -> (minus n m)=O -> n=m.
+Intro; Assert H2 := (H1 ? ? (lt_le_weak ? ? H) H0); Rewrite H2 in H; Elim (lt_n_n ? H).
+Pose R := [n,m:nat](le m n)->(minus n m)=(0)->n=m.
+Cut ((n,m:nat)(R n m)) -> ((n0,m:nat)(le m n0)->(minus n0 m)=(0)->n0=m).
+Intro; Apply H1.
+Apply nat_double_ind.
+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; Intros; Apply H1; Assumption.
+Qed.
+
+Lemma le_minusni_n : (n,i:nat) (le i n)->(le (minus n i) n).
+Pose R := [m,n:nat] (le n m) -> (le (minus m n) m).
+Cut ((m,n:nat)(R m n)) -> ((n,i:nat)(le i n)->(le (minus n i) n)).
+Intro; Apply H.
+Apply nat_double_ind.
+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; Intros; Apply H; Assumption.
+Qed.
+
+Lemma lt_minus_O_lt : (m,n:nat) (lt m n) -> (lt O (minus n m)).
+Intros n m; Pattern n m; Apply nat_double_ind; [
+  Intros; Rewrite <- minus_n_O; Assumption
+| Intros; Elim (lt_n_O ? H)
+| Intros; Simpl; Apply H; Apply lt_S_n; Assumption].
+Qed.
+
+Lemma even_odd_cor : (n:nat) (EX p : nat | n=(mult (2) p)\/n=(S (mult (2) p))).
+Intro.
+Assert H := (even_or_odd n).
+Exists (div2 n).
+Assert H0 := (even_odd_double n).
+Elim H0; Intros.
+Elim H1; Intros H3 _.
+Elim H2; Intros H4 _.
+Replace (mult (2) (div2 n)) with (Div2.double (div2 n)).
+Elim H; Intro.
+Left.
+Apply H3; Assumption.
+Right.
+Apply H4; Assumption.
+Unfold Div2.double; Ring.
+Qed.
+
+(* 2m <= 2n => m<=n *)
+Lemma le_double : (m,n:nat) (le (mult (2) m) (mult (2) n)) -> (le m n).
+Intros; Apply INR_le.
+Assert H1 := (le_INR ? ? H).
+Do 2 Rewrite mult_INR in H1.
+Apply Rle_monotony_contra with ``(INR (S (S O)))``.
+Replace (INR (S (S O))) with ``2``; [Sup0 | Reflexivity].
+Assumption.
+Qed.
+
+(* Here, we have the euclidian division *)
+(* This lemma is used in the proof of sin_eq_0 : (sin x)=0<->x=kPI *)
+Lemma euclidian_division : (x,y:R) ``y<>0`` -> (EXT k:Z | (EXT r : R | ``x==(IZR k)*y+r``/\``0<=r<(Rabsolu y)``)).
+Intros.
+Pose k0 := Cases (case_Rabsolu y) of
+     (leftT _) => (Zminus `1` (up ``x/-y``))
+   | (rightT _) => (Zminus (up ``x/y``) `1`) end.
+Exists k0.
+Exists ``x-(IZR k0)*y``.
+Split.
+Ring.
+Unfold k0; Case (case_Rabsolu 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.
+Apply Rle_monotony_contra with ``/-y``.
+Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
+Rewrite Rmult_Or; Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
+Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption].
+Apply Rle_anti_compatibility with ``(IZR (up (x/( -y))))-x/( -y)``.
+Rewrite Rplus_Or; Unfold Rdiv; Pattern 4 ``/-y``; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
+Replace ``(IZR (up (x*/ -y)))-x* -/y+( -(x*/y)+ -((IZR (up (x*/ -y)))-1))`` with R1; [Idtac | Ring].
+Elim H0; Intros _ H1; Unfold Rdiv in H1; Exact H1.
+Rewrite (Rabsolu_left ? r); Apply Rlt_monotony_contra with ``/-y``.
+Apply Rlt_Rinv; Apply Rgt_RO_Ropp; Exact r.
+Rewrite <- Rinv_l_sym.
+Rewrite (Rmult_sym ``/-y``); Rewrite Rmult_Rplus_distrl; Rewrite <- Ropp_Rinv; [Idtac | Assumption].
+Rewrite Rmult_assoc; Repeat Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/( -y))))-1)``.
+Replace ``(IZR (up (x/( -y))))-1+1`` with ``(IZR (up (x/( -y))))``; [Idtac | Ring].
+Replace ``(IZR (up (x/( -y))))-1+( -(x*/y)+ -((IZR (up (x/( -y))))-1))`` with ``-(x*/y)``; [Idtac | Ring].
+Rewrite <- Ropp_mul3; Rewrite (Ropp_Rinv ? H); Elim H0; Unfold Rdiv; Intros H1 _; Exact H1.
+Apply Ropp_neq; Assumption.
+Assert H0 := (archimed ``x/y``); Rewrite <- Z_R_minus; Simpl; Cut ``0<y``.
+Intro; Unfold Rminus; Replace ``-(((IZR (up (x/y)))+ -1)*y)`` with ``(1-(IZR (up (x/y))))*y``; [Idtac | Ring].
+Split.
+Apply Rle_monotony_contra with ``/y``.
+Apply Rlt_Rinv; Assumption.
+Rewrite Rmult_Or; Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rle_anti_compatibility with ``(IZR (up (x/y)))-x/y``; Rewrite Rplus_Or; Unfold Rdiv; Replace ``(IZR (up (x*/y)))-x*/y+(x*/y+(1-(IZR (up (x*/y)))))`` with R1; [Idtac | Ring]; Elim H0; Intros _ H2; Unfold Rdiv in H2; Exact H2.
+Rewrite (Rabsolu_right ? r); Apply Rlt_monotony_contra with ``/y``.
+Apply Rlt_Rinv; Assumption.
+Rewrite <- (Rinv_l_sym ? H); Rewrite (Rmult_sym ``/y``); Rewrite Rmult_Rplus_distrl; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1r | Assumption]; Apply Rlt_anti_compatibility with ``((IZR (up (x/y)))-1)``; 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; Intros H2 _; Exact H2.
+Case (total_order_T R0 y); Intro.
+Elim s; Intro.
+Assumption.
+Elim H; Symmetry; Exact b.
+Assert H1 := (Rle_sym2 ? ? r); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r0)).
+Qed.
+
+Lemma tech8 : (n,i:nat) (le n (plus (S n) i)).
+Intros; Induction i.
+Replace (plus (S n) O) with (S n); [Apply le_n_Sn | Ring].
+Replace (plus (S n) (S i)) with (S (plus (S n) i)).
+Apply le_S; Assumption.
+Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
+Qed.
diff --git a/theories7/Reals/Binomial.v b/theories7/Reals/Binomial.v
new file mode 100644
index 00000000..1dfd2ec0
--- /dev/null
+++ b/theories7/Reals/Binomial.v
@@ -0,0 +1,181 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Binomial.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require PartSum.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Definition C [n,p:nat] : R := ``(INR (fact n))/((INR (fact p))*(INR (fact (minus n p))))``.
+
+Lemma pascal_step1 : (n,i:nat) (le i n) -> (C n i) == (C n (minus n i)).
+Intros; Unfold C; Replace (minus n (minus n i)) with i.
+Rewrite Rmult_sym.
+Reflexivity.
+Apply plus_minus; Rewrite plus_sym; Apply le_plus_minus; Assumption.
+Qed.
+
+Lemma pascal_step2 : (n,i:nat) (le i n) -> (C (S n) i) == ``(INR (S n))/(INR (minus (S n) i))*(C n i)``.
+Intros; Unfold C; Replace (minus (S n) i) with (S (minus n i)).
+Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
+Intro; Repeat Rewrite H0.
+Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
+Ring.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply not_O_INR; Discriminate.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply prod_neq_R0.
+Apply not_O_INR; Discriminate.
+Apply INR_fact_neq_0.
+Intro; Reflexivity.
+Apply minus_Sn_m; Assumption.
+Qed.
+
+Lemma pascal_step3 : (n,i:nat) (lt i n) -> (C n (S i)) == ``(INR (minus n i))/(INR (S i))*(C n i)``.
+Intros; Unfold C.
+Cut (n:nat) (fact (S n))=(mult (S n) (fact n)).
+Intro.
+Cut (minus n i) = (S (minus n (S i))).
+Intro.
+Pattern 2 (minus n i); Rewrite H1.
+Repeat Rewrite H0; Unfold Rdiv; Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
+Rewrite <- H1; Rewrite (Rmult_sym ``/(INR (minus n i))``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (minus n i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Ring.
+Apply not_O_INR; Apply minus_neq_O; Assumption.
+Apply not_O_INR; Discriminate.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
+Apply not_O_INR; Discriminate.
+Apply INR_fact_neq_0.
+Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
+Apply INR_fact_neq_0.
+Rewrite minus_Sn_m.
+Simpl; Reflexivity.
+Apply lt_le_S; Assumption.
+Intro; Reflexivity.
+Qed.
+
+(**********)
+Lemma pascal : (n,i:nat) (lt i n) -> ``(C n i)+(C n (S i))==(C (S n) (S i))``.
+Intros.
+Rewrite pascal_step3; [Idtac | Assumption].
+Replace ``(C n i)+(INR (minus n i))/(INR (S i))*(C n i)`` with ``(C n i)*(1+(INR (minus n i))/(INR (S i)))``; [Idtac | Ring].
+Replace ``1+(INR (minus n i))/(INR (S i))`` with ``(INR (S n))/(INR (S i))``.
+Rewrite pascal_step1.
+Rewrite Rmult_sym; Replace (S i) with (minus (S n) (minus n i)).
+Rewrite <- pascal_step2.
+Apply pascal_step1.
+Apply le_trans with n.
+Apply le_minusni_n.
+Apply lt_le_weak; Assumption.
+Apply le_n_Sn.
+Apply le_minusni_n.
+Apply lt_le_weak; Assumption.
+Rewrite <- minus_Sn_m.
+Cut (minus n (minus n i))=i.
+Intro; Rewrite H0; Reflexivity.
+Symmetry; Apply plus_minus.
+Rewrite plus_sym; 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.
+Repeat Rewrite S_INR.
+Rewrite minus_INR.
+Cut ``((INR i)+1)<>0``.
+Intro.
+Apply r_Rmult_mult with ``(INR i)+1``; [Idtac | Assumption].
+Rewrite Rmult_Rplus_distr.
+Rewrite Rmult_1r.
+Do 2 Rewrite (Rmult_sym ``(INR i)+1``).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym; [Idtac | Assumption].
+Ring.
+Rewrite <- S_INR.
+Apply not_O_INR; Discriminate.
+Apply lt_le_weak; Assumption.
+Qed.
+
+(*********************)
+(*********************)
+Lemma binomial : (x,y:R;n:nat) ``(pow (x+y) n)``==(sum_f_R0 [i:nat]``(C n i)*(pow x i)*(pow y (minus n i))`` n).
+Intros; Induction n.
+Unfold C; Simpl; Unfold Rdiv; Repeat Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
+Pattern 1 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite pow_add; Rewrite Hrecn.
+Replace ``(pow (x+y) (S O))`` with ``x+y``; [Idtac | Simpl; Ring].
+Rewrite tech5.
+Cut (p:nat)(C p p)==R1.
+Cut (p:nat)(C p O)==R1.
+Intros; Rewrite H0; Rewrite <- minus_n_n; Rewrite Rmult_1l.
+Replace (pow y O) with R1; [Rewrite Rmult_1r | Simpl; Reflexivity].
+Induction n.
+Simpl; Do 2 Rewrite H; Ring.
+(* N >= 1 *)
+Pose N := (S n).
+Rewrite Rmult_Rplus_distr.
+Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) x) with (sum_f_R0 [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))`` N).
+Replace (Rmult (sum_f_R0 ([i:nat]``(C N i)*(pow x i)*(pow y (minus N i))``) N) y) with (sum_f_R0 [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))`` N).
+Rewrite (decomp_sum [i:nat]``(C (S N) i)*(pow x i)*(pow y (minus (S N) i))`` N).
+Rewrite H; Replace (pow x O) with R1; [Idtac | Reflexivity].
+Do 2 Rewrite Rmult_1l.
+Replace (minus (S N) O) with (S N); [Idtac | Reflexivity].
+Pose An := [i:nat]``(C N i)*(pow x (S i))*(pow y (minus N i))``.
+Pose Bn := [i:nat]``(C N (S i))*(pow x (S i))*(pow y (minus N i))``.
+Replace (pred N) with n.
+Replace (sum_f_R0 ([i:nat]``(C (S N) (S i))*(pow x (S i))*(pow y (minus (S N) (S i)))``) n) with (sum_f_R0 [i:nat]``(An i)+(Bn i)`` n).
+Rewrite plus_sum.
+Replace (pow x (S N)) with (An (S n)).
+Rewrite (Rplus_sym (sum_f_R0 An n)).
+Repeat Rewrite Rplus_assoc.
+Rewrite <- tech5.
+Fold N.
+Pose Cn := [i:nat]``(C N i)*(pow x i)*(pow y (minus (S N) i))``.
+Cut (i:nat) (lt i N)-> (Cn (S i))==(Bn i).
+Intro; Replace (sum_f_R0 Bn n) with (sum_f_R0 [i:nat](Cn (S i)) n).
+Replace (pow y (S N)) with (Cn O).
+Rewrite <- Rplus_assoc; Rewrite (decomp_sum Cn N).
+Replace (pred N) with n.
+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; Apply le_lt_trans with n; [Assumption | Apply lt_n_Sn].
+Intros; Unfold Bn Cn.
+Replace (minus (S N) (S i)) with (minus N i); Reflexivity.
+Unfold An; Fold N; Rewrite <- minus_n_n; Rewrite H0; Simpl; Ring.
+Apply sum_eq.
+Intros; Unfold An Bn; Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
+Rewrite <- pascal; [Ring | Apply le_lt_trans with n; [Assumption | Unfold N; Apply lt_n_Sn]].
+Unfold N; Reflexivity.
+Unfold N; Apply lt_O_Sn.
+Rewrite <- (Rmult_sym y); Rewrite scal_sum; Apply sum_eq.
+Intros; Replace (minus (S N) i) with (S (minus N i)).
+Replace (S (minus N i)) with (plus (minus N i) (1)); [Idtac | Ring].
+Rewrite pow_add; Replace (pow y (S O)) with y; [Idtac | Simpl; Ring]; Ring.
+Apply minus_Sn_m; Assumption.
+Rewrite <- (Rmult_sym x); Rewrite scal_sum; Apply sum_eq.
+Intros; Replace (S i) with (plus i (1)); [Idtac | Ring]; Rewrite pow_add; Replace (pow x (S O)) with x; [Idtac | Simpl; Ring]; Ring.
+Intro; Unfold C.
+Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
+Replace (minus p O) with p; [Idtac | Apply minus_n_O].
+Rewrite Rmult_1l; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
+Intro; Unfold C.
+Replace (minus p p) with O; [Idtac | Apply minus_n_n].
+Replace (INR (fact O)) with R1; [Idtac | Reflexivity].
+Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | Apply INR_fact_neq_0].
+Qed.
diff --git a/theories7/Reals/Cauchy_prod.v b/theories7/Reals/Cauchy_prod.v
new file mode 100644
index 00000000..9442eff0
--- /dev/null
+++ b/theories7/Reals/Cauchy_prod.v
@@ -0,0 +1,347 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Cauchy_prod.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require PartSum.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(**********)
+Lemma sum_N_predN : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==``(sum_f_R0 An (pred N)) + (An N)``.
+Intros.
+Replace N with (S (pred N)).
+Rewrite tech5.
+Reflexivity.
+Symmetry; Apply S_pred with O; Assumption.
+Qed.
+
+(**********)
+Lemma sum_plus : (An,Bn:nat->R;N:nat) (sum_f_R0 [l:nat]``(An l)+(Bn l)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
+Intros.
+Induction N.
+Reflexivity.
+Do 3 Rewrite tech5.
+Rewrite HrecN; Ring.
+Qed.
+
+(* The main result *)
+Theorem cauchy_finite : (An,Bn:nat->R;N:nat) (lt O N) -> (Rmult (sum_f_R0 An N) (sum_f_R0 Bn N)) == (Rplus (sum_f_R0 [k:nat](sum_f_R0 [p:nat]``(An p)*(Bn (minus k p))`` k) N) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N))). 
+Intros; Induction N.
+Elim (lt_n_n ? H).
+Cut N=O\/(lt O N).
+Intro; Elim H0; Intro.
+Rewrite H1; Simpl; Ring.
+Replace (pred (S N)) with (S (pred N)).
+Do 5 Rewrite tech5.
+Rewrite Rmult_Rplus_distrl; Rewrite Rmult_Rplus_distr; Rewrite (HrecN H1).
+Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Replace (pred (minus (S N) (S (pred N)))) with (O).
+Rewrite Rmult_Rplus_distr; Replace (sum_f_R0 [l:nat]``(An (S (plus l (S (pred N)))))*(Bn (minus (S N) l))`` O) with ``(An (S N))*(Bn (S N))``.
+Repeat Rewrite <- Rplus_assoc; Do 2 Rewrite <- (Rplus_sym ``(An (S N))*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Rewrite <- minus_n_n; Cut N=(1)\/(le (2) N).
+Intro; Elim H2; Intro.
+Rewrite H3; Simpl; Ring.
+Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))).
+Replace (sum_f_R0 [p:nat]``(An p)*(Bn (minus (S N) p))`` N) with (Rplus (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)) ``(An O)*(Bn (S N))``).
+Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) (Rmult (Bn (S N)) (sum_f_R0 [l:nat](An (S l)) (pred N)))).
+Rewrite (decomp_sum An N H1); Rewrite Rmult_Rplus_distrl; Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym ``(An O)*(Bn (S N))``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Repeat Rewrite <- Rplus_assoc; Rewrite <- (Rplus_sym (Rmult (sum_f_R0 [i:nat](An (S i)) (pred N)) (Bn (S N)))); Rewrite <- (Rplus_sym (Rmult (Bn (S N)) (sum_f_R0 [i:nat](An (S i)) (pred N)))); Rewrite (Rmult_sym (Bn (S N))); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)) with (Rplus (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))) (Rmult (An (S N)) (sum_f_R0 [l:nat](Bn (S l)) (pred N)))).
+Rewrite (decomp_sum Bn N H1); Rewrite Rmult_Rplus_distr.
+Pose Z := (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) (pred (pred N))); Pose Z2 := (sum_f_R0 [i:nat](Bn (S i)) (pred N)); Ring.
+Rewrite (sum_N_predN [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
+Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) (pred (pred N))) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) ``(An (S N))*(Bn (S k))``) (pred (pred N))).
+Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (pred (minus N k)))) [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))).
+Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Replace (pred (minus N (pred N))) with O.
+Simpl; Rewrite <- minus_n_O.
+Replace (S (pred N)) with N.
+Replace (sum_f_R0 [k:nat]``(An (S N))*(Bn (S k))`` (pred (pred N))) with (sum_f_R0 [k:nat]``(Bn (S k))*(An (S N))`` (pred (pred N))).
+Rewrite <- (scal_sum [l:nat](Bn (S l)) (pred (pred N)) (An (S N))); Rewrite (sum_N_predN [l:nat](Bn (S l)) (pred N)).
+Replace (S (pred N)) with N.
+Ring.
+Apply S_pred with O; Assumption.
+Apply lt_pred; Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
+Apply sum_eq; Intros; Apply Rmult_sym.
+Apply S_pred with O; Assumption.
+Replace (minus N (pred N)) with (1).
+Reflexivity.
+Pattern 1 N; Replace N with (S (pred N)).
+Rewrite <- minus_Sn_m.
+Rewrite <- minus_n_n; Reflexivity.
+Apply le_n.
+Symmetry; Apply S_pred with O; Assumption.
+Apply sum_eq; Intros; Rewrite (sum_N_predN [l:nat]``(An (S (S (plus l i))))*(Bn (minus N l))`` (pred (minus N i))).
+Replace (S (S (plus (pred (minus N i)) i))) with (S N).
+Replace (minus N (pred (minus N i))) with (S i).
+Ring.
+Rewrite pred_of_minus; Apply INR_eq; Repeat Rewrite minus_INR.
+Rewrite S_INR; Ring.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply INR_le; Rewrite minus_INR.
+Apply Rle_anti_compatibility with ``(INR i)-1``.
+Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
+Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
+Rewrite <- minus_INR.
+Apply le_INR; Apply le_trans with (pred (pred N)).
+Assumption.
+Rewrite <- pred_of_minus; Apply le_pred_n.
+Apply le_trans with (2).
+Apply le_n_Sn.
+Assumption.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Rewrite <- pred_of_minus.
+Apply le_trans with (pred N).
+Apply le_S_n.
+Replace (S (pred N)) with N.
+Replace (S (pred (minus N i))) with (minus N i).
+Apply simpl_le_plus_l with i; Rewrite le_plus_minus_r.
+Apply le_plus_r.
+Apply le_trans with (pred (pred N)); [Assumption | Apply le_trans with (pred N); Apply le_pred_n].
+Apply S_pred with O.
+Apply simpl_lt_plus_l with i; Rewrite le_plus_minus_r.
+Replace (plus i O) with i; [Idtac | Ring].
+Apply le_lt_trans with (pred (pred N)); [Assumption | Apply lt_trans with (pred N); Apply lt_pred_n_n].
+Apply lt_S_n.
+Replace (S (pred N)) with N.
+Apply lt_le_trans with (2).
+Apply lt_n_Sn.
+Assumption.
+Apply S_pred with O; Assumption.
+Assumption.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply S_pred with O; Assumption.
+Apply le_pred_n.
+Apply INR_eq; Rewrite pred_of_minus; Do 3 Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite minus_INR.
+Ring.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply INR_le.
+Rewrite minus_INR.
+Apply Rle_anti_compatibility with ``(INR i)-1``.
+Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
+Replace ``(INR i)-1+((INR N)-(INR i))`` with ``(INR N)-(INR (S O))``; [Idtac | Ring].
+Rewrite <- minus_INR.
+Apply le_INR.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Rewrite <- pred_of_minus.
+Apply le_pred_n.
+Apply le_trans with (2).
+Apply le_n_Sn.
+Assumption.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply lt_le_trans with (1).
+Apply lt_O_Sn.
+Apply INR_le.
+Rewrite pred_of_minus.
+Repeat Rewrite minus_INR.
+Apply Rle_anti_compatibility with ``(INR i)-1``.
+Replace ``(INR i)-1+(INR (S O))`` with (INR i); [Idtac | Ring].
+Replace ``(INR i)-1+((INR N)-(INR i)-(INR (S O)))`` with ``(INR N)-(INR (S O)) -(INR (S O))``.
+Repeat Rewrite <- minus_INR.
+Apply le_INR.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Do 2 Rewrite <- pred_of_minus.
+Apply le_n.
+Apply simpl_le_plus_l with (1).
+Rewrite le_plus_minus_r.
+Simpl; Assumption.
+Apply le_trans with (2); [Apply le_n_Sn | Assumption].
+Apply le_trans with (2); [Apply le_n_Sn | Assumption].
+Ring.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply simpl_le_plus_l with i.
+Rewrite le_plus_minus_r.
+Replace (plus i (1)) with (S i).
+Replace N with (S (pred N)).
+Apply le_n_S.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_pred_n.
+Symmetry; Apply S_pred with O; Assumption.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Reflexivity.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply lt_le_trans with (1).
+Apply lt_O_Sn.
+Apply le_S_n.
+Replace (S (pred N)) with N.
+Assumption.
+Apply S_pred with O; Assumption.
+Replace (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus (S N) l))`` (pred (minus (S N) k))) (pred N)) with (sum_f_R0 [k:nat](Rplus (sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) ``(An (S k))*(Bn (S N))``) (pred N)).
+Rewrite (sum_plus [k:nat](sum_f_R0 [l:nat]``(An (S (S (plus l k))))*(Bn (minus N l))`` (pred (minus N k))) [k:nat]``(An (S k))*(Bn (S N))``).
+Apply Rplus_plus_r.
+Rewrite scal_sum; Reflexivity.
+Apply sum_eq; Intros; Rewrite Rplus_sym; Rewrite (decomp_sum [l:nat]``(An (S (plus l i)))*(Bn (minus (S N) l))`` (pred (minus (S N) i))).
+Replace (plus O i) with i; [Idtac | Ring].
+Rewrite <- minus_n_O; Apply Rplus_plus_r.
+Replace (pred (pred (minus (S N) i))) with (pred (minus N i)).
+Apply sum_eq; Intros.
+Replace (minus (S N) (S i0)) with (minus N i0); [Idtac | Reflexivity].
+Replace (plus (S i0) i) with (S (plus i0 i)).
+Reflexivity.
+Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
+Cut (minus N i)=(pred (minus (S N) i)).
+Intro; Rewrite H5; Reflexivity.
+Rewrite pred_of_minus.
+Apply INR_eq; Repeat Rewrite minus_INR.
+Rewrite S_INR; Ring.
+Apply le_trans with N.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply simpl_le_plus_l with i.
+Rewrite le_plus_minus_r.
+Replace (plus i (1)) with (S i).
+Apply le_n_S.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_trans with N.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Replace (pred (minus (S N) i)) with (minus (S N) (S i)).
+Replace (minus (S N) (S i)) with (minus N i); [Idtac | Reflexivity].
+Apply simpl_lt_plus_l with i.
+Rewrite le_plus_minus_r.
+Replace (plus i O) with i; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n.
+Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Rewrite pred_of_minus.
+Apply INR_eq; Repeat Rewrite minus_INR.
+Repeat Rewrite S_INR; Ring.
+Apply le_trans with N.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply simpl_le_plus_l with i.
+Rewrite le_plus_minus_r.
+Replace (plus i (1)) with (S i).
+Apply le_n_S.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_trans with N.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply le_n_S.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Rewrite Rplus_sym.
+Rewrite (decomp_sum [p:nat]``(An p)*(Bn (minus (S N) p))`` N).
+Rewrite <- minus_n_O.
+Apply Rplus_plus_r.
+Apply sum_eq; Intros.
+Reflexivity.
+Assumption.
+Rewrite Rplus_sym.
+Rewrite (decomp_sum [k:nat](sum_f_R0 [l:nat]``(An (S (plus l k)))*(Bn (minus N l))`` (pred (minus N k))) (pred N)).
+Rewrite <- minus_n_O.
+Replace (sum_f_R0 [l:nat]``(An (S (plus l O)))*(Bn (minus N l))`` (pred N)) with (sum_f_R0 [l:nat]``(An (S l))*(Bn (minus N l))`` (pred N)).
+Apply Rplus_plus_r.
+Apply sum_eq; Intros.
+Replace (pred (minus N (S i))) with (pred (pred (minus N i))).
+Apply sum_eq; Intros.
+Replace (plus i0 (S i)) with (S (plus i0 i)).
+Reflexivity.
+Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring.
+Cut (pred (minus N i))=(minus N (S i)).
+Intro; Rewrite H5; Reflexivity.
+Rewrite pred_of_minus.
+Apply INR_eq.
+Repeat Rewrite minus_INR.
+Repeat Rewrite S_INR; Ring.
+Apply le_trans with (S (pred (pred N))).
+Apply le_n_S; Assumption.
+Replace (S (pred (pred N))) with (pred N).
+Apply le_pred_n.
+Apply S_pred with O.
+Apply lt_S_n.
+Replace (S (pred N)) with N.
+Apply lt_le_trans with (2).
+Apply lt_n_Sn.
+Assumption.
+Apply S_pred with O; Assumption.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply simpl_le_plus_l with i.
+Rewrite le_plus_minus_r.
+Replace (plus i (1)) with (S i).
+Replace N with (S (pred N)).
+Apply le_n_S.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_pred_n.
+Symmetry; Apply S_pred with O; Assumption.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_trans with (pred (pred N)).
+Assumption.
+Apply le_trans with (pred N); Apply le_pred_n.
+Apply sum_eq; Intros.
+Replace (plus i O) with i; [Reflexivity | Trivial].
+Apply lt_S_n.
+Replace (S (pred N)) with N.
+Apply lt_le_trans with (2); [Apply lt_n_Sn | Assumption].
+Apply S_pred with O; Assumption.
+Inversion H1.
+Left; Reflexivity.
+Right; Apply le_n_S; Assumption.
+Simpl.
+Replace (S (pred N)) with N.
+Reflexivity.
+Apply S_pred with O; Assumption.
+Simpl.
+Cut (minus N (pred N))=(1).
+Intro; Rewrite H2; Reflexivity.
+Rewrite pred_of_minus.
+Apply INR_eq; Repeat Rewrite minus_INR.
+Ring.
+Apply lt_le_S; Assumption.
+Rewrite <- pred_of_minus; Apply le_pred_n.
+Simpl; Symmetry; Apply S_pred with O; Assumption.
+Inversion H.
+Left; Reflexivity.
+Right; Apply lt_le_trans with (1); [Apply lt_n_Sn | Exact H1].
+Qed.
diff --git a/theories7/Reals/Cos_plus.v b/theories7/Reals/Cos_plus.v
new file mode 100644
index 00000000..481e51bf
--- /dev/null
+++ b/theories7/Reals/Cos_plus.v
@@ -0,0 +1,1017 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Cos_plus.v,v 1.1.2.1 2004/07/16 19:31:31 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo_def.
+Require Cos_rel.
+Require Max.
+V7only [Import nat_scope.]. Open Local Scope nat_scope.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Definition Majxy [x,y:R] : nat->R := [n:nat](Rdiv (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (4) (S n))) (INR (fact n))).
+
+Lemma Majxy_cv_R0 : (x,y:R) (Un_cv (Majxy x y) R0).
+Intros.
+Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
+Pose C0 := (pow C (4)).
+Cut ``0<C``.
+Intro.
+Cut ``0<C0``.
+Intro.
+Assert H1 := (cv_speed_pow_fact C0).
+Unfold Un_cv in H1; Unfold R_dist in H1.
+Unfold Un_cv; Unfold R_dist; Intros.
+Cut ``0<eps/C0``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]].
+Elim (H1 ``eps/C0`` H3); Intros N0 H4.
+Exists N0; Intros.
+Replace (Majxy x y n) with ``(pow C0 (S n))/(INR (fact n))``.
+Simpl.
+Apply Rlt_monotony_contra with ``(Rabsolu (/C0))``.
+Apply Rabsolu_pos_lt.
+Apply Rinv_neq_R0.
+Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
+Rewrite <- Rabsolu_mult.
+Unfold Rminus; Rewrite Rmult_Rplus_distr.
+Rewrite Ropp_O; Rewrite Rmult_Or.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite (Rabsolu_right ``/C0``).
+Rewrite <- (Rmult_sym eps).
+Replace ``(pow C0 n)*/(INR (fact n))+0`` with ``(pow C0 n)*/(INR (fact n))-0``; [Idtac | Ring].
+Unfold Rdiv in H4; Apply H4; Assumption.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Assumption.
+Red; Intro; Rewrite H6 in H0; Elim (Rlt_antirefl ? H0).
+Unfold Majxy.
+Unfold C0.
+Rewrite pow_mult.
+Unfold C; Reflexivity.
+Unfold C0; Apply pow_lt; Assumption.
+Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C.
+Apply RmaxLess1.
+Qed.
+
+Lemma reste1_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste1 x y N))<=(Majxy x y (pred N))``.
+Intros.
+Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
+Unfold Reste1.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (Rabsolu (sum_f_R0
+          [l:nat]
+           ``(pow ( -1) (S (plus l k)))/
+           (INR (fact (mult (S (S O)) (S (plus l k)))))*
+           (pow x (mult (S (S O)) (S (plus l k))))*
+           (pow ( -1) (minus N l))/
+           (INR (fact (mult (S (S O)) (minus N l))))*
+           (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))))
+     (pred N)).
+Apply (sum_Rabsolu [k:nat]
+        (sum_f_R0
+          [l:nat]
+           ``(pow ( -1) (S (plus l k)))/
+           (INR (fact (mult (S (S O)) (S (plus l k)))))*
+           (pow x (mult (S (S O)) (S (plus l k))))*
+           (pow ( -1) (minus N l))/
+           (INR (fact (mult (S (S O)) (minus N l))))*
+           (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+          (sum_f_R0
+            [l:nat]
+             (Rabsolu (``(pow ( -1) (S (plus l k)))/
+             (INR (fact (mult (S (S O)) (S (plus l k)))))*
+             (pow x (mult (S (S O)) (S (plus l k))))*
+             (pow ( -1) (minus N l))/
+             (INR (fact (mult (S (S O)) (minus N l))))*
+             (pow y (mult (S (S O)) (minus N l)))``)) (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle.
+Intros.
+Apply (sum_Rabsolu [l:nat]
+        ``(pow ( -1) (S (plus l n)))/
+        (INR (fact (mult (S (S O)) (S (plus l n)))))*
+        (pow x (mult (S (S O)) (S (plus l n))))*
+        (pow ( -1) (minus N l))/
+        (INR (fact (mult (S (S O)) (minus N l))))*
+        (pow y (mult (S (S O)) (minus N l)))`` (pred (minus N n))).
+Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (mult (S (S O)) (S (plus l k)))) (fact (mult (S (S O)) (minus N l)))))*(pow C (mult (S (S O)) (S (plus N k))))`` (pred (minus N k))) (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
+Do 2 Rewrite pow_1_abs.
+Do 2 Rewrite Rmult_1l.
+Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (S (plus n0 n)))))``).
+Rewrite (Rabsolu_right ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
+Rewrite mult_INR.
+Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Rewrite <- Rmult_assoc.
+Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (minus N n0))))``).
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Do 2 Rewrite <- Pow_Rabsolu.
+Apply Rle_trans with ``(pow (Rabsolu x) (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
+Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Apply pow_incr.
+Split.
+Apply Rabsolu_pos.
+Unfold C.
+Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
+Apply Rle_trans with ``(pow C (mult (S (S O)) (S (plus n0 n))))*(pow C (mult (S (S O)) (minus N n0)))``.
+Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S O)) (minus N n0)))``).
+Apply Rle_monotony.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Apply pow_incr.
+Split.
+Apply Rabsolu_pos.
+Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
+Apply RmaxLess1.
+Apply RmaxLess2.
+Right.
+Replace (mult (2) (S (plus N n))) with (plus (mult (2) (minus N n0)) (mult (2) (S (plus n0 n)))).
+Rewrite pow_add.
+Apply Rmult_sym.
+Apply INR_eq; Rewrite plus_INR; Do 3 Rewrite mult_INR.
+Rewrite minus_INR.
+Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
+Apply le_trans with (pred (minus N n)).
+Exact H1.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (sum_f_R0
+          [l:nat]
+           ``/(INR
+              (mult (fact (mult (S (S O)) (S (plus l k))))
+              (fact (mult (S (S O)) (minus N l)))))*
+           (pow C (mult (S (S (S (S O)))) N))`` (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv.
+Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
+Apply Rle_pow.
+Unfold C; Apply RmaxLess1.
+Replace (mult (4) N) with (mult (2) (mult (2) N)); [Idtac | Ring].
+Apply mult_le.
+Replace (mult (2) N) with (S (plus N (pred N))).
+Apply le_n_S.
+Apply le_reg_l; Assumption.
+Rewrite pred_of_minus.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Rewrite minus_INR.
+Repeat Rewrite S_INR; Ring.
+Apply lt_le_S; Assumption.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (sum_f_R0
+          [l:nat]
+         ``(pow C (mult (S (S (S (S O)))) N))*(Rsqr (/(INR (fact (S (plus N k))))))`` (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
+Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Replace ``/(INR
+      (mult (fact (mult (S (S O)) (S (plus n0 n))))
+      (fact (mult (S (S O)) (minus N n0)))))`` with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (mult (S (S O)) (S (plus n0 n))))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
+Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (plus N n))) (S (plus N n)))/(INR (fact (mult (S (S O)) (S (plus N n)))))``.
+Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (plus N n)))))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply C_maj.
+Apply mult_le.
+Apply le_n_S.
+Apply le_reg_r.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Right.
+Unfold Rdiv; Rewrite Rmult_sym.
+Unfold Binomial.C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace (minus (mult (2) (S (plus N n))) (S (plus N n))) with (S (plus N n)).
+Rewrite Rinv_Rmult.
+Unfold Rsqr; Reflexivity.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_eq; Rewrite S_INR; Rewrite minus_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_2n.
+Apply INR_fact_neq_0.
+Unfold Rdiv; Rewrite Rmult_sym.
+Unfold Binomial.C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace (minus (mult (2) (S (plus N n))) (mult (2) (S (plus n0 n)))) with (mult (2) (minus N n0)).
+Rewrite mult_INR.
+Reflexivity.
+Apply INR_eq; Rewrite minus_INR.
+Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
+Ring.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply mult_le.
+Apply le_n_S.
+Apply le_reg_r.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_fact_neq_0.
+Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S N)))*(pow C (mult (S (S (S (S O)))) N))`` (pred N)).
+Apply sum_Rle; Intros.
+Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) N))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (plus N n))))))``).
+Rewrite sum_cte.
+Rewrite <- Rmult_assoc.
+Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Apply Rle_trans with ``(Rsqr (/(INR (fact (S (plus N n))))))*(INR N)``.
+Apply Rle_monotony.
+Apply pos_Rsqr.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_INR.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
+Apply pos_INR.
+Apply Rle_trans with ``/(INR (fact (S (plus N n))))``.
+Pattern 2 ``/(INR (fact (S (plus N n))))``; Rewrite <- Rmult_1r.
+Unfold Rsqr.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
+Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r.
+Replace R1 with (INR (S O)).
+Apply le_INR.
+Apply lt_le_S.
+Apply INR_lt; Apply INR_fact_lt_0.
+Reflexivity.
+Apply INR_fact_neq_0.
+Apply Rle_monotony_contra with ``(INR (fact (S (plus N n))))``.
+Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with ``(INR (fact (S N)))``.
+Apply INR_fact_lt_0.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym (INR (fact (S N)))).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Apply le_INR.
+Apply fact_growing.
+Apply le_n_S.
+Apply le_plus_l.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Rewrite sum_cte.
+Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) N))/(INR (fact (pred N)))``.
+Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) N))``).
+Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Cut (S (pred N)) = N.
+Intro; Rewrite H0.
+Pattern 2 N; Rewrite <- H0.
+Do 2 Rewrite fact_simpl.
+Rewrite H0.
+Repeat Rewrite mult_INR.
+Repeat Rewrite Rinv_Rmult.
+Rewrite (Rmult_sym ``/(INR (S N))``).
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Pattern 2 ``/(INR (fact (pred N)))``; Rewrite <- Rmult_1r.
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_monotony_contra with (INR (S N)).
+Apply lt_INR_0; Apply lt_O_Sn.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Rewrite Rmult_1l.
+Apply le_INR; Apply le_n_Sn.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR.
+Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
+Apply not_O_INR.
+Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
+Apply INR_fact_neq_0.
+Apply not_O_INR; Discriminate.
+Apply prod_neq_R0.
+Apply not_O_INR.
+Red; Intro; Rewrite H1 in H; Elim (lt_n_n ? H).
+Apply INR_fact_neq_0.
+Symmetry; Apply S_pred with O; Assumption.
+Right.
+Unfold Majxy.
+Unfold C.
+Replace (S (pred N)) with N.
+Reflexivity.
+Apply S_pred with O; Assumption.
+Qed.
+
+Lemma reste2_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste2 x y N))<=(Majxy x y N)``.
+Intros.
+Pose C := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
+Unfold Reste2.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (Rabsolu (sum_f_R0
+          [l:nat]
+           ``(pow ( -1) (S (plus l k)))/
+           (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
+           (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
+           (pow ( -1) (minus N l))/
+           (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
+           (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))))
+     (pred N)).
+Apply (sum_Rabsolu [k:nat]
+        (sum_f_R0
+          [l:nat]
+           ``(pow ( -1) (S (plus l k)))/
+           (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
+           (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
+           (pow ( -1) (minus N l))/
+           (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
+           (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+          (sum_f_R0
+            [l:nat]
+             (Rabsolu (``(pow ( -1) (S (plus l k)))/
+             (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
+             (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
+             (pow ( -1) (minus N l))/
+             (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
+             (pow y (plus (mult (S (S O)) (minus N l)) (S O)))``)) (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle.
+Intros.
+Apply (sum_Rabsolu [l:nat]
+        ``(pow ( -1) (S (plus l n)))/
+        (INR (fact (plus (mult (S (S O)) (S (plus l n))) (S O))))*
+        (pow x (plus (mult (S (S O)) (S (plus l n))) (S O)))*
+        (pow ( -1) (minus N l))/
+        (INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*
+        (pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N n))).
+Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O))) (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*(pow C (mult (S (S O)) (S (S (plus N k)))))`` (pred (minus N k))) (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Unfold Rdiv; Repeat Rewrite Rabsolu_mult.
+Do 2 Rewrite pow_1_abs.
+Do 2 Rewrite Rmult_1l.
+Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O))))``).
+Rewrite (Rabsolu_right ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
+Rewrite mult_INR.
+Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Rewrite <- Rmult_assoc.
+Rewrite <- (Rmult_sym ``/(INR (fact (plus (mult (S (S O)) (minus N n0)) (S O))))``).
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Do 2 Rewrite <- Pow_Rabsolu.
+Apply Rle_trans with ``(pow (Rabsolu x) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
+Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Apply pow_incr.
+Split.
+Apply Rabsolu_pos.
+Unfold C.
+Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)); Apply RmaxLess2.
+Apply Rle_trans with ``(pow C (plus (mult (S (S O)) (S (plus n0 n))) (S O)))*(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``.
+Do 2 Rewrite <- (Rmult_sym ``(pow C (plus (mult (S (S O)) (minus N n0)) (S O)))``).
+Apply Rle_monotony.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Apply pow_incr.
+Split.
+Apply Rabsolu_pos.
+Unfold C; Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
+Apply RmaxLess1.
+Apply RmaxLess2.
+Right.
+Replace (mult (2) (S (S (plus N n)))) with (plus (plus (mult (2) (minus N n0)) (S O)) (plus (mult (2) (S (plus n0 n))) (S O))).
+Repeat Rewrite pow_add.
+Ring.
+Apply INR_eq; Repeat Rewrite plus_INR; Do 3 Rewrite mult_INR.
+Rewrite minus_INR.
+Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Ring.
+Apply le_trans with (pred (minus N n)).
+Exact H1.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Apply INR_fact_lt_0.
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Apply INR_fact_lt_0.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (sum_f_R0
+          [l:nat]
+           ``/(INR
+              (mult (fact (plus (mult (S (S O)) (S (plus l k))) (S O)))
+              (fact (plus (mult (S (S O)) (minus N l)) (S O)))))*
+           (pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv.
+Rewrite mult_INR; Apply Rmult_lt_pos; Apply INR_fact_lt_0.
+Apply Rle_pow.
+Unfold C; Apply RmaxLess1.
+Replace (mult (4) (S N)) with (mult (2) (mult (2) (S N))); [Idtac | Ring].
+Apply mult_le.
+Replace (mult (2) (S N)) with (S (S (plus N N))).
+Repeat Apply le_n_S.
+Apply le_reg_l.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_eq; Do 2Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR.
+Repeat Rewrite S_INR; Ring.
+Apply Rle_trans with (sum_f_R0
+     [k:nat]
+        (sum_f_R0
+          [l:nat]
+         ``(pow C (mult (S (S (S (S O)))) (S N)))*(Rsqr (/(INR (fact (S (S (plus N k)))))))`` (pred (minus N k)))
+     (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
+Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Replace ``/(INR
+      (mult (fact (plus (mult (S (S O)) (S (plus n0 n))) (S O)))
+      (fact (plus (mult (S (S O)) (minus N n0)) (S O)))))`` with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (plus (mult (S (S O)) (S (plus n0 n))) (S O)))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
+Apply Rle_trans with ``(Binomial.C (mult (S (S O)) (S (S (plus N n)))) (S (S (plus N n))))/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``.
+Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S (S (plus N n))))))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply C_maj.
+Apply le_trans with (mult (2) (S (S (plus n0 n)))).
+Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
+Apply le_n_Sn.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply mult_le.
+Repeat Apply le_n_S.
+Apply le_reg_r.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Right.
+Unfold Rdiv; Rewrite Rmult_sym.
+Unfold Binomial.C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace (minus (mult (2) (S (S (plus N n)))) (S (S (plus N n)))) with (S (S (plus N n))).
+Rewrite Rinv_Rmult.
+Unfold Rsqr; Reflexivity.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_eq; Do 2 Rewrite S_INR; Rewrite minus_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_2n.
+Apply INR_fact_neq_0.
+Unfold Rdiv; Rewrite Rmult_sym.
+Unfold Binomial.C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace (minus (mult (2) (S (S (plus N n)))) (plus (mult (2) (S (plus n0 n))) (S O))) with (plus (mult (2) (minus N n0)) (S O)).
+Rewrite mult_INR.
+Reflexivity.
+Apply INR_eq; Rewrite minus_INR.
+Do 2 Rewrite plus_INR; Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite minus_INR.
+Ring.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_trans with (mult (2) (S (S (plus n0 n)))).
+Replace (mult (2) (S (S (plus n0 n)))) with (S (plus (mult (2) (S (plus n0 n))) (1))).
+Apply le_n_Sn.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply mult_le.
+Repeat Apply le_n_S.
+Apply le_reg_r.
+Apply le_trans with (pred (minus N n)).
+Assumption.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply INR_fact_neq_0.
+Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)/(INR (fact (S (S N))))*(pow C (mult (S (S (S (S O)))) (S N)))`` (pred N)).
+Apply sum_Rle; Intros.
+Rewrite <- (scal_sum [_:nat]``(pow C (mult (S (S (S (S O)))) (S N)))`` (pred (minus N n)) ``(Rsqr (/(INR (fact (S (S (plus N n)))))))``).
+Rewrite sum_cte.
+Rewrite <- Rmult_assoc.
+Do 2 Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Apply Rle_trans with ``(Rsqr (/(INR (fact (S (S (plus N n)))))))*(INR N)``.
+Apply Rle_monotony.
+Apply pos_Rsqr.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_INR.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n O) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Assumption.
+Apply lt_pred_n_n; Assumption.
+Apply le_trans with (pred N).
+Assumption.
+Apply le_pred_n.
+Rewrite Rmult_sym; Unfold Rdiv; Apply Rle_monotony.
+Apply pos_INR.
+Apply Rle_trans with ``/(INR (fact (S (S (plus N n)))))``.
+Pattern 2 ``/(INR (fact (S (S (plus N n)))))``; Rewrite <- Rmult_1r.
+Unfold Rsqr.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
+Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r.
+Replace R1 with (INR (S O)).
+Apply le_INR.
+Apply lt_le_S.
+Apply INR_lt; Apply INR_fact_lt_0.
+Reflexivity.
+Apply INR_fact_neq_0.
+Apply Rle_monotony_contra with ``(INR (fact (S (S (plus N n)))))``.
+Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with ``(INR (fact (S (S N))))``.
+Apply INR_fact_lt_0.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym (INR (fact (S (S N))))).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Apply le_INR.
+Apply fact_growing.
+Repeat Apply le_n_S.
+Apply le_plus_l.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Rewrite sum_cte.
+Apply Rle_trans with ``(pow C (mult (S (S (S (S O)))) (S N)))/(INR (fact N))``.
+Rewrite <- (Rmult_sym ``(pow C (mult (S (S (S (S O)))) (S N)))``).
+Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply pow_le.
+Left; Apply Rlt_le_trans with R1.
+Apply Rlt_R0_R1.
+Unfold C; Apply RmaxLess1.
+Cut (S (pred N)) = N.
+Intro; Rewrite H0.
+Do 2 Rewrite fact_simpl.
+Repeat Rewrite mult_INR.
+Repeat Rewrite Rinv_Rmult.
+Apply Rle_trans with ``(INR (S (S N)))*(/(INR (S (S N)))*(/(INR (S N))*/(INR (fact N))))*
+   (INR N)``.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym (INR N)).
+Rewrite (Rmult_sym (INR (S (S N)))).
+Apply Rle_monotony.
+Repeat Apply Rmult_le_pos.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
+Left; Apply Rlt_Rinv.
+Apply INR_fact_lt_0.
+Apply pos_INR.
+Apply le_INR.
+Apply le_trans with (S N); Apply le_n_Sn.
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Apply Rle_trans with ``/(INR (S N))*/(INR (fact N))*(INR (S N))``.
+Repeat Rewrite Rmult_assoc.
+Repeat Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply le_INR; Apply le_n_Sn.
+Rewrite (Rmult_sym ``/(INR (S N))``).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Right; Reflexivity.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+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; Apply S_pred with O; Assumption.
+Right.
+Unfold Majxy.
+Unfold C.
+Reflexivity.
+Qed.
+
+Lemma reste1_cv_R0 : (x,y:R) (Un_cv (Reste1 x y) R0).
+Intros.
+Assert H := (Majxy_cv_R0 x y).
+Unfold Un_cv in H; Unfold R_dist in H.
+Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H eps H0); Intros N0 H1.
+Exists (S N0); Intros.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
+Apply Rle_lt_trans with (Rabsolu (Majxy x y (pred n))).
+Rewrite (Rabsolu_right (Majxy x y (pred n))).
+Apply reste1_maj.
+Apply lt_le_trans with (S N0).
+Apply lt_O_Sn.
+Assumption.
+Apply Rle_sym1.
+Unfold Majxy.
+Unfold Rdiv; Apply Rmult_le_pos.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Replace (Majxy x y (pred n)) with ``(Majxy x y (pred n))-0``; [Idtac | Ring].
+Apply H1.
+Unfold ge; Apply le_S_n.
+Replace (S (pred n)) with n.
+Assumption.
+Apply S_pred with O.
+Apply lt_le_trans with (S N0); [Apply lt_O_Sn | Assumption].
+Qed.
+
+Lemma reste2_cv_R0 : (x,y:R) (Un_cv (Reste2 x y) R0).
+Intros.
+Assert H := (Majxy_cv_R0 x y).
+Unfold Un_cv in H; Unfold R_dist in H.
+Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H eps H0); Intros N0 H1.
+Exists (S N0); Intros.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
+Apply Rle_lt_trans with (Rabsolu (Majxy x y n)).
+Rewrite (Rabsolu_right (Majxy x y n)).
+Apply reste2_maj.
+Apply lt_le_trans with (S N0).
+Apply lt_O_Sn.
+Assumption.
+Apply Rle_sym1.
+Unfold Majxy.
+Unfold Rdiv; Apply Rmult_le_pos.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Replace (Majxy x y n) with ``(Majxy x y n)-0``; [Idtac | Ring].
+Apply H1.
+Unfold ge; Apply le_trans with (S N0).
+Apply le_n_Sn.
+Exact H2.
+Qed.
+
+Lemma reste_cv_R0 : (x,y:R) (Un_cv (Reste x y) R0).
+Intros.
+Unfold Reste.
+Pose An := [n:nat](Reste2 x y n).
+Pose Bn := [n:nat](Reste1 x y (S n)).
+Cut (Un_cv [n:nat]``(An n)-(Bn n)`` ``0-0``) -> (Un_cv [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))`` ``0``).
+Intro.
+Apply H.
+Apply CV_minus.
+Unfold An.
+Replace [n:nat](Reste2 x y n) with (Reste2 x y).
+Apply reste2_cv_R0.
+Reflexivity.
+Unfold Bn.
+Assert H0 := (reste1_cv_R0 x y).
+Unfold Un_cv in H0; Unfold R_dist in H0.
+Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H0 eps H1); Intros N0 H2.
+Exists N0; Intros.
+Apply H2.
+Unfold ge; Apply le_trans with (S N0).
+Apply le_n_Sn.
+Apply le_n_S; Assumption.
+Unfold An Bn.
+Intro.
+Replace R0 with ``0-0``; [Idtac | Ring].
+Exact H.
+Qed.
+
+Theorem cos_plus : (x,y:R) ``(cos (x+y))==(cos x)*(cos y)-(sin x)*(sin y)``. 
+Intros. 
+Cut (Un_cv (C1 x y) ``(cos x)*(cos y)-(sin x)*(sin y)``). 
+Cut (Un_cv (C1 x y) ``(cos (x+y))``). 
+Intros. 
+Apply UL_sequence with (C1 x y); Assumption. 
+Apply C1_cvg. 
+Unfold Un_cv; Unfold R_dist. 
+Intros. 
+Assert H0 := (A1_cvg x). 
+Assert H1 := (A1_cvg y). 
+Assert H2 := (B1_cvg x). 
+Assert H3 := (B1_cvg y). 
+Assert H4 := (CV_mult ? ? ? ? H0 H1). 
+Assert H5 := (CV_mult ? ? ? ? H2 H3). 
+Assert H6 := (reste_cv_R0 x y).
+Unfold Un_cv in H4; Unfold Un_cv in H5; Unfold Un_cv in H6.
+Unfold R_dist in H4; Unfold R_dist in H5; Unfold R_dist in H6. 
+Cut ``0<eps/3``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
+Elim (H4 ``eps/3`` H7); Intros N1 H8. 
+Elim (H5 ``eps/3`` H7); Intros N2 H9. 
+Elim (H6 ``eps/3`` H7); Intros N3 H10.
+Pose N := (S (S (max (max N1 N2) N3))). 
+Exists N. 
+Intros. 
+Cut n = (S (pred n)). 
+Intro; Rewrite H12. 
+Rewrite <- cos_plus_form. 
+Rewrite <- H12. 
+Apply Rle_lt_trans with ``(Rabsolu ((A1 x n)*(A1 y n)-(cos x)*(cos y)))+(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n))))``. 
+Replace ``(A1 x n)*(A1 y n)-(B1 x (pred n))*(B1 y (pred n))+
+     (Reste x y (pred n))-((cos x)*(cos y)-(sin x)*(sin y))`` with ``((A1 x n)*(A1 y n)-(cos x)*(cos y))+((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))+(Reste x y (pred n)))``; [Apply Rabsolu_triang | Ring].
+Replace ``eps`` with ``eps/3+(eps/3+eps/3)``.
+Apply Rplus_lt. 
+Apply H8. 
+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).
+Apply le_max_l.
+Apply le_trans with (S (max (max N1 N2) N3)); Apply le_n_Sn.
+Assumption. 
+Apply Rle_lt_trans with ``(Rabsolu ((sin x)*(sin y)-(B1 x (pred n))*(B1 y (pred n))))+(Rabsolu (Reste x y (pred n)))``.
+Apply Rabsolu_triang.
+Apply Rplus_lt.
+Rewrite <- Rabsolu_Ropp. 
+Rewrite Ropp_distr2. 
+Apply H9. 
+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.
+Apply le_n_S.
+Apply le_trans with (max (max N1 N2) N3).
+Apply le_max_l.
+Apply le_n_Sn.
+Assumption.
+Replace (Reste x y (pred n)) with ``(Reste x y (pred n))-0``.
+Apply H10.
+Unfold ge.
+Apply le_S_n.
+Rewrite <- H12.
+Apply le_trans with N.
+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 4 eps; Replace eps with ``3*eps/3``.
+Ring.
+Unfold Rdiv.
+Rewrite <- Rmult_assoc.
+Apply Rinv_r_simpl_m.
+DiscrR.
+Apply lt_le_trans with (pred N).
+Unfold N; Simpl; Apply lt_O_Sn.
+Apply le_S_n.
+Rewrite <- H12.
+Replace (S (pred N)) with N.
+Assumption.
+Unfold N; Simpl; Reflexivity.
+Cut (lt O N). 
+Intro. 
+Cut (lt O n). 
+Intro. 
+Apply S_pred with O; Assumption.
+Apply lt_le_trans with N; Assumption. 
+Unfold N; Apply lt_O_Sn.
+Qed.
diff --git a/theories7/Reals/Cos_rel.v b/theories7/Reals/Cos_rel.v
new file mode 100644
index 00000000..e29825ab
--- /dev/null
+++ b/theories7/Reals/Cos_rel.v
@@ -0,0 +1,360 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Cos_rel.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo_def.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Definition A1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))`` N). 
+ 
+Definition B1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))`` N). 
+ 
+Definition C1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat]``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))`` N). 
+ 
+Definition Reste1 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (mult (S (S O)) (S (plus l k)))))*(pow x (mult (S (S O)) (S (plus l k))))*(pow (-1) (minus N l))/(INR (fact (mult (S (S O)) (minus N l))))*(pow y (mult (S (S O)) (minus N l)))`` (pred (minus N k))) (pred N)).
+
+Definition Reste2 [x,y:R] : nat -> R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow (-1) (S (plus l k)))/(INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*(pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*(pow (-1) (minus N l))/(INR (fact (plus (mult (S (S O)) (minus N l)) (S O))))*(pow y (plus (mult (S (S O)) (minus N l)) (S O)))`` (pred (minus N k))) (pred N)).
+
+Definition Reste [x,y:R] : nat -> R := [N:nat]``(Reste2 x y N)-(Reste1 x y (S N))``.
+
+(* Here is the main result that will be used to prove that (cos (x+y))=(cos x)(cos y)-(sin x)(sin y) *)
+Theorem cos_plus_form : (x,y:R;n:nat) (lt O n) -> ``(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.
+Rewrite (cauchy_finite [k:nat]
+        ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
+        (pow x (mult (S (S O)) k))`` [k:nat]
+      ``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*
+      (pow y (mult (S (S O)) k))`` (S n)).
+Rewrite (cauchy_finite [k:nat]
+      ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
+      (pow x (plus (mult (S (S O)) k) (S O)))`` [k:nat]
+      ``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*
+      (pow y (plus (mult (S (S O)) k) (S O)))`` n H).
+Unfold Reste.
+Replace (sum_f_R0
+   [k:nat]
+      (sum_f_R0
+        [l:nat]
+         ``(pow ( -1) (S (plus l k)))/
+         (INR (fact (mult (S (S O)) (S (plus l k)))))*
+         (pow x (mult (S (S O)) (S (plus l k))))*
+         ((pow ( -1) (minus (S n) l))/
+         (INR (fact (mult (S (S O)) (minus (S n) l))))*
+         (pow y (mult (S (S O)) (minus (S n) l))))``
+        (pred (minus (S n) k))) (pred (S n))) with (Reste1 x y (S n)).
+Replace (sum_f_R0
+   [k:nat]
+      (sum_f_R0
+        [l:nat]
+         ``(pow ( -1) (S (plus l k)))/
+         (INR (fact (plus (mult (S (S O)) (S (plus l k))) (S O))))*
+         (pow x (plus (mult (S (S O)) (S (plus l k))) (S O)))*
+         ((pow ( -1) (minus n l))/
+         (INR (fact (plus (mult (S (S O)) (minus n l)) (S O))))*
+         (pow y (plus (mult (S (S O)) (minus n l)) (S O))))``
+        (pred (minus n k))) (pred n)) with (Reste2 x y n).
+Ring.
+Replace (sum_f_R0
+   [k:nat]
+      (sum_f_R0
+        [p:nat]
+         ``(pow ( -1) p)/(INR (fact (mult (S (S O)) p)))*
+         (pow x (mult (S (S O)) p))*((pow ( -1) (minus k p))/
+         (INR (fact (mult (S (S O)) (minus k p))))*
+         (pow y (mult (S (S O)) (minus k p))))`` k) (S n)) with (sum_f_R0 [k:nat](Rmult ``(pow (-1) k)/(INR (fact (mult (S (S O)) k)))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) k) (mult (S (S O)) l))*(pow x (mult (S (S O)) l))*(pow y (mult (S (S O)) (minus k l)))`` k)) (S n)).
+Pose sin_nnn := [n:nat]Cases n of O => R0 | (S p) => (Rmult ``(pow (-1) (S p))/(INR (fact (mult (S (S O)) (S p))))`` (sum_f_R0 [l:nat]``(C (mult (S (S O)) (S p)) (S (mult (S (S O)) l)))*(pow x (S (mult (S (S O)) l)))*(pow y (S (mult (S (S O)) (minus p l))))`` p)) end.
+Replace (Ropp (sum_f_R0
+       [k:nat]
+          (sum_f_R0
+            [p:nat]
+             ``(pow ( -1) p)/
+             (INR (fact (plus (mult (S (S O)) p) (S O))))*
+             (pow x (plus (mult (S (S O)) p) (S O)))*
+             ((pow ( -1) (minus k p))/
+             (INR (fact (plus (mult (S (S O)) (minus k p)) (S O))))*
+             (pow y (plus (mult (S (S O)) (minus k p)) (S O))))`` k)
+       n)) with (sum_f_R0 sin_nnn (S n)).
+Rewrite <- sum_plus.
+Unfold C1.
+Apply sum_eq; Intros.
+Induction i.
+Simpl.
+Rewrite Rplus_Ol.
+Replace (C O O) with R1.
+Unfold Rdiv; Rewrite Rinv_R1.
+Ring.
+Unfold C.
+Rewrite <- minus_n_n.
+Simpl.
+Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rinv_R1; Ring.
+Unfold sin_nnn.
+Rewrite <- Rmult_Rplus_distr.
+Apply Rmult_mult_r.
+Rewrite binomial.
+Pose Wn := [i0:nat]``(C (mult (S (S O)) (S i)) i0)*(pow x i0)*
+         (pow y (minus (mult (S (S O)) (S i)) i0))``.
+Replace (sum_f_R0
+   [l:nat]
+      ``(C (mult (S (S O)) (S i)) (mult (S (S O)) l))*
+      (pow x (mult (S (S O)) l))*
+      (pow y (mult (S (S O)) (minus (S i) l)))`` (S i)) with (sum_f_R0 [l:nat](Wn (mult (2) l)) (S i)).
+Replace (sum_f_R0
+     [l:nat]
+        ``(C (mult (S (S O)) (S i)) (S (mult (S (S O)) l)))*
+        (pow x (S (mult (S (S O)) l)))*
+        (pow y (S (mult (S (S O)) (minus i l))))`` i) with (sum_f_R0 [l:nat](Wn (S (mult (2) l))) i).
+Rewrite Rplus_sym.
+Apply sum_decomposition.
+Apply sum_eq; Intros.
+Unfold Wn.
+Apply Rmult_mult_r.
+Replace (minus (mult (2) (S i)) (S (mult (2) i0))) with (S (mult (2) (minus i i0))).
+Reflexivity.
+Apply INR_eq.
+Rewrite S_INR; Rewrite mult_INR.
+Repeat Rewrite minus_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Replace (mult (2) (S i)) with (S (S (mult (2) i))).
+Apply le_n_S.
+Apply le_trans with (mult (2) i).
+Apply mult_le; Assumption.
+Apply le_n_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Assumption.
+Apply sum_eq; Intros.
+Unfold Wn.
+Apply Rmult_mult_r.
+Replace (minus (mult (2) (S i)) (mult (2) i0)) with (mult (2) (minus (S i) i0)).
+Reflexivity.
+Apply INR_eq.
+Rewrite mult_INR.
+Repeat Rewrite minus_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply mult_le; Assumption.
+Assumption.
+Rewrite <- (Ropp_Ropp (sum_f_R0 sin_nnn (S n))).
+Apply eq_Ropp.
+Replace ``-(sum_f_R0 sin_nnn (S n))`` with ``-1*(sum_f_R0 sin_nnn (S n))``; [Idtac | Ring].
+Rewrite scal_sum.
+Rewrite decomp_sum.
+Replace (sin_nnn O) with R0.
+Rewrite Rmult_Ol; Rewrite Rplus_Ol.
+Replace (pred (S n)) with n; [Idtac | Reflexivity].
+Apply sum_eq; Intros.
+Rewrite Rmult_sym.
+Unfold sin_nnn.
+Rewrite scal_sum.
+Rewrite scal_sum.
+Apply sum_eq; Intros.
+Unfold Rdiv.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) (S i))))``).
+Repeat Rewrite <- Rmult_assoc.
+Replace ``/(INR (fact (mult (S (S O)) (S i))))*
+   (C (mult (S (S O)) (S i)) (S (mult (S (S O)) i0)))`` with ``/(INR (fact (plus (mult (S (S O)) i0) (S O))))*/(INR (fact (plus (mult (S (S O)) (minus i i0)) (S O))))``.
+Replace (S (mult (2) i0)) with (plus (mult (2) i0) (1)); [Idtac | Ring].
+Replace (S (mult (2) (minus i i0))) with (plus (mult (2) (minus i i0)) (1)); [Idtac | Ring].
+Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i0)*(pow (-1) (minus i i0))``.
+Ring.
+Simpl.
+Pattern 2 i; Replace i with (plus i0 (minus i i0)).
+Rewrite pow_add.
+Ring.
+Symmetry; Apply le_plus_minus; Assumption.
+Unfold C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite Rinv_Rmult.
+Replace (S (mult (S (S O)) i0)) with (plus (mult (2) i0) (1)); [Apply Rmult_mult_r | Ring].
+Replace (minus (mult (2) (S i)) (plus (mult (2) i0) (1))) with (plus (mult (2) (minus i i0)) (1)).
+Reflexivity.
+Apply INR_eq.
+Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite minus_INR.
+Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Replace (plus (mult (2) i0) (1)) with (S (mult (2) i0)).
+Replace (mult (2) (S i)) with (S (S (mult (2) i))).
+Apply le_n_S.
+Apply le_trans with (mult (2) i).
+Apply mult_le; Assumption.
+Apply le_n_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Assumption.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Reflexivity.
+Apply lt_O_Sn.
+Apply sum_eq; Intros.
+Rewrite scal_sum.
+Apply sum_eq; Intros.
+Unfold Rdiv.
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- (Rmult_sym ``/(INR (fact (mult (S (S O)) i)))``).
+Repeat Rewrite <- Rmult_assoc.
+Replace ``/(INR (fact (mult (S (S O)) i)))*
+   (C (mult (S (S O)) i) (mult (S (S O)) i0))`` with ``/(INR (fact (mult (S (S O)) i0)))*/(INR (fact (mult (S (S O)) (minus i i0))))``.
+Replace ``(pow (-1) i)`` with ``(pow (-1) i0)*(pow (-1) (minus i i0))``.
+Ring.
+Pattern 2 i; Replace i with (plus i0 (minus i i0)).
+Rewrite pow_add.
+Ring.
+Symmetry; Apply le_plus_minus; Assumption.
+Unfold C.
+Unfold Rdiv; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Rewrite Rinv_Rmult.
+Replace (minus (mult (2) i) (mult (2) i0)) with (mult (2) (minus i i0)).
+Reflexivity.
+Apply INR_eq.
+Rewrite mult_INR; Repeat Rewrite minus_INR.
+Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply mult_le; Assumption.
+Assumption.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Unfold Reste2; Apply sum_eq; Intros.
+Apply sum_eq; Intros.
+Unfold Rdiv; Ring. 
+Unfold Reste1; Apply sum_eq; Intros.
+Apply sum_eq; Intros.
+Unfold Rdiv; Ring.
+Apply lt_O_Sn.
+Qed.
+
+Lemma pow_sqr : (x:R;i:nat) (pow x (mult (2) i))==(pow ``x*x`` i). 
+Intros. 
+Assert H := (pow_Rsqr x i).
+Unfold Rsqr in H; Exact H.
+Qed. 
+ 
+Lemma A1_cvg : (x:R) (Un_cv (A1 x) (cos x)). 
+Intro. 
+Assert H := (exist_cos ``x*x``). 
+Elim H; Intros. 
+Assert p_i := p. 
+Unfold cos_in in p. 
+Unfold cos_n infinit_sum in p. 
+Unfold R_dist in p. 
+Cut ``(cos x)==x0``. 
+Intro. 
+Rewrite H0. 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Elim (p eps H1); Intros. 
+Exists x1; Intros. 
+Unfold A1. 
+Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow x (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow (x*x) i)``) n). 
+Apply H2; Assumption. 
+Apply sum_eq. 
+Intros. 
+Replace ``(pow (x*x) i)`` with ``(pow x (mult (S (S O)) i))``. 
+Reflexivity. 
+Apply pow_sqr. 
+Unfold cos. 
+Case (exist_cos (Rsqr x)). 
+Unfold Rsqr; Intros. 
+Unfold cos_in in p_i. 
+Unfold cos_in in c. 
+Apply unicity_sum with [i:nat]``(cos_n i)*(pow (x*x) i)``; Assumption. 
+Qed. 
+ 
+Lemma C1_cvg : (x,y:R) (Un_cv (C1 x y) (cos (Rplus x y))). 
+Intros. 
+Assert H := (exist_cos ``(x+y)*(x+y)``). 
+Elim H; Intros. 
+Assert p_i := p. 
+Unfold cos_in in p. 
+Unfold cos_n infinit_sum in p. 
+Unfold R_dist in p. 
+Cut ``(cos (x+y))==x0``. 
+Intro. 
+Rewrite H0. 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Elim (p eps H1); Intros. 
+Exists x1; Intros. 
+Unfold C1. 
+Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (mult (S (S O)) k)))*(pow (x+y) (mult (S (S O)) k))``) n) with (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (mult (S (S O)) i)))*(pow ((x+y)*(x+y)) i)``) n). 
+Apply H2; Assumption. 
+Apply sum_eq. 
+Intros. 
+Replace ``(pow ((x+y)*(x+y)) i)`` with ``(pow (x+y) (mult (S (S O)) i))``. 
+Reflexivity. 
+Apply pow_sqr. 
+Unfold cos. 
+Case (exist_cos (Rsqr ``x+y``)). 
+Unfold Rsqr; Intros. 
+Unfold cos_in in p_i. 
+Unfold cos_in in c. 
+Apply unicity_sum with [i:nat]``(cos_n i)*(pow ((x+y)*(x+y)) i)``; Assumption. 
+Qed. 
+ 
+Lemma B1_cvg : (x:R) (Un_cv (B1 x) (sin x)). 
+Intro. 
+Case (Req_EM x R0); Intro. 
+Rewrite H. 
+Rewrite sin_0. 
+Unfold B1. 
+Unfold Un_cv; Unfold R_dist; Intros; Exists O; Intros. 
+Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (plus (mult (S (S O)) k) (S O)))``) n) with R0. 
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption. 
+Induction n. 
+Simpl; Ring. 
+Rewrite tech5; Rewrite <- Hrecn. 
+Simpl; Ring. 
+Unfold ge; Apply le_O_n. 
+Assert H0 := (exist_sin ``x*x``). 
+Elim H0; Intros. 
+Assert p_i := p. 
+Unfold sin_in in p. 
+Unfold sin_n infinit_sum in p. 
+Unfold R_dist in p. 
+Cut ``(sin x)==x*x0``. 
+Intro. 
+Rewrite H1. 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Cut ``0<eps/(Rabsolu x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption]]. 
+Elim (p ``eps/(Rabsolu x)`` H3); Intros. 
+Exists x1; Intros. 
+Unfold B1. 
+Replace (sum_f_R0 ([k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow x (plus (mult (S (S O)) k) (S O)))``) n) with (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)). 
+Replace (Rminus (Rmult x (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n)) (Rmult x x0)) with (Rmult x (Rminus (sum_f_R0 ([i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (x*x) i)``) n) x0)); [Idtac | Ring]. 
+Rewrite Rabsolu_mult. 
+Apply Rlt_monotony_contra with ``/(Rabsolu x)``. 
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. 
+Rewrite <- Rmult_assoc. 
+Rewrite <- Rinv_l_sym. 
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Unfold Rdiv in H4; Apply H4; Assumption. 
+Apply Rabsolu_no_R0; Assumption. 
+Rewrite scal_sum. 
+Apply sum_eq. 
+Intros. 
+Rewrite pow_add. 
+Rewrite pow_sqr. 
+Simpl. 
+Ring. 
+Unfold sin. 
+Case (exist_sin (Rsqr x)). 
+Unfold Rsqr; Intros. 
+Unfold sin_in in p_i. 
+Unfold sin_in in s. 
+Assert H1 := (unicity_sum [i:nat]``(sin_n i)*(pow (x*x) i)`` x0 x1 p_i s). 
+Rewrite H1; Reflexivity. 
+Qed. 
diff --git a/theories7/Reals/DiscrR.v b/theories7/Reals/DiscrR.v
new file mode 100644
index 00000000..31c90727
--- /dev/null
+++ b/theories7/Reals/DiscrR.v
@@ -0,0 +1,58 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i        $Id: DiscrR.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $       i*)
+
+Require RIneq.
+Require Omega.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Lemma Rlt_R0_R2 : ``0<2``.
+Replace ``2`` with (INR (2)); [Apply lt_INR_0; Apply lt_O_Sn | Reflexivity].
+Qed.
+
+Lemma Rplus_lt_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
+Intros.
+Apply Rlt_trans with x.
+Assumption. 
+Pattern 1 x; Rewrite <- Rplus_Or.
+Apply Rlt_compatibility.
+Assumption.
+Qed.
+
+Lemma IZR_eq : (z1,z2:Z) z1=z2 -> (IZR z1)==(IZR z2).
+Intros; Rewrite H; Reflexivity.
+Qed.
+
+Lemma IZR_neq : (z1,z2:Z) `z1<>z2` -> ``(IZR z1)<>(IZR z2)``.
+Intros; Red; Intro; Elim H; Apply eq_IZR; Assumption.
+Qed.
+
+Tactic Definition DiscrR :=
+  Try Match Context With
+  | [ |- ~(?1==?2) ] -> Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_neq; Try Discriminate | Reflexivity] | Reflexivity] | Reflexivity].
+
+Recursive Tactic Definition Sup0 :=
+  Match Context With
+  | [ |- ``0<1`` ] -> Apply Rlt_R0_R1
+  | [ |- ``0<?1`` ] -> Repeat (Apply Rmult_lt_pos Orelse Apply Rplus_lt_pos; Try Apply Rlt_R0_R1 Orelse Apply Rlt_R0_R2)
+  | [ |- ``?1>0`` ] -> Change ``0<?1``; Sup0.
+
+Tactic Definition SupOmega := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_lt; Omega | Reflexivity] | Reflexivity] | Reflexivity].
+  
+Recursive Tactic Definition Sup :=
+  Match Context With
+  | [ |- (Rgt ?1 ?2) ] -> Change ``?2<?1``; Sup
+  | [ |- ``0<?1`` ] -> Sup0
+  | [ |- (Rlt (Ropp ?1) R0) ] -> Rewrite <- Ropp_O; Sup
+  | [ |- (Rlt (Ropp ?1) (Ropp ?2)) ] -> Apply Rlt_Ropp; Sup
+  | [ |- (Rlt (Ropp ?1) ?2) ] -> Apply Rlt_trans with ``0``; Sup
+  | [ |- (Rlt ?1 ?2) ] -> SupOmega
+  | _ -> Idtac.
+
+Tactic Definition RCompute := Replace ``2`` with (IZR `2`); [Replace R1 with (IZR `1`); [Replace R0 with (IZR `0`); [Repeat Rewrite <- plus_IZR Orelse Rewrite <- mult_IZR Orelse Rewrite <- Ropp_Ropp_IZR Orelse Rewrite Z_R_minus; Apply IZR_eq; Try Reflexivity | Reflexivity] | Reflexivity] | Reflexivity].
diff --git a/theories7/Reals/Exp_prop.v b/theories7/Reals/Exp_prop.v
new file mode 100644
index 00000000..6ed9c00b
--- /dev/null
+++ b/theories7/Reals/Exp_prop.v
@@ -0,0 +1,890 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Exp_prop.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require Ranalysis1.
+Require PSeries_reg.
+Require Div2.
+Require Even.
+Require Max.
+V7only [Import R_scope.].
+Open Local Scope nat_scope.
+V7only [Import nat_scope.].
+Open Local Scope R_scope.
+
+Definition E1 [x:R] : nat->R := [N:nat](sum_f_R0 [k:nat]``/(INR (fact k))*(pow x k)`` N).
+
+Lemma E1_cvg : (x:R) (Un_cv (E1 x) (exp x)).
+Intro; Unfold exp; Unfold projT1.
+Case (exist_exp x); Intro.
+Unfold exp_in Un_cv; Unfold infinit_sum E1; Trivial.
+Qed.
+
+Definition Reste_E [x,y:R] : nat->R := [N:nat](sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
+
+Lemma exp_form : (x,y:R;n:nat) (lt O n) -> ``(E1 x n)*(E1 y n)-(Reste_E x y n)==(E1 (x+y) n)``.
+Intros; Unfold E1.
+Rewrite cauchy_finite.
+Unfold Reste_E; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Apply sum_eq; Intros.
+Rewrite binomial.
+Rewrite scal_sum; Apply sum_eq; Intros.
+Unfold C; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym (INR (fact i))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite Rinv_Rmult.
+Ring.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply H.
+Qed.
+
+Definition maj_Reste_E [x,y:R] : nat->R := [N:nat]``4*(pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) N))/(Rsqr (INR (fact (div2 (pred N)))))``.
+
+Lemma Rle_Rinv : (x,y:R) ``0<x`` -> ``0<y`` -> ``x<=y`` -> ``/y<=/x``.
+Intros; Apply Rle_monotony_contra with x.
+Apply H.
+Rewrite <- Rinv_r_sym.
+Apply Rle_monotony_contra with y.
+Apply H0.
+Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Apply H1.
+Red; Intro; Rewrite H2 in H0; Elim (Rlt_antirefl ? H0).
+Red; Intro; Rewrite H2 in H; Elim (Rlt_antirefl ? H).
+Qed.
+
+(**********)
+Lemma div2_double : (N:nat) (div2 (mult (2) N))=N.
+Intro; Induction N.
+Reflexivity.
+Replace (mult (2) (S N)) with (S (S (mult (2) N))).
+Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Qed.
+
+Lemma div2_S_double : (N:nat) (div2 (S (mult (2) N)))=N.
+Intro; Induction N.
+Reflexivity.
+Replace (mult (2) (S N)) with (S (S (mult (2) N))).
+Simpl; Simpl in HrecN; Rewrite HrecN; Reflexivity.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Qed.
+
+Lemma div2_not_R0 : (N:nat) (lt (1) N) -> (lt O (div2 N)).
+Intros; Induction N.
+Elim (lt_n_O ? H).
+Cut (lt (1) N)\/N=(1).
+Intro; Elim H0; Intro.
+Assert H2 := (even_odd_dec N).
+Elim H2; Intro.
+Rewrite <- (even_div2 ? a); Apply HrecN; Assumption.
+Rewrite <- (odd_div2 ? b); Apply lt_O_Sn.
+Rewrite H1; Simpl; Apply lt_O_Sn.
+Inversion H.
+Right; Reflexivity.
+Left; Apply lt_le_trans with (2); [Apply lt_n_Sn | Apply H1].
+Qed.
+
+Lemma Reste_E_maj : (x,y:R;N:nat) (lt O N) -> ``(Rabsolu (Reste_E x y N))<=(maj_Reste_E x y N)``.
+Intros; Pose M := (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))).
+Apply Rle_trans with (Rmult (pow M (mult (2) N)) (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``/(Rsqr (INR (fact (div2 (S N)))))`` (pred (minus N k))) (pred N))). 
+Unfold Reste_E.
+Apply Rle_trans with (sum_f_R0 [k:nat](Rabsolu (sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k)))) (pred N)).
+Apply (sum_Rabsolu [k:nat](sum_f_R0 [l:nat]``/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))`` (pred (minus N k))) (pred N)).
+Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(Rabsolu (/(INR (fact (S (plus l k))))*(pow x (S (plus l k)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))))`` (pred (minus N k))) (pred N)).
+Apply sum_Rle; Intros.
+Apply (sum_Rabsolu [l:nat]``/(INR (fact (S (plus l n))))*(pow x (S (plus l n)))*(/(INR (fact (minus N l)))*(pow y (minus N l)))``).
+Apply Rle_trans with (sum_f_R0 [k:nat](sum_f_R0 [l:nat]``(pow M (mult (S (S O)) N))*/(INR (fact (S l)))*/(INR (fact (minus N l)))`` (pred (minus N k))) (pred N)).
+Apply sum_Rle; Intros.
+Apply sum_Rle; Intros.
+Repeat Rewrite Rabsolu_mult.
+Do 2 Rewrite <- Pow_Rabsolu.
+Rewrite (Rabsolu_right ``/(INR (fact (S (plus n0 n))))``).
+Rewrite (Rabsolu_right ``/(INR (fact (minus N n0)))``).
+Replace ``/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*
+   (/(INR (fact (minus N n0)))*(pow (Rabsolu y) (minus N n0)))`` with ``/(INR (fact (minus N n0)))*/(INR (fact (S (plus n0 n))))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``; [Idtac | Ring].
+Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
+Repeat Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_trans with ``/(INR (fact (S n0)))*(pow (Rabsolu x) (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
+Rewrite (Rmult_sym ``/(INR (fact (S (plus n0 n))))``); Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Rewrite (Rmult_sym ``/(INR (fact (S n0)))``); Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Apply Rle_Rinv.
+Apply INR_fact_lt_0.
+Apply INR_fact_lt_0.
+Apply le_INR; Apply fact_growing; Apply le_n_S.
+Apply le_plus_l.
+Rewrite (Rmult_sym ``(pow M (mult (S (S O)) N))``); Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow (Rabsolu y) (minus N n0))``.
+Do 2 Rewrite <- (Rmult_sym ``(pow (Rabsolu y) (minus N n0))``).
+Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Apply pow_incr; Split.
+Apply Rabsolu_pos.
+Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
+Apply RmaxLess1.
+Unfold M; Apply RmaxLess2.
+Apply Rle_trans with ``(pow M (S (plus n0 n)))*(pow M (minus N n0))``.
+Apply Rle_monotony.
+Apply pow_le; Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Unfold M; Apply RmaxLess1.
+Apply pow_incr; Split.
+Apply Rabsolu_pos.
+Apply Rle_trans with (Rmax (Rabsolu x) (Rabsolu y)).
+Apply RmaxLess2.
+Unfold M; Apply RmaxLess2.
+Rewrite <- pow_add; Replace (plus (S (plus n0 n)) (minus N n0)) with (plus N (S n)).
+Apply Rle_pow.
+Unfold M; Apply RmaxLess1.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring].
+Apply le_reg_l.
+Replace N with (S (pred N)).
+Apply le_n_S; Apply H0.
+Symmetry; Apply S_pred with O; Apply H.
+Apply INR_eq; Do 2 Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite minus_INR.
+Ring.
+Apply le_trans with (pred (minus N n)).
+Apply H1.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n (0)) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Apply H0.
+Apply lt_pred_n_n.
+Apply H.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Rewrite scal_sum.
+Apply sum_Rle; Intros.
+Rewrite <- Rmult_sym.
+Rewrite scal_sum.
+Apply sum_Rle; Intros.
+Rewrite (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
+Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Unfold M; Apply RmaxLess1.
+Assert H2 := (even_odd_cor N).
+Elim H2; Intros N0 H3.
+Elim H3; Intro.
+Apply Rle_trans with ``/(INR (fact n0))*/(INR (fact (minus N n0)))``.
+Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (minus N n0)))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_Rinv.
+Apply INR_fact_lt_0.
+Apply INR_fact_lt_0.
+Apply le_INR.
+Apply fact_growing.
+Apply le_n_Sn.
+Replace ``/(INR (fact n0))*/(INR (fact (minus N n0)))`` with ``(C N n0)/(INR (fact N))``.
+Pattern 1 N; Rewrite H4.
+Apply Rle_trans with ``(C N N0)/(INR (fact N))``.
+Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact N))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Rewrite H4.
+Apply C_maj.
+Rewrite <- H4; Apply le_trans with (pred (minus N n)).
+Apply H1.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n (0)) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Apply H0.
+Apply lt_pred_n_n.
+Apply H.
+Apply le_trans with (pred N).
+Apply H0.
+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.
+Repeat Rewrite Rinv_Rmult.
+Rewrite (Rmult_sym (INR (fact N))).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Replace (minus N N0) with N0.
+Ring.
+Replace N with (plus N0 N0).
+Symmetry; Apply minus_plus.
+Rewrite H4.
+Apply INR_eq; Rewrite plus_INR; Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Unfold C Rdiv.
+Rewrite (Rmult_sym (INR (fact N))).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rinv_Rmult.
+Rewrite Rmult_1r; Ring.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Replace ``/(INR (fact (S n0)))*/(INR (fact (minus 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; Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S N)))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Cut (S N) = (mult (2) (S N0)).
+Intro; Rewrite H5; Apply C_maj.
+Rewrite <- H5; Apply le_n_S.
+Apply le_trans with (pred (minus N n)).
+Apply H1.
+Apply le_S_n.
+Replace (S (pred (minus N n))) with (minus N n).
+Apply le_trans with N.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply le_n_Sn.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n (0)) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Apply H0.
+Apply lt_pred_n_n.
+Apply H.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply INR_eq; Rewrite H4.
+Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat  Rewrite S_INR; Ring.
+Cut (S N) = (mult (2) (S N0)).
+Intro.
+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.
+Repeat Rewrite Rinv_Rmult.
+Replace (minus (S N) (S N0)) with (S N0).
+Rewrite (Rmult_sym (INR (fact (S N)))).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Reflexivity.
+Apply INR_fact_neq_0.
+Replace (S N) with (plus (S N0) (S N0)).
+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.
+Apply INR_eq; Rewrite H4; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Unfold C Rdiv.
+Rewrite (Rmult_sym (INR (fact (S N)))).
+Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Rewrite Rinv_Rmult.
+Reflexivity.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Unfold maj_Reste_E.
+Unfold Rdiv; Rewrite (Rmult_sym ``4``).
+Rewrite Rmult_assoc.
+Apply Rle_monotony.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Apply Rle_trans with (sum_f_R0 [k:nat]``(INR (minus N k))*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
+Apply sum_Rle; Intros.
+Rewrite sum_cte.
+Replace (S (pred (minus N n))) with (minus N n).
+Right; Apply Rmult_sym.
+Apply S_pred with O.
+Apply simpl_lt_plus_l with n.
+Rewrite <- le_plus_minus.
+Replace (plus n (0)) with n; [Idtac | Ring].
+Apply le_lt_trans with (pred N).
+Apply H0.
+Apply lt_pred_n_n.
+Apply H.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Apply Rle_trans with (sum_f_R0 [k:nat]``(INR N)*/(Rsqr (INR (fact (div2 (S N)))))`` (pred N)).
+Apply sum_Rle; Intros.
+Do 2 Rewrite <- (Rmult_sym ``/(Rsqr (INR (fact (div2 (S N)))))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt.
+Apply INR_fact_neq_0.
+Apply le_INR.
+Apply simpl_le_plus_l with n.
+Rewrite <- le_plus_minus.
+Apply le_plus_r.
+Apply le_trans with (pred N).
+Apply H0.
+Apply le_pred_n.
+Rewrite sum_cte; Replace (S (pred N)) with N.
+Cut (div2 (S N)) = (S (div2 (pred N))).
+Intro; Rewrite H0.
+Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rsqr_times.
+Rewrite Rinv_Rmult.
+Rewrite (Rmult_sym (INR N)); Repeat Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
+Rewrite <- H0.
+Cut ``(INR N)<=(INR (mult (S (S O)) (div2 (S N))))``.
+Intro; Apply Rle_monotony_contra with ``(Rsqr (INR (div2 (S N))))``.
+Apply Rsqr_pos_lt.
+Apply not_O_INR; Red; Intro.
+Cut (lt (1) (S N)).
+Intro; Assert H4 := (div2_not_R0 ? H3).
+Rewrite H2 in H4; Elim (lt_n_O ? H4).
+Apply lt_n_S; Apply H.
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Replace ``(INR N)*(INR N)`` with (Rsqr (INR N)); [Idtac | Reflexivity].
+Rewrite Rmult_assoc.
+Rewrite Rmult_sym.
+Replace ``4`` with (Rsqr ``2``); [Idtac | SqRing].
+Rewrite <- Rsqr_times.
+Apply Rsqr_incr_1.
+Replace ``2`` with (INR (2)).
+Rewrite <- mult_INR; Apply H1.
+Reflexivity.
+Left; Apply lt_INR_0; Apply H.
+Left; Apply Rmult_lt_pos.
+Sup0.
+Apply lt_INR_0; Apply div2_not_R0.
+Apply lt_n_S; Apply H.
+Cut (lt (1) (S N)).
+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 2 N; Rewrite H3.
+Rewrite div2_S_double.
+Right; Rewrite H3; Reflexivity.
+Pattern 2 N; Rewrite H3.
+Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
+Rewrite div2_double.
+Rewrite H3.
+Rewrite S_INR; Do 2 Rewrite mult_INR.
+Rewrite (S_INR N0).
+Rewrite Rmult_Rplus_distr.
+Apply Rle_compatibility.
+Rewrite Rmult_1r.
+Simpl.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+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.
+Cut (lt O N0).
+Intro; Rewrite H2.
+Rewrite div2_S_double.
+Replace (mult (2) N0) with (S (S (mult (2) (pred N0)))).
+Replace (pred (S (S (mult (2) (pred N0))))) with (S (mult (2) (pred N0))).
+Rewrite div2_S_double.
+Apply S_pred with O; Apply H3.
+Reflexivity.
+Replace N0 with (S (pred N0)).
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Symmetry; Apply S_pred with O; Apply H3.
+Rewrite H2 in H.
+Apply neq_O_lt.
+Red; Intro.
+Rewrite <- H3 in H.
+Simpl in H.
+Elim (lt_n_O ? H).
+Rewrite H2.
+Replace (pred (S (mult (2) N0))) with (mult (2) N0); [Idtac | Reflexivity].
+Replace (S (S (mult (2) N0))) with (mult (2) (S N0)).
+Do 2 Rewrite div2_double.
+Reflexivity.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply S_pred with O; Apply H.
+Qed.
+
+Lemma maj_Reste_cv_R0 : (x,y:R) (Un_cv (maj_Reste_E x y) ``0``).
+Intros; Assert H := (Majxy_cv_R0 x y).
+Unfold Un_cv in H; Unfold Un_cv; Intros.
+Cut ``0<eps/4``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
+Elim (H ? H1); Intros N0 H2.
+Exists (max (mult (2) (S N0)) (2)); Intros.
+Unfold R_dist in H2; Unfold R_dist; Rewrite minus_R0; Unfold Majxy in H2; Unfold maj_Reste_E.
+Rewrite Rabsolu_right.
+Apply Rle_lt_trans with ``4*(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))``.
+Apply Rle_monotony.
+Left; Sup0.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
+Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``); Rewrite (Rmult_sym ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))``); Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Rle_trans with ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S O)) n))``.
+Rewrite Rmult_sym; Pattern 2 (pow (Rmax R1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (2) n)); Rewrite <- Rmult_1r; Apply Rle_monotony.
+Apply pow_le; Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Apply Rle_monotony_contra with ``(INR (fact (div2 (pred n))))``.
+Apply INR_fact_lt_0.
+Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
+Replace R1 with (INR (1)); [Apply le_INR | Reflexivity].
+Apply lt_le_S.
+Apply INR_lt.
+Apply INR_fact_lt_0.
+Apply INR_fact_neq_0.
+Apply Rle_pow.
+Apply RmaxLess1.
+Assert H4 := (even_odd_cor n).
+Elim H4; Intros N1 H5.
+Elim H5; Intro.
+Cut (lt O N1).
+Intro.
+Rewrite H6.
+Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
+Rewrite div2_S_double.
+Replace (S (pred N1)) with N1.
+Apply INR_le.
+Right.
+Do 3 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply S_pred with O; Apply H7.
+Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
+Reflexivity.
+Pattern 2 N1; Replace N1 with (S (pred N1)).
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Symmetry ; Apply S_pred with O; Apply H7.
+Apply INR_lt.
+Apply Rlt_monotony_contra with (INR (2)).
+Simpl; Sup0.
+Rewrite Rmult_Or; Rewrite <- mult_INR.
+Apply lt_INR_0.
+Rewrite <- H6.
+Apply lt_le_trans with (2).
+Apply lt_O_Sn.
+Apply le_trans with (max (mult (2) (S N0)) (2)).
+Apply le_max_r.
+Apply H3.
+Rewrite H6.
+Replace (pred (S (mult (2) N1))) with (mult (2) N1).
+Rewrite div2_double.
+Replace (mult (4) (S N1)) with (mult (2) (mult (2) (S N1))).
+Apply mult_le.
+Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
+Apply le_n_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Ring.
+Reflexivity.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply Rlt_monotony_contra with ``/4``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite Rmult_sym.
+Replace ``(pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))`` with ``(Rabsolu ((pow (Rmax 1 (Rmax (Rabsolu x) (Rabsolu y))) (mult (S (S (S (S O)))) (S (div2 (pred n)))))/(INR (fact (div2 (pred n))))-0))``.
+Apply H2; Unfold ge.
+Cut (le (mult (2) (S N0)) n).
+Intro; Apply le_S_n.
+Apply INR_le; Apply Rle_monotony_contra with (INR (2)).
+Simpl; Sup0.
+Do 2 Rewrite <- mult_INR; Apply le_INR.
+Apply le_trans with n.
+Apply H4.
+Assert H5 := (even_odd_cor n).
+Elim H5; Intros N1 H6.
+Elim H6; Intro.
+Cut (lt O N1).
+Intro.
+Rewrite H7.
+Apply mult_le.
+Replace (pred (mult (2) N1)) with (S (mult (2) (pred N1))).
+Rewrite div2_S_double.
+Replace (S (pred N1)) with N1.
+Apply le_n.
+Apply S_pred with O; Apply H8.
+Replace (mult (2) N1) with (S (S (mult (2) (pred N1)))).
+Reflexivity.
+Pattern 2 N1; Replace N1 with (S (pred N1)).
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Symmetry; Apply S_pred with O; Apply H8.
+Apply INR_lt.
+Apply Rlt_monotony_contra with (INR (2)).
+Simpl; Sup0.
+Rewrite Rmult_Or; Rewrite <- mult_INR.
+Apply lt_INR_0.
+Rewrite <- H7.
+Apply lt_le_trans with (2).
+Apply lt_O_Sn.
+Apply le_trans with (max (mult (2) (S N0)) (2)).
+Apply le_max_r.
+Apply H3.
+Rewrite H7.
+Replace (pred (S (mult (2) N1))) with (mult (2) N1).
+Rewrite div2_double.
+Replace (mult (2) (S N1)) with (S (S (mult (2) N1))).
+Apply le_n_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Reflexivity.
+Apply le_trans with (max (mult (2) (S N0)) (2)).
+Apply le_max_l.
+Apply H3.
+Rewrite minus_R0; Apply Rabsolu_right.
+Apply Rle_sym1.
+Unfold Rdiv; Repeat Apply Rmult_le_pos.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Left; Apply Rlt_Rinv; Apply INR_fact_lt_0.
+DiscrR.
+Apply Rle_sym1.
+Unfold Rdiv; Apply Rmult_le_pos.
+Left; Sup0.
+Apply Rmult_le_pos.
+Apply pow_le.
+Apply Rle_trans with R1.
+Left; Apply Rlt_R0_R1.
+Apply RmaxLess1.
+Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Apply INR_fact_neq_0.
+Qed.
+
+(**********)
+Lemma Reste_E_cv : (x,y:R) (Un_cv (Reste_E x y) R0).
+Intros; Assert H := (maj_Reste_cv_R0 x y).
+Unfold Un_cv in H; Unfold Un_cv; Intros; Elim (H ? H0); Intros.
+Exists (max x0 (1)); Intros.
+Unfold R_dist; Rewrite minus_R0.
+Apply Rle_lt_trans with (maj_Reste_E x y n).
+Apply Reste_E_maj.
+Apply lt_le_trans with (1).
+Apply lt_O_Sn.
+Apply le_trans with (max x0 (1)).
+Apply le_max_r.
+Apply H2.
+Replace (maj_Reste_E x y n) with (R_dist (maj_Reste_E x y n) R0).
+Apply H1.
+Unfold ge; Apply le_trans with (max x0 (1)).
+Apply le_max_l.
+Apply H2.
+Unfold R_dist; Rewrite minus_R0; Apply Rabsolu_right.
+Apply Rle_sym1; Apply Rle_trans with (Rabsolu (Reste_E x y n)).
+Apply Rabsolu_pos.
+Apply Reste_E_maj.
+Apply lt_le_trans with (1).
+Apply lt_O_Sn.
+Apply le_trans with (max x0 (1)).
+Apply le_max_r.
+Apply H2.
+Qed.
+
+(**********)
+Lemma exp_plus : (x,y:R) ``(exp (x+y))==(exp x)*(exp y)``.
+Intros; Assert H0 := (E1_cvg x).
+Assert H := (E1_cvg y).
+Assert H1 := (E1_cvg ``x+y``).
+EApply UL_sequence.
+Apply H1.
+Assert H2 := (CV_mult ? ? ? ? H0 H).
+Assert H3 := (CV_minus ? ? ? ? H2 (Reste_E_cv x y)).
+Unfold Un_cv; Unfold Un_cv in H3; Intros.
+Elim (H3 ? H4); Intros.
+Exists (S x0); Intros.
+Rewrite <- (exp_form x y n).
+Rewrite minus_R0 in H5.
+Apply H5.
+Unfold ge; Apply le_trans with (S x0).
+Apply le_n_Sn.
+Apply H6.
+Apply lt_le_trans with (S x0).
+Apply lt_O_Sn.
+Apply H6.
+Qed.
+
+(**********)
+Lemma exp_pos_pos : (x:R) ``0<x`` -> ``0<(exp x)``.
+Intros; Pose An := [N:nat]``/(INR (fact N))*(pow x N)``.
+Cut (Un_cv [n:nat](sum_f_R0 An n) (exp x)).
+Intro; Apply Rlt_le_trans with (sum_f_R0 An O).
+Unfold An; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Apply Rlt_R0_R1.
+Apply sum_incr.
+Assumption.
+Intro; Unfold An; Left; Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply (pow_lt ? n H).
+Unfold exp; Unfold projT1; Case (exist_exp x); Intro.
+Unfold exp_in; Unfold infinit_sum Un_cv; Trivial.
+Qed.
+
+(**********)
+Lemma exp_pos : (x:R) ``0<(exp x)``.
+Intro; Case (total_order_T R0 x); Intro.
+Elim s; Intro.
+Apply (exp_pos_pos ? a).
+Rewrite <- b; Rewrite exp_0; Apply Rlt_R0_R1.
+Replace (exp x) with ``1/(exp (-x))``.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_R0_R1.
+Apply Rlt_Rinv; Apply exp_pos_pos.
+Apply (Rgt_RO_Ropp ? r).
+Cut ``(exp (-x))<>0``.
+Intro; Unfold Rdiv; Apply r_Rmult_mult with ``(exp (-x))``.
+Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
+Rewrite <- exp_plus.
+Rewrite Rplus_Ropp_l; Rewrite exp_0; Reflexivity.
+Apply H.
+Apply H.
+Assert H := (exp_plus x ``-x``).
+Rewrite Rplus_Ropp_r in H; Rewrite exp_0 in H.
+Red; Intro; Rewrite H0 in H.
+Rewrite Rmult_Or in H.
+Elim R1_neq_R0; Assumption.
+Qed.
+
+(* ((exp h)-1)/h -> 0 quand h->0 *)
+Lemma derivable_pt_lim_exp_0 : (derivable_pt_lim exp ``0`` ``1``).
+Unfold derivable_pt_lim; Intros.
+Pose fn := [N:nat][x:R]``(pow x N)/(INR (fact (S N)))``.
+Cut (CVN_R fn).
+Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
+Intro cv; Cut ((n:nat)(continuity (fn n))).
+Intro; Cut (continuity (SFL fn cv)).
+Intro; Unfold continuity in H1.
+Assert H2 := (H1 R0).
+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 ? H); Intros alp H3.
+Elim H3; Intros.
+Exists (mkposreal ? H4); Intros.
+Rewrite Rplus_Ol; Rewrite exp_0.
+Replace ``((exp h)-1)/h`` with (SFL fn cv h).
+Replace R1 with (SFL fn cv R0).
+Apply H5.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Apply (not_sym ? ? H6).
+Rewrite minus_R0; Apply H7.
+Unfold SFL.
+Case (cv ``0``); Intros.
+EApply UL_sequence.
+Apply u.
+Unfold Un_cv SP.
+Intros; Exists (1); Intros.
+Unfold R_dist; Rewrite decomp_sum.
+Rewrite (Rplus_sym (fn O R0)).
+Replace (fn O R0) with R1.
+Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
+Replace (sum_f_R0 [i:nat](fn (S i) ``0``) (pred n)) with R0.
+Rewrite Rabsolu_R0; Apply H8.
+Symmetry; Apply sum_eq_R0; Intros.
+Unfold fn.
+Simpl.
+Unfold Rdiv; Do 2 Rewrite Rmult_Ol; Reflexivity.
+Unfold fn; Simpl.
+Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
+Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H9].
+Unfold SFL exp.
+Unfold projT1.
+Case (cv h); Case (exist_exp h); Intros.
+EApply UL_sequence.
+Apply u.
+Unfold Un_cv; Intros.
+Unfold exp_in in e.
+Unfold infinit_sum in e.
+Cut ``0<eps0*(Rabsolu h)``.
+Intro; Elim (e ? H9); Intros N0 H10.
+Exists N0; Intros.
+Unfold R_dist.
+Apply Rlt_monotony_contra with ``(Rabsolu h)``.
+Apply Rabsolu_pos_lt; Assumption.
+Rewrite <- Rabsolu_mult.
+Rewrite Rminus_distr.
+Replace ``h*(x-1)/h`` with ``(x-1)``.
+Unfold R_dist in H10.
+Replace ``h*(SP fn n h)-(x-1)`` with (Rminus (sum_f_R0 [i:nat]``/(INR (fact i))*(pow h i)`` (S n)) x).
+Rewrite (Rmult_sym (Rabsolu h)).
+Apply H10.
+Unfold ge.
+Apply le_trans with (S N0).
+Apply le_n_Sn.
+Apply le_n_S; Apply H11.
+Rewrite decomp_sum.
+Replace ``/(INR (fact O))*(pow h O)`` with R1.
+Unfold Rminus.
+Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Rewrite <- (Rplus_sym ``-x``).
+Rewrite <- (Rplus_sym ``-x+1``).
+Rewrite Rplus_assoc; Repeat Apply Rplus_plus_r.
+Replace (pred (S n)) with n; [Idtac | Reflexivity].
+Unfold SP.
+Rewrite scal_sum.
+Apply sum_eq; Intros.
+Unfold fn.
+Replace (pow h (S i)) with ``h*(pow h i)``.
+Unfold Rdiv; Ring.
+Simpl; Ring.
+Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
+Apply lt_O_Sn.
+Unfold Rdiv.
+Rewrite <- Rmult_assoc.
+Symmetry; Apply Rinv_r_simpl_m.
+Assumption.
+Apply Rmult_lt_pos.
+Apply H8.
+Apply Rabsolu_pos_lt; Assumption.
+Apply SFL_continuity; Assumption.
+Intro; Unfold fn.
+Replace [x:R]``(pow x n)/(INR (fact (S n)))`` with (div_fct (pow_fct n) (fct_cte (INR (fact (S n))))); [Idtac | Reflexivity].
+Apply continuity_div.
+Apply derivable_continuous; Apply (derivable_pow n).
+Apply derivable_continuous; Apply derivable_const.
+Intro; Unfold fct_cte; Apply INR_fact_neq_0.
+Apply (CVN_R_CVS ? X).
+Assert H0 := Alembert_exp.
+Unfold CVN_R.
+Intro; Unfold CVN_r.
+Apply Specif.existT with [N:nat]``(pow r N)/(INR (fact (S N)))``.
+Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``(pow r k)/(INR (fact (S k)))``) n) l)).
+Intro.
+Elim X; Intros.
+Exists x; Intros.
+Split.
+Apply p.
+Unfold Boule; Intros.
+Rewrite minus_R0 in H1.
+Unfold fn.
+Unfold Rdiv; Rewrite Rabsolu_mult.
+Cut ``0<(INR (fact (S n)))``.
+Intro.
+Rewrite (Rabsolu_right ``/(INR (fact (S n)))``).
+Do 2 Rewrite <- (Rmult_sym ``/(INR (fact (S n)))``).
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply H2.
+Rewrite <- Pow_Rabsolu.
+Apply pow_maj_Rabs.
+Rewrite Rabsolu_Rabsolu; Left; Apply H1.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply H2.
+Apply INR_fact_lt_0.
+Cut (r::R)<>``0``.
+Intro; Apply Alembert_C2.
+Intro; Apply Rabsolu_no_R0.
+Unfold Rdiv; Apply prod_neq_R0.
+Apply pow_nonzero; Assumption.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Unfold Un_cv in H0.
+Unfold Un_cv; Intros.
+Cut ``0<eps0/r``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply (cond_pos r)]].
+Elim (H0 ? H3); Intros N0 H4.
+Exists N0; Intros.
+Cut (ge (S n) N0).
+Intro hyp_sn.
+Assert H6 := (H4 ? hyp_sn).
+Unfold R_dist in H6; Rewrite minus_R0 in H6.
+Rewrite Rabsolu_Rabsolu in H6.
+Unfold R_dist; Rewrite minus_R0.
+Rewrite Rabsolu_Rabsolu.
+Replace ``(Rabsolu ((pow r (S n))/(INR (fact (S (S n))))))/
+     (Rabsolu ((pow r n)/(INR (fact (S n)))))`` with ``r*/(INR (fact (S (S n))))*//(INR (fact (S n)))``.
+Rewrite Rmult_assoc; Rewrite Rabsolu_mult.
+Rewrite (Rabsolu_right r).
+Apply Rlt_monotony_contra with ``/r``.
+Apply Rlt_Rinv; Apply (cond_pos r).
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps0).
+Apply H6.
+Assumption.
+Apply Rle_sym1; Left; Apply (cond_pos r).
+Unfold Rdiv.
+Repeat Rewrite Rabsolu_mult.
+Repeat Rewrite Rabsolu_Rinv.
+Rewrite Rinv_Rmult.
+Repeat Rewrite Rabsolu_right.
+Rewrite Rinv_Rinv.
+Rewrite (Rmult_sym r).
+Rewrite (Rmult_sym (pow r (S n))).
+Repeat Rewrite Rmult_assoc.
+Apply Rmult_mult_r.
+Rewrite (Rmult_sym r).
+Rewrite <- Rmult_assoc; Rewrite <- (Rmult_sym (INR (fact (S n)))).
+Apply Rmult_mult_r.
+Simpl.
+Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Ring.
+Apply pow_nonzero; Assumption.
+Apply INR_fact_neq_0.
+Apply Rle_sym1; Left; Apply INR_fact_lt_0.
+Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
+Apply Rle_sym1; Left; Apply INR_fact_lt_0.
+Apply Rle_sym1; Left; Apply pow_lt; Apply (cond_pos r).
+Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
+Apply Rinv_neq_R0; Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Unfold ge; Apply le_trans with n.
+Apply H5.
+Apply le_n_Sn.
+Assert H1 := (cond_pos r); Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
+Qed.
+
+(**********)
+Lemma derivable_pt_lim_exp : (x:R) (derivable_pt_lim exp x (exp x)).
+Intro; Assert H0 := derivable_pt_lim_exp_0.
+Unfold derivable_pt_lim in H0; Unfold derivable_pt_lim; Intros.
+Cut ``0<eps/(exp x)``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H | Apply Rlt_Rinv; Apply exp_pos]].
+Elim (H0 ? H1); Intros del H2.
+Exists del; Intros.
+Assert H5 := (H2 ? H3 H4).
+Rewrite Rplus_Ol in H5; Rewrite exp_0 in H5.
+Replace ``((exp (x+h))-(exp x))/h-(exp x)`` with ``(exp x)*(((exp h)-1)/h-1)``.
+Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (exp x)).
+Apply Rlt_monotony_contra with ``/(exp x)``.
+Apply Rlt_Rinv; Apply exp_pos.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
+Apply H5.
+Assert H6 := (exp_pos x); Red; Intro; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6).
+Apply Rle_sym1; Left; Apply exp_pos.
+Rewrite Rminus_distr.
+Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rminus_distr.
+Rewrite Rmult_1r; Rewrite exp_plus; Reflexivity.
+Qed.
diff --git a/theories7/Reals/Integration.v b/theories7/Reals/Integration.v
new file mode 100644
index 00000000..410429ed
--- /dev/null
+++ b/theories7/Reals/Integration.v
@@ -0,0 +1,13 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Integration.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
+
+Require Export NewtonInt.
+Require Export RiemannInt_SF.
+Require Export RiemannInt.
\ No newline at end of file
diff --git a/theories7/Reals/MVT.v b/theories7/Reals/MVT.v
new file mode 100644
index 00000000..eae414b1
--- /dev/null
+++ b/theories7/Reals/MVT.v
@@ -0,0 +1,517 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: MVT.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis1.
+Require Rtopology.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(* The Mean Value Theorem *)
+Theorem MVT : (f,g:R->R;a,b:R;pr1:(c:R)``a<c<b``->(derivable_pt f c);pr2:(c:R)``a<c<b``->(derivable_pt g c)) ``a<b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> ((c:R)``a<=c<=b``->(continuity_pt g c)) -> (EXT c : R | (EXT P : ``a<c<b`` | ``((g b)-(g a))*(derive_pt f c (pr1 c P))==((f b)-(f a))*(derive_pt g c (pr2 c P))``)).
+Intros; Assert H2 := (Rlt_le ? ? H).
+Pose h := [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)``.
+Cut (c:R)``a<c<b``->(derivable_pt h c).
+Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt h c)).
+Intro; Assert H4 := (continuity_ab_maj h a b H2 H3).
+Assert H5 := (continuity_ab_min h a b H2 H3).
+Elim H4; Intros Mx H6.
+Elim H5; Intros mx H7.
+Cut (h a)==(h b).
+Intro; Pose M := (h Mx); Pose m := (h mx).
+Cut (c:R;P:``a<c<b``) (derive_pt h c (X c P))==``((g b)-(g a))*(derive_pt f c (pr1 c P))-((f b)-(f a))*(derive_pt g c (pr2 c P))``.
+Intro; Case (Req_EM (h a) M); Intro.
+Case (Req_EM (h a) m); Intro.
+Cut ((c:R)``a<=c<=b``->(h c)==M).
+Intro; Cut ``a<(a+b)/2<b``.
+(*** h constant ***)
+Intro; Exists ``(a+b)/2``.
+Exists H13.
+Apply Rminus_eq; Rewrite <- H9; Apply deriv_constant2 with a b.
+Elim H13; Intros; Assumption.
+Elim H13; Intros; Assumption.
+Intros; Rewrite (H12 ``(a+b)/2``).
+Apply H12; Split; Left; Assumption.
+Elim H13; Intros; Split; Left; Assumption.
+Split.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H.
+DiscrR.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite Rplus_sym; Rewrite double; Apply Rlt_compatibility; Apply H.
+DiscrR.
+Intros; Elim H6; Intros H13 _.
+Elim H7; Intros H14 _.
+Apply Rle_antisym.
+Apply H13; Apply H12.
+Rewrite H10 in H11; Rewrite H11; Apply H14; Apply H12.
+Cut ``a<mx<b``.
+(*** h admet un minimum global sur [a,b] ***)
+Intro; Exists mx.
+Exists H12.
+Apply Rminus_eq; Rewrite <- H9; Apply deriv_minimum with a b.
+Elim H12; Intros; Assumption.
+Elim H12; Intros; Assumption.
+Intros; Elim H7; Intros.
+Apply H15; Split; Left; Assumption.
+Elim H7; Intros _ H12; Elim H12; Intros; Split.
+Inversion H13.
+Apply H15.
+Rewrite H15 in H11; Elim H11; Reflexivity.
+Inversion H14.
+Apply H15.
+Rewrite H8 in H11; Rewrite <- H15 in H11; Elim H11; Reflexivity.
+Cut ``a<Mx<b``.
+(*** h admet un maximum global sur [a,b] ***)
+Intro; Exists Mx.
+Exists H11.
+Apply Rminus_eq; Rewrite <- H9; Apply deriv_maximum with a b.
+Elim H11; Intros; Assumption.
+Elim H11; Intros; Assumption.
+Intros; Elim H6; Intros; Apply H14.
+Split; Left; Assumption.
+Elim H6; Intros _ H11; Elim H11; Intros; Split.
+Inversion H12.
+Apply H14.
+Rewrite H14 in H10; Elim H10; Reflexivity.
+Inversion H13.
+Apply H14.
+Rewrite H8 in H10; Rewrite <- H14 in H10; Elim H10; Reflexivity.
+Intros; Unfold h; Replace (derive_pt [y:R]``((g b)-(g a))*(f y)-((f b)-(f a))*(g y)`` c (X c P)) with (derive_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c (derivable_pt_minus ? ? ? (derivable_pt_mult ? ? ? (derivable_pt_const ``(g b)-(g a)`` c) (pr1 c P)) (derivable_pt_mult ? ? ? (derivable_pt_const ``(f b)-(f a)`` c) (pr2 c P)))); [Idtac | Apply pr_nu].
+Rewrite derive_pt_minus; Do 2 Rewrite derive_pt_mult; Do 2 Rewrite derive_pt_const; Do 2 Rewrite Rmult_Ol; Do 2 Rewrite Rplus_Ol; Reflexivity.
+Unfold h; Ring.
+Intros; Unfold h; Change (continuity_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
+Apply continuity_pt_minus; Apply continuity_pt_mult.
+Apply derivable_continuous_pt; Apply derivable_const.
+Apply H0; Apply H3.
+Apply derivable_continuous_pt; Apply derivable_const.
+Apply H1; Apply H3.
+Intros; Change (derivable_pt (minus_fct (mult_fct (fct_cte ``(g b)-(g a)``) f) (mult_fct (fct_cte ``(f b)-(f a)``) g)) c).
+Apply derivable_pt_minus; Apply derivable_pt_mult.
+Apply derivable_pt_const.
+Apply (pr1 ? H3).
+Apply derivable_pt_const.
+Apply (pr2 ? H3).
+Qed.
+
+(* Corollaries ... *)
+Lemma MVT_cor1 : (f:(R->R); a,b:R; pr:(derivable f)) ``a < b``->(EXT c:R | ``(f b)-(f a) == (derive_pt f c (pr c))*(b-a)``/\``a < c < b``).
+Intros f a b pr H; Cut (c:R)``a<c<b``->(derivable_pt f c); [Intro | Intros; Apply pr].
+Cut (c:R)``a<c<b``->(derivable_pt id c); [Intro | Intros; Apply derivable_pt_id].
+Cut ((c:R)``a<=c<=b``->(continuity_pt f c)); [Intro | Intros; Apply derivable_continuous_pt; Apply pr].
+Cut ((c:R)``a<=c<=b``->(continuity_pt id c)); [Intro | Intros; Apply derivable_continuous_pt; Apply derivable_id].
+Assert H2 := (MVT f id a b X X0 H H0 H1).
+Elim H2; Intros c H3; Elim H3; Intros.
+Exists c; Split.
+Cut (derive_pt id c (X0 c x)) == (derive_pt id c (derivable_pt_id c)); [Intro | Apply pr_nu].
+Rewrite H5 in H4; Rewrite (derive_pt_id c) in H4; Rewrite Rmult_1r in H4; Rewrite <- H4; Replace (derive_pt f c (X c x)) with (derive_pt f c (pr c)); [Idtac | Apply pr_nu]; Apply Rmult_sym.
+Apply x.
+Qed.
+
+Theorem MVT_cor2 : (f,f':R->R;a,b:R) ``a<b`` -> ((c:R)``a<=c<=b``->(derivable_pt_lim f c (f' c))) -> (EXT c:R | ``(f b)-(f a)==(f' c)*(b-a)``/\``a<c<b``).
+Intros f f' a b H H0; Cut ((c:R)``a<=c<=b``->(derivable_pt f c)).
+Intro; Cut ((c:R)``a<c<b``->(derivable_pt f c)).
+Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt f c)).
+Intro; Cut ((c:R)``a<=c<=b``->(derivable_pt id c)).
+Intro; Cut ((c:R)``a<c<b``->(derivable_pt id c)).
+Intro; Cut ((c:R)``a<=c<=b``->(continuity_pt id c)).
+Intro; Elim (MVT f id a b X0 X2 H H1 H2); Intros; Elim H3; Clear H3; Intros; Exists x; Split.
+Cut (derive_pt id x (X2 x x0))==R1.
+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_1r in H3; Rewrite Rmult_sym; 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.
+Assumption.
+Intros; Apply derivable_continuous_pt; Apply X1; Assumption.
+Intros; Apply derivable_pt_id.
+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; Apply Specif.existT with (f' c); Apply H0; Apply H1.
+Qed.
+
+Lemma MVT_cor3 : (f,f':(R->R); a,b:R) ``a < b``  -> ((x:R)``a <= x`` ->  ``x <= b``->(derivable_pt_lim f x (f' x))) -> (EXT c:R | ``a<=c``/\``c<=b``/\``(f b)==(f a) + (f' c)*(b-a)``).
+Intros f f' a b H H0; Assert H1 : (EXT c:R | ``(f b) -(f a) == (f' c)*(b-a)``/\``a<c<b``); [Apply MVT_cor2; [Apply H | Intros; Elim H1; Intros; Apply (H0 ? H2 H3)] | Elim H1; Intros; Exists x; Elim H2; Intros; Elim H4; Intros; Split; [Left; Assumption | Split; [Left; Assumption | Rewrite <- H3; Ring]]].
+Qed.
+
+Lemma Rolle : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ``a<b`` -> (f a)==(f b) -> (EXT c:R | (EXT P: ``a<c<b`` | ``(derive_pt f c (pr c P))==0``)).
+Intros; Assert H2 : (x:R)``a<x<b``->(derivable_pt id x).
+Intros; Apply derivable_pt_id.
+Assert H3 := (MVT f id a b pr H2 H0 H); Assert H4 : (x:R)``a<=x<=b``->(continuity_pt id x).
+Intros; Apply derivable_continuous; Apply derivable_id.
+Elim (H3 H4); Intros; Elim H5; Intros; Exists x; Exists x0; Rewrite H1 in H6; Unfold id in H6; Unfold Rminus in H6; Rewrite Rplus_Ropp_r in H6; Rewrite Rmult_Ol in H6; Apply r_Rmult_mult with ``b-a``; [Rewrite Rmult_Or; Apply H6 | Apply Rminus_eq_contra; Red; Intro; Rewrite H7 in H0; Elim (Rlt_antirefl ? H0)].
+Qed.
+
+(**********)
+Lemma nonneg_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``0<=(derive_pt f x (pr x))``) -> (increasing f).
+Intros.
+Unfold increasing.
+Intros.
+Case (total_order_T x y); Intro.
+Elim s; Intro.
+Apply Rle_anti_compatibility with ``-(f x)``.
+Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
+Assert H1 := (MVT_cor1 f ? ? pr a).
+Elim H1; Intros.
+Elim H2; Intros.
+Unfold Rminus in H3.
+Rewrite H3.
+Apply Rmult_le_pos.
+Apply H.
+Apply Rle_anti_compatibility with x.
+Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
+Rewrite b; Right; Reflexivity.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
+Qed.
+ 
+(**********)
+Lemma nonpos_derivative_0 : (f:R->R;pr:(derivable f)) (decreasing f) -> ((x:R) ``(derive_pt f x (pr x))<=0``).
+Intros f pr H x; Assert H0 :=H; Unfold decreasing in H0; Generalize (derivable_derive f x (pr x)); Intro; Elim H1; Intros l H2.
+Rewrite H2; Case (total_order l R0); Intro.
+Left; Assumption.
+Elim H3; Intro.
+Right; Assumption.
+Generalize (derive_pt_eq_1 f x l (pr x) H2); Intros; Cut ``0< (l/2)``.
+Intro; Elim (H5 ``(l/2)`` H6); Intros delta H7; Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
+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 Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
+Intros; Generalize (Rlt_compatibility_r ``-l`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``(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))``.
+Intro.
+Generalize (Rlt_Ropp ``-(((f (x+delta/2))+ -(f x))/(delta/2))`` ``-(l/2)`` H15). 
+Repeat Rewrite Ropp_Ropp.
+Intro.
+Generalize (Rlt_trans ``0`` ``l/2`` ``((f (x+delta/2))-(f x))/(delta/2)`` H6 H16); Intro.
+Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``0`` H17 H10)).
+Ring.
+Pattern 3 l; Rewrite double_var.
+Ring.
+Intros.
+Generalize (Rge_Ropp ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` r).
+Rewrite Ropp_O.
+Intro.
+Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` ``0`` H13 H15)).
+Replace ``-(((f (x+delta/2))-(f x))/(delta/2)-l)`` with ``(((f (x))-(f (x+delta/2)))/(delta/2)) +l``.
+Unfold Rminus.
+Apply ge0_plus_gt0_is_gt0.
+Unfold Rdiv; Apply Rmult_le_pos.
+Cut ``x<=(x+(delta*/2))``.
+Intro; Generalize (H0 x ``x+(delta*/2)`` H13); Intro; Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H14); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
+Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
+Left; Apply Rlt_Rinv; Assumption.
+Assumption.
+Rewrite Ropp_distr2.
+Unfold Rminus.
+Rewrite (Rplus_sym l).
+Unfold Rdiv.
+Rewrite <- Ropp_mul1.
+Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Rewrite (Rplus_sym (f x)).
+Reflexivity.
+Replace ``((f (x+delta/2))-(f x))/(delta/2)`` with ``-(((f x)-(f (x+delta/2)))/(delta/2))``.
+Rewrite <- Ropp_O.
+Apply Rge_Ropp.
+Apply Rle_sym1.
+Unfold Rdiv; Apply Rmult_le_pos.
+Cut ``x<=(x+(delta*/2))``.
+Intro; Generalize (H0 x ``x+(delta*/2)`` H10); Intro.
+Generalize (Rle_compatibility ``-(f (x+delta/2))`` ``(f (x+delta/2))`` ``(f x)`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
+Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
+Left; Apply Rlt_Rinv; Assumption.
+Unfold Rdiv; Rewrite <- Ropp_mul1.
+Rewrite Ropp_distr2.
+Reflexivity.
+Split.
+Unfold Rdiv; Apply prod_neq_R0.
+Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H8; Elim (Rlt_antirefl ``0`` H8).
+Apply Rinv_neq_R0; DiscrR.
+Split.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Rewrite Rabsolu_right.
+Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite double; Pattern 1 (pos delta); Rewrite <- Rplus_Or.
+Apply Rlt_compatibility; Apply (cond_pos delta).
+DiscrR.
+Apply Rle_sym1; Unfold Rdiv; Left; Apply Rmult_lt_pos.
+Apply (cond_pos delta).
+Apply Rlt_Rinv; Sup0.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply H4 | Apply Rlt_Rinv; Sup0].
+Qed.
+
+(**********)
+Lemma increasing_decreasing_opp : (f:R->R) (increasing f) -> (decreasing (opp_fct f)).
+Unfold increasing decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rge_Ropp; Apply Rle_sym1; Assumption.
+Qed.
+
+(**********)
+Lemma nonpos_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<=0``) -> (decreasing f).
+Intros.
+Cut (h:R)``-(-(f h))==(f h)``.
+Intro.
+Generalize (increasing_decreasing_opp (opp_fct f)).
+Unfold decreasing.
+Unfold opp_fct.
+Intros.
+Rewrite <- (H0 x); Rewrite <- (H0 y).
+Apply H1.
+Cut (x:R)``0<=(derive_pt (opp_fct f) x ((derivable_opp f pr) x))``.
+Intros.
+Replace [x:R]``-(f x)`` with (opp_fct f); [Idtac | Reflexivity].
+Apply (nonneg_derivative_1 (opp_fct f) (derivable_opp f pr) H3).
+Intro.
+Assert H3 := (derive_pt_opp f x0 (pr x0)).
+Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
+Intro.
+Rewrite <- H4.
+Rewrite H3.
+Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Apply (H x0).
+Apply pr_nu.
+Assumption.
+Intro; Ring.
+Qed.
+ 
+(**********)
+Lemma positive_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``0<(derive_pt f x (pr x))``)->(strict_increasing f).
+Intros.
+Unfold strict_increasing.
+Intros.
+Apply Rlt_anti_compatibility with ``-(f x)``.
+Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
+Assert H1 := (MVT_cor1 f ? ? pr H0).
+Elim H1; Intros.
+Elim H2; Intros.
+Unfold Rminus in H3.
+Rewrite H3.
+Apply Rmult_lt_pos.
+Apply H.
+Apply Rlt_anti_compatibility with x.
+Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
+Qed.
+
+(**********)
+Lemma strictincreasing_strictdecreasing_opp : (f:R->R) (strict_increasing f) ->
+(strict_decreasing (opp_fct f)).
+Unfold strict_increasing strict_decreasing opp_fct; Intros; Generalize (H x y H0); Intro; Apply Rlt_Ropp; Assumption.
+Qed.
+ 
+(**********)
+Lemma negative_derivative : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))<0``)->(strict_decreasing f).
+Intros.
+Cut (h:R)``- (-(f h))==(f h)``.
+Intros.
+Generalize (strictincreasing_strictdecreasing_opp (opp_fct f)).
+Unfold strict_decreasing opp_fct.
+Intros.
+Rewrite <- (H0 x).
+Rewrite <- (H0 y).
+Apply H1; [Idtac | Assumption].
+Cut (x:R)``0<(derive_pt (opp_fct f) x (derivable_opp f pr x))``.
+Intros; EApply positive_derivative; Apply H3.
+Intro.
+Assert H3 := (derive_pt_opp f x0 (pr x0)).
+Cut ``(derive_pt (opp_fct f) x0 (derivable_pt_opp f x0 (pr x0)))==(derive_pt (opp_fct f) x0 (derivable_opp f pr x0))``.
+Intro.
+Rewrite <- H4; Rewrite H3.
+Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply (H x0).
+Apply pr_nu.
+Intro; Ring.
+Qed.
+ 
+(**********)
+Lemma null_derivative_0 : (f:R->R;pr:(derivable f)) (constant f)->((x:R) ``(derive_pt f x (pr x))==0``). 
+Intros.
+Unfold constant in H.
+Apply derive_pt_eq_0.
+Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Simpl; Intros.
+Rewrite (H x ``x+h``); Unfold Rminus; Unfold Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Qed.
+
+(**********)
+Lemma increasing_decreasing : (f:R->R) (increasing f) -> (decreasing f) -> (constant f).
+Unfold increasing decreasing constant; Intros; Case (total_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; Apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
+Qed.
+
+(**********)
+Lemma null_derivative_1 : (f:R->R;pr:(derivable f)) ((x:R) ``(derive_pt f x (pr x))==0``)->(constant f).
+Intros.
+Cut (x:R)``(derive_pt f x (pr x)) <= 0``.
+Cut (x:R)``0 <= (derive_pt f x (pr x))``.
+Intros.
+Assert H2 := (nonneg_derivative_1 f pr H0).
+Assert H3 := (nonpos_derivative_1 f  pr H1).
+Apply increasing_decreasing; Assumption.
+Intro; Right; Symmetry; Apply (H x).
+Intro; Right; Apply (H x).
+Qed.
+
+(**********)
+Lemma derive_increasing_interv_ax : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> (((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``)) /\ (((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``)).
+Intros.
+Split; Intros.
+Apply Rlt_anti_compatibility with ``-(f x)``.
+Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
+Assert H4 := (MVT_cor1 f ? ? pr H3).
+Elim H4; Intros.
+Elim H5; Intros.
+Unfold Rminus in H6.
+Rewrite H6.
+Apply Rmult_lt_pos.
+Apply H0.
+Elim H7; Intros.
+Split.
+Elim H1; Intros.
+Apply Rle_lt_trans with x; Assumption.
+Elim H2; Intros.
+Apply Rlt_le_trans with y; Assumption.
+Apply Rlt_anti_compatibility with x.
+Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Assumption | Ring].
+Apply Rle_anti_compatibility with ``-(f x)``.
+Rewrite Rplus_Ropp_l; Rewrite Rplus_sym.
+Assert H4 := (MVT_cor1 f ? ? pr H3).
+Elim H4; Intros.
+Elim H5; Intros.
+Unfold Rminus in H6.
+Rewrite H6.
+Apply Rmult_le_pos.
+Apply H0.
+Elim H7; Intros.
+Split.
+Elim H1; Intros.
+Apply Rle_lt_trans with x; Assumption.
+Elim H2; Intros.
+Apply Rlt_le_trans with y; Assumption.
+Apply Rle_anti_compatibility with x.
+Rewrite Rplus_Or; Replace ``x+(y+ -x)`` with y; [Left; Assumption | Ring].
+Qed.
+
+(**********)
+Lemma derive_increasing_interv : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<(f y)``).
+Intros.
+Generalize (derive_increasing_interv_ax a b f pr H); Intro.
+Elim H4; Intros H5 _; Apply (H5 H0 x y H1 H2 H3).
+Qed.
+
+(**********)
+Lemma derive_increasing_interv_var : (a,b:R;f:R->R;pr:(derivable f)) ``a<b``-> ((t:R) ``a<t<b`` -> ``0<=(derive_pt f t (pr t))``) -> ((x,y:R) ``a<=x<=b``->``a<=y<=b``->``x<y``->``(f x)<=(f y)``).
+Intros a b f pr H H0 x y H1 H2 H3; Generalize (derive_increasing_interv_ax a b f pr H); Intro; Elim H4; Intros _ H5; Apply (H5 H0 x y H1 H2 H3).
+Qed.
+
+(**********)
+(**********)
+Theorem IAF : (f:R->R;a,b,k:R;pr:(derivable f)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt f c (pr c))<=k``) -> ``(f b)-(f a)<=k*(b-a)``.
+Intros.
+Case (total_order_T a b); Intro.
+Elim s; Intro.
+Assert H1 := (MVT_cor1 f ? ? pr a0).
+Elim H1; Intros.
+Elim H2; Intros.
+Rewrite H3.
+Do 2 Rewrite <- (Rmult_sym ``(b-a)``).
+Apply Rle_monotony.
+Apply Rle_anti_compatibility with ``a``; Rewrite Rplus_Or.
+Replace ``a+(b-a)`` with b; [Assumption | Ring].
+Apply H0.
+Elim H4; Intros.
+Split; Left; Assumption.
+Rewrite b0.
+Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
+Rewrite Rmult_Or; Right; Reflexivity.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Qed.
+
+Lemma IAF_var : (f,g:R->R;a,b:R;pr1:(derivable f);pr2:(derivable g)) ``a<=b`` -> ((c:R) ``a<=c<=b`` -> ``(derive_pt g c (pr2 c))<=(derive_pt f c (pr1 c))``) -> ``(g b)-(g a)<=(f b)-(f a)``.
+Intros.
+Cut (derivable (minus_fct g f)).
+Intro.
+Cut (c:R)``a<=c<=b``->``(derive_pt (minus_fct g f) c (X c))<=0``.
+Intro. 
+Assert H2 := (IAF (minus_fct g f) a b R0 X H H1).
+Rewrite Rmult_Ol in H2; Unfold minus_fct in H2.
+Apply Rle_anti_compatibility with ``-(f b)+(f a)``.
+Replace ``-(f b)+(f a)+((f b)-(f a))`` with R0; [Idtac | Ring].
+Replace ``-(f b)+(f a)+((g b)-(g a))`` with ``(g b)-(f b)-((g a)-(f a))``; [Apply H2 | Ring].
+Intros.
+Cut (derive_pt (minus_fct g f) c (X c))==(derive_pt (minus_fct g f) c (derivable_pt_minus ? ? ? (pr2 c) (pr1 c))).
+Intro.
+Rewrite H2.
+Rewrite derive_pt_minus.
+Apply Rle_anti_compatibility with (derive_pt f c (pr1 c)).
+Rewrite Rplus_Or.
+Replace ``(derive_pt f c (pr1 c))+((derive_pt g c (pr2 c))-(derive_pt f c (pr1 c)))`` with ``(derive_pt g c (pr2 c))``; [Idtac | Ring].
+Apply H0; Assumption.
+Apply pr_nu.
+Apply derivable_minus; Assumption.
+Qed.
+
+(* If f has a null derivative in ]a,b[ and is continue in [a,b], *)
+(* then f is constant on [a,b] *)
+Lemma null_derivative_loc : (f:R->R;a,b:R;pr:(x:R)``a<x<b``->(derivable_pt f x)) ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R;P:``a<x<b``)(derive_pt f x (pr x P))==R0) -> (constant_D_eq f [x:R]``a<=x<=b`` (f a)).
+Intros; Unfold constant_D_eq; Intros; Case (total_order_T a b); Intro.
+Elim s; Intro.
+Assert H2 : (y:R)``a<y<x``->(derivable_pt id y).
+Intros; Apply derivable_pt_id.
+Assert H3 : (y:R)``a<=y<=x``->(continuity_pt id y).
+Intros; Apply derivable_continuous; Apply derivable_id.
+Assert H4 : (y:R)``a<y<x``->(derivable_pt f y).
+Intros; Apply pr; Elim H4; Intros; Split.
+Assumption.
+Elim H1; Intros; Apply Rlt_le_trans with x; Assumption.
+Assert H5 : (y:R)``a<=y<=x``->(continuity_pt f y).
+Intros; Apply H; Elim H5; Intros; Split.
+Assumption.
+Elim H1; Intros; Apply Rle_trans with x; Assumption.
+Elim H1; Clear H1; Intros; Elim H1; Clear H1; Intro.
+Assert H7 := (MVT f id a x H4 H2 H1 H5 H3).
+Elim H7; Intros; Elim H8; Intros; Assert H10 : ``a<x0<b``.
+Elim x1; Intros; Split.
+Assumption.
+Apply Rlt_le_trans with x; Assumption.
+Assert H11 : ``(derive_pt f x0 (H4 x0 x1))==0``.
+Replace (derive_pt f x0 (H4 x0 x1)) with (derive_pt f x0 (pr x0 H10)); [Apply H0 | Apply pr_nu].
+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_Or in H9; Rewrite Rmult_1r in H9; Apply Rminus_eq; Symmetry; Assumption.
+Rewrite H1; Reflexivity.
+Assert H2 : x==a.
+Rewrite <- b0 in H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
+Rewrite H2; Reflexivity.
+Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H2 H3) r)).
+Qed.
+
+(* Unicity of the antiderivative *)
+Lemma antiderivative_Ucte : (f,g1,g2:R->R;a,b:R) (antiderivative f g1 a b) -> (antiderivative f g2 a b) -> (EXT c:R | (x:R)``a<=x<=b``->``(g1 x)==(g2 x)+c``).
+Unfold antiderivative; Intros; Elim H; Clear H; Intros; Elim H0; Clear H0; Intros H0 _; Exists ``(g1 a)-(g2 a)``; Intros; Assert H3 : (x:R)``a<=x<=b``->(derivable_pt g1 x).
+Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H x0 H3); Intros; EApply derive_pt_eq_1; Symmetry; Apply H4.
+Assert H4 : (x:R)``a<=x<=b``->(derivable_pt g2 x).
+Intros; Unfold derivable_pt; Apply Specif.existT with (f x0); Elim (H0 x0 H4); Intros; EApply derive_pt_eq_1; Symmetry; Apply H5.
+Assert H5 : (x:R)``a<x<b``->(derivable_pt (minus_fct g1 g2) x).
+Intros; Elim H5; Intros; Apply derivable_pt_minus; [Apply H3; Split; Left; Assumption | Apply H4; Split; Left; Assumption].
+Assert H6 : (x:R)``a<=x<=b``->(continuity_pt (minus_fct g1 g2) x).
+Intros; Apply derivable_continuous_pt; Apply derivable_pt_minus; [Apply H3 | Apply H4]; Assumption.
+Assert H7 : (x:R;P:``a<x<b``)(derive_pt (minus_fct g1 g2) x (H5 x P))==``0``.
+Intros; Elim P; Intros; Apply derive_pt_eq_0; Replace R0 with ``(f x0)-(f x0)``; [Idtac | Ring].
+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; Apply H10.
+Assert H8 := (null_derivative_loc (minus_fct g1 g2) a b H5 H6 H7); Unfold constant_D_eq in H8; Assert H9 := (H8 ? H2); Unfold minus_fct in H9; Rewrite <- H9; Ring.
+Qed.
diff --git a/theories7/Reals/NewtonInt.v b/theories7/Reals/NewtonInt.v
new file mode 100644
index 00000000..56e5f15e
--- /dev/null
+++ b/theories7/Reals/NewtonInt.v
@@ -0,0 +1,600 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: NewtonInt.v,v 1.1.2.1 2004/07/16 19:31:32 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require Ranalysis.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(*******************************************)
+(*            Newton's Integral            *)
+(*******************************************)
+
+Definition Newton_integrable [f:R->R;a,b:R] : Type := (sigTT ? [g:R->R](antiderivative f g a b)\/(antiderivative f g b a)).
+
+Definition NewtonInt [f:R->R;a,b:R;pr:(Newton_integrable f a b)] : R := let g = Cases pr of (existTT a b) => a end in ``(g b)-(g a)``.
+
+(* If f is differentiable, then f' is Newton integrable (Tautology ?) *)
+Lemma FTCN_step1 : (f:Differential;a,b:R) (Newton_integrable [x:R](derive_pt f x (cond_diff f x)) a b).
+Intros f a b; Unfold Newton_integrable; Apply existTT with (d1 f); Unfold antiderivative; Intros; Case (total_order_Rle a b); Intro; [Left; Split; [Intros; Exists (cond_diff f x); Reflexivity | Assumption] | Right; Split; [Intros; Exists (cond_diff f x); Reflexivity | Auto with real]].
+Defined.
+
+(* By definition, we have the Fondamental Theorem of Calculus *)
+Lemma FTC_Newton : (f:Differential;a,b:R) (NewtonInt [x:R](derive_pt f x (cond_diff f x)) a b (FTCN_step1 f a b))==``(f b)-(f a)``.
+Intros; Unfold NewtonInt; Reflexivity.
+Qed.
+
+(* $\int_a^a f$ exists forall a:R and f:R->R *)
+Lemma NewtonInt_P1 : (f:R->R;a:R) (Newton_integrable f a a).
+Intros f a; Unfold Newton_integrable; Apply existTT with (mult_fct (fct_cte (f a)) id); Left; Unfold antiderivative; Split.
+Intros; Assert H1 : (derivable_pt (mult_fct (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; 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; Rewrite H2; Ring].
+Right; Reflexivity.
+Defined.
+
+(* $\int_a^a f = 0$ *)
+Lemma NewtonInt_P2 : (f:R->R;a:R) ``(NewtonInt f a a (NewtonInt_P1 f a))==0``.
+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 *)
+Lemma NewtonInt_P3 : (f:R->R;a,b:R;X:(Newton_integrable f a b)) (Newton_integrable f b a).
+Unfold Newton_integrable; Intros; Elim X; Intros g H; Apply existTT with g; Tauto.
+Defined.
+
+(* $\int_a^b f = -\int_b^a f$ *)
+Lemma NewtonInt_P4 : (f:R->R;a,b:R;pr:(Newton_integrable f a b)) ``(NewtonInt f a b pr)==-(NewtonInt f b a (NewtonInt_P3 f a b pr))``.
+Intros; Unfold Newton_integrable in pr; Elim pr; Intros; Elim p; Intro.
+Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)).
+Intros; Elim o; Intro.
+Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
+Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
+Rewrite H3; Ring.
+Assert H1 := (antiderivative_Ucte f x x0 a b H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Assert H3 : ``a<=a<=b``.
+Split; [Right; Reflexivity | Assumption].
+Assert H4 : ``a<=b<=b``.
+Split; [Assumption | Right; Reflexivity].
+Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
+Unfold NewtonInt; Case (NewtonInt_P3 f a b (existTT R->R [g:(R->R)](antiderivative f g a b)\/(antiderivative f g b a) x p)); Intros; Elim o; Intro.
+Assert H1 := (antiderivative_Ucte f x x0 b a H H0); Elim H1; Intros; Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Assert H3 : ``b<=a<=a``.
+Split; [Assumption | Right; Reflexivity].
+Assert H4 : ``b<=b<=a``.
+Split; [Right; Reflexivity | Assumption].
+Assert H5 := (H2 ? H3); Assert H6 := (H2 ? H4); Rewrite H5; Rewrite H6; Ring.
+Unfold antiderivative in H0; Elim H0; Intros; Elim H2; Intro.
+Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)).
+Rewrite H3; Ring.
+Qed.
+
+(* The set of Newton integrable functions is a vectorial space *)
+Lemma NewtonInt_P5 : (f,g:R->R;l,a,b:R) (Newton_integrable f a b) -> (Newton_integrable g a b) -> (Newton_integrable [x:R]``l*(f x)+(g x)`` a b).
+Unfold Newton_integrable; Intros; Elim X; Intros; Elim X0; Intros; Exists [y:R]``l*(x y)+(x0 y)``.
+Elim p; Intro.
+Elim p0; Intro.
+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 [y:R]``l*(x y)+(x0 y)`` x1).
+Reg.
+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_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
+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; Assumption | Rewrite <- H5; Assumption].
+Assert H11 : ``b<=x1<=a``.
+Split; Right; [Rewrite <- H5; Symmetry; Assumption | Assumption].
+Assert H12 : (derivable_pt x x1).
+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; Exists (g x1); Elim (H1 ? H11); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
+Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
+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)``.
+Elim (H3 ? H10); Intros; Rewrite H16; Apply pr_nu.
+Rewrite H15; Rewrite H16; Ring.
+Right; Reflexivity.
+Elim p0; Intro.
+Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Elim H4; Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H5 H2)).
+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; Assumption | Rewrite H5; Assumption].
+Assert H11 : ``b<=x1<=a``.
+Split; Right; [Rewrite H5; Symmetry; Assumption | Assumption].
+Assert H12 : (derivable_pt x x1).
+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; Exists (g x1); Elim (H1 ? H10); Intros; EApply derive_pt_eq_1; Symmetry; Apply H13.
+Assert H14 : (derivable_pt [y:R]``l*(x y)+(x0 y)`` x1).
+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; 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 [y:R]``l*(x y)+(x0 y)`` x1).
+Reg.
+Exists H5; Symmetry; Reg; Rewrite <- H3; Rewrite <- H4; Reflexivity.
+Assumption.
+Defined.
+
+(**********)
+Lemma antiderivative_P1 : (f,g,F,G:R->R;l,a,b:R) (antiderivative f F a b) -> (antiderivative g G a b) -> (antiderivative [x:R]``l*(f x)+(g x)`` [x:R]``l*(F x)+(G x)`` a b).
+Unfold antiderivative; Intros; Elim H; Elim H0; Clear H H0; Intros; Split.
+Intros; Elim (H ? H3); Elim (H1 ? H3); Intros.
+Assert H6 : (derivable_pt [x:R]``l*(F x)+(G x)`` x).
+Reg.
+Exists H6; Symmetry; Reg; Rewrite <- H4; Rewrite <- H5; Ring.
+Assumption.
+Qed.
+
+(* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *)
+Lemma NewtonInt_P6 : (f,g:R->R;l,a,b:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable g a b)) (NewtonInt [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)``.
+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.
+Elim s; Intro.
+Elim o; Intro.
+Elim o0; Intro.
+Elim o1; Intro.
+Assert H2 := (antiderivative_P1 f g x0 x1 l a b H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``a<=a<=b``.
+Split; [Right; Reflexivity | Left; Assumption].
+Assert H6 : ``a<=b<=b``.
+Split; [Left; Assumption | Right; Reflexivity].
+Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
+Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 a0)).
+Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 a0)).
+Rewrite b0; Ring.
+Elim o; Intro.
+Unfold antiderivative in H; Elim H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 r)).
+Elim o0; Intro.
+Unfold antiderivative in H0; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
+Elim o1; Intro.
+Unfold antiderivative in H1; Elim H1; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 r)).
+Assert H2 := (antiderivative_P1 f g x0 x1 l b a H0 H1); Assert H3 := (antiderivative_Ucte ? ? ? ? ? H H2); Elim H3; Intros; Assert H5 : ``b<=a<=a``.
+Split; [Left; Assumption | Right; Reflexivity].
+Assert H6 : ``b<=b<=a``.
+Split; [Right; Reflexivity | Left; Assumption].
+Assert H7 := (H4 ? H5); Assert H8 := (H4 ? H6); Rewrite H7; Rewrite H8; Ring.
+Qed.
+
+Lemma antiderivative_P2 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 b c) -> (antiderivative f [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))``  end) a c).
+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.
+Elim s; Intro.
+Assert H5 : ``a<=x<=b``.
+Split; [Assumption | Left; Assumption].
+Assert H6 := (H ? H5); Elim H6; Clear H6; Intros; Assert H7 : (derivable_pt_lim [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x (f x)).
+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; Pose D := (Rmin x1 ``b-x``).
+Assert H11 : ``0<D``.
+Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``b-x``); Intro.
+Apply (cond_pos x1).
+Apply Rlt_Rminus; Assumption.
+Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
+Case (total_order_Rle ``x+h`` b); Intro.
+Apply H10.
+Assumption.
+Apply Rlt_le_trans with D; [Assumption | Unfold D; Apply Rmin_l].
+Elim n; Left; Apply Rlt_le_trans with ``x+D``.
+Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h).
+Apply Rle_Rabsolu.
+Apply H13.
+Apply Rle_anti_compatibility with ``-x``; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite Rplus_sym; Unfold D; Apply Rmin_r.
+Elim n; Left; Assumption.
+Assert H8 : (derivable_pt  [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
+Unfold derivable_pt; Apply Specif.existT with (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; Assumption | Assumption].
+Elim (H ? H5); Elim (H0 ? H6); Intros; Assert H9 : (derive_pt F0 x x1)==(f x).
+Symmetry; Assumption.
+Assert H10 : (derive_pt F1 x x0)==(f x).
+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 H13 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
+Unfold derivable_pt_lim; Unfold derivable_pt_lim in H11 H12; Intros; Elim (H11 ? H13); Elim (H12 ? H13); Intros; Pose D := (Rmin x2 x3); Assert H16 : ``0<D``.
+Unfold D; Unfold Rmin; Case (total_order_Rle x2 x3); Intro.
+Apply (cond_pos x2).
+Apply (cond_pos x3).
+Exists (mkposreal ? H16); Intros; Case (total_order_Rle x b); Intro.
+Case (total_order_Rle ``x+h`` b); Intro.
+Apply H15.
+Assumption.
+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; Apply Rmin_l].
+Rewrite b0; Ring.
+Elim n; Right; Assumption.
+Assert H14 : (derivable_pt [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end) x).
+Unfold derivable_pt; Apply Specif.existT with (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; Assert H7 : (derivable_pt_lim [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x (f x)).
+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; Pose D := (Rmin x1 ``x-b``); Assert H11 : ``0<D``.
+Unfold D; Unfold Rmin; Case (total_order_Rle x1 ``x-b``); Intro.
+Apply (cond_pos x1).
+Apply Rlt_Rminus; Assumption.
+Exists (mkposreal ? H11); Intros; Case (total_order_Rle x b); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
+Case (total_order_Rle ``x+h`` b); Intro.
+Cut ``b<x+h``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)).
+Apply Rlt_anti_compatibility with ``-h-b``; Replace ``-h-b+b`` with ``-h``; [Idtac | Ring]; Replace ``-h-b+(x+h)`` with ``x-b``; [Idtac | Ring]; Apply Rle_lt_trans with (Rabsolu h).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Apply Rlt_le_trans with D.
+Apply H13.
+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; Apply Rmin_l.
+Assert H8 : (derivable_pt  [x:R]Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end x).
+Unfold derivable_pt; Apply Specif.existT with (f x); Apply H7.
+Exists H8; Symmetry; Apply derive_pt_eq_0; Apply H7.
+Qed.
+
+Lemma antiderivative_P3 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 c b) -> (antiderivative f F1 c a)\/(antiderivative f F0 a c).
+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; Split.
+Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
+Left; Assumption.
+Right; Unfold antiderivative; Split.
+Intros; Apply H1; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with c; Assumption].
+Right; Assumption.
+Left; Unfold antiderivative; Split.
+Intros; Apply H; Elim H3; Intros; Split; [Assumption | Apply Rle_trans with a; Assumption].
+Left; Assumption.
+Qed.
+
+Lemma antiderivative_P4 : (f,F0,F1:R->R;a,b,c:R) (antiderivative f F0 a b) -> (antiderivative f F1 a c) -> (antiderivative f F1 b c)\/(antiderivative f F0 c b).
+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; Split.
+Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
+Left; Assumption.
+Right; Unfold antiderivative; Split.
+Intros; Apply H1; Elim H3; Intros; Split; [Apply Rle_trans with c; Assumption | Assumption].
+Right; Assumption.
+Left; Unfold antiderivative; Split.
+Intros; Apply H; Elim H3; Intros; Split; [Apply Rle_trans with b; Assumption | Assumption].
+Left; Assumption.
+Qed.
+
+Lemma NewtonInt_P7 : (f:R->R;a,b,c:R) ``a<b`` -> ``b<c`` -> (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
+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; Pose g := [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))``  end); Apply existTT with g; Left; Unfold g; Apply antiderivative_P2.
+Elim H0; Intro.
+Assumption.
+Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hab)).
+Elim H1; Intro.
+Assumption.
+Unfold antiderivative in H; Elim H; Clear H; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 Hbc)).
+Qed.
+
+Lemma NewtonInt_P8 : (f:(R->R); a,b,c:R) (Newton_integrable f a b) -> (Newton_integrable f b c) -> (Newton_integrable f a c).
+Intros.
+Elim X; Intros F0 H0.
+Elim X0; Intros F1 H1.
+Case (total_order_T a b); Intro.
+Elim s; Intro.
+Case (total_order_T b c); Intro.
+Elim s0; Intro.
+(* a<b & b<c *)
+Unfold Newton_integrable; Apply existTT with [x:R](Cases (total_order_Rle x b) of (leftT _) => (F0 x) | (rightT _) => ``(F1 x)+((F0 b)-(F1 b))`` end).
+Elim H0; Intro.
+Elim H1; Intro.
+Left; Apply antiderivative_P2; Assumption.
+Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a1)).
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+(* a<b & b=c *)
+Rewrite b0 in X; Apply X.
+(* a<b & b>c *)
+Case (total_order_T a c); Intro.
+Elim s0; Intro.
+Unfold Newton_integrable; Apply existTT with F0.
+Left.
+Elim H1; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim H0; Intro.
+Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
+Elim H3; Intro.
+Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
+Assumption.
+Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+Rewrite b0; Apply NewtonInt_P1.
+Unfold Newton_integrable; Apply existTT with F1.
+Right.
+Elim H1; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim H0; Intro.
+Assert H3 := (antiderivative_P3 f F0 F1 a b c H2 H).
+Elim H3; Intro.
+Assumption.
+Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
+Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+(* a=b *)
+Rewrite b0; Apply X0.
+Case (total_order_T b c); Intro.
+Elim s; Intro.
+(* a>b & b<c *)
+Case (total_order_T a c); Intro.
+Elim s0; Intro.
+Unfold Newton_integrable; Apply existTT with F1.
+Left.
+Elim H1; Intro.
+(*****************)
+Elim H0; Intro.
+Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 r)).
+Assert H3 := (antiderivative_P4 f F0 F1 b a c H2 H).
+Elim H3; Intro.
+Assumption.
+Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 a1)).
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+Rewrite b0; Apply NewtonInt_P1.
+Unfold Newton_integrable; Apply existTT with F0.
+Right.
+Elim H0; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim H1; Intro.
+Assert H3 := (antiderivative_P4 f F0 F1 b a c H H2).
+Elim H3; Intro.
+Unfold antiderivative in H4; Elim H4; Clear H4; Intros _ H4.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 r0)).
+Assumption.
+Unfold antiderivative in H2; Elim H2; Clear H2; Intros _ H2.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H2 a0)).
+(* a>b & b=c *)
+Rewrite b0 in X; Apply X.
+(* a>b & b>c *)
+Assert X1 := (NewtonInt_P3 f a b X).
+Assert X2 := (NewtonInt_P3 f b c X0).
+Apply NewtonInt_P3.
+Apply NewtonInt_P7 with b; Assumption.
+Defined.
+
+(* Chasles' relation *)
+Lemma NewtonInt_P9 : (f:R->R;a,b,c:R;pr1:(Newton_integrable f a b);pr2:(Newton_integrable f b c)) ``(NewtonInt f a c (NewtonInt_P8 f a b c pr1 pr2))==(NewtonInt f a b pr1)+(NewtonInt f b c pr2)``.
+Intros; Unfold NewtonInt.
+Case (NewtonInt_P8 f a b c pr1 pr2); Intros.
+Case pr1; Intros.
+Case pr2; Intros.
+Case (total_order_T a b); Intro.
+Elim s; Intro.
+Case (total_order_T b c); Intro.
+Elim s0; Intro.
+(* a<b & b<c *)
+Elim o0; Intro.
+Elim o1; Intro.
+Elim o; Intro.
+Assert H2 := (antiderivative_P2 f x0 x1 a b c H H0).
+Assert H3 := (antiderivative_Ucte f x [x:R]
+          Cases (total_order_Rle x b) of
+            (leftT _) => (x0 x)
+          | (rightT _) => ``(x1 x)+((x0 b)-(x1 b))``
+          end a c H1 H2).
+Elim H3; Intros.
+Assert H5 : ``a<=a<=c``.
+Split; [Right; Reflexivity | Left; Apply Rlt_trans with b; Assumption].
+Assert H6 : ``a<=c<=c``.
+Split; [Left; Apply Rlt_trans with b; Assumption | Right; Reflexivity].
+Rewrite (H4 ? H5); Rewrite (H4 ? H6).
+Case (total_order_Rle a b); Intro.
+Case (total_order_Rle c b); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a1)).
+Ring.
+Elim n; Left; Assumption.
+Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? a0 a1))).
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a1)).
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+(* a<b & b=c *)
+Rewrite <- b0.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
+Rewrite <- b0 in o.
+Elim o0; Intro.
+Elim o; Intro.
+Assert H1 := (antiderivative_Ucte f x x0 a b H0 H).
+Elim H1; Intros.
+Rewrite (H2 b).
+Rewrite (H2 a).
+Ring.
+Split; [Right; Reflexivity | Left; Assumption].
+Split; [Left; Assumption | Right; Reflexivity].
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H a0)).
+(* a<b & b>c *)
+Elim o1; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim o0; Intro.
+Elim o; Intro.
+Assert H2 := (antiderivative_P2 f x x1 a c b H1 H).
+Assert H3 := (antiderivative_Ucte ? ? ? a b H0 H2).
+Elim H3; Intros.
+Rewrite (H4 a).
+Rewrite (H4 b).
+Case (total_order_Rle b c); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 r)).
+Case (total_order_Rle a c); Intro.
+Ring.
+Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
+Split; [Left; Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Left; Assumption].
+Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H1 H0).
+Assert H3 := (antiderivative_Ucte ? ? ? c b H H2).
+Elim H3; Intros.
+Rewrite (H4 c).
+Rewrite (H4 b).
+Case (total_order_Rle b a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 a0)).
+Case (total_order_Rle c a); Intro.
+Ring.
+Elim n0; Unfold antiderivative in H1; Elim H1; Intros; Assumption.
+Split; [Left; Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Left; Assumption].
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
+(* a=b *)
+Rewrite b0 in o; Rewrite b0.
+Elim o; Intro.
+Elim o1; Intro.
+Assert H1 := (antiderivative_Ucte ? ? ? b c H H0).
+Elim H1; Intros.
+Assert H3 : ``b<=c``.
+Unfold antiderivative in H; Elim H; Intros; Assumption.
+Rewrite (H2 b).
+Rewrite (H2 c).
+Ring.
+Split; [Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Assumption].
+Assert H1 : ``b==c``.
+Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
+Rewrite H1; Ring.
+Elim o1; Intro.
+Assert H1 : ``b==c``.
+Unfold antiderivative in H H0; Elim H; Elim H0; Intros; Apply Rle_antisym; Assumption.
+Rewrite H1; Ring.
+Assert H1 := (antiderivative_Ucte ? ? ? c b H H0).
+Elim H1; Intros.
+Assert H3 : ``c<=b``.
+Unfold antiderivative in H; Elim H; Intros; Assumption.
+Rewrite (H2 c).
+Rewrite (H2 b).
+Ring.
+Split; [Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Assumption].
+(* a>b & b<c *)
+Case (total_order_T b c); Intro.
+Elim s; Intro.
+Elim o0; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim o1; Intro.
+Elim o; Intro.
+Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H H1).
+Assert H3 := (antiderivative_Ucte ? ? ? b c H0 H2).
+Elim H3; Intros.
+Rewrite (H4 b).
+Rewrite (H4 c).
+Case (total_order_Rle b a); Intro.
+Case (total_order_Rle c a); Intro.
+Assert H5 : ``a==c``.
+Unfold antiderivative in  H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
+Rewrite H5; Ring.
+Ring.
+Elim n; Left; Assumption.
+Split; [Left; Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Left; Assumption].
+Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H1).
+Assert H3 := (antiderivative_Ucte ? ? ? b a H H2).
+Elim H3; Intros.
+Rewrite (H4 a).
+Rewrite (H4 b).
+Case (total_order_Rle b c); Intro.
+Case (total_order_Rle a c); Intro.
+Assert H5 : ``a==c``.
+Unfold antiderivative in  H1; Elim H1; Intros; Apply Rle_antisym; Assumption.
+Rewrite H5; Ring.
+Ring.
+Elim n; Left; Assumption.
+Split; [Right; Reflexivity | Left; Assumption].
+Split; [Left; Assumption | Right; Reflexivity].
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 a0)).
+(* a>b & b=c *)
+Rewrite <- b0.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or.
+Rewrite <- b0 in o.
+Elim o0; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim o; Intro.
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
+Assert H1 := (antiderivative_Ucte f x x0 b a H0 H).
+Elim H1; Intros.
+Rewrite (H2 b).
+Rewrite (H2 a).
+Ring.
+Split; [Left; Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Left; Assumption].
+(* a>b & b>c *)
+Elim o0; Intro.
+Unfold antiderivative in H; Elim H; Clear H; Intros _ H.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Elim o1; Intro.
+Unfold antiderivative in H0; Elim H0; Clear H0; Intros _ H0.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r0)).
+Elim o; Intro.
+Unfold antiderivative in H1; Elim H1; Clear H1; Intros _ H1.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 (Rlt_trans ? ? ? r0 r))).
+Assert H2 := (antiderivative_P2 ? ? ? ? ? ? H0 H).
+Assert H3 := (antiderivative_Ucte ? ? ? c a H1 H2).
+Elim H3; Intros.
+Assert H5 : ``c<=a``.
+Unfold antiderivative in H1; Elim H1; Intros; Assumption.
+Rewrite (H4 c).
+Rewrite (H4 a).
+Case (total_order_Rle a b); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r1 r)).
+Case (total_order_Rle c b); Intro.
+Ring.
+Elim n0; Left; Assumption.
+Split; [Assumption | Right; Reflexivity].
+Split; [Right; Reflexivity | Assumption].
+Qed.
+
diff --git a/theories7/Reals/PSeries_reg.v b/theories7/Reals/PSeries_reg.v
new file mode 100644
index 00000000..68645379
--- /dev/null
+++ b/theories7/Reals/PSeries_reg.v
@@ -0,0 +1,194 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: PSeries_reg.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Ranalysis1.
+Require Max.
+Require Even.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Definition Boule [x:R;r:posreal] : R -> Prop := [y:R]``(Rabsolu (y-x))<r``.
+
+(* Uniform convergence *)
+Definition CVU [fn:nat->R->R;f:R->R;x:R;r:posreal] : Prop := (eps:R)``0<eps``->(EX N:nat | (n:nat;y:R) (le N n)->(Boule x r y)->``(Rabsolu ((f y)-(fn n y)))<eps``). 
+
+(* Normal convergence *)
+Definition CVN_r [fn:nat->R->R;r:posreal] : Type := (SigT ? [An:nat->R](sigTT R [l:R]((Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu (An k)) n) l)/\((n:nat)(y:R)(Boule R0 r y)->(Rle (Rabsolu (fn n y)) (An n)))))).
+
+Definition CVN_R [fn:nat->R->R] : Type := (r:posreal) (CVN_r fn r).
+
+Definition SFL [fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))] : R-> R := [y:R](Cases (cv y) of (existTT a b) => a end).
+
+(* In a complete space, normal convergence implies uniform convergence *)
+Lemma CVN_CVU : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> (CVU [n:nat](SP fn n) (SFL fn cv) ``0`` r).
+Intros; Unfold CVU; Intros.
+Unfold CVN_r in X.
+Elim X; Intros An X0.
+Elim X0; Intros s H0.
+Elim H0; Intros.
+Cut (Un_cv [n:nat](Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s) R0).
+Intro; Unfold Un_cv in H3.
+Elim (H3 eps H); Intros N0 H4.
+Exists N0; Intros.
+Apply Rle_lt_trans with (Rabsolu (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)).
+Rewrite <- (Rabsolu_Ropp (Rminus (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n) s)); Rewrite Ropp_distr3; Rewrite (Rabsolu_right (Rminus s (sum_f_R0 [k:nat]``(Rabsolu (An k))`` n))).
+EApply sum_maj1.
+Unfold SFL; Case (cv y); Intro.
+Trivial.
+Apply H1.
+Intro; Elim H0; Intros.
+Rewrite (Rabsolu_right (An n0)).
+Apply H8; Apply H6.
+Apply Rle_sym1; Apply Rle_trans with (Rabsolu (fn n0 y)).
+Apply Rabsolu_pos.
+Apply H8; Apply H6.
+Apply Rle_sym1; Apply Rle_anti_compatibility with (sum_f_R0 [k:nat](Rabsolu (An k)) n).
+Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym s); Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Apply sum_incr.
+Apply H1.
+Intro; Apply Rabsolu_pos.
+Unfold R_dist in H4; Unfold Rminus in H4; Rewrite Ropp_O in H4.
+Assert H7 := (H4 n H5).
+Rewrite Rplus_Or in H7; Apply H7.
+Unfold Un_cv in H1; Unfold Un_cv; Intros.
+Elim (H1? H3); Intros.
+Exists x; Intros.
+Unfold R_dist; Unfold R_dist in H4.
+Rewrite minus_R0; Apply H4; Assumption.
+Qed.
+
+(* Each limit of a sequence of functions which converges uniformly is continue *)
+Lemma CVU_continuity : (fn:nat->R->R;f:R->R;x:R;r:posreal) (CVU fn f x r) -> ((n:nat)(y:R) (Boule x r y)->(continuity_pt (fn n) y)) -> ((y:R) (Boule x r y) -> (continuity_pt f y)).
+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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
+Elim (H ? H3); Intros N0 H4.
+Assert H5 := (H0 N0 y H1).
+Cut (EXT del : posreal | (h:R) ``(Rabsolu h)<del`` -> (Boule x r ``y+h``) ).
+Intro.
+Elim H6; Intros del1 H7.
+Unfold continuity_pt in H5; Unfold continue_in in H5; Unfold limit1_in in H5; Unfold limit_in in H5; Simpl in H5; Unfold R_dist in H5.
+Elim (H5 ? H3); Intros del2 H8.
+Pose del := (Rmin del1 del2).
+Exists del; Intros.
+Split.
+Unfold del; Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
+Apply (cond_pos del1).
+Elim H8; Intros; Assumption.
+Intros; Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(f y)))``.
+Replace ``(f x0)-(f y)`` with ``((f x0)-(fn N0 x0))+((fn N0 x0)-(f y))``; [Apply Rabsolu_triang | Ring].
+Apply Rle_lt_trans with ``(Rabsolu ((f x0)-(fn N0 x0)))+(Rabsolu ((fn N0 x0)-(fn N0 y)))+(Rabsolu ((fn N0 y)-(f y)))``.
+Rewrite Rplus_assoc; Apply Rle_compatibility.
+Replace ``(fn N0 x0)-(f y)`` with ``((fn N0 x0)-(fn N0 y))+((fn N0 y)-(f y))``; [Apply Rabsolu_triang | Ring].
+Replace ``eps`` with ``eps/3+eps/3+eps/3``.
+Repeat Apply Rplus_lt.
+Apply H4.
+Apply le_n.
+Replace x0 with ``y+(x0-y)``; [Idtac | Ring]; Apply H7.
+Elim H9; Intros.
+Apply Rlt_le_trans with del.
+Assumption.
+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; Apply Rmin_r.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H4.
+Apply le_n.
+Assumption.
+Apply r_Rmult_mult with ``3``.
+Do 2 Rewrite Rmult_Rplus_distr; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
+Ring.
+DiscrR.
+DiscrR.
+Cut ``0<r-(Rabsolu (x-y))``.
+Intro; Exists (mkposreal ? H6).
+Simpl; Intros.
+Unfold Boule; Replace ``y+h-x`` with ``h+(y-x)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu h)+(Rabsolu (y-x))``.
+Apply Rabsolu_triang.
+Apply Rlt_anti_compatibility with ``-(Rabsolu (x-y))``.
+Rewrite <- (Rabsolu_Ropp ``y-x``); Rewrite Ropp_distr3.
+Replace ``-(Rabsolu (x-y))+r`` with ``r-(Rabsolu (x-y))``.
+Replace ``-(Rabsolu (x-y))+((Rabsolu h)+(Rabsolu (x-y)))`` with (Rabsolu h).
+Apply H7.
+Ring.
+Ring.
+Unfold Boule in H1; Rewrite <- (Rabsolu_Ropp ``x-y``); Rewrite Ropp_distr3; Apply Rlt_anti_compatibility with ``(Rabsolu (y-x))``.
+Rewrite Rplus_Or; Replace ``(Rabsolu (y-x))+(r-(Rabsolu (y-x)))`` with ``(pos r)``; [Apply H1 | Ring].
+Qed.
+
+(**********)
+Lemma continuity_pt_finite_SF : (fn:nat->R->R;N:nat;x:R) ((n:nat)(le n N)->(continuity_pt (fn n) x)) -> (continuity_pt [y:R](sum_f_R0 [k:nat]``(fn k y)`` N) x).
+Intros; Induction N.
+Simpl; Apply (H O); Apply le_n.
+Simpl; Replace [y:R](Rplus (sum_f_R0 [k:nat](fn k y) N) (fn (S N) y)) with (plus_fct [y:R](sum_f_R0 [k:nat](fn k y) N) [y:R](fn (S N) y)); [Idtac | Reflexivity].
+Apply continuity_pt_plus.
+Apply HrecN.
+Intros; Apply H.
+Apply le_trans with N; [Assumption | Apply le_n_Sn].
+Apply (H (S N)); Apply le_n.
+Qed.
+
+(* Continuity and normal convergence *)
+Lemma SFL_continuity_pt : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l));r:posreal) (CVN_r fn r) -> ((n:nat)(y:R) (Boule ``0`` r y) -> (continuity_pt (fn n) y)) -> ((y:R) (Boule ``0`` r y) -> (continuity_pt (SFL fn cv) y)).
+Intros; EApply CVU_continuity.
+Apply CVN_CVU.
+Apply X.
+Intros; Unfold SP; Apply continuity_pt_finite_SF.
+Intros; Apply H.
+Apply H1.
+Apply H0.
+Qed.
+
+Lemma SFL_continuity : (fn:nat->R->R;cv:(x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))) (CVN_R fn) -> ((n:nat)(continuity (fn n))) -> (continuity (SFL fn cv)).
+Intros; Unfold continuity; Intro.
+Cut ``0<(Rabsolu x)+1``; [Intro | Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1]].
+Cut (Boule ``0`` (mkposreal ? H0) x).
+Intro; EApply SFL_continuity_pt with (mkposreal ? H0).
+Apply X.
+Intros; Apply (H n y).
+Apply H1.
+Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Qed.
+
+(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) 
+Lemma CVN_R_CVS : (fn:nat->R->R) (CVN_R fn) -> ((x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l))).
+Intros; Apply R_complete.
+Unfold SP; Pose An := [N:nat](fn N x).
+Change (Cauchy_crit_series An).
+Apply cauchy_abs.
+Unfold Cauchy_crit_series; Apply CV_Cauchy.
+Unfold CVN_R in X; Cut ``0<(Rabsolu x)+1``.
+Intro; Assert H0 := (X (mkposreal ? H)).
+Unfold CVN_r in H0; Elim H0; Intros Bn H1.
+Elim H1; Intros l H2.
+Elim H2; Intros.
+Apply Rseries_CV_comp with Bn.
+Intro; Split.
+Apply Rabsolu_pos.
+Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0.
+Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Apply existTT with l.
+Cut (n:nat)``0<=(Bn n)``.
+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 [k:nat](Rabsolu (Bn k)) n).
+Apply H7; Assumption.
+Apply sum_eq; Intros; Apply Rabsolu_right; Apply Rle_sym1; Apply H5.
+Intro; Apply Rle_trans with (Rabsolu (An n)).
+Apply Rabsolu_pos.
+Unfold An; Apply H4; Unfold Boule; Simpl; Rewrite minus_R0; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Apply ge0_plus_gt0_is_gt0; [Apply Rabsolu_pos | Apply Rlt_R0_R1].
+Qed.
diff --git a/theories7/Reals/PartSum.v b/theories7/Reals/PartSum.v
new file mode 100644
index 00000000..ee5fa498
--- /dev/null
+++ b/theories7/Reals/PartSum.v
@@ -0,0 +1,476 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: PartSum.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require Rcomplete.
+Require Max.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Lemma tech1 : (An:nat->R;N:nat) ((n:nat)``(le n N)``->``0<(An n)``) -> ``0 < (sum_f_R0 An N)``.
+Intros; Induction N.
+Simpl; Apply H; Apply le_n.
+Simpl; Apply gt0_plus_gt0_is_gt0.
+Apply HrecN; Intros; Apply H; Apply le_S; Assumption.
+Apply H; Apply le_n.
+Qed.
+
+(* Chasles' relation *)
+Lemma tech2 : (An:nat->R;m,n:nat) (lt m n) -> (sum_f_R0 An n) == (Rplus (sum_f_R0 An m) (sum_f_R0 [i:nat]``(An (plus (S m) i))`` (minus n (S m)))). 
+Intros; Induction n.
+Elim (lt_n_O ? H).
+Cut (lt m n)\/m=n.
+Intro; Elim H0; Intro.
+Replace (sum_f_R0 An (S n)) with ``(sum_f_R0 An n)+(An (S n))``; [Idtac | Reflexivity].
+Replace (minus (S n) (S m)) with (S (minus n (S m))).
+Replace (sum_f_R0 [i:nat](An (plus (S m) i)) (S (minus n (S m)))) with (Rplus (sum_f_R0 [i:nat](An (plus (S m) i)) (minus n (S m))) (An (plus (S m) (S (minus n (S m)))))); [Idtac | Reflexivity].
+Replace (plus (S m) (S (minus n (S m)))) with (S n).
+Rewrite (Hrecn H1).
+Ring.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
+Rewrite S_INR; Ring.
+Apply lt_le_S; Assumption.
+Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
+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.
+Replace (plus n O) with n; [Reflexivity | Ring].
+Inversion H.
+Right; Reflexivity.
+Left; Apply lt_le_trans with (S m); [Apply lt_n_Sn | Assumption].
+Qed.
+
+(* Sum of geometric sequences *)
+Lemma tech3 : (k:R;N:nat) ``k<>1`` -> (sum_f_R0 [i:nat](pow k i) N)==``(1-(pow k (S N)))/(1-k)``.
+Intros; Cut ``1-k<>0``.
+Intro; Induction N.
+Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite <- Rinv_r_sym.
+Reflexivity.
+Apply H0.
+Replace (sum_f_R0 ([i:nat](pow k i)) (S N)) with (Rplus (sum_f_R0 [i:nat](pow k i) N) (pow k (S N))); [Idtac | Reflexivity]; Rewrite HrecN; Replace ``(1-(pow k (S N)))/(1-k)+(pow k (S N))`` with ``((1-(pow k (S N)))+(1-k)*(pow k (S N)))/(1-k)``.
+Apply r_Rmult_mult with ``1-k``.
+Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/(1-k)``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [ Do 2 Rewrite Rmult_1l; Simpl; Ring | Apply H0].
+Apply H0.
+Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite (Rmult_sym ``1-k``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Reflexivity.
+Apply H0.
+Apply Rminus_eq_contra; Red; Intro; Elim H; Symmetry; Assumption.
+Qed.
+
+Lemma tech4 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> ``(An N)<=(An O)*(pow k N)``.
+Intros; Induction N.
+Simpl; Right; Ring.
+Apply Rle_trans with ``k*(An N)``.
+Left; Apply (H0 N).
+Replace (S N) with (plus N (1)); [Idtac | Ring].
+Rewrite pow_add; Simpl; Rewrite Rmult_1r; Replace ``(An O)*((pow k N)*k)`` with ``k*((An O)*(pow k N))``; [Idtac | Ring]; Apply Rle_monotony.
+Assumption.
+Apply HrecN.
+Qed.
+
+Lemma tech5 : (An:nat->R;N:nat) (sum_f_R0 An (S N))==``(sum_f_R0 An N)+(An (S N))``.
+Intros; Reflexivity.
+Qed.
+
+Lemma tech6 : (An:nat->R;k:R;N:nat) ``0<=k`` -> ((i:nat)``(An (S i))<k*(An i)``) -> (Rle (sum_f_R0 An N) (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N))).
+Intros; Induction N.
+Simpl; Right; Ring.
+Apply Rle_trans with (Rplus (Rmult (An O) (sum_f_R0 [i:nat](pow k i) N)) (An (S N))).
+Rewrite tech5; Do 2 Rewrite <- (Rplus_sym (An (S N))); Apply Rle_compatibility.
+Apply HrecN.
+Rewrite tech5 ; Rewrite Rmult_Rplus_distr; Apply Rle_compatibility.
+Apply tech4; Assumption.
+Qed.
+
+Lemma tech7 : (r1,r2:R) ``r1<>0`` -> ``r2<>0`` -> ``r1<>r2`` -> ``/r1<>/r2``.
+Intros; Red; Intro.
+Assert H3 := (Rmult_mult_r r1 ? ? H2).
+Rewrite <- Rinv_r_sym in H3; [Idtac | Assumption].
+Assert H4 := (Rmult_mult_r r2 ? ? H3).
+Rewrite Rmult_1r in H4; Rewrite <- Rmult_assoc in H4.
+Rewrite Rinv_r_simpl_m in H4; [Idtac | Assumption].
+Elim H1; Symmetry; Assumption.
+Qed.
+
+Lemma tech11 : (An,Bn,Cn:nat->R;N:nat) ((i:nat) (An i)==``(Bn i)-(Cn i)``) -> (sum_f_R0 An N)==``(sum_f_R0 Bn N)-(sum_f_R0 Cn N)``.
+Intros; Induction N.
+Simpl; Apply H.
+Do 3 Rewrite tech5; Rewrite HrecN; Rewrite (H (S N)); Ring.
+Qed.
+
+Lemma tech12 : (An:nat->R;x:R;l:R) (Un_cv [N:nat](sum_f_R0 [i:nat]``(An i)*(pow x i)`` N) l) -> (Pser An x l).
+Intros; Unfold Pser; Unfold infinit_sum; Unfold Un_cv in H; Assumption.
+Qed. 
+
+Lemma scal_sum : (An:nat->R;N:nat;x:R) (Rmult x (sum_f_R0 An N))==(sum_f_R0 [i:nat]``(An i)*x`` N).
+Intros; Induction N.
+Simpl; Ring.
+Do 2 Rewrite tech5.
+Rewrite Rmult_Rplus_distr; Rewrite <- HrecN; Ring.
+Qed.
+
+Lemma decomp_sum : (An:nat->R;N:nat) (lt O N) -> (sum_f_R0 An N)==(Rplus (An O) (sum_f_R0 [i:nat](An (S i)) (pred N))).
+Intros; Induction N.
+Elim (lt_n_n ? H).
+Cut (lt O N)\/N=O.
+Intro; Elim H0; Intro.
+Cut (S (pred N))=(pred (S N)).
+Intro; Rewrite <- H2.
+Do 2 Rewrite tech5.
+Replace (S (S (pred N))) with (S N).
+Rewrite (HrecN H1); Ring.
+Rewrite H2; Simpl; Reflexivity.
+Assert H2 := (O_or_S N).
+Elim H2; Intros.
+Elim a; Intros.
+Rewrite <- p.
+Simpl; Reflexivity.
+Rewrite <- b in H1; Elim (lt_n_n ? H1).
+Rewrite H1; Simpl; Reflexivity.
+Inversion H.
+Right; Reflexivity.
+Left; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
+Qed.
+
+Lemma plus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)+(Bn i)`` N)==``(sum_f_R0 An N)+(sum_f_R0 Bn N)``.
+Intros; Induction N.
+Simpl; Ring.
+Do 3 Rewrite tech5; Rewrite HrecN; Ring.
+Qed.
+
+Lemma sum_eq : (An,Bn:nat->R;N:nat) ((i:nat)(le i N)->(An i)==(Bn i)) -> (sum_f_R0 An N)==(sum_f_R0 Bn N).
+Intros; Induction 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].
+Qed.
+
+(* Unicity of the limit defined by convergent series *)
+Lemma unicity_sum : (An:nat->R;l1,l2:R) (infinit_sum An l1) -> (infinit_sum An l2) -> l1 == l2.
+Unfold infinit_sum; Intros.
+Case (Req_EM l1 l2); Intro.
+Assumption.
+Cut ``0<(Rabsolu ((l1-l2)/2))``; [Intro | Apply Rabsolu_pos_lt].
+Elim (H ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
+Elim (H0 ``(Rabsolu ((l1-l2)/2))`` H2); Intros.
+Pose N := (max x0 x); Cut (ge N x0).
+Cut (ge N x).
+Intros; Assert H7 := (H3 N H5); Assert H8 := (H4 N H6).
+Cut ``(Rabsolu (l1-l2)) <= (R_dist (sum_f_R0 An N) l1) + (R_dist (sum_f_R0 An N) l2)``.
+Intro; Assert H10 := (Rplus_lt ? ? ? ? H7 H8); Assert H11 := (Rle_lt_trans ? ? ? H9 H10); Unfold Rdiv in H11; Rewrite Rabsolu_mult in H11.
+Cut ``(Rabsolu (/2))==/2``.
+Intro; Rewrite H12 in H11; Assert H13 := double_var; Unfold Rdiv in H13; Rewrite <- H13 in H11.
+Elim (Rlt_antirefl ? H11).
+Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H20; Generalize (lt_INR_0 (2) (neq_O_lt (2) H20)); Unfold INR; Intro; Assumption | Discriminate].
+Unfold R_dist; Rewrite <- (Rabsolu_Ropp ``(sum_f_R0 An N)-l1``); Rewrite Ropp_distr3.
+Replace ``l1-l2`` with ``((l1-(sum_f_R0 An N)))+((sum_f_R0 An N)-l2)``; [Idtac | Ring].
+Apply Rabsolu_triang.
+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_R0; DiscrR.
+Qed.
+
+Lemma minus_sum : (An,Bn:nat->R;N:nat) (sum_f_R0 [i:nat]``(An i)-(Bn i)`` N)==``(sum_f_R0 An N)-(sum_f_R0 Bn N)``. 
+Intros; Induction N. 
+Simpl; Ring. 
+Do 3 Rewrite tech5; Rewrite HrecN; Ring. 
+Qed. 
+
+Lemma sum_decomposition : (An:nat->R;N:nat) (Rplus (sum_f_R0 [l:nat](An (mult (2) l)) (S N)) (sum_f_R0 [l:nat](An (S (mult (2) l))) N))==(sum_f_R0 An (mult (2) (S N))).
+Intros.
+Induction N.
+Simpl; Ring.
+Rewrite tech5.
+Rewrite (tech5 [l:nat](An (S (mult (2) l))) N).
+Replace (mult (2) (S (S N))) with (S (S (mult (2) (S N)))).
+Rewrite (tech5 An (S (mult (2) (S N)))).
+Rewrite (tech5 An (mult (2) (S N))).
+Rewrite <- HrecN.
+Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR;Repeat Rewrite S_INR.
+Ring.
+Qed.
+
+Lemma sum_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``(An n)<=(Bn n)``) -> ``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
+Intros.
+Induction N.
+Simpl; Apply H.
+Apply le_n.
+Do 2 Rewrite tech5.
+Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
+Apply Rle_compatibility.
+Apply H.
+Apply le_n.
+Do 2 Rewrite <- (Rplus_sym ``(Bn (S N))``).
+Apply Rle_compatibility.
+Apply HrecN.
+Intros; Apply H.
+Apply le_trans with N; [Assumption | Apply le_n_Sn].
+Qed.
+
+Lemma sum_Rabsolu : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [l:nat](Rabsolu (An l)) N)).
+Intros.
+Induction N.
+Simpl.
+Right; Reflexivity.
+Do 2 Rewrite tech5.
+Apply Rle_trans with ``(Rabsolu (sum_f_R0 An N))+(Rabsolu (An (S N)))``.
+Apply Rabsolu_triang.
+Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
+Apply Rle_compatibility.
+Apply HrecN.
+Qed.
+
+Lemma sum_cte : (x:R;N:nat) (sum_f_R0 [_:nat]x N) == ``x*(INR (S N))``.
+Intros.
+Induction N.
+Simpl; Ring.
+Rewrite tech5.
+Rewrite HrecN; Repeat Rewrite S_INR; Ring.
+Qed.
+
+(**********)
+Lemma sum_growing : (An,Bn:nat->R;N:nat) ((n:nat)``(An n)<=(Bn n)``)->``(sum_f_R0 An N)<=(sum_f_R0 Bn N)``.
+Intros.
+Induction N.
+Simpl; Apply H.
+Do 2 Rewrite tech5.
+Apply Rle_trans with ``(sum_f_R0 An N)+(Bn (S N))``.
+Apply Rle_compatibility; Apply H.
+Do 2 Rewrite <- (Rplus_sym (Bn (S N))).
+Apply Rle_compatibility; Apply HrecN.
+Qed.
+
+(**********)
+Lemma Rabsolu_triang_gen : (An:nat->R;N:nat) (Rle (Rabsolu (sum_f_R0 An N)) (sum_f_R0 [i:nat](Rabsolu (An i)) N)). 
+Intros.
+Induction N.
+Simpl.
+Right; Reflexivity.
+Do 2 Rewrite tech5.
+Apply Rle_trans with ``(Rabsolu ((sum_f_R0 An N)))+(Rabsolu (An (S N)))``.
+Apply Rabsolu_triang.
+Do 2 Rewrite <- (Rplus_sym (Rabsolu (An (S N)))).
+Apply Rle_compatibility; Apply HrecN.
+Qed.
+
+(**********)
+Lemma cond_pos_sum : (An:nat->R;N:nat) ((n:nat)``0<=(An n)``) -> ``0<=(sum_f_R0 An N)``.
+Intros.
+Induction N.
+Simpl; Apply H.
+Rewrite tech5.
+Apply ge0_plus_ge0_is_ge0.
+Apply HrecN.
+Apply H.
+Qed.
+
+(* Cauchy's criterion for series *)
+Definition Cauchy_crit_series [An:nat->R] : Prop := (Cauchy_crit [N:nat](sum_f_R0 An N)).
+
+(* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *)
+Lemma cauchy_abs : (An:nat->R) (Cauchy_crit_series [i:nat](Rabsolu (An i))) -> (Cauchy_crit_series An).
+Unfold Cauchy_crit_series; Unfold Cauchy_crit.
+Intros.
+Elim (H eps H0); Intros.
+Exists x.
+Intros.
+Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m))).
+Intro.
+Apply Rle_lt_trans with (R_dist (sum_f_R0 [i:nat](Rabsolu (An i)) n) (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
+Assumption.
+Apply H1; Assumption.
+Assert H4 := (lt_eq_lt_dec n m).
+Elim H4; Intro.
+Elim a; Intro.
+Rewrite (tech2 An n m); [Idtac | Assumption].
+Rewrite (tech2 [i:nat](Rabsolu (An i)) n m); [Idtac | Assumption].
+Unfold R_dist.
+Unfold Rminus.
+Do 2 Rewrite Ropp_distr1.
+Do 2 Rewrite <- Rplus_assoc.
+Do 2 Rewrite Rplus_Ropp_r.
+Do 2 Rewrite Rplus_Ol.
+Do 2 Rewrite Rabsolu_Ropp.
+Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S n) i))) (minus m (S n)))).
+Pose Bn:=[i:nat](An (plus (S n) i)).
+Replace [i:nat](Rabsolu (An (plus (S n) i))) with [i:nat](Rabsolu (Bn i)).
+Apply Rabsolu_triang_gen.
+Unfold Bn; Reflexivity.
+Apply Rle_sym1.
+Apply cond_pos_sum.
+Intro; Apply Rabsolu_pos.
+Rewrite b.
+Unfold R_dist.
+Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r.
+Rewrite Rabsolu_R0; Right; Reflexivity.
+Rewrite (tech2 An m n); [Idtac | Assumption].
+Rewrite (tech2 [i:nat](Rabsolu (An i)) m n); [Idtac | Assumption].
+Unfold R_dist.
+Unfold Rminus.
+Do 2 Rewrite Rplus_assoc.
+Rewrite (Rplus_sym (sum_f_R0 An m)).
+Rewrite (Rplus_sym (sum_f_R0 [i:nat](Rabsolu (An i)) m)).
+Do 2 Rewrite Rplus_assoc.
+Do 2 Rewrite Rplus_Ropp_l.
+Do 2 Rewrite Rplus_Or.
+Rewrite (Rabsolu_right (sum_f_R0 [i:nat](Rabsolu (An (plus (S m) i))) (minus n (S m)))).
+Pose Bn:=[i:nat](An (plus (S m) i)).
+Replace [i:nat](Rabsolu (An (plus (S m) i))) with [i:nat](Rabsolu (Bn i)).
+Apply Rabsolu_triang_gen.
+Unfold Bn; Reflexivity.
+Apply Rle_sym1.
+Apply cond_pos_sum.
+Intro; Apply Rabsolu_pos.
+Qed.
+
+(**********)
+Lemma cv_cauchy_1 : (An:nat->R) (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)) -> (Cauchy_crit_series An).
+Intros.
+Elim X; Intros.
+Unfold Un_cv in p.
+Unfold Cauchy_crit_series; Unfold Cauchy_crit.
+Intros.
+Cut ``0<eps/2``.
+Intro.
+Elim (p ``eps/2`` H0); Intros.
+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.
+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 <- (Rabsolu_Ropp ``(sum_f_R0 An m)-x``).
+Apply Rabsolu_triang.
+Apply Rlt_le_trans with ``eps/2+eps/2``.
+Apply Rplus_lt.
+Apply H1; Assumption.
+Apply H1; Assumption.
+Right; Symmetry; Apply double_var.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Qed.
+
+Lemma cv_cauchy_2 : (An:nat->R) (Cauchy_crit_series An) -> (sigTT R [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros.
+Apply R_complete.
+Unfold Cauchy_crit_series in H.
+Exact H.
+Qed.
+
+(**********)
+Lemma sum_eq_R0 : (An:nat->R;N:nat) ((n:nat)(le n N)->``(An n)==0``) -> (sum_f_R0 An N)==R0.
+Intros; Induction N.
+Simpl; Apply H; Apply le_n.
+Rewrite tech5; Rewrite HrecN; [Rewrite Rplus_Ol; Apply H; Apply le_n | Intros; Apply H; Apply le_trans with N; [Assumption | Apply le_n_Sn]].
+Qed.
+
+Definition SP [fn:nat->R->R;N:nat] : R->R := [x:R](sum_f_R0 [k:nat]``(fn k x)`` N).
+
+(**********)
+Lemma sum_incr : (An:nat->R;N:nat;l:R) (Un_cv [n:nat](sum_f_R0 An n) l) -> ((n:nat)``0<=(An n)``) -> ``(sum_f_R0 An N)<=l``.
+Intros; Case (total_order_T (sum_f_R0 An N) l); Intro.
+Elim s; Intro.
+Left; Apply a.
+Right; Apply b.
+Cut (Un_growing [n:nat](sum_f_R0 An n)).
+Intro; Pose l1 := (sum_f_R0 An N).
+Fold l1 in r.
+Unfold Un_cv in H; Cut ``0<l1-l``.
+Intro; Elim (H ? H2); Intros.
+Pose N0 := (max x N); Cut (ge N0 x).
+Intro; Assert H5 := (H3 N0 H4).
+Cut ``l1<=(sum_f_R0 An N0)``.
+Intro; Unfold R_dist in H5; Rewrite Rabsolu_right in H5.
+Cut ``(sum_f_R0 An N0)<l1``.
+Intro; Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H7 H6)).
+Apply Rlt_anti_compatibility with ``-l``.
+Do 2 Rewrite (Rplus_sym ``-l``).
+Apply H5.
+Apply Rle_sym1; Apply Rle_anti_compatibility with l.
+Rewrite Rplus_Or; Replace ``l+((sum_f_R0 An N0)-l)`` with (sum_f_R0 An N0); [Idtac | Ring]; Apply Rle_trans with l1.
+Left; Apply r.
+Apply H6.
+Unfold l1; Apply Rle_sym2; Apply (growing_prop [k:nat](sum_f_R0 An k)).
+Apply H1.
+Unfold ge N0; Apply le_max_r.
+Unfold ge N0; Apply le_max_l.
+Apply Rlt_anti_compatibility with l; Rewrite Rplus_Or; Replace ``l+(l1-l)`` with l1; [Apply r | Ring].
+Unfold Un_growing; Intro; Simpl; Pattern 1 (sum_f_R0 An n); Rewrite <- Rplus_Or; Apply Rle_compatibility; Apply H0.
+Qed.
+
+(**********)
+Lemma sum_cv_maj : (An:nat->R;fn:nat->R->R;x,l1,l2:R) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu l1)<=l2``.
+Intros; Case (total_order_T (Rabsolu l1) l2); Intro.
+Elim s; Intro.
+Left; Apply a.
+Right; Apply b.
+Cut (n0:nat)``(Rabsolu (SP fn n0 x))<=(sum_f_R0 An n0)``.
+Intro; Cut ``0<((Rabsolu l1)-l2)/2``.
+Intro; Unfold Un_cv in H H0.
+Elim (H ? H3); Intros Na H4.
+Elim (H0 ? H3); Intros Nb H5.
+Pose N := (max Na Nb).
+Unfold R_dist in H4 H5.
+Cut ``(Rabsolu ((sum_f_R0 An N)-l2))<((Rabsolu l1)-l2)/2``.
+Intro; Cut ``(Rabsolu ((Rabsolu l1)-(Rabsolu (SP fn N x))))<((Rabsolu l1)-l2)/2``.
+Intro; Cut ``(sum_f_R0 An N)<((Rabsolu l1)+l2)/2``.
+Intro; Cut ``((Rabsolu l1)+l2)/2<(Rabsolu (SP fn N x))``.
+Intro; Cut ``(sum_f_R0 An N)<(Rabsolu (SP fn N x))``.
+Intro; Assert H11 := (H2 N).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H10)).
+Apply Rlt_trans with ``((Rabsolu l1)+l2)/2``; Assumption.
+Case (case_Rabsolu ``(Rabsolu l1)-(Rabsolu (SP fn N x))``); Intro.
+Apply Rlt_trans with (Rabsolu l1).
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite double; Apply Rlt_compatibility; Apply r.
+DiscrR.
+Apply (Rminus_lt ? ? r0).
+Rewrite (Rabsolu_right ? r0) in H7.
+Apply Rlt_anti_compatibility with ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))``.
+Replace ``((Rabsolu l1)-l2)/2-(Rabsolu (SP fn N x))+((Rabsolu l1)+l2)/2`` with ``(Rabsolu l1)-(Rabsolu (SP fn N x))``.
+Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H7.
+Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``/2``); Pattern 1 (Rabsolu l1); Rewrite double_var; Unfold Rdiv; Ring.
+Case (case_Rabsolu ``(sum_f_R0 An N)-l2``); Intro.
+Apply Rlt_trans with l2.
+Apply (Rminus_lt ? ? r0).
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite (double l2); Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite (Rplus_sym (Rabsolu l1)); Apply Rlt_compatibility; Apply r.
+DiscrR.
+Rewrite (Rabsolu_right ? r0) in H6; Apply Rlt_anti_compatibility with ``-l2``.
+Replace ``-l2+((Rabsolu l1)+l2)/2`` with ``((Rabsolu l1)-l2)/2``.
+Rewrite Rplus_sym; Apply H6.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite Rminus_distr; Rewrite Rmult_Rplus_distrl; Pattern 2 l2; Rewrite double_var; Repeat Rewrite (Rmult_sym ``/2``); Rewrite Ropp_distr1; Unfold Rdiv; Ring.
+Apply Rle_lt_trans with ``(Rabsolu ((SP fn N x)-l1))``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply Rabsolu_triang_inv2.
+Apply H4; Unfold ge N; Apply le_max_l.
+Apply H5; Unfold ge N; Apply le_max_r.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_anti_compatibility with l2.
+Rewrite Rplus_Or; Replace ``l2+((Rabsolu l1)-l2)`` with (Rabsolu l1); [Apply r | Ring].
+Apply Rlt_Rinv; Sup0.
+Intros; Induction n0.
+Unfold SP; Simpl; Apply H1.
+Unfold SP; Simpl.
+Apply Rle_trans with (Rplus (Rabsolu (sum_f_R0 [k:nat](fn k x) n0)) (Rabsolu (fn (S n0) x))).
+Apply Rabsolu_triang.
+Apply Rle_trans with ``(sum_f_R0 An n0)+(Rabsolu (fn (S n0) x))``.
+Do 2 Rewrite <- (Rplus_sym (Rabsolu (fn (S n0) x))).
+Apply Rle_compatibility; Apply Hrecn0.
+Apply Rle_compatibility; Apply H1.
+Qed.
diff --git a/theories7/Reals/RIneq.v b/theories7/Reals/RIneq.v
new file mode 100644
index 00000000..00d41c70
--- /dev/null
+++ b/theories7/Reals/RIneq.v
@@ -0,0 +1,1631 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: RIneq.v,v 1.2.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+(***************************************************************************)
+(**              Basic lemmas for the classical reals numbers              *)
+(***************************************************************************)
+
+Require Export Raxioms.
+Require Export ZArithRing.
+Require Omega.
+Require Export Field.
+
+Open Local Scope Z_scope.
+Open Local Scope R_scope.
+
+Implicit Variable Type r:R.
+
+(***************************************************************************)
+(**       Instantiating Ring tactic on reals                               *)
+(***************************************************************************)
+
+Lemma RTheory : (Ring_Theory Rplus Rmult R1 R0 Ropp [x,y:R]false).
+  Split.
+  Exact Rplus_sym.
+  Symmetry; Apply Rplus_assoc.
+  Exact Rmult_sym.
+  Symmetry; Apply Rmult_assoc.
+  Intro; Apply Rplus_Ol.
+  Intro; Apply Rmult_1l.
+  Exact Rplus_Ropp_r.
+  Intros.
+  Rewrite Rmult_sym.
+  Rewrite (Rmult_sym n p).
+  Rewrite (Rmult_sym m p).
+  Apply Rmult_Rplus_distr.
+  Intros; Contradiction.
+Defined.
+
+Add Field R Rplus Rmult R1 R0 Ropp [x,y:R]false Rinv RTheory Rinv_l
+          with minus:=Rminus div:=Rdiv.
+
+(**************************************************************************)
+(**  Relation between orders and equality                                 *)
+(**************************************************************************)
+
+(**********)
+Lemma Rlt_antirefl:(r:R)~``r<r``.
+  Generalize Rlt_antisym. Intuition EAuto.
+Qed.
+Hints Resolve Rlt_antirefl : real.
+
+Lemma Rle_refl : (x:R) ``x<=x``.
+Intro; Right; Reflexivity.
+Qed.
+
+Lemma Rlt_not_eq:(r1,r2:R)``r1<r2``->``r1<>r2``.
+  Red; Intros r1 r2 H H0; Apply (Rlt_antirefl r1).
+  Pattern 2 r1; Rewrite H0; Trivial.
+Qed.
+
+Lemma Rgt_not_eq:(r1,r2:R)``r1>r2``->``r1<>r2``.
+Intros; Apply sym_not_eqT; Apply Rlt_not_eq; Auto with real.
+Qed.
+
+(**********)
+Lemma imp_not_Req:(r1,r2:R)(``r1<r2``\/ ``r1>r2``) -> ``r1<>r2``.
+Generalize Rlt_not_eq Rgt_not_eq. Intuition EAuto.
+Qed.
+Hints Resolve imp_not_Req : real.
+
+(** Reasoning by case on equalities and order *)
+
+(**********)
+Lemma Req_EM:(r1,r2:R)(r1==r2)\/``r1<>r2``.
+Intros ; Generalize (total_order_T r1 r2) imp_not_Req ; Intuition EAuto 3. 
+Qed.
+Hints Resolve Req_EM : real.
+
+(**********)
+Lemma total_order:(r1,r2:R)``r1<r2``\/(r1==r2)\/``r1>r2``.
+Intros;Generalize (total_order_T r1 r2);Tauto.
+Qed.
+
+(**********)
+Lemma not_Req:(r1,r2:R)``r1<>r2``->(``r1<r2``\/``r1>r2``).
+Intros; Generalize (total_order_T r1 r2) ; Tauto.
+Qed.
+
+
+(*********************************************************************************)
+(**       Order Lemma  : relating [<], [>], [<=] and [>=]  	                 *)
+(*********************************************************************************)
+
+(**********)
+Lemma Rlt_le:(r1,r2:R)``r1<r2``-> ``r1<=r2``.
+Intros ; Red ; Tauto.
+Qed.
+Hints Resolve Rlt_le : real.
+
+(**********)
+Lemma Rle_ge : (r1,r2:R)``r1<=r2`` -> ``r2>=r1``.
+NewDestruct 1; Red; Auto with real.
+Qed.
+
+Hints Immediate Rle_ge : real.
+
+(**********)
+Lemma Rge_le : (r1,r2:R)``r1>=r2`` -> ``r2<=r1``.
+NewDestruct 1; Red; Auto with real.
+Qed.
+
+Hints Resolve Rge_le : real.
+
+(**********)
+Lemma not_Rle:(r1,r2:R)~``r1<=r2`` -> ``r2<r1``.
+Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rle; Tauto.
+Qed.
+
+Hints Immediate not_Rle : real.
+
+Lemma not_Rge:(r1,r2:R)~``r1>=r2`` -> ``r1<r2``.
+Intros; Apply not_Rle; Auto with real.
+Qed.
+
+(**********)
+Lemma Rlt_le_not:(r1,r2:R)``r2<r1`` -> ~``r1<=r2``.
+Generalize Rlt_antisym imp_not_Req ; Unfold Rle.
+Intuition EAuto 3.
+Qed.
+
+Lemma Rle_not:(r1,r2:R)``r1>r2`` -> ~``r1<=r2``.
+Proof Rlt_le_not.
+
+Hints Immediate Rlt_le_not : real.
+
+Lemma Rle_not_lt: (r1, r2:R) ``r2 <= r1`` -> ~``r1<r2``.
+Intros r1 r2. Generalize (Rlt_antisym r1 r2) (imp_not_Req r1 r2).
+Unfold Rle; Intuition.
+Qed.
+
+(**********)
+Lemma Rlt_ge_not:(r1,r2:R)``r1<r2`` -> ~``r1>=r2``.
+Generalize Rlt_le_not. Unfold Rle Rge. Intuition EAuto 3.
+Qed.
+
+Hints Immediate Rlt_ge_not : real.
+
+(**********)
+Lemma eq_Rle:(r1,r2:R)r1==r2->``r1<=r2``.
+Unfold Rle; Tauto.
+Qed.
+Hints Immediate eq_Rle : real.
+
+Lemma eq_Rge:(r1,r2:R)r1==r2->``r1>=r2``.
+Unfold Rge; Tauto.
+Qed.
+Hints Immediate eq_Rge : real.
+
+Lemma eq_Rle_sym:(r1,r2:R)r2==r1->``r1<=r2``.
+Unfold Rle; Auto.
+Qed.
+Hints Immediate eq_Rle_sym : real.
+
+Lemma eq_Rge_sym:(r1,r2:R)r2==r1->``r1>=r2``.
+Unfold Rge; Auto.
+Qed.
+Hints Immediate eq_Rge_sym : real.
+
+Lemma Rle_antisym : (r1,r2:R)``r1<=r2`` -> ``r2<=r1``-> r1==r2.
+Intros r1 r2; Generalize (Rlt_antisym r1 r2) ; Unfold Rle ; Intuition.
+Qed.
+Hints Resolve Rle_antisym : real.
+
+(**********)
+Lemma Rle_le_eq:(r1,r2:R)(``r1<=r2``/\``r2<=r1``)<->(r1==r2).
+Intuition.
+Qed.
+
+Lemma Rlt_rew : (x,x',y,y':R)``x==x'``->``x'<y'`` -> `` y' == y`` -> ``x < y``.
+Intros x x' y y'; Intros; Replace x with x'; Replace y with y'; Assumption.
+Qed.
+
+(**********)
+Lemma Rle_trans:(r1,r2,r3:R) ``r1<=r2``->``r2<=r3``->``r1<=r3``.
+Generalize trans_eqT Rlt_trans Rlt_rew.
+Unfold Rle.
+Intuition EAuto 2.
+Qed.
+
+(**********)
+Lemma Rle_lt_trans:(r1,r2,r3:R)``r1<=r2``->``r2<r3``->``r1<r3``.
+Generalize Rlt_trans Rlt_rew. 
+Unfold Rle.
+Intuition EAuto 2.
+Qed.
+
+(**********)
+Lemma Rlt_le_trans:(r1,r2,r3:R)``r1<r2``->``r2<=r3``->``r1<r3``.
+Generalize Rlt_trans Rlt_rew; Unfold Rle; Intuition EAuto 2.
+Qed.
+
+
+(** Decidability of the order *)
+Lemma total_order_Rlt:(r1,r2:R)(sumboolT ``r1<r2`` ~(``r1<r2``)).
+Intros;Generalize (total_order_T r1 r2) (imp_not_Req r1 r2) ; Intuition.
+Qed.
+
+(**********)
+Lemma total_order_Rle:(r1,r2:R)(sumboolT ``r1<=r2`` ~(``r1<=r2``)).
+Intros r1 r2.
+Generalize (total_order_T r1 r2) (imp_not_Req r1 r2).
+Intuition EAuto 4 with real.
+Qed.
+
+(**********)
+Lemma total_order_Rgt:(r1,r2:R)(sumboolT ``r1>r2`` ~(``r1>r2``)).
+Intros;Unfold Rgt;Intros;Apply total_order_Rlt.
+Qed.
+
+(**********)
+Lemma total_order_Rge:(r1,r2:R)(sumboolT (``r1>=r2``) ~(``r1>=r2``)).
+Intros;Generalize (total_order_Rle r2 r1);Intuition.
+Qed.
+
+Lemma total_order_Rlt_Rle:(r1,r2:R)(sumboolT ``r1<r2`` ``r2<=r1``).
+Intros;Generalize (total_order_T r1 r2); Intuition.
+Qed.
+
+Lemma Rle_or_lt: (n, m:R)(Rle n m) \/ (Rlt m n).
+Intros n m; Elim (total_order_Rlt_Rle m n);Auto with real.
+Qed.
+
+Lemma total_order_Rle_Rlt_eq :(r1,r2:R)``r1<=r2``-> 
+                              (sumboolT ``r1<r2`` ``r1==r2``).
+Intros r1 r2 H;Generalize (total_order_T r1 r2); Intuition.
+Qed.
+
+(**********)
+Lemma inser_trans_R:(n,m,p,q:R)``n<=m<p``-> (sumboolT ``n<=m<q`` ``q<=m<p``).
+Intros n m p q; Intros; Generalize (total_order_Rlt_Rle m q); Intuition.
+Qed.
+
+(****************************************************************)
+(**        Field Lemmas                                         *)
+(* This part contains lemma involving the Fields operations     *)
+(****************************************************************)
+(*********************************************************)
+(**      Addition                                        *)
+(*********************************************************)
+
+Lemma Rplus_ne:(r:R)``r+0==r``/\``0+r==r``.
+Intro;Split;Ring.
+Qed.
+Hints Resolve Rplus_ne : real v62.
+
+Lemma Rplus_Or:(r:R)``r+0==r``.
+Intro; Ring.
+Qed.
+Hints Resolve Rplus_Or : real.
+
+(**********)
+Lemma Rplus_Ropp_l:(r:R)``(-r)+r==0``.
+  Intro; Ring.
+Qed.
+Hints Resolve Rplus_Ropp_l : real.
+
+
+(**********)
+Lemma Rplus_Ropp:(x,y:R)``x+y==0``->``y== -x``.
+  Intros x y H; Replace y with ``(-x+x)+y``;
+  [ Rewrite -> Rplus_assoc; Rewrite -> H; Ring
+  | Ring ].
+Qed.
+
+(*i New i*)
+Hint eqT_R_congr : real := Resolve (congr_eqT R).
+
+Lemma Rplus_plus_r:(r,r1,r2:R)(r1==r2)->``r+r1==r+r2``.
+  Auto with real.
+Qed.
+
+(*i Old i*)Hints Resolve Rplus_plus_r : v62.
+
+(**********)
+Lemma r_Rplus_plus:(r,r1,r2:R)``r+r1==r+r2``->r1==r2.
+  Intros; Transitivity ``(-r+r)+r1``.
+  Ring.
+  Transitivity ``(-r+r)+r2``.
+  Repeat Rewrite -> Rplus_assoc; Rewrite <- H; Reflexivity.
+  Ring.
+Qed.
+Hints Resolve r_Rplus_plus : real.
+
+(**********)
+Lemma Rplus_ne_i:(r,b:R)``r+b==r`` -> ``b==0``.
+  Intros r b; Pattern 2 r; Replace r with ``r+0``;
+  EAuto with real.
+Qed.
+
+(***********************************************************)       
+(**       Multiplication                                   *)
+(***********************************************************)
+
+(**********)
+Lemma Rinv_r:(r:R)``r<>0``->``r* (/r)==1``.
+  Intros; Rewrite -> Rmult_sym; Auto with real.
+Qed.
+Hints Resolve Rinv_r : real.
+
+Lemma Rinv_l_sym:(r:R)``r<>0``->``1==(/r) * r``.
+  Symmetry; Auto with real.
+Qed.
+
+Lemma Rinv_r_sym:(r:R)``r<>0``->``1==r* (/r)``.
+  Symmetry; Auto with real.
+Qed.
+Hints Resolve Rinv_l_sym Rinv_r_sym : real.
+
+
+(**********)
+Lemma Rmult_Or :(r:R) ``r*0==0``.
+Intro; Ring.
+Qed.
+Hints Resolve Rmult_Or : real v62.
+
+(**********)
+Lemma Rmult_Ol:(r:R) ``0*r==0``.
+Intro; Ring.
+Qed.
+Hints Resolve Rmult_Ol : real v62.
+
+(**********)
+Lemma Rmult_ne:(r:R)``r*1==r``/\``1*r==r``.
+Intro;Split;Ring.
+Qed.
+Hints Resolve Rmult_ne : real v62.
+
+(**********)
+Lemma Rmult_1r:(r:R)(``r*1==r``).
+Intro; Ring.
+Qed.
+Hints Resolve Rmult_1r : real.
+
+(**********)
+Lemma Rmult_mult_r:(r,r1,r2:R)r1==r2->``r*r1==r*r2``.
+  Auto with real.
+Qed.
+
+(*i OLD i*)Hints Resolve Rmult_mult_r : v62.
+
+(**********)
+Lemma r_Rmult_mult:(r,r1,r2:R)(``r*r1==r*r2``)->``r<>0``->(r1==r2).
+  Intros; Transitivity ``(/r * r)*r1``.
+  Rewrite Rinv_l; Auto with real.
+  Transitivity ``(/r * r)*r2``.
+  Repeat Rewrite Rmult_assoc; Rewrite H; Trivial.
+  Rewrite Rinv_l; Auto with real.
+Qed.
+
+(**********)
+Lemma without_div_Od:(r1,r2:R)``r1*r2==0`` -> ``r1==0`` \/ ``r2==0``.
+  Intros; Case (Req_EM r1 ``0``); [Intro Hz | Intro Hnotz].
+  Auto.
+  Right; Apply r_Rmult_mult with r1; Trivial.
+  Rewrite H; Auto with real.
+Qed.
+
+(**********)
+Lemma without_div_Oi:(r1,r2:R) ``r1==0``\/``r2==0`` -> ``r1*r2==0``.
+  Intros r1 r2 [H | H]; Rewrite H; Auto with real.
+Qed.
+
+Hints Resolve without_div_Oi : real.
+
+(**********)
+Lemma without_div_Oi1:(r1,r2:R) ``r1==0`` -> ``r1*r2==0``.
+  Auto with real.
+Qed.
+
+(**********)
+Lemma without_div_Oi2:(r1,r2:R) ``r2==0`` -> ``r1*r2==0``.
+  Auto with real.
+Qed.
+
+
+(**********) 
+Lemma without_div_O_contr:(r1,r2:R)``r1*r2<>0`` -> ``r1<>0`` /\ ``r2<>0``.
+Intros r1 r2 H; Split; Red; Intro; Apply H; Auto with real.
+Qed.
+
+(**********) 
+Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``.
+Red; Intros r1 r2 (H1,H2) H.
+Case (without_div_Od r1 r2); Auto with real.
+Qed.
+Hints Resolve mult_non_zero : real.
+
+(**********) 
+Lemma Rmult_Rplus_distrl:
+   (r1,r2,r3:R) ``(r1+r2)*r3 == (r1*r3)+(r2*r3)``.
+Intros; Ring.
+Qed.
+
+(** Square function *)
+
+(***********)
+Definition Rsqr:R->R:=[r:R]``r*r``.
+V7only[Notation "x ²" := (Rsqr x) (at level 2,left associativity).].
+
+(***********)
+Lemma Rsqr_O:(Rsqr ``0``)==``0``.
+  Unfold Rsqr; Auto with real.
+Qed.
+
+(***********)
+Lemma Rsqr_r_R0:(r:R)(Rsqr r)==``0``->``r==0``.
+Unfold Rsqr;Intros;Elim (without_div_Od r r H);Trivial.
+Qed.
+
+(*********************************************************)
+(**      Opposite                                        *)
+(*********************************************************)
+
+(**********)
+Lemma eq_Ropp:(r1,r2:R)(r1==r2)->``-r1 == -r2``.
+  Auto with real.
+Qed.
+Hints Resolve eq_Ropp : real.
+
+(**********)
+Lemma Ropp_O:``-0==0``.
+  Ring.
+Qed.
+Hints Resolve Ropp_O : real v62.
+
+(**********)
+Lemma eq_RoppO:(r:R)``r==0``-> ``-r==0``.
+  Intros; Rewrite -> H; Auto with real.
+Qed.
+Hints Resolve eq_RoppO : real.
+
+(**********)
+Lemma Ropp_Ropp:(r:R)``-(-r)==r``.
+  Intro; Ring.
+Qed.
+Hints Resolve Ropp_Ropp : real.
+
+(*********)
+Lemma Ropp_neq:(r:R)``r<>0``->``-r<>0``.
+Red;Intros r H H0.
+Apply H.
+Transitivity ``-(-r)``; Auto with real.
+Qed.
+Hints Resolve Ropp_neq : real.
+
+(**********)
+Lemma Ropp_distr1:(r1,r2:R)``-(r1+r2)==(-r1 + -r2)``.
+  Intros; Ring.
+Qed.
+Hints Resolve Ropp_distr1 : real.
+
+(** Opposite and multiplication *)
+
+Lemma Ropp_mul1:(r1,r2:R)``(-r1)*r2 == -(r1*r2)``.
+  Intros; Ring.
+Qed.
+Hints Resolve Ropp_mul1 : real.
+
+(**********)
+Lemma Ropp_mul2:(r1,r2:R)``(-r1)*(-r2)==r1*r2``.
+  Intros; Ring.
+Qed.
+Hints Resolve Ropp_mul2 : real.
+
+Lemma Ropp_mul3 : (r1,r2:R) ``r1*(-r2) == -(r1*r2)``.
+Intros; Rewrite <- Ropp_mul1; Ring.
+Qed.
+
+(** Substraction *)
+
+Lemma minus_R0:(r:R)``r-0==r``.
+Intro;Ring.
+Qed.
+Hints Resolve minus_R0 : real.
+
+Lemma Rminus_Ropp:(r:R)``0-r==-r``.
+Intro;Ring.
+Qed.
+Hints Resolve Rminus_Ropp : real.
+
+(**********)
+Lemma Ropp_distr2:(r1,r2:R)``-(r1-r2)==r2-r1``.
+  Intros; Ring.
+Qed.
+Hints Resolve Ropp_distr2 : real.
+
+Lemma Ropp_distr3:(r1,r2:R)``-(r2-r1)==r1-r2``.
+Intros; Ring.
+Qed.
+Hints Resolve Ropp_distr3 : real. 
+
+(**********)
+Lemma eq_Rminus:(r1,r2:R)(r1==r2)->``r1-r2==0``.
+  Intros; Rewrite H; Ring.
+Qed.
+Hints Resolve eq_Rminus : real.
+
+(**********)
+Lemma Rminus_eq:(r1,r2:R)``r1-r2==0`` -> r1==r2.
+  Intros r1 r2; Unfold Rminus; Rewrite -> Rplus_sym; Intro.
+  Rewrite <- (Ropp_Ropp r2); Apply (Rplus_Ropp (Ropp r2) r1 H).
+Qed.
+Hints Immediate Rminus_eq : real.
+
+Lemma Rminus_eq_right:(r1,r2:R)``r2-r1==0`` -> r1==r2.
+Intros;Generalize (Rminus_eq r2 r1 H);Clear H;Intro H;Rewrite H;Ring.
+Qed.
+Hints Immediate Rminus_eq_right : real.
+
+Lemma Rplus_Rminus: (p,q:R)``p+(q-p)``==q.
+Intros; Ring.
+Qed.
+Hints Resolve Rplus_Rminus:real.
+
+(**********)
+Lemma Rminus_eq_contra:(r1,r2:R)``r1<>r2``->``r1-r2<>0``.
+Red; Intros r1 r2 H H0.
+Apply H; Auto with real.
+Qed.
+Hints Resolve Rminus_eq_contra : real.
+
+Lemma Rminus_not_eq:(r1,r2:R)``r1-r2<>0``->``r1<>r2``.
+Red; Intros; Elim H; Apply eq_Rminus; Auto.
+Qed.
+Hints Resolve Rminus_not_eq : real.
+
+Lemma Rminus_not_eq_right:(r1,r2:R)``r2-r1<>0`` -> ``r1<>r2``.
+Red; Intros;Elim H;Rewrite H0; Ring.
+Qed.
+Hints Resolve Rminus_not_eq_right : real. 
+
+V7only [Notation not_sym := (sym_not_eq R).].
+
+(**********)
+Lemma Rminus_distr:  (x,y,z:R) ``x*(y-z)==(x*y) - (x*z)``.
+Intros; Ring.
+Qed.
+
+(** Inverse *)
+Lemma Rinv_R1:``/1==1``.
+Field;Auto with real.
+Qed.
+Hints Resolve Rinv_R1 : real.
+
+(*********)
+Lemma Rinv_neq_R0:(r:R)``r<>0``->``(/r)<>0``.
+Red; Intros; Apply R1_neq_R0.
+Replace ``1`` with ``(/r) * r``; Auto with real.
+Qed.
+Hints Resolve Rinv_neq_R0 : real.
+
+(*********)
+Lemma Rinv_Rinv:(r:R)``r<>0``->``/(/r)==r``.
+Intros;Field;Auto with real.
+Qed.
+Hints Resolve Rinv_Rinv : real.
+
+(*********)
+Lemma Rinv_Rmult:(r1,r2:R)``r1<>0``->``r2<>0``->``/(r1*r2)==(/r1)*(/r2)``.
+Intros;Field;Auto with real.
+Qed.
+
+(*********)
+Lemma Ropp_Rinv:(r:R)``r<>0``->``-(/r)==/(-r)``.
+Intros;Field;Auto with real.
+Qed.
+
+Lemma Rinv_r_simpl_r : (r1,r2:R)``r1<>0``->``r1*(/r1)*r2==r2``.
+Intros; Transitivity ``1*r2``; Auto with real.
+Rewrite Rinv_r; Auto with real.
+Qed.
+
+Lemma Rinv_r_simpl_l : (r1,r2:R)``r1<>0``->``r2*r1*(/r1)==r2``.
+Intros; Transitivity ``r2*1``; Auto with real.
+Transitivity ``r2*(r1*/r1)``; Auto with real.
+Qed.
+
+Lemma Rinv_r_simpl_m : (r1,r2:R)``r1<>0``->``r1*r2*(/r1)==r2``.
+Intros; Transitivity ``r2*1``; Auto with real.
+Transitivity ``r2*(r1*/r1)``; Auto with real.
+Ring.
+Qed.
+Hints Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m : real.
+
+(*********)
+Lemma Rinv_Rmult_simpl:(a,b,c:R)``a<>0``->``(a*(/b))*(c*(/a))==c*(/b)``.
+Intros a b c; Intros.
+Transitivity ``(a*/a)*(c*(/b))``; Auto with real.
+Ring.
+Qed.
+
+(** Order and addition *)
+
+Lemma Rlt_compatibility_r:(r,r1,r2:R)``r1<r2``->``r1+r<r2+r``.
+Intros.
+Rewrite (Rplus_sym r1 r); Rewrite (Rplus_sym r2 r); Auto with real.
+Qed.
+
+Hints Resolve Rlt_compatibility_r : real.
+
+(**********)
+Lemma Rlt_anti_compatibility:  (r,r1,r2:R)``r+r1 < r+r2`` -> ``r1<r2``.
+Intros; Cut ``(-r+r)+r1 < (-r+r)+r2``.
+Rewrite -> Rplus_Ropp_l.
+Elim (Rplus_ne r1); Elim (Rplus_ne r2); Intros; Rewrite <- H3;
+ Rewrite <- H1; Auto with zarith real.
+Rewrite -> Rplus_assoc; Rewrite -> Rplus_assoc;
+ Apply (Rlt_compatibility ``-r`` ``r+r1`` ``r+r2`` H).
+Qed.
+
+(**********)
+Lemma Rle_compatibility:(r,r1,r2:R)``r1<=r2`` -> ``r+r1 <= r+r2 ``.
+Unfold Rle; Intros; Elim H; Intro.
+Left; Apply (Rlt_compatibility r r1 r2 H0).
+Right; Rewrite <- H0; Auto with zarith real.
+Qed.
+
+(**********)
+Lemma Rle_compatibility_r:(r,r1,r2:R)``r1<=r2`` -> ``r1+r<=r2+r``.
+Unfold Rle; Intros; Elim H; Intro.
+Left; Apply (Rlt_compatibility_r r r1 r2 H0).
+Right; Rewrite <- H0; Auto with real.
+Qed.
+
+Hints Resolve Rle_compatibility Rle_compatibility_r : real.
+
+(**********)
+Lemma Rle_anti_compatibility: (r,r1,r2:R)``r+r1<=r+r2`` -> ``r1<=r2``.
+Unfold Rle; Intros; Elim H; Intro.
+Left; Apply (Rlt_anti_compatibility r r1 r2 H0).
+Right; Apply (r_Rplus_plus r r1 r2 H0).
+Qed.
+
+(**********)
+Lemma sum_inequa_Rle_lt:(a,x,b,c,y,d:R)``a<=x`` -> ``x<b`` ->
+           ``c<y`` -> ``y<=d`` -> ``a+c < x+y < b+d``.
+Intros;Split.
+Apply Rlt_le_trans with ``a+y``; Auto with real.
+Apply Rlt_le_trans with ``b+y``; Auto with real.
+Qed.
+
+(*********)
+Lemma Rplus_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<r4`` -> ``r1+r3 < r2+r4``.
+Intros; Apply Rlt_trans with ``r2+r3``; Auto with real.
+Qed.
+
+Lemma Rplus_le:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<=r4`` -> ``r1+r3 <= r2+r4``.
+Intros; Apply Rle_trans with ``r2+r3``; Auto with real.
+Qed.
+
+(*********)
+Lemma Rplus_lt_le_lt:(r1,r2,r3,r4:R)``r1<r2`` -> ``r3<=r4`` -> 
+                     ``r1+r3 < r2+r4``.
+Intros; Apply Rlt_le_trans with ``r2+r3``; Auto with real.
+Qed.
+
+(*********)
+Lemma Rplus_le_lt_lt:(r1,r2,r3,r4:R)``r1<=r2`` -> ``r3<r4`` -> 
+                                    ``r1+r3 < r2+r4``.
+Intros; Apply Rle_lt_trans with ``r2+r3``; Auto with real.
+Qed.
+
+Hints Immediate Rplus_lt Rplus_le Rplus_lt_le_lt Rplus_le_lt_lt : real.
+
+(** Order and Opposite *)
+
+(**********)
+Lemma Rgt_Ropp:(r1,r2:R) ``r1 > r2`` -> ``-r1 < -r2``.
+Unfold Rgt; Intros.
+Apply (Rlt_anti_compatibility ``r2+r1``).
+Replace ``r2+r1+(-r1)`` with r2.
+Replace ``r2+r1+(-r2)`` with r1.
+Trivial.
+Ring.
+Ring.
+Qed.
+Hints Resolve Rgt_Ropp.
+
+(**********)
+Lemma Rlt_Ropp:(r1,r2:R) ``r1 < r2`` -> ``-r1 > -r2``.
+Unfold Rgt; Auto with real.
+Qed.
+Hints Resolve Rlt_Ropp : real.
+
+Lemma Ropp_Rlt: (x,y:R) ``-y < -x`` ->``x<y``.
+Intros x y H'.
+Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp y); Auto with real.
+Qed.
+Hints Immediate Ropp_Rlt : real.
+
+Lemma Rlt_Ropp1:(r1,r2:R) ``r2 < r1`` -> ``-r1 < -r2``.
+Auto with real.
+Qed.
+Hints Resolve Rlt_Ropp1 : real.
+
+(**********)
+Lemma Rle_Ropp:(r1,r2:R) ``r1 <= r2`` -> ``-r1 >= -r2``.
+Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
+Qed.
+Hints Resolve Rle_Ropp : real.
+
+Lemma Ropp_Rle: (x,y:R) ``-y <= -x`` ->``x <= y``.
+Intros x y H.
+Elim H;Auto with real.
+Intro H1;Rewrite <-(Ropp_Ropp x);Rewrite <-(Ropp_Ropp y);Rewrite H1;
+  Auto with real.
+Qed.
+Hints Immediate Ropp_Rle : real.
+
+Lemma Rle_Ropp1:(r1,r2:R) ``r2 <= r1`` -> ``-r1 <= -r2``.
+Intros r1 r2 H;Elim H;Auto with real.
+Qed.
+Hints Resolve Rle_Ropp1 : real.
+
+(**********)
+Lemma Rge_Ropp:(r1,r2:R) ``r1 >= r2`` -> ``-r1 <= -r2``.
+Unfold Rge; Intros r1 r2 [H|H]; Auto with real.
+Qed.
+Hints Resolve Rge_Ropp : real.
+
+(**********)
+Lemma Rlt_RO_Ropp:(r:R) ``0 < r`` -> ``0 > -r``.
+Intros; Replace ``0`` with ``-0``; Auto with real.
+Qed.
+Hints Resolve Rlt_RO_Ropp : real.
+
+(**********)
+Lemma Rgt_RO_Ropp:(r:R) ``0 > r`` -> ``0 < -r``.
+Intros; Replace ``0`` with ``-0``; Auto with real.
+Qed.
+Hints Resolve Rgt_RO_Ropp : real.
+
+(**********)
+Lemma Rgt_RoppO:(r:R)``r>0``->``(-r)<0``.
+Intros; Rewrite <- Ropp_O; Auto with real.
+Qed.
+
+(**********)
+Lemma Rlt_RoppO:(r:R)``r<0``->``-r>0``.
+Intros; Rewrite <- Ropp_O; Auto with real.
+Qed.
+Hints Resolve Rgt_RoppO Rlt_RoppO: real.
+
+(**********)
+Lemma Rle_RO_Ropp:(r:R) ``0 <= r`` -> ``0 >= -r``.
+Intros; Replace ``0`` with ``-0``; Auto with real.
+Qed.
+Hints Resolve Rle_RO_Ropp : real.
+
+(**********)
+Lemma Rge_RO_Ropp:(r:R) ``0 >= r`` -> ``0 <= -r``.
+Intros; Replace ``0`` with ``-0``; Auto with real.
+Qed.
+Hints Resolve Rge_RO_Ropp : real.
+
+(** Order and multiplication *)
+
+Lemma Rlt_monotony_r:(r,r1,r2:R)``0<r`` -> ``r1 < r2`` -> ``r1*r < r2*r``.
+Intros; Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
+Qed.
+Hints Resolve Rlt_monotony_r.
+
+Lemma Rlt_monotony_contra: (z, x, y:R) ``0<z`` ->``z*x<z*y`` ->``x<y``.
+Intros z x y H H0.
+Case (total_order x y); Intros Eq0; Auto; Elim Eq0; Clear Eq0; Intros Eq0.
+ Rewrite Eq0 in H0;ElimType False;Apply (Rlt_antirefl ``z*y``);Auto.
+Generalize (Rlt_monotony z y x H Eq0);Intro;ElimType False;
+ Generalize (Rlt_trans ``z*x`` ``z*y`` ``z*x`` H0 H1);Intro;
+ Apply (Rlt_antirefl ``z*x``);Auto.
+Qed.
+
+V7only [
+Notation Rlt_monotony_rev := Rlt_monotony_contra.
+Notation "'Rlt_monotony_contra' a b c" := (Rlt_monotony_contra c a b)
+  (at level 10, a,b,c at level 9, only parsing).
+].
+
+Lemma Rlt_anti_monotony:(r,r1,r2:R)``r < 0`` -> ``r1 < r2`` -> ``r*r1 > r*r2``.
+Intros; Replace r with ``-(-r)``; Auto with real.
+Rewrite (Ropp_mul1 ``-r``); Rewrite (Ropp_mul1 ``-r``).
+Apply Rlt_Ropp; Auto with real.
+Qed.
+
+(**********)
+Lemma Rle_monotony: 
+  (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r*r1 <= r*r2``.
+Intros r r1 r2 H H0; NewDestruct H; NewDestruct H0; Unfold Rle; Auto with real.
+Right; Rewrite <- H; Do 2 Rewrite Rmult_Ol; Reflexivity.
+Qed.
+Hints Resolve Rle_monotony : real.
+
+Lemma Rle_monotony_r: 
+  (r,r1,r2:R)``0 <= r`` -> ``r1 <= r2`` -> ``r1*r <= r2*r``.
+Intros r r1 r2 H;
+Rewrite (Rmult_sym r1 r); Rewrite (Rmult_sym r2 r); Auto with real.
+Qed.
+Hints Resolve Rle_monotony_r : real.
+
+Lemma Rmult_le_reg_l:
+  (z, x, y:R) ``0<z`` ->``z*x<=z*y`` ->``x<=y``.
+Intros z x y H H0;Case H0; Auto with real.
+Intros H1; Apply Rlt_le.
+Apply Rlt_monotony_contra with z := z;Auto.
+Intros H1;Replace x with (Rmult (Rinv z) (Rmult z x)); Auto with real.
+Replace y with (Rmult (Rinv z) (Rmult z y)).
+ Rewrite H1;Auto with real.
+Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
+Rewrite <- Rmult_assoc; Rewrite Rinv_l; Auto with real.
+Qed.
+
+V7only [
+Notation "'Rle_monotony_contra' a b c" := (Rmult_le_reg_l c a b)
+  (at level 10, a,b,c at level 9, only parsing).
+Notation Rle_monotony_contra := Rmult_le_reg_l.
+].
+
+
+Lemma Rle_anti_monotony1
+	:(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r2 <= r*r1``.
+Intros; Replace r with ``-(-r)``; Auto with real.
+Do 2 Rewrite (Ropp_mul1 ``-r``).
+Apply Rle_Ropp1; Auto with real.
+Qed.
+Hints Resolve Rle_anti_monotony1 : real.
+
+Lemma Rle_anti_monotony
+	:(r,r1,r2:R)``r <= 0`` -> ``r1 <= r2`` -> ``r*r1 >= r*r2``.
+Intros; Apply Rle_ge; Auto with real.
+Qed.
+Hints Resolve Rle_anti_monotony : real.
+
+Lemma Rle_Rmult_comp:
+  (x, y, z, t:R) ``0 <= x`` -> ``0 <= z`` -> ``x <= y`` -> ``z <= t`` ->
+  ``x*z <= y*t``.
+Intros x y z t H' H'0 H'1 H'2.
+Apply Rle_trans with r2 := ``x*t``; Auto with real.
+Repeat Rewrite [x:?](Rmult_sym x t).
+Apply Rle_monotony; Auto.
+Apply Rle_trans with z; Auto.
+Qed.
+Hints Resolve Rle_Rmult_comp :real.
+
+Lemma Rmult_lt:(r1,r2,r3,r4:R)``r3>0`` -> ``r2>0`` ->
+  `` r1 < r2`` -> ``r3 < r4`` -> ``r1*r3 < r2*r4``.
+Intros; Apply Rlt_trans with ``r2*r3``; Auto with real.
+Qed.
+
+(*********)
+Lemma Rmult_lt_0
+  :(r1,r2,r3,r4:R)``r3>=0``->``r2>0``->``r1<r2``->``r3<r4``->``r1*r3<r2*r4``.
+Intros; Apply Rle_lt_trans with ``r2*r3``; Auto with real.
+Qed.
+
+(** Order and Substractions *)
+Lemma Rlt_minus:(r1,r2:R)``r1 < r2`` -> ``r1-r2 < 0``.
+Intros; Apply (Rlt_anti_compatibility ``r2``).
+Replace ``r2+(r1-r2)`` with r1.
+Replace  ``r2+0`` with r2; Auto with real.
+Ring.
+Qed.
+Hints Resolve Rlt_minus : real.
+
+(**********)
+Lemma Rle_minus:(r1,r2:R)``r1 <= r2`` -> ``r1-r2 <= 0``.
+NewDestruct 1; Unfold Rle; Auto with real.
+Qed.
+
+(**********)
+Lemma Rminus_lt:(r1,r2:R)``r1-r2 < 0`` -> ``r1 < r2``.
+Intros; Replace r1 with ``r1-r2+r2``.
+Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
+Ring.
+Qed.
+
+(**********)
+Lemma Rminus_le:(r1,r2:R)``r1-r2 <= 0`` -> ``r1 <= r2``.
+Intros; Replace r1 with ``r1-r2+r2``.
+Pattern 3 r2; Replace r2 with ``0+r2``; Auto with real.
+Ring.
+Qed.
+
+(**********)
+Lemma tech_Rplus:(r,s:R)``0<=r`` -> ``0<s`` -> ``r+s<>0``.
+Intros; Apply sym_not_eqT; Apply Rlt_not_eq.
+Rewrite Rplus_sym; Replace ``0`` with ``0+0``; Auto with real.
+Qed.
+Hints Immediate tech_Rplus : real.
+
+(** Order and the square function *)
+Lemma pos_Rsqr:(r:R)``0<=(Rsqr r)``.
+Intro; Case (total_order_Rlt_Rle 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.
+Qed.
+
+(***********)
+Lemma pos_Rsqr1:(r:R)``r<>0``->``0<(Rsqr r)``.
+Intros; Case (not_Req 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.
+Qed.
+Hints Resolve pos_Rsqr pos_Rsqr1 : real.
+
+(** Zero is less than one *)
+Lemma Rlt_R0_R1:``0<1``.
+Replace ``1`` with ``(Rsqr 1)``; Auto with real.
+Unfold Rsqr; Auto with real.
+Qed.
+Hints Resolve Rlt_R0_R1 : real.
+
+Lemma Rle_R0_R1:``0<=1``.
+Left.
+Exact Rlt_R0_R1.
+Qed.
+
+(** Order and inverse *)
+Lemma Rlt_Rinv:(r:R)``0<r``->``0</r``.
+Intros; Apply not_Rle; Red; Intros.
+Absurd ``1<=0``; Auto with real.
+Replace ``1`` with ``r*(/r)``; Auto with real.
+Replace ``0`` with ``r*0``; Auto with real.
+Qed.
+Hints Resolve Rlt_Rinv : real.
+
+(*********)
+Lemma Rlt_Rinv2:(r:R)``r < 0``->``/r < 0``.
+Intros; Apply not_Rle; Red; Intros.
+Absurd ``1<=0``; Auto with real.
+Replace ``1`` with ``r*(/r)``; Auto with real.
+Replace ``0`` with ``r*0``; Auto with real.
+Qed.
+Hints Resolve Rlt_Rinv2 : real.
+
+(*********)
+Lemma Rinv_lt:(r1,r2:R)``0 < r1*r2`` -> ``r1 < r2`` -> ``/r2 < /r1``.
+Intros; Apply Rlt_monotony_rev with ``r1*r2``; Auto with real.
+Case (without_div_O_contr r1 r2 ); Intros; Auto with real.
+Replace ``r1*r2*/r2`` with r1.
+Replace ``r1*r2*/r1`` with r2; Trivial.
+Symmetry; Auto with real.
+Symmetry; Auto with real.
+Qed.
+
+Lemma Rlt_Rinv_R1: (x, y:R) ``1 <= x`` -> ``x<y`` ->``/y< /x``.
+Intros x y H' H'0.
+Cut (Rlt R0 x); [Intros Lt0 | Apply Rlt_le_trans with r2 := R1]; 
+  Auto with real.
+Apply Rlt_monotony_contra with z := x; Auto with real.
+Rewrite (Rmult_sym x (Rinv x)); Rewrite Rinv_l; Auto with real.
+Apply Rlt_monotony_contra with z := y; Auto with real.
+Apply Rlt_trans with r2:=x;Auto.
+Cut ``y*(x*/y)==x``.
+Intro H1;Rewrite H1;Rewrite (Rmult_1r y);Auto.
+Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite (Rmult_sym y (Rinv y));
+ Rewrite Rinv_l; Auto with real.
+Apply imp_not_Req; Right.
+Red; Apply Rlt_trans with r2 := x; Auto with real.
+Qed.
+Hints Resolve Rlt_Rinv_R1 :real.
+
+(*********************************************************)        
+(**      Greater                                         *)
+(*********************************************************)
+
+(**********)
+Lemma Rge_ge_eq:(r1,r2:R)``r1 >= r2`` -> ``r2 >= r1`` -> r1==r2.
+Intros; Apply Rle_antisym; Auto with real.
+Qed.
+
+(**********)
+Lemma Rlt_not_ge:(r1,r2:R)~(``r1<r2``)->``r1>=r2``.
+Intros; Unfold Rge; Elim (total_order r1 r2); Intro.
+Absurd ``r1<r2``; Trivial.
+Case H0; Auto.
+Qed.
+
+(**********)
+Lemma Rnot_lt_le:(r1,r2:R)~(``r1<r2``)->``r2<=r1``.
+Intros; Apply Rge_le; Apply Rlt_not_ge; Assumption.
+Qed.
+
+(**********)
+Lemma Rgt_not_le:(r1,r2:R)~(``r1>r2``)->``r1<=r2``.
+Intros r1 r2 H; Apply Rge_le.
+Exact (Rlt_not_ge r2 r1 H).
+Qed.
+
+(**********)
+Lemma Rgt_ge:(r1,r2:R)``r1>r2`` -> ``r1 >= r2``.
+Red; Auto with real.
+Qed.
+
+V7only [
+(**********)
+Lemma Rlt_sym:(r1,r2:R)``r1<r2`` <-> ``r2>r1``.
+Split; Unfold Rgt; Auto with real.
+Qed.
+
+(**********)
+Lemma Rle_sym1:(r1,r2:R)``r1<=r2``->``r2>=r1``.
+Proof Rle_ge.
+
+Notation "'Rle_sym2' a b" := (Rge_le b a)
+  (at level 10, a,b at next level).
+Notation "'Rle_sym2' a" := [b:R](Rge_le b a)
+  (at level 10, a at next level).
+Notation Rle_sym2 := Rge_le.
+(*
+(**********)
+Lemma Rle_sym2:(r1,r2:R)``r2>=r1`` -> ``r1<=r2``.
+Proof [r1,r2](Rge_le r2 r1).
+*)
+
+(**********)
+Lemma Rle_sym:(r1,r2:R)``r1<=r2``<->``r2>=r1``.
+Split; Auto with real.
+Qed.
+].
+
+(**********)
+Lemma Rge_gt_trans:(r1,r2,r3:R)``r1>=r2``->``r2>r3``->``r1>r3``.
+Unfold Rgt; Intros; Apply Rlt_le_trans with r2; Auto with real.
+Qed.
+
+(**********)
+Lemma Rgt_ge_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>=r3`` -> ``r1>r3``.
+Unfold Rgt; Intros; Apply Rle_lt_trans with r2; Auto with real.
+Qed.
+
+(**********)
+Lemma Rgt_trans:(r1,r2,r3:R)``r1>r2`` -> ``r2>r3`` -> ``r1>r3``.
+Unfold Rgt; Intros; Apply Rlt_trans with r2; Auto with real.
+Qed.
+
+(**********)
+Lemma Rge_trans:(r1,r2,r3:R)``r1>=r2`` -> ``r2>=r3`` -> ``r1>=r3``.
+Intros; Apply Rle_ge.
+Apply Rle_trans with r2; Auto with real.
+Qed.
+
+(**********)
+Lemma Rlt_r_plus_R1:(r:R)``0<=r`` -> ``0<r+1``.
+Intros.
+Apply Rlt_le_trans with ``1``; Auto with real.
+Pattern 1 ``1``; Replace ``1`` with ``0+1``; Auto with real.
+Qed.
+Hints Resolve Rlt_r_plus_R1: real.
+
+(**********)
+Lemma Rlt_r_r_plus_R1:(r:R)``r<r+1``.
+Intros.
+Pattern 1 r; Replace r with ``r+0``; Auto with real.
+Qed.
+Hints Resolve Rlt_r_r_plus_R1: real.
+
+(**********)
+Lemma tech_Rgt_minus:(r1,r2:R)``0<r2``->``r1>r1-r2``.
+Red; Unfold Rminus; Intros.
+Pattern 2 r1; Replace r1 with ``r1+0``; Auto with real.
+Qed.
+
+(***********)
+Lemma Rgt_plus_plus_r:(r,r1,r2:R)``r1>r2``->``r+r1 > r+r2``.
+Unfold Rgt; Auto with real.
+Qed.
+Hints Resolve Rgt_plus_plus_r : real.
+
+(***********)
+Lemma Rgt_r_plus_plus:(r,r1,r2:R)``r+r1 > r+r2`` -> ``r1 > r2``.
+Unfold Rgt; Intros; Apply (Rlt_anti_compatibility r r2 r1 H).
+Qed.
+
+(***********)
+Lemma Rge_plus_plus_r:(r,r1,r2:R)``r1>=r2`` -> ``r+r1 >= r+r2``.
+Intros; Apply Rle_ge; Auto with real.
+Qed.
+Hints Resolve Rge_plus_plus_r : real.
+
+(***********)
+Lemma Rge_r_plus_plus:(r,r1,r2:R)``r+r1 >= r+r2`` -> ``r1>=r2``.
+Intros; Apply Rle_ge; Apply Rle_anti_compatibility with r; Auto with real.
+Qed.
+
+(***********)
+Lemma Rmult_ge_compat_r:
+ (z,x,y:R) ``z>=0`` -> ``x>=y`` -> ``x*z >= y*z``.
+Intros z x y; Intros; Apply Rle_ge; Apply Rle_monotony_r; Apply Rge_le; Assumption.
+Qed.
+
+V7only [
+Notation "'Rge_monotony' a b c" := (Rmult_ge_compat_r c a b)
+  (at level 10, a,b,c at level 9, only parsing).
+Notation Rge_monotony := Rmult_ge_compat_r.
+].
+
+(***********)
+Lemma Rgt_minus:(r1,r2:R)``r1>r2`` -> ``r1-r2 > 0``.
+Intros; Replace ``0`` with ``r2-r2``; Auto with real.
+Unfold Rgt Rminus; Auto with real.
+Qed.
+
+(*********)
+Lemma minus_Rgt:(r1,r2:R)``r1-r2 > 0`` -> ``r1>r2``.
+Intros; Replace r2 with ``r2+0``; Auto with real.
+Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
+Qed.
+
+(**********)
+Lemma Rge_minus:(r1,r2:R)``r1>=r2`` -> ``r1-r2 >= 0``.
+Unfold Rge; Intros; Elim H; Intro.
+Left; Apply (Rgt_minus r1 r2 H0).
+Right; Apply (eq_Rminus r1 r2 H0).
+Qed.
+
+(*********)
+Lemma minus_Rge:(r1,r2:R)``r1-r2 >= 0`` -> ``r1>=r2``.
+Intros; Replace r2 with ``r2+0``; Auto with real.
+Intros; Replace r1 with ``r2+(r1-r2)``; Auto with real.
+Qed.
+
+
+(*********)
+Lemma Rmult_gt:(r1,r2:R)``r1>0`` -> ``r2>0`` -> ``r1*r2>0``.
+Unfold Rgt;Intros.
+Replace ``0`` with ``0*r2``; Auto with real.
+Qed.
+
+(*********)
+Lemma Rmult_lt_pos:(x,y:R)``0<x`` -> ``0<y`` -> ``0<x*y``.
+Proof Rmult_gt.
+
+(***********)
+Lemma Rplus_eq_R0_l:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``.
+Intros a b [H|H] H0 H1; Auto with real.
+Absurd ``0<a+b``.
+Rewrite H1; Auto with real.
+Replace ``0`` with ``0+0``; Auto with real.
+Qed.
+
+
+Lemma Rplus_eq_R0
+	:(a,b:R)``0<=a`` -> ``0<=b`` -> ``a+b==0`` -> ``a==0``/\``b==0``.
+Intros a b; Split.
+Apply Rplus_eq_R0_l with b; Auto with real.
+Apply Rplus_eq_R0_l with a; Auto with real.
+Rewrite Rplus_sym; Auto with real.
+Qed.
+
+
+(***********)
+Lemma Rplus_Rsr_eq_R0_l:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``.
+Intros a b; Intros; Apply Rsqr_r_R0; Apply Rplus_eq_R0_l with (Rsqr b); Auto with real.
+Qed.
+
+Lemma Rplus_Rsr_eq_R0:(a,b:R)``(Rsqr a)+(Rsqr b)==0``->``a==0``/\``b==0``.
+Intros a b; Split.
+Apply Rplus_Rsr_eq_R0_l with b; Auto with real.
+Apply Rplus_Rsr_eq_R0_l with a; Auto with real.
+Rewrite Rplus_sym; Auto with real.
+Qed.
+
+
+(**********************************************************) 
+(**       Injection from [N] to [R]                       *)
+(**********************************************************)
+
+(**********)
+Lemma S_INR:(n:nat)(INR (S n))==``(INR n)+1``.
+Intro; Case n; Auto with real.
+Qed.
+
+(**********)
+Lemma S_O_plus_INR:(n:nat)
+    (INR (plus (S O) n))==``(INR (S O))+(INR n)``.
+Intro; Simpl; Case n; Intros; Auto with real.
+Qed.
+
+(**********)
+Lemma plus_INR:(n,m:nat)(INR (plus n m))==``(INR n)+(INR m)``. 
+Intros n m; Induction n.
+Simpl; Auto with real.
+Replace (plus (S n) m) with (S (plus n m)); Auto with arith.
+Repeat Rewrite S_INR.
+Rewrite Hrecn; Ring.
+Qed.
+
+(**********)
+Lemma minus_INR:(n,m:nat)(le m n)->(INR (minus n m))==``(INR n)-(INR m)``.
+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.
+Rewrite H0; Ring.
+Qed.
+
+(*********)
+Lemma mult_INR:(n,m:nat)(INR (mult n m))==(Rmult (INR n) (INR m)).
+Intros n m; Induction n.
+Simpl; Auto with real.
+Intros; Repeat Rewrite S_INR; Simpl.
+Rewrite plus_INR; Rewrite Hrecn; Ring.
+Qed.
+
+Hints Resolve plus_INR minus_INR mult_INR : real.
+
+(*********)
+Lemma lt_INR_0:(n:nat)(lt O n)->``0 < (INR n)``.
+Induction 1; Intros; Auto with real.
+Rewrite S_INR; Auto with real.
+Qed.
+Hints Resolve lt_INR_0: real.
+
+Lemma lt_INR:(n,m:nat)(lt n m)->``(INR n) < (INR m)``.
+Induction 1; Intros; Auto with real.
+Rewrite S_INR; Auto with real.
+Rewrite S_INR; Apply Rlt_trans with (INR m0); Auto with real.
+Qed.
+Hints Resolve lt_INR: real.
+
+Lemma INR_lt_1:(n:nat)(lt (S O) n)->``1 < (INR n)``.
+Intros;Replace ``1`` with (INR (S O));Auto with real.
+Qed.
+Hints Resolve INR_lt_1: real.
+
+(**********)
+Lemma INR_pos : (p:positive)``0<(INR (convert p))``.
+Intro; Apply lt_INR_0.
+Simpl; Auto with real.
+Apply compare_convert_O.
+Qed.
+Hints Resolve INR_pos : real.
+
+(**********)
+Lemma pos_INR:(n:nat)``0 <= (INR n)``.
+Intro n; Case n.
+Simpl; Auto with real.
+Auto with arith real.
+Qed.
+Hints Resolve pos_INR: real.
+
+Lemma INR_lt:(n,m:nat)``(INR n) < (INR m)``->(lt n m).
+Double Induction n m;Intros.
+Simpl;ElimType False;Apply (Rlt_antirefl R0);Auto.
+Auto with arith.
+Generalize (pos_INR (S n0));Intro;Cut (INR O)==R0;
+  [Intro H2;Rewrite H2 in H0;Idtac|Simpl;Trivial]. 
+Generalize (Rle_lt_trans ``0`` (INR (S n0)) ``0`` H1 H0);Intro;
+  ElimType False;Apply (Rlt_antirefl R0);Auto.
+Do 2 Rewrite S_INR in H1;Cut ``(INR n1) < (INR n0)``.
+Intro H2;Generalize (H0 n0 H2);Intro;Auto with arith.
+Apply (Rlt_anti_compatibility ``1`` (INR n1) (INR n0)).
+Rewrite Rplus_sym;Rewrite (Rplus_sym ``1`` (INR n0));Trivial.
+Qed.
+Hints Resolve INR_lt: real.
+
+(*********)
+Lemma le_INR:(n,m:nat)(le n m)->``(INR n)<=(INR m)``.
+Induction 1; Intros; Auto with real.
+Rewrite S_INR.
+Apply Rle_trans with (INR m0); Auto with real.
+Qed.
+Hints Resolve le_INR: real.
+
+(**********)
+Lemma not_INR_O:(n:nat)``(INR n)<>0``->~n=O.
+Red; Intros n H H1.
+Apply H.
+Rewrite H1; Trivial.
+Qed.
+Hints Immediate not_INR_O : real.
+
+(**********)
+Lemma not_O_INR:(n:nat)~n=O->``(INR n)<>0``.
+Intro n; Case n.
+Intro; Absurd (0)=(0); Trivial.
+Intros; Rewrite S_INR.
+Apply Rgt_not_eq; Red; Auto with real.
+Qed.
+Hints Resolve not_O_INR : real.
+
+Lemma not_nm_INR:(n,m:nat)~n=m->``(INR n)<>(INR m)``.
+Intros n m H; Case (le_or_lt n m); Intros H1.
+Case (le_lt_or_eq ? ? H1); Intros H2.
+Apply imp_not_Req; Auto with real.
+ElimType False;Auto.
+Apply sym_not_eqT; Apply imp_not_Req; Auto with real.
+Qed.
+Hints Resolve not_nm_INR : real.
+
+Lemma INR_eq: (n,m:nat)(INR n)==(INR m)->n=m.
+Intros;Case (le_or_lt n m); Intros H1.
+Case (le_lt_or_eq ? ? H1); Intros H2;Auto.
+Cut ~n=m.
+Intro H3;Generalize (not_nm_INR n m H3);Intro H4;
+  ElimType False;Auto.
+Omega.
+Symmetry;Cut ~m=n.
+Intro H3;Generalize (not_nm_INR m n H3);Intro H4;
+  ElimType False;Auto.
+Omega.
+Qed.
+Hints Resolve INR_eq : real.
+
+Lemma INR_le: (n, m : nat) (Rle (INR n) (INR m)) ->  (le n m).
+Intros;Elim H;Intro.
+Generalize (INR_lt n m H0);Intro;Auto with arith.
+Generalize (INR_eq n m H0);Intro;Rewrite H1;Auto.
+Qed.
+Hints Resolve INR_le : real.
+
+Lemma not_1_INR:(n:nat)~n=(S O)->``(INR n)<>1``.
+Replace ``1``  with (INR (S O)); Auto with real.
+Qed.
+Hints Resolve not_1_INR : real.
+
+(**********************************************************) 
+(**      Injection from [Z] to [R]                        *)
+(**********************************************************)
+
+V7only [
+(**********)
+Definition Z_of_nat := inject_nat.
+Notation INZ:=Z_of_nat.
+].
+
+(**********)
+Lemma IZN:(z:Z)(`0<=z`)->(Ex [m:nat] z=(INZ m)).
+Intros z; Unfold INZ; Apply inject_nat_complete; Assumption.
+Qed.
+
+(**********)
+Lemma INR_IZR_INZ:(n:nat)(INR n)==(IZR (INZ n)).
+Induction n; Auto with real.
+Intros; Simpl; Rewrite bij1; Auto with real.
+Qed.
+
+Lemma plus_IZR_NEG_POS : 
+  (p,q:positive)(IZR `(POS p)+(NEG q)`)==``(IZR (POS p))+(IZR (NEG q))``.
+Intros.
+Case (lt_eq_lt_dec (convert p) (convert q)).
+Intros [H | H]; Simpl.
+Rewrite convert_compare_INFERIEUR; Simpl; Trivial.
+Rewrite (true_sub_convert q p).
+Rewrite minus_INR; Auto with arith; Ring.
+Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
+Rewrite (convert_intro p q); Trivial.
+Rewrite convert_compare_EGAL; Simpl; Auto with real.
+Intro H; Simpl.
+Rewrite convert_compare_SUPERIEUR; Simpl; Auto with arith.
+Rewrite (true_sub_convert p q).
+Rewrite minus_INR; Auto with arith; Ring.
+Apply ZC2; Apply convert_compare_INFERIEUR; Trivial.
+Qed.
+
+(**********)
+Lemma plus_IZR:(z,t:Z)(IZR `z+t`)==``(IZR z)+(IZR t)``.
+Intro z; NewDestruct z; Intro t; NewDestruct t; Intros; Auto with real.
+Simpl; Intros; Rewrite convert_add; Auto with real.
+Apply plus_IZR_NEG_POS.
+Rewrite Zplus_sym; Rewrite Rplus_sym; Apply plus_IZR_NEG_POS.
+Simpl; Intros; Rewrite convert_add; Rewrite plus_INR; Auto with real.
+Qed.
+
+(**********)
+Lemma mult_IZR:(z,t:Z)(IZR `z*t`)==``(IZR z)*(IZR t)``.
+Intros z t; Case z; Case t; Simpl; Auto with real.
+Intros t1 z1; Rewrite times_convert; Auto with real.
+Intros t1 z1; Rewrite times_convert; Auto with real.
+Rewrite Rmult_sym.
+Rewrite Ropp_mul1; Auto with real.
+Apply eq_Ropp; Rewrite mult_sym; Auto with real.
+Intros t1 z1; Rewrite times_convert; Auto with real.
+Rewrite Ropp_mul1; Auto with real.
+Intros t1 z1; Rewrite times_convert; Auto with real.
+Rewrite Ropp_mul2; Auto with real.
+Qed.
+
+(**********)
+Lemma Ropp_Ropp_IZR:(z:Z)(IZR (`-z`))==``-(IZR z)``.
+Intro z; Case z; Simpl; Auto with real.
+Qed.
+
+(**********)
+Lemma Z_R_minus:(z1,z2:Z)``(IZR z1)-(IZR z2)``==(IZR `z1-z2`).
+Intros z1 z2; Unfold Rminus; Unfold Zminus.
+Rewrite <-(Ropp_Ropp_IZR z2); Symmetry; Apply plus_IZR.
+Qed. 
+
+(**********)
+Lemma lt_O_IZR:(z:Z)``0 < (IZR z)``->`0<z`.
+Intro z; Case z; Simpl; Intros.
+Absurd ``0<0``; Auto with real.
+Unfold Zlt; Simpl; Trivial.
+Case Rlt_le_not with 1:=H.
+Replace ``0`` with ``-0``; Auto with real.
+Qed.
+
+(**********)
+Lemma lt_IZR:(z1,z2:Z)``(IZR z1)<(IZR z2)``->`z1<z2`.
+Intros z1 z2 H; Apply Zlt_O_minus_lt. 
+Apply lt_O_IZR.
+Rewrite <- Z_R_minus.
+Exact (Rgt_minus (IZR z2) (IZR z1) H).
+Qed.
+
+(**********)
+Lemma eq_IZR_R0:(z:Z)``(IZR z)==0``->`z=0`.
+Intro z; NewDestruct z; Simpl; Intros; Auto with zarith.
+Case (Rlt_not_eq ``0`` (INR (convert p))); Auto with real.
+Case (Rlt_not_eq ``-(INR (convert p))`` ``0`` ); Auto with real.
+Apply Rgt_RoppO. Unfold Rgt; Apply INR_pos.
+Qed.
+
+(**********)
+Lemma eq_IZR:(z1,z2:Z)(IZR z1)==(IZR z2)->z1=z2.
+Intros z1 z2 H;Generalize (eq_Rminus (IZR z1) (IZR z2) H);
+ Rewrite (Z_R_minus z1 z2);Intro;Generalize (eq_IZR_R0 `z1-z2` H0);
+ Intro;Omega.
+Qed.
+
+(**********)
+Lemma not_O_IZR:(z:Z)`z<>0`->``(IZR z)<>0``.
+Intros z H; Red; Intros H0; Case H.
+Apply eq_IZR; Auto.
+Qed.
+
+(*********)
+Lemma le_O_IZR:(z:Z)``0<= (IZR z)``->`0<=z`.
+Unfold Rle; Intros z [H|H].
+Red;Intro;Apply (Zlt_le_weak `0` z (lt_O_IZR z H)); Assumption.
+Rewrite (eq_IZR_R0 z); Auto with zarith real.
+Qed.
+
+(**********)
+Lemma le_IZR:(z1,z2:Z)``(IZR z1)<=(IZR z2)``->`z1<=z2`.
+Unfold Rle; Intros z1 z2 [H|H].
+Apply (Zlt_le_weak z1 z2); Auto with real.
+Apply lt_IZR; Trivial.
+Rewrite (eq_IZR z1 z2); Auto with zarith real.
+Qed.
+
+(**********)
+Lemma le_IZR_R1:(z:Z)``(IZR z)<=1``-> `z<=1`.
+Pattern 1 ``1``; Replace ``1`` with (IZR `1`); Intros; Auto.
+Apply le_IZR; Trivial.
+Qed.
+
+(**********)
+Lemma IZR_ge: (m,n:Z) `m>= n` -> ``(IZR m)>=(IZR n)``.
+Intros m n H; Apply Rlt_not_ge;Red;Intro.
+Generalize (lt_IZR m n H0); Intro; Omega.
+Qed.
+
+Lemma IZR_le: (m,n:Z) `m<= n` -> ``(IZR m)<=(IZR n)``.
+Intros m n H;Apply Rgt_not_le;Red;Intro.
+Unfold Rgt in H0;Generalize (lt_IZR n m H0); Intro; Omega.
+Qed.
+
+Lemma IZR_lt: (m,n:Z) `m< n` -> ``(IZR m)<(IZR n)``.
+Intros m n H;Cut `m<=n`.
+Intro H0;Elim (IZR_le m n H0);Intro;Auto.
+Generalize (eq_IZR m n H1);Intro;ElimType False;Omega.
+Omega.
+Qed.
+
+Lemma one_IZR_lt1 : (z:Z)``-1<(IZR z)<1``->`z=0`.
+Intros z (H1,H2).
+Apply Zle_antisym.
+Apply Zlt_n_Sm_le; Apply lt_IZR; Trivial.
+Replace `0` with (Zs `-1`); Trivial.
+Apply Zlt_le_S; Apply lt_IZR; Trivial.
+Qed.
+
+Lemma one_IZR_r_R1
+  : (r:R)(z,x:Z)``r<(IZR z)<=r+1``->``r<(IZR x)<=r+1``->z=x.
+Intros r z x (H1,H2) (H3,H4).
+Cut `z-x=0`; Auto with zarith.
+Apply one_IZR_lt1.
+Rewrite <- Z_R_minus; Split.
+Replace ``-1`` with ``r-(r+1)``.
+Unfold Rminus; Apply Rplus_lt_le_lt; Auto with real.
+Ring.
+Replace ``1`` with ``(r+1)-r``.
+Unfold Rminus; Apply Rplus_le_lt_lt; Auto with real.
+Ring.
+Qed.
+
+
+(**********)
+Lemma single_z_r_R1: 
+   (r:R)(z,x:Z)``r<(IZR z)``->``(IZR z)<=r+1``->``r<(IZR x)``->
+        ``(IZR x)<=r+1``->z=x.
+Intros; Apply one_IZR_r_R1 with r; Auto.
+Qed.
+
+(**********)
+Lemma tech_single_z_r_R1
+	:(r:R)(z:Z)``r<(IZR z)``->``(IZR z)<=r+1``
+         -> (Ex [s:Z] (~s=z/\``r<(IZR s)``/\``(IZR s)<=r+1``))->False.
+Intros r z H1 H2 (s, (H3,(H4,H5))).
+Apply H3; Apply single_z_r_R1 with r; Trivial.
+Qed.
+
+(*****************************************************************)
+(** Definitions of new types                                     *)
+(*****************************************************************)
+
+Record nonnegreal : Type := mknonnegreal {
+nonneg :> R;
+cond_nonneg : ``0<=nonneg`` }.
+
+Record posreal : Type := mkposreal {
+pos :> R;
+cond_pos : ``0<pos`` }.
+
+Record nonposreal : Type := mknonposreal {
+nonpos :> R;
+cond_nonpos : ``nonpos<=0`` }.
+
+Record negreal : Type := mknegreal {
+neg :> R;
+cond_neg : ``neg<0`` }.
+
+Record nonzeroreal : Type := mknonzeroreal {
+nonzero :> R;
+cond_nonzero : ~``nonzero==0`` }.
+
+(**********)
+Lemma prod_neq_R0 : (x,y:R) ~``x==0``->~``y==0``->~``x*y==0``.
+Intros x y; Intros; Red; Intro; Generalize (without_div_Od x y H1); Intro; Elim H2; Intro; [Rewrite H3 in H; Elim H | Rewrite H3 in H0; Elim H0]; Reflexivity.
+Qed.
+
+(*********)
+Lemma Rmult_le_pos : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x*y``.
+Intros x y H H0; Rewrite <- (Rmult_Ol x); Rewrite <- (Rmult_sym x); Apply (Rle_monotony x R0 y H H0).
+Qed.
+
+Lemma double : (x:R) ``2*x==x+x``.
+Intro; Ring.
+Qed.
+
+Lemma double_var : (x:R) ``x == x/2 + x/2``.
+Intro; Rewrite <- double; Unfold Rdiv; Rewrite <- Rmult_assoc; Symmetry; Apply Rinv_r_simpl_m.
+Replace ``2`` with (INR (2)); [Apply not_O_INR; Discriminate | Unfold INR; Ring].
+Qed.
+
+(**********************************************************)
+(** Other rules about < and <=                            *)
+(**********************************************************)
+
+Lemma gt0_plus_gt0_is_gt0 : (x,y:R) ``0<x`` -> ``0<y`` -> ``0<x+y``.
+Intros x y; Intros; Apply Rlt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
+Qed.
+
+Lemma ge0_plus_gt0_is_gt0 : (x,y:R) ``0<=x`` -> ``0<y`` -> ``0<x+y``.
+Intros x y; Intros; Apply Rle_lt_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rlt_compatibility; Assumption].
+Qed.
+
+Lemma gt0_plus_ge0_is_gt0 : (x,y:R) ``0<x`` -> ``0<=y`` -> ``0<x+y``.
+Intros x y; Intros; Rewrite <- Rplus_sym; Apply ge0_plus_gt0_is_gt0; Assumption.
+Qed.
+
+Lemma ge0_plus_ge0_is_ge0 : (x,y:R) ``0<=x`` -> ``0<=y`` -> ``0<=x+y``.
+Intros x y; Intros; Apply Rle_trans with x; [Assumption | Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption].
+Qed.
+
+Lemma plus_le_is_le : (x,y,z:R) ``0<=y`` -> ``x+y<=z`` -> ``x<=z``.
+Intros x y z; Intros; Apply Rle_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
+Qed.
+
+Lemma plus_lt_is_lt : (x,y,z:R) ``0<=y`` -> ``x+y<z`` -> ``x<z``.
+Intros x y z; Intros; Apply Rle_lt_trans with ``x+y``; [Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Assumption | Assumption].
+Qed.
+
+Lemma Rmult_lt2 : (r1,r2,r3,r4:R) ``0<=r1`` -> ``0<=r3`` -> ``r1<r2`` -> ``r3<r4`` -> ``r1*r3<r2*r4``.
+Intros; Apply Rle_lt_trans with ``r2*r3``; [Apply Rle_monotony_r; [Assumption | Left; Assumption] | Apply Rlt_monotony; [Apply Rle_lt_trans with r1; Assumption | Assumption]].
+Qed.
+
+Lemma le_epsilon : (x,y:R) ((eps : R) ``0<eps``->``x<=y+eps``) -> ``x<=y``.
+Intros x y; Intros; Elim (total_order x y); Intro.
+Left; Assumption.
+Elim H0; Intro.
+Right; Assumption.
+Clear H0; Generalize (Rgt_minus x y H1); Intro H2; Change ``0<x-y`` in H2.
+Cut ``0<2``.
+Intro.
+Generalize (Rmult_lt_pos ``x-y`` ``/2`` H2 (Rlt_Rinv ``2`` H0)); Intro H3; Generalize (H ``(x-y)*/2`` H3); Replace ``y+(x-y)*/2`` with ``(y+x)*/2``.
+Intro H4; Generalize (Rle_monotony ``2`` x ``(y+x)*/2`` (Rlt_le ``0`` ``2`` H0) H4); Rewrite <- (Rmult_sym ``((y+x)*/2)``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Replace ``2*x`` with ``x+x``.
+Rewrite (Rplus_sym y); Intro H5; Apply Rle_anti_compatibility with x; Assumption.
+Ring. 
+Replace ``2`` with (INR (S (S O))); [Apply not_O_INR; Discriminate | Ring].
+Pattern 2 y; Replace y with ``y/2+y/2``.
+Unfold Rminus Rdiv.
+Repeat Rewrite Rmult_Rplus_distrl.
+Ring.
+Cut (z:R) ``2*z == z + z``.
+Intro.
+Rewrite <- (H4 ``y/2``).
+Unfold Rdiv.
+Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
+Replace ``2`` with (INR (2)).
+Apply not_O_INR.
+Discriminate.
+Unfold INR; Reflexivity.
+Intro; Ring.
+Cut ~(O=(2)); [Intro H0; Generalize (lt_INR_0 (2) (neq_O_lt (2) H0)); Unfold INR; Intro; Assumption | Discriminate].
+Qed.
+
+(**********)
+Lemma complet_weak : (E:R->Prop) (bound E) -> (ExT [x:R] (E x)) -> (ExT [m:R] (is_lub E m)).
+Intros; Elim (complet E H H0); Intros; Split with x; Assumption.
+Qed.
diff --git a/theories7/Reals/RList.v b/theories7/Reals/RList.v
new file mode 100644
index 00000000..b89296fb
--- /dev/null
+++ b/theories7/Reals/RList.v
@@ -0,0 +1,427 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: RList.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Inductive Rlist : Type :=
+| nil : Rlist
+| cons : R -> Rlist -> Rlist.
+
+Fixpoint In [x:R;l:Rlist] : Prop :=
+Cases l of
+| nil => False
+| (cons a l') => ``x==a``\/(In x l') end.
+
+Fixpoint Rlength [l:Rlist] : nat :=
+Cases l of
+| nil => O
+| (cons a l') => (S (Rlength l')) end.
+
+Fixpoint MaxRlist [l:Rlist] : R :=
+ Cases l of
+ | nil => R0
+ | (cons a l1) => 
+   Cases l1 of
+   | nil => a
+   | (cons a' l2) => (Rmax a (MaxRlist l1)) 
+   end
+end.
+
+Fixpoint MinRlist [l:Rlist] : R :=
+Cases l of
+ | nil => R1 
+ | (cons a l1) => 
+   Cases l1 of
+   | nil => a
+   | (cons a' l2) => (Rmin a (MinRlist l1)) 
+   end
+end.
+
+Lemma MaxRlist_P1 : (l:Rlist;x:R) (In x l)->``x<=(MaxRlist l)``.
+Intros; Induction l.
+Simpl in H; Elim H.
+Induction l.
+Simpl in H; Elim H; Intro.
+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; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
+Apply Hrecl; Simpl; Tauto.
+Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
+Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
+Apply Hrecl; Simpl; Tauto.
+Apply Rle_trans with (MaxRlist (cons r0 l)); [Apply Hrecl; Simpl; Tauto | Left; Auto with real].
+Reflexivity.
+Qed.
+
+Fixpoint AbsList [l:Rlist] : R->Rlist :=
+[x:R] Cases l of
+| nil => nil
+| (cons a l') => (cons ``(Rabsolu (a-x))/2`` (AbsList l' x))
+end.
+
+Lemma MinRlist_P1 : (l:Rlist;x:R) (In x l)->``(MinRlist l)<=x``.
+Intros; Induction l.
+Simpl in H; Elim H.
+Induction l.
+Simpl in H; Elim H; Intro.
+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; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
+Apply Rle_trans with (MinRlist (cons r0 l)).
+Assumption.
+Apply Hrecl; Simpl; Tauto.
+Apply Hrecl; Simpl; Tauto.
+Apply Rle_trans with (MinRlist (cons r0 l)).
+Apply Rmin_r.
+Apply Hrecl; Simpl; Tauto.
+Reflexivity.
+Qed.
+
+Lemma AbsList_P1 : (l:Rlist;x,y:R) (In y l) -> (In ``(Rabsolu (y-x))/2`` (AbsList l x)).
+Intros; Induction l.
+Elim H.
+Simpl; Simpl in H; Elim H; Intro.
+Left; Rewrite H0; Reflexivity.
+Right; Apply Hrecl; Assumption.
+Qed.
+
+Lemma MinRlist_P2 : (l:Rlist) ((y:R)(In y l)->``0<y``)->``0<(MinRlist l)``.
+Intros; Induction l.
+Apply Rlt_R0_R1.
+Induction l.
+Simpl; Apply H; Simpl; Tauto.
+Replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
+Unfold Rmin; Case (total_order_Rle r (MinRlist (cons r0 l))); Intro.
+Apply H; Simpl; Tauto.
+Apply Hrecl; Intros; Apply H; Simpl; Simpl in H0; Tauto.
+Reflexivity.
+Qed.
+
+Lemma AbsList_P2 : (l:Rlist;x,y:R) (In y (AbsList l x)) -> (EXT z : R | (In z l)/\``y==(Rabsolu (z-x))/2``).
+Intros; Induction l.
+Elim H.
+Elim H; Intro.
+Exists r; Split.
+Simpl; Tauto.
+Assumption.
+Assert H1 := (Hrecl H0); Elim H1; Intros; Elim H2; Clear H2; Intros; Exists x0; Simpl; Simpl in H2; Tauto.
+Qed.
+
+Lemma MaxRlist_P2 : (l:Rlist) (EXT y:R | (In y l)) -> (In (MaxRlist l) l).
+Intros; Induction l.
+Simpl in H; Elim H; Trivial.
+Induction l.
+Simpl; Left; Reflexivity.
+Change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))); Unfold Rmax; Case (total_order_Rle r (MaxRlist (cons r0 l))); Intro.
+Right; Apply Hrecl; Exists r0; Left; Reflexivity.
+Left; Reflexivity.
+Qed.
+
+Fixpoint pos_Rl [l:Rlist] : nat->R :=
+[i:nat] Cases l of
+| nil => R0
+| (cons a l') =>
+ Cases i of
+ | O => a
+ | (S i') => (pos_Rl l' i')
+ end
+end.
+
+Lemma pos_Rl_P1 : (l:Rlist;a:R) (lt O (Rlength l)) -> (pos_Rl (cons a l) (Rlength l))==(pos_Rl l (pred (Rlength l))).
+Intros; Induction l; [Elim (lt_n_O ? H) | Simpl; Case (Rlength l); [Reflexivity | Intro; Reflexivity]].
+Qed.
+
+Lemma pos_Rl_P2 : (l:Rlist;x:R) (In x l)<->(EX i:nat | (lt i (Rlength l))/\x==(pos_Rl l i)).
+Intros; Induction l.
+Split; Intro; [Elim H | Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H1)].
+Split; Intro.
+Elim H; Intro.
+Exists O; Split; [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; 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; Apply S_pred with O; Assumption.
+Exists (pred x0); Split; [Simpl in H1; Apply lt_S_n; Rewrite H5; Assumption | Rewrite <- H5 in H2; Simpl in H2; Assumption].
+Qed.
+
+Lemma Rlist_P1 : (l:Rlist;P:R->R->Prop) ((x:R)(In x l)->(EXT y:R | (P x y))) -> (EXT l':Rlist | (Rlength l)=(Rlength l')/\(i:nat) (lt i (Rlength l))->(P (pos_Rl l i) (pos_Rl l' i))).
+Intros; Induction l.
+Exists nil; Intros; Split; [Reflexivity | Intros; Simpl in H0; Elim (lt_n_O ? H0)].
+Assert H0 : (In r (cons r l)).
+Simpl; Left; Reflexivity.
+Assert H1 := (H ? H0); Assert H2 : (x:R)(In x l)->(EXT y:R | (P x y)).
+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; Rewrite H5; Reflexivity.
+Intros; Elim (zerop i); Intro.
+Rewrite a; Simpl; Assumption.
+Assert H8 : i=(S (pred i)).
+Apply S_pred with O; Assumption.
+Rewrite H8; Simpl; Apply H6; Simpl in H7; Apply lt_S_n; Rewrite <- H8; Assumption.
+Qed.
+
+Definition ordered_Rlist [l:Rlist] : Prop := (i:nat) (lt i (pred (Rlength l))) -> (Rle (pos_Rl l i) (pos_Rl l (S i))).
+
+Fixpoint insert [l:Rlist] : R->Rlist :=
+[x:R] Cases l of
+| nil => (cons x nil)
+| (cons a l') =>
+ Cases (total_order_Rle a x) of
+ | (leftT _) => (cons a (insert l' x))
+ | (rightT _) => (cons x l)
+ end
+end.
+
+Fixpoint cons_Rlist [l:Rlist] : Rlist->Rlist :=
+[k:Rlist] Cases l of
+| nil => k
+| (cons a l') => (cons a (cons_Rlist l' k)) end.
+
+Fixpoint cons_ORlist [k:Rlist] : Rlist->Rlist :=
+[l:Rlist] Cases k of
+| nil => l
+| (cons a k') => (cons_ORlist k' (insert l a))
+end.
+
+Fixpoint app_Rlist [l:Rlist] : (R->R)->Rlist :=
+[f:R->R] Cases l of
+| nil => nil
+| (cons a l') => (cons (f a) (app_Rlist l' f))
+end.
+
+Fixpoint mid_Rlist [l:Rlist] : R->Rlist :=
+[x:R] Cases l of
+| nil => nil
+| (cons a l') => (cons ``(x+a)/2`` (mid_Rlist l' a))
+end.
+
+Definition Rtail [l:Rlist] : Rlist :=
+Cases l of
+| nil => nil
+| (cons a l') => l'
+end.
+
+Definition FF [l:Rlist;f:R->R] : Rlist := 
+Cases l of
+| nil => nil
+| (cons a l') => (app_Rlist (mid_Rlist l' a) f)
+end.
+
+Lemma RList_P0 : (l:Rlist;a:R) ``(pos_Rl (insert l a) O) == a`` \/ ``(pos_Rl (insert l a) O) == (pos_Rl l O)``.
+Intros; Induction l; [Left; Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Right; Reflexivity | Left; Reflexivity]].
+Qed.
+
+Lemma RList_P1 : (l:Rlist;a:R) (ordered_Rlist l) -> (ordered_Rlist (insert l a)).
+Intros; Induction l.
+Simpl; Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
+Simpl; Case (total_order_Rle r a); Intro.
+Assert H1 : (ordered_Rlist l).
+Unfold ordered_Rlist; Unfold ordered_Rlist in H; Intros; Assert H1 : (lt (S i) (pred (Rlength (cons r l)))); [Simpl; Replace (Rlength l) with (S (pred (Rlength l))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; 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; Intros; Induction i.
+Simpl; Assert H3 := (RList_P0 l a); Elim H3; Intro.
+Rewrite H4; Assumption.
+Induction l; [Simpl; Assumption | Rewrite H4; Apply (H O); 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 O; Apply neq_O_lt; Red; Intro; Rewrite <- H3 in H0; Elim (lt_n_O ? H0)].
+Unfold ordered_Rlist; Intros; Induction i; [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 : (l1,l2:Rlist) (ordered_Rlist l2) ->(ordered_Rlist (cons_ORlist l1 l2)).
+Induction l1; [Intros; Simpl; Apply H | Intros; Simpl; Apply H; Apply RList_P1; Assumption].
+Qed.
+
+Lemma RList_P3 : (l:Rlist;x:R) (In x l) <-> (EX i:nat | x==(pos_Rl l i)/\(lt i (Rlength l))).
+Intros; Split; Intro; Induction l.
+Elim H.
+Elim H; Intro; [Exists O; Split; [Apply H0 | Simpl; Apply lt_O_Sn] | Elim (Hrecl H0); Intros; Elim H1; Clear H1; Intros; Exists (S x0); Split; [Apply H1 | Simpl; Apply lt_n_S; Assumption]].
+Elim H; Intros; Elim H0; Intros; Elim (lt_n_O ? H2).
+Simpl; Elim H; Intros; Elim H0; Clear H0; Intros; Induction x0; [Left; Apply H0 | Right; Apply Hrecl; Exists x0; Split; [Apply H0 | Simpl in H1; Apply lt_S_n; Assumption]].
+Qed.
+
+Lemma RList_P4 : (l1:Rlist;a:R) (ordered_Rlist (cons a l1)) -> (ordered_Rlist l1).
+Intros; Unfold ordered_Rlist; Intros; Apply (H (S i)); Simpl; Replace (Rlength l1) with (S (pred (Rlength l1))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H1 in H0; Elim (lt_n_O ? H0)].
+Qed.
+
+Lemma RList_P5 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``(pos_Rl l O)<=x``.
+Intros; Induction l; [Elim H0 | Simpl; Elim H0; Intro; [Rewrite H1; Right; Reflexivity | Apply Rle_trans with (pos_Rl l O); [Apply (H O); Simpl; Induction l; [Elim H1 | Simpl; Apply lt_O_Sn] | Apply Hrecl; [EApply RList_P4; Apply H | Assumption]]]].
+Qed.
+
+Lemma RList_P6 : (l:Rlist) (ordered_Rlist l)<->((i,j:nat)(le i j)->(lt j (Rlength l))->``(pos_Rl l i)<=(pos_Rl l j)``).
+Induction l; Split; Intro.
+Intros; Right; Reflexivity.
+Unfold ordered_Rlist; Intros; Simpl in H0; Elim (lt_n_O ? H0).
+Intros; Induction i; [Induction j; [Right; Reflexivity | Simpl; Apply Rle_trans with (pos_Rl r0 O); [Apply (H0 O); 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 | Apply le_O_n | Simpl in H2; Apply lt_S_n; Assumption]]] | Induction j; [Elim (le_Sn_O ? H1) | 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; Intros; Apply H0; [Apply le_n_Sn | Simpl; Simpl in H1; Apply lt_n_S; Assumption].
+Qed.
+
+Lemma RList_P7 : (l:Rlist;x:R) (ordered_Rlist l) -> (In x l) -> ``x<=(pos_Rl l (pred (Rlength l)))``.
+Intros; Assert H1 := (RList_P6 l); Elim H1; Intros H2 _; Assert H3 := (H2 H); Clear H1 H2; Assert H1 := (RList_P3 l x); Elim H1; 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 O; 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; Intro; Rewrite <- H7 in H5; Elim (lt_n_O ? H5)].
+Qed.
+
+Lemma RList_P8 : (l:Rlist;a,x:R) (In x (insert l a)) <-> x==a\/(In x l).
+Induction l.
+Intros; Split; Intro; Simpl in H; Apply H.
+Intros; Split; Intro; [Simpl in H0; Generalize H0; Case (total_order_Rle r a); Intros; [Simpl in H1; Elim H1; Intro; [Right; Left; Assumption |Elim (H a x); Intros; Elim (H3 H2); Intro; [Left; Assumption | Right; Right; Assumption]] | Simpl in H1; Decompose [or] H1; [Left; Assumption | Right; Left; Assumption | Right; Right; Assumption]]  |  Simpl; Case (total_order_Rle r a); Intro; [Simpl in H0; Decompose [or] H0; [Right; Elim (H a x); Intros; Apply H3; Left | Left | Right; Elim (H a x); Intros; Apply H3; Right] | Simpl in H0; Decompose [or] H0; [Left | Right; Left | Right; Right]]; Assumption].
+Qed.
+
+Lemma RList_P9 : (l1,l2:Rlist;x:R) (In x (cons_ORlist l1 l2)) <-> (In x l1)\/(In x l2).
+Induction l1.
+Intros; Split; Intro; [Simpl in H; Right; Assumption | Simpl; Elim H; Intro; [Elim H0 | Assumption]].
+Intros; Split.
+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; 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 | Left; Assumption] | Right; Elim (RList_P8 l2 r x); Intros _ H3; Apply H3; Right; Assumption].
+Qed.
+
+Lemma RList_P10 : (l:Rlist;a:R) (Rlength (insert l a))==(S (Rlength l)).
+Intros; Induction l; [Reflexivity | Simpl; Case (total_order_Rle r a); Intro; [Simpl; Rewrite Hrecl; Reflexivity | Reflexivity]].
+Qed.
+
+Lemma RList_P11 : (l1,l2:Rlist) (Rlength (cons_ORlist l1 l2))=(plus (Rlength l1) (Rlength l2)).
+Induction l1; [Intro; Reflexivity | 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.
+
+Lemma RList_P12 : (l:Rlist;i:nat;f:R->R) (lt i (Rlength l)) -> (pos_Rl (app_Rlist l f) i)==(f (pos_Rl l i)).
+Induction l; [Intros; Elim (lt_n_O ? H) | Intros; Induction i; [Reflexivity | Simpl; Apply H; Apply lt_S_n; Apply H0]].
+Qed.
+
+Lemma RList_P13 : (l:Rlist;i:nat;a:R) (lt i (pred (Rlength l))) -> ``(pos_Rl (mid_Rlist l a) (S i)) == ((pos_Rl l i)+(pos_Rl l (S i)))/2``.
+Induction l.
+Intros; Simpl in H; Elim (lt_n_O ? H).
+Induction r0.
+Intros; Simpl in H0; Elim (lt_n_O ? H0).
+Intros; Simpl in H1; Induction i.
+Reflexivity.
+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``; Apply H0; Simpl; Apply lt_S_n; Assumption.
+Qed.
+
+Lemma RList_P14 : (l:Rlist;a:R) (Rlength (mid_Rlist l a))=(Rlength l).
+Induction l; Intros; [Reflexivity | Simpl; Rewrite (H r); Reflexivity].
+Qed.
+
+Lemma RList_P15 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 O)==(pos_Rl l2 O) -> (pos_Rl (cons_ORlist l1 l2) O)==(pos_Rl l1 O).
+Intros; Apply Rle_antisym.
+Induction l1; [Simpl; Simpl in H1; Right; Symmetry; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (0))); Intros; Assert H4 : (In (pos_Rl (cons r l1) (0)) (cons r l1))\/(In (pos_Rl (cons r l1) (0)) l2); [Left; Left; Reflexivity | Assert H5 := (H3 H4); Apply RList_P5; [Apply RList_P2; Assumption | Assumption]]].
+Induction l1; [Simpl; Simpl in H1; Right; Assumption | Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (0)) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (pos_Rl (cons_ORlist (cons r l1) l2) (0))); Intros; Apply H3; Exists O; Split; [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 | Rewrite H1; Apply RList_P5; Assumption]]].
+Qed.
+
+Lemma RList_P16 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 (pred (Rlength l2))) -> (pos_Rl (cons_ORlist l1 l2) (pred (Rlength (cons_ORlist l1 l2))))==(pos_Rl l1 (pred (Rlength l1))).
+Intros; Apply Rle_antisym.
+Induction l1.
+Simpl; Simpl in H1; Right; Symmetry; Assumption. 
+Assert H2 : (In (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2)))) (cons_ORlist (cons r l1) l2)); [Elim (RList_P3 (cons_ORlist (cons r l1) l2) (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; Apply lt_n_Sn] | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons_ORlist (cons r l1) l2) (pred (Rlength (cons_ORlist (cons r l1) l2))))); Intros; Assert H5 := (H3 H2); Elim H5; Intro; [Apply RList_P7; Assumption | Rewrite H1; Apply RList_P7; Assumption]].
+Induction l1.
+Simpl; Simpl in H1; Right; Assumption.
+Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Assert 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)); Elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); Intros; Apply H5; Exists (Rlength l1); Split; [Reflexivity | Simpl; Apply lt_n_Sn] | Assert H5 := (H3 H4); Apply RList_P7; [Apply RList_P2; Assumption | Elim (RList_P9 (cons r l1) l2 (pos_Rl (cons r l1) (pred (Rlength (cons r l1))))); Intros; Apply H7; Left; Elim (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; Apply lt_n_Sn]]].
+Qed.
+
+Lemma RList_P17 : (l1:Rlist;x:R;i:nat) (ordered_Rlist l1) -> (In x l1) -> ``(pos_Rl l1 i)<x`` -> (lt i (pred (Rlength l1))) -> ``(pos_Rl l1 (S i))<=x``.
+Induction l1.
+Intros; Elim H0.
+Intros; Induction i.
+Simpl; Elim H1; Intro; [Simpl in H2; Rewrite H4 in H2; Elim (Rlt_antirefl ? H2) | Apply RList_P5; [Apply RList_P4 with r; Assumption | Assumption]].
+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 O); [Apply (H0 O); 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 | Simpl in H3; Apply lt_S_n; Apply lt_trans with (Rlength r0); [Apply H3 | Apply lt_n_Sn]]] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H2))].
+Apply H; Try Assumption; [Apply RList_P4 with r; Assumption | Simpl in H3; Apply lt_S_n; Replace (S (pred (Rlength r0))) with (Rlength r0); [Apply H3 | Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H5 in H3; Elim (lt_n_O ? H3)]].
+Qed.
+
+Lemma RList_P18 : (l:Rlist;f:R->R) (Rlength (app_Rlist l f))=(Rlength l).
+Induction l; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
+Qed.
+
+Lemma RList_P19 : (l:Rlist) ~l==nil -> (EXT r:R | (EXT r0:Rlist | l==(cons r r0))).
+Intros; Induction l; [Elim H; Reflexivity | Exists r; Exists l; Reflexivity].
+Qed.
+
+Lemma RList_P20 : (l:Rlist) (le (2) (Rlength l)) -> (EXT r:R | (EXT r1:R | (EXT l':Rlist | l==(cons r (cons r1 l'))))). 
+Intros; Induction l; [Simpl in H; Elim (le_Sn_O ? H) | Induction l; [Simpl in H; Elim (le_Sn_O ? (le_S_n ? ? H)) | Exists r; Exists r0; Exists l; Reflexivity]].
+Qed.
+
+Lemma RList_P21 : (l,l':Rlist) l==l' -> (Rtail l)==(Rtail l').
+Intros; Rewrite H; Reflexivity.
+Qed.
+
+Lemma RList_P22 : (l1,l2:Rlist) ~l1==nil -> (pos_Rl (cons_Rlist l1 l2) O)==(pos_Rl l1 O).
+Induction l1; [Intros; Elim H; Reflexivity | Intros; Reflexivity].
+Qed.
+
+Lemma RList_P23 : (l1,l2:Rlist) (Rlength (cons_Rlist l1 l2))==(plus (Rlength l1) (Rlength l2)).
+Induction l1; [Intro; Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
+Qed.
+
+Lemma RList_P24 : (l1,l2:Rlist) ~l2==nil -> (pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2)))) == (pos_Rl l2 (pred (Rlength l2))).
+Induction l1.
+Intros; Reflexivity.
+Intros; Rewrite <- (H l2 H0); Induction l2.
+Elim H0; Reflexivity.
+Do 2 Rewrite RList_P23; Replace (plus (Rlength (cons r r0)) (Rlength (cons r1 l2))) with (S (S (plus (Rlength r0) (Rlength l2)))); [Replace (plus (Rlength r0) (Rlength (cons r1 l2))) with (S (plus (Rlength r0) (Rlength l2))); [Reflexivity | Simpl; Apply INR_eq; Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring] | Simpl; Apply INR_eq; Do 3 Rewrite S_INR; Do 2 Rewrite plus_INR; Rewrite S_INR; Ring].
+Qed.
+
+Lemma RList_P25 : (l1,l2:Rlist) (ordered_Rlist l1) -> (ordered_Rlist l2) -> ``(pos_Rl l1 (pred (Rlength l1)))<=(pos_Rl l2 O)`` -> (ordered_Rlist (cons_Rlist l1 l2)).
+Induction l1.
+Intros; Simpl; Assumption.
+Induction r0.
+Intros; Simpl; Simpl in H2; Unfold ordered_Rlist; Intros; Simpl in H3.
+Induction i.
+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 O; 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; Intros; Simpl in H4; Induction i.
+Simpl; Apply (H1 O); 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))``; Apply (H i); Simpl; Apply lt_S_n; Assumption.
+Qed.
+
+Lemma RList_P26 : (l1,l2:Rlist;i:nat) (lt i (Rlength l1)) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l1 i).
+Induction l1.
+Intros; Elim (lt_n_O ? H).
+Intros; Induction i.
+Apply RList_P22; Discriminate.
+Apply (H l2 i); Simpl in H0; Apply lt_S_n; Assumption.
+Qed.
+
+Lemma RList_P27 : (l1,l2,l3:Rlist) (cons_Rlist l1 (cons_Rlist l2 l3))==(cons_Rlist (cons_Rlist l1 l2) l3).
+Induction l1; Intros; [Reflexivity | Simpl; Rewrite (H l2 l3); Reflexivity].
+Qed.
+
+Lemma RList_P28 : (l:Rlist) (cons_Rlist l nil)==l.
+Induction l; [Reflexivity | Intros; Simpl; Rewrite H; Reflexivity].
+Qed.
+
+Lemma RList_P29 : (l2,l1:Rlist;i:nat) (le (Rlength l1) i) -> (lt i (Rlength (cons_Rlist l1 l2))) -> (pos_Rl (cons_Rlist l1 l2) i)==(pos_Rl l2 (minus i (Rlength l1))).
+Induction l2.
+Intros; Rewrite RList_P28 in H0; Elim (lt_n_n ? (le_lt_trans ? ? ? H H0)).
+Intros; Replace (cons_Rlist l1 (cons r r0)) with (cons_Rlist (cons_Rlist l1 (cons r nil)) r0).
+Inversion H0.
+Rewrite <- minus_n_n; Simpl; Rewrite RList_P26.
+Clear l2 r0 H i H0 H1 H2; Induction l1.
+Reflexivity.
+Simpl; Assumption.
+Rewrite RList_P23; Rewrite plus_sym; Simpl; Apply lt_n_Sn.
+Replace (minus (S m) (Rlength l1)) with (S (minus (S m) (S (Rlength l1)))).
+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_sym; Simpl; Rewrite <- H3; Apply le_n_S; Assumption.
+Repeat Rewrite RList_P23; Simpl; Rewrite RList_P23 in H1; Rewrite plus_sym in H1; Simpl in H1; Rewrite (plus_sym (Rlength l1)); Simpl; Rewrite plus_sym; Apply H1.
+Rewrite RList_P23; Rewrite plus_sym; Reflexivity.
+Change (S (minus m (Rlength l1)))=(minus (S m) (Rlength l1)); Apply minus_Sn_m; Assumption.
+Replace (cons r r0) with (cons_Rlist (cons r nil) r0); [Symmetry; Apply RList_P27 | Reflexivity].
+Qed.
diff --git a/theories7/Reals/R_Ifp.v b/theories7/Reals/R_Ifp.v
new file mode 100644
index 00000000..621cca64
--- /dev/null
+++ b/theories7/Reals/R_Ifp.v
@@ -0,0 +1,552 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: R_Ifp.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+(**********************************************************)
+(** Complements for the reals.Integer and fractional part *)
+(*                                                        *)
+(**********************************************************)
+
+Require Rbase.
+Require Omega.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(*********************************************************)
+(**      Fractional part                                 *)
+(*********************************************************)
+
+(**********)
+Definition Int_part:R->Z:=[r:R](`(up r)-1`).
+
+(**********)
+Definition frac_part:R->R:=[r:R](Rminus r (IZR (Int_part r))).
+
+(**********)
+Lemma tech_up:(r:R)(z:Z)(Rlt r (IZR z))->(Rle (IZR z) (Rplus r R1))->
+  z=(up r).
+Intros;Generalize (archimed r);Intro;Elim H1;Intros;Clear H1;
+ Unfold Rgt in H2;Unfold Rminus in H3;
+Generalize (Rle_compatibility r (Rplus (IZR (up r)) 
+ (Ropp r)) R1 H3);Intro;Clear H3;
+ Rewrite (Rplus_sym (IZR (up r)) (Ropp r)) in H1;
+ Rewrite <-(Rplus_assoc r (Ropp r) (IZR (up r))) in H1;
+ Rewrite (Rplus_Ropp_r r) in H1;Elim (Rplus_ne (IZR (up r)));Intros a b;
+ Rewrite b in H1;Clear a b;Apply (single_z_r_R1 r z (up r));Auto with zarith real.
+Qed.
+
+(**********)
+Lemma up_tech:(r:R)(z:Z)(Rle (IZR z) r)->(Rlt r (IZR `z+1`))->
+  `z+1`=(up r).
+Intros;Generalize (Rle_compatibility R1 (IZR z) r H);Intro;Clear H;
+ Rewrite (Rplus_sym R1 (IZR z)) in H1;Rewrite (Rplus_sym R1 r) in H1;
+ Cut (R1==(IZR `1`));Auto with zarith real.
+Intro;Generalize H1;Pattern 1 R1;Rewrite H;Intro;Clear H H1;
+ Rewrite <-(plus_IZR z `1`) in H2;Apply (tech_up r `z+1`);Auto with zarith real.
+Qed.
+
+(**********)
+Lemma fp_R0:(frac_part R0)==R0.
+Unfold frac_part; Unfold Int_part; Elim (archimed R0);
+ Intros; Unfold Rminus;
+ Elim (Rplus_ne (Ropp (IZR `(up R0)-1`))); Intros a b;
+ Rewrite b;Clear a b;Rewrite <- Z_R_minus;Cut (up R0)=`1`.
+Intro;Rewrite H1;
+ Rewrite (eq_Rminus (IZR `1`) (IZR `1`) (refl_eqT R (IZR `1`)));
+ Apply Ropp_O. 
+Elim (archimed R0);Intros;Clear H2;Unfold Rgt in H1;
+ Rewrite (minus_R0 (IZR (up R0))) in H0;
+ Generalize (lt_O_IZR (up R0) H1);Intro;Clear H1;
+ Generalize (le_IZR_R1 (up R0) H0);Intro;Clear H H0;Omega.
+Qed.
+
+(**********)
+Lemma for_base_fp:(r:R)(Rgt (Rminus (IZR (up r)) r) R0)/\ 
+                       (Rle (Rminus (IZR (up r)) r) R1).
+Intro; Split;
+ Cut (Rgt (IZR (up r)) r)/\(Rle (Rminus (IZR (up r)) r) R1).
+Intro; Elim H; Intros.
+Apply (Rgt_minus (IZR (up r)) r H0).
+Apply archimed.
+Intro; Elim H; Intros.
+Exact H1.
+Apply archimed.
+Qed.
+
+(**********)
+Lemma base_fp:(r:R)(Rge (frac_part r) R0)/\(Rlt (frac_part r) R1).
+Intro; Unfold frac_part; Unfold Int_part; Split.
+     (*sup a O*)
+Cut (Rge (Rminus r (IZR (up r))) (Ropp R1)).
+Rewrite <- Z_R_minus;Simpl;Intro; Unfold Rminus;
+ Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
+ Fold (Rminus r (IZR (up r)));
+ Fold (Rminus (Rminus r (IZR (up r))) (Ropp R1));
+ Apply Rge_minus;Auto with zarith real.
+Rewrite <- Ropp_distr2;Apply Rle_Ropp;Elim (for_base_fp r); Auto with zarith real.
+    (*inf a 1*) 
+Cut (Rlt (Rminus r (IZR (up r))) R0).
+Rewrite <- Z_R_minus; Simpl;Intro; Unfold Rminus;
+ Rewrite Ropp_distr1;Rewrite <-Rplus_assoc;
+ Fold (Rminus r (IZR (up r)));Rewrite Ropp_Ropp;
+ Elim (Rplus_ne R1);Intros a b;Pattern 2 R1;Rewrite <-a;Clear a b;
+ Rewrite (Rplus_sym  (Rminus r (IZR (up r))) R1);
+ Apply Rlt_compatibility;Auto with zarith real.
+Elim (for_base_fp r);Intros;Rewrite <-Ropp_O;
+ Rewrite<-Ropp_distr2;Apply Rgt_Ropp;Auto with zarith real.
+Qed.
+
+(*********************************************************)
+(**      Properties                                      *)
+(*********************************************************)
+
+(**********)
+Lemma base_Int_part:(r:R)(Rle (IZR (Int_part r)) r)/\
+                    (Rgt (Rminus (IZR (Int_part r)) r) (Ropp R1)). 
+Intro;Unfold Int_part;Elim (archimed r);Intros.
+Split;Rewrite <- (Z_R_minus (up r) `1`);Simpl.
+Generalize (Rle_minus (Rminus (IZR (up r)) r) R1 H0);Intro;
+ Unfold Rminus in H1;
+ Rewrite (Rplus_assoc (IZR (up r)) (Ropp r) (Ropp R1)) in 
+ H1;Rewrite (Rplus_sym (Ropp r) (Ropp R1)) in H1;
+ Rewrite <-(Rplus_assoc (IZR (up r)) (Ropp R1) (Ropp r)) in
+ H1;Fold (Rminus (IZR (up r)) R1) in H1;
+ Fold (Rminus (Rminus (IZR (up r)) R1) r) in H1;
+ Apply Rminus_le;Auto with zarith real.
+Generalize (Rgt_plus_plus_r (Ropp R1) (IZR (up r)) r H);Intro;
+ Rewrite (Rplus_sym (Ropp R1) (IZR (up r))) in H1;
+ Generalize (Rgt_plus_plus_r (Ropp r) 
+   (Rplus (IZR (up r)) (Ropp R1)) (Rplus (Ropp R1) r) H1);
+ Intro;Clear H H0 H1;
+ Rewrite (Rplus_sym (Ropp r) (Rplus (IZR (up r)) (Ropp R1)))
+ in H2;Fold (Rminus (IZR (up r)) R1) in H2;
+ Fold (Rminus (Rminus (IZR (up r)) R1) r) in H2;
+ Rewrite (Rplus_sym (Ropp r) (Rplus (Ropp R1) r)) in H2;
+ Rewrite (Rplus_assoc (Ropp R1) r (Ropp r)) in H2;
+ Rewrite (Rplus_Ropp_r r) in H2;Elim (Rplus_ne (Ropp R1));Intros a b;
+ Rewrite a in H2;Clear a b;Auto with zarith real.  
+Qed.
+
+(**********)
+Lemma Int_part_INR:(n : nat)  (Int_part (INR n)) = (inject_nat n).
+Intros n; Unfold Int_part.
+Cut (up (INR n)) = (Zplus (inject_nat n) (inject_nat (1))).
+Intros H'; Rewrite H'; Simpl; Ring.
+Apply sym_equal; Apply tech_up; Auto.
+Replace (Zplus (inject_nat n) (inject_nat (1))) with (INZ (S n)).
+Repeat Rewrite <- INR_IZR_INZ.
+Apply lt_INR; Auto.
+Rewrite Zplus_sym; Rewrite <- inj_plus; Simpl; Auto.
+Rewrite plus_IZR; Simpl; Auto with real.
+Repeat Rewrite <- INR_IZR_INZ; Auto with real.
+Qed.
+
+(**********)
+Lemma fp_nat:(r:R)(frac_part r)==R0->(Ex [c:Z](r==(IZR c))).
+Unfold frac_part;Intros;Split with (Int_part r);Apply Rminus_eq; Auto with zarith real.
+Qed.
+
+(**********)
+Lemma R0_fp_O:(r:R)~R0==(frac_part r)->~R0==r.
+Red;Intros;Rewrite <- H0 in H;Generalize fp_R0;Intro;Auto with zarith real.
+Qed.
+
+(**********)
+Lemma Rminus_Int_part1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
+  (Int_part (Rminus r1 r2))=(Zminus (Int_part r1) (Int_part r2)).
+Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
+ Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
+ Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
+ Rewrite (Ropp_O) in H0;
+ Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
+ Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
+ Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
+ Unfold Rgt in H2;
+ Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
+   (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
+ Clear H1;Elim (Rplus_ne R1);Intros a b;Rewrite a in H6;Clear a b H5;
+ Generalize (Rge_minus (frac_part r1) (frac_part r2) H);Intro;Clear H;
+ Fold (Rminus (frac_part r1) (frac_part r2)) in H6;
+ Generalize (Rle_sym2 R0 (Rminus (frac_part r1) (frac_part r2)) H1);
+ Intro;Clear H1 H3 H4 H0 H2;Unfold frac_part in H6 H;
+ Unfold Rminus in H6 H;
+ Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H;
+ Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+  (IZR (Int_part r2))) in H;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H;
+ Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+  (IZR (Int_part r2))) in H;
+ Rewrite <-(Rplus_assoc r1 (Ropp r2) 
+  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H;
+ Fold (Rminus r1 r2) in H;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
+ in H;Generalize (Rle_compatibility 
+  (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R0 
+  (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H);Intro;
+ Clear H;Rewrite (Rplus_sym (Rminus r1 r2)
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
+ Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
+ Unfold Rminus in H0;Fold (Rminus r1 r2) in H0;
+ Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) 
+  (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H0;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
+  (Ropp (IZR (Int_part r1)))) in H0;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in 
+ H0;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H0;
+ Clear a b;
+ Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2)))));
+ Intros a b;Rewrite a in H0;Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) 
+ in H0;Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;
+ Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+ Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H6;
+ Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H6;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H6;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+  (IZR (Int_part r2))) in H6;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H6;
+ Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+  (IZR (Int_part r2))) in H6;
+ Rewrite <-(Rplus_assoc r1 (Ropp r2) 
+  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H6;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H6;
+ Fold (Rminus r1 r2) in H6;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
+ in H6;Generalize (Rlt_compatibility 
+   (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) 
+   (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R1 H6);
+ Intro;Clear H6;
+ Rewrite (Rplus_sym (Rminus r1 r2)
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
+ Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
+ Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
+ Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;Clear a b;
+ Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
+ Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
+ Cut R1==(IZR `1`);Auto with zarith real.
+Intro;Rewrite H1 in H;Clear H1;
+ Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)` `1`) in H;
+ Generalize (up_tech  (Rminus r1 r2) `(Int_part r1)-(Int_part r2)`
+  H0 H);Intros;Clear H H0;Unfold 1 Int_part;Omega.
+Qed.
+
+(**********)
+Lemma Rminus_Int_part2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
+  (Int_part (Rminus r1 r2))=(Zminus (Zminus (Int_part r1) (Int_part r2)) `1`).
+Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;
+ Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
+ Generalize (Rle_Ropp R0 (frac_part r2) H4);Intro;Clear H4;
+ Rewrite (Ropp_O) in H0;
+ Generalize (Rle_sym2 (Ropp (frac_part r2)) R0 H0);Intro;Clear H0;
+ Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
+ Generalize (Rlt_Ropp (frac_part r2) R1 H1);Intro;Clear H1;
+ Unfold Rgt in H2;
+ Generalize (sum_inequa_Rle_lt R0 (frac_part r1) R1 (Ropp R1)
+   (Ropp (frac_part r2)) R0 H0 H3 H2 H4);Intro;Elim H1;Intros;
+ Clear H1;Elim (Rplus_ne (Ropp R1));Intros a b;Rewrite b in H5;
+ Clear a b H6;Generalize (Rlt_minus (frac_part r1) (frac_part r2) H);
+ Intro;Clear H;Fold (Rminus (frac_part r1) (frac_part r2)) in H5;
+ Clear H3 H4 H0 H2;Unfold frac_part in H5 H1;
+ Unfold Rminus in H5 H1;
+ Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H5;
+ Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H5;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H5;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+  (IZR (Int_part r2))) in H5;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H5;
+ Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+  (IZR (Int_part r2))) in H5;
+ Rewrite <-(Rplus_assoc r1 (Ropp r2) 
+  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H5;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H5;
+ Fold (Rminus r1 r2) in H5;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
+ in H5;Generalize (Rlt_compatibility 
+  (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) (Ropp R1) 
+  (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) H5);
+ Intro;Clear H5;Rewrite (Rplus_sym (Rminus r1 r2)
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H;
+ Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H;
+ Unfold Rminus in H;Fold (Rminus r1 r2) in H;
+ Rewrite (Rplus_assoc (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))) 
+  (Rplus (IZR (Int_part r2)) (Ropp (IZR (Int_part r1))))) in H;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r2))) (IZR (Int_part r2))
+  (Ropp (IZR (Int_part r1)))) in H;Rewrite (Rplus_Ropp_l (IZR (Int_part r2))) in 
+ H;Elim (Rplus_ne (Ropp (IZR (Int_part r1))));Intros a b;Rewrite b in H;
+ Clear a b;Rewrite (Rplus_Ropp_r (IZR (Int_part r1))) in H;
+ Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H;
+ Clear a b;Fold (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H;
+ Rewrite (Ropp_distr1 r2 (Ropp (IZR (Int_part r2)))) in H1;
+ Rewrite (Ropp_Ropp (IZR (Int_part r2))) in H1;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus (Ropp r2) (IZR (Int_part r2)))) in H1;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+  (IZR (Int_part r2))) in H1;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (Ropp r2)) in H1;
+ Rewrite (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+  (IZR (Int_part r2))) in H1;
+ Rewrite <-(Rplus_assoc r1 (Ropp r2) 
+  (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2)))) in H1;
+ Rewrite (Rplus_sym (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) in H1;
+ Fold (Rminus r1 r2) in H1;Fold (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) 
+ in H1;Generalize (Rlt_compatibility 
+   (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) 
+   (Rplus (Rminus r1 r2) (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) R0 H1);
+ Intro;Clear H1;
+ Rewrite (Rplus_sym (Rminus r1 r2)
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1)))) in H0;
+ Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rminus (IZR (Int_part r2)) (IZR (Int_part r1))) (Rminus r1 r2)) in H0;
+ Rewrite <-(Ropp_distr2 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+ Rewrite (Rplus_Ropp_r (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
+ Elim (Rplus_ne (Rminus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
+ Rewrite <-(Rplus_Ropp_l R1) in H0;
+ Rewrite <-(Rplus_assoc (Rminus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Ropp R1) R1) in H0;
+ Fold (Rminus (Rminus (IZR (Int_part r1)) (IZR (Int_part r2))) R1) in H0;
+ Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H0;
+ Rewrite (Z_R_minus (Int_part r1) (Int_part r2)) in H;
+ Cut R1==(IZR `1`);Auto with zarith real.
+Intro;Rewrite H1 in H;Rewrite H1 in H0;Clear H1;
+ Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H;
+ Rewrite (Z_R_minus `(Int_part r1)-(Int_part r2)` `1`) in H0;
+ Rewrite <-(plus_IZR `(Int_part r1)-(Int_part r2)-1` `1`) in H0;
+ Generalize (Rlt_le (IZR `(Int_part r1)-(Int_part r2)-1`) (Rminus r1 r2) H);
+ Intro;Clear H;
+ Generalize (up_tech  (Rminus r1 r2) `(Int_part r1)-(Int_part r2)-1`
+  H1 H0);Intros;Clear H0 H1;Unfold 1 Int_part;Omega.
+Qed.
+
+(**********)
+Lemma Rminus_fp1:(r1,r2:R)(Rge (frac_part r1) (frac_part r2))->
+  (frac_part (Rminus r1 r2))==(Rminus (frac_part r1) (frac_part r2)).
+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;
+ Rewrite -> (Ropp_distr1 (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))));
+ Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
+ Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
+ Rewrite -> (Rplus_assoc r1 (Ropp r2)
+             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
+ Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
+             (Rplus (Ropp r2) (IZR (Int_part r2))));
+ Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+             (IZR (Int_part r2)));
+ Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+             (IZR (Int_part r2)));
+ Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
+Qed.
+
+(**********)
+Lemma Rminus_fp2:(r1,r2:R)(Rlt (frac_part r1) (frac_part r2))->
+  (frac_part (Rminus r1 r2))==
+  (Rplus (Rminus (frac_part r1) (frac_part r2)) R1).
+Intros;Unfold frac_part;Generalize (Rminus_Int_part2 r1 r2 H);Intro;
+ Rewrite -> H0;
+ Rewrite <- (Z_R_minus (Zminus (Int_part r1) (Int_part r2)) `1`);
+ Rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));Unfold Rminus;
+ Rewrite -> (Ropp_distr1 (Rplus (IZR (Int_part r1)) (Ropp (IZR (Int_part r2))))
+             (Ropp (IZR `1`)));
+ Rewrite -> (Ropp_distr1 r2 (Ropp (IZR (Int_part r2))));
+ Rewrite -> (Ropp_Ropp (IZR `1`));
+ Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));
+ Rewrite -> (Ropp_distr1 (IZR (Int_part r1)));
+ Rewrite -> (Ropp_Ropp (IZR (Int_part r2)));Simpl;
+ Rewrite <- (Rplus_assoc (Rplus r1 (Ropp r2))
+             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))) R1);
+ Rewrite -> (Rplus_assoc r1 (Ropp r2)
+             (Rplus (Ropp (IZR (Int_part r1))) (IZR (Int_part r2))));
+ Rewrite -> (Rplus_assoc r1 (Ropp (IZR (Int_part r1)))
+             (Rplus (Ropp r2) (IZR (Int_part r2)))); 
+ Rewrite <- (Rplus_assoc (Ropp r2) (Ropp (IZR (Int_part r1)))
+             (IZR (Int_part r2)));
+ Rewrite <- (Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp r2)
+             (IZR (Int_part r2)));
+ Rewrite -> (Rplus_sym (Ropp r2) (Ropp (IZR (Int_part r1))));Auto with zarith real.
+Qed.
+
+(**********)
+Lemma plus_Int_part1:(r1,r2:R)(Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
+  (Int_part (Rplus r1 r2))=(Zplus (Zplus (Int_part r1) (Int_part r2)) `1`).
+Intros;
+ Generalize (Rle_sym2 R1 (Rplus (frac_part r1) (frac_part r2)) H);
+ Intro;Clear H;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H H2;
+ Generalize (Rlt_compatibility (frac_part r2) (frac_part r1) R1 H3);
+ Intro;Clear H3;
+ Generalize (Rlt_compatibility R1 (frac_part r2) R1 H1);Intro;Clear H1;
+ Rewrite (Rplus_sym R1 (frac_part r2)) in H2;
+ Generalize (Rlt_trans (Rplus (frac_part r2) (frac_part r1))
+  (Rplus (frac_part r2) R1) (Rplus R1 R1) H H2);Intro;Clear H H2;
+ Rewrite (Rplus_sym (frac_part r2) (frac_part r1)) in H1;
+ Unfold frac_part in H0 H1;Unfold Rminus in H0 H1;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+  r2) in H1;
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H0;
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H0;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+  r2) in H0;
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H0;
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H0;
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+ Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  R1 (Rplus (Rplus r1 r2)
+           (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H0);Intro;
+ Clear H0;
+ Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rplus (Rplus r1 r2)
+   (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) (Rplus R1 R1) H1);
+ Intro;Clear H1;
+ Rewrite (Rplus_sym (Rplus r1 r2) 
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H;
+ Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H;
+ Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H;
+ Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H;Clear a b;
+ Rewrite (Rplus_sym (Rplus r1 r2) 
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
+ Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
+ Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
+ Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H0;Clear a b;
+ Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1 R1) in 
+ H0;Cut R1==(IZR `1`);Auto with zarith real.
+Intro;Rewrite H1 in H0;Rewrite H1 in H;Clear H1;
+ Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H; 
+ Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
+ Rewrite <-(plus_IZR `(Int_part r1)+(Int_part r2)` `1`) in H;
+ 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 (Rplus r1 r2) `(Int_part r1)+(Int_part r2)+1` H H0);Intro;
+ Clear H H0;Unfold 1 Int_part;Omega.
+Qed.
+
+(**********)
+Lemma plus_Int_part2:(r1,r2:R)(Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
+  (Int_part (Rplus r1 r2))=(Zplus (Int_part r1) (Int_part r2)).
+Intros;Elim (base_fp r1);Elim (base_fp r2);Intros;Clear H1 H3;
+ Generalize (Rle_sym2 R0 (frac_part r2) H0);Intro;Clear H0;
+ Generalize (Rle_sym2 R0 (frac_part r1) H2);Intro;Clear H2;
+ Generalize (Rle_compatibility (frac_part r1) R0 (frac_part r2) H1);
+ Intro;Clear H1;Elim (Rplus_ne (frac_part r1));Intros a b;
+ Rewrite a in H2;Clear a b;Generalize (Rle_trans R0 (frac_part r1)
+  (Rplus (frac_part r1) (frac_part r2)) H0 H2);Intro;Clear H0 H2;
+ Unfold frac_part in H H1;Unfold Rminus in H H1;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H1;
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H1;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+  r2) in H1;
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H1;
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H1;
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2))))) in H;
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2)))) in H;
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+  r2) in H;
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2) in H;
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2))))) in H;
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+ Generalize (Rle_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  R0 (Rplus (Rplus r1 r2)
+           (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) H1);Intro;
+ Clear H1;
+ Generalize (Rlt_compatibility (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Rplus (Rplus r1 r2)
+   (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) R1 H);
+ Intro;Clear H;
+ Rewrite (Rplus_sym (Rplus r1 r2) 
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H1;
+ Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H1;
+ Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H1;
+ Elim (Rplus_ne (Rplus r1 r2));Intros a b;Rewrite b in H1;Clear a b;
+ Rewrite (Rplus_sym (Rplus r1 r2) 
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))) in H0;
+ Rewrite <-(Rplus_assoc (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) (Rplus r1 r2)) in H0;
+ Rewrite (Rplus_Ropp_r (Rplus (IZR (Int_part r1)) (IZR (Int_part r2)))) in H0;
+ Elim (Rplus_ne (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))));Intros a b;
+ Rewrite a in H0;Clear a b;Elim (Rplus_ne (Rplus r1 r2));Intros a b;
+ Rewrite b in H0;Clear a b;Cut R1==(IZR `1`);Auto with zarith real.
+Intro;Rewrite H in H1;Clear H;
+ Rewrite <-(plus_IZR (Int_part r1) (Int_part r2)) in H0;
+ 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 (Rplus r1 r2) `(Int_part r1)+(Int_part r2)` H0 H1);Intro;
+ Clear H0 H1;Unfold 1 Int_part;Omega.
+Qed.
+
+(**********)
+Lemma plus_frac_part1:(r1,r2:R)
+  (Rge (Rplus (frac_part r1) (frac_part r2)) R1)->
+                (frac_part (Rplus r1 r2))==
+                (Rminus (Rplus (frac_part r1) (frac_part r2)) R1).
+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;Unfold 3 4 Rminus;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2)))));
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+   r2);
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));
+ Unfold Rminus;
+ Rewrite (Rplus_assoc (Rplus r1 r2) 
+  (Ropp (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))))
+  (Ropp R1));
+ Rewrite <-(Ropp_distr1 (Rplus (IZR (Int_part r1)) (IZR (Int_part r2))) R1);
+ Trivial with zarith real.
+Qed.
+
+(**********)
+Lemma plus_frac_part2:(r1,r2:R)
+  (Rlt (Rplus (frac_part r1) (frac_part r2)) R1)->
+(frac_part (Rplus r1 r2))==(Rplus (frac_part r1) (frac_part r2)).
+Intros;Unfold frac_part;
+ Generalize (plus_Int_part2 r1 r2 H);Intro;Rewrite H0;
+ Rewrite (plus_IZR (Int_part r1) (Int_part r2));Unfold 2 3 Rminus;
+ Rewrite (Rplus_assoc r1 (Ropp (IZR (Int_part r1))) 
+  (Rplus r2 (Ropp (IZR (Int_part r2)))));
+ Rewrite (Rplus_sym r2 (Ropp (IZR (Int_part r2))));
+ Rewrite <-(Rplus_assoc (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))
+  r2);
+ Rewrite (Rplus_sym 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))) r2);
+ Rewrite <-(Rplus_assoc r1 r2 
+  (Rplus (Ropp (IZR (Int_part r1))) (Ropp (IZR (Int_part r2)))));
+ Rewrite <-(Ropp_distr1 (IZR (Int_part r1)) (IZR (Int_part r2)));Unfold Rminus;
+ Trivial with zarith real.
+Qed.
diff --git a/theories7/Reals/R_sqr.v b/theories7/Reals/R_sqr.v
new file mode 100644
index 00000000..fc01a164
--- /dev/null
+++ b/theories7/Reals/R_sqr.v
@@ -0,0 +1,232 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: R_sqr.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rbasic_fun.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(****************************************************)
+(* Rsqr : some results                              *)
+(****************************************************)
+
+Tactic Definition SqRing := Unfold Rsqr; Ring.
+
+Lemma Rsqr_neg : (x:R) ``(Rsqr x)==(Rsqr (-x))``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_times : (x,y:R) ``(Rsqr (x*y))==(Rsqr x)*(Rsqr y)``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_plus : (x,y:R) ``(Rsqr (x+y))==(Rsqr x)+(Rsqr y)+2*x*y``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr x)+(Rsqr y)-2*x*y``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_neg_minus : (x,y:R) ``(Rsqr (x-y))==(Rsqr (y-x))``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_1 : ``(Rsqr 1)==1``.
+SqRing.
+Qed.
+
+Lemma Rsqr_gt_0_0 : (x:R) ``0<(Rsqr x)`` -> ~``x==0``.
+Intros; Red; Intro; Rewrite H0 in H; Rewrite Rsqr_O in H; Elim (Rlt_antirefl ``0`` H).
+Qed.
+
+Lemma Rsqr_pos_lt : (x:R) ~(x==R0)->``0<(Rsqr x)``.
+Intros; Case (total_order R0 x); Intro; [Unfold Rsqr; Apply Rmult_lt_pos; Assumption | Elim H0; Intro; [Elim H; Symmetry; Exact H1 | Rewrite Rsqr_neg; Generalize (Rlt_Ropp x ``0`` H1); Rewrite Ropp_O; Intro; Unfold Rsqr; Apply Rmult_lt_pos; Assumption]].
+Qed.
+
+Lemma Rsqr_div : (x,y:R) ~``y==0`` -> ``(Rsqr (x/y))==(Rsqr x)/(Rsqr y)``.
+Intros; Unfold Rsqr.
+Unfold Rdiv.
+Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc.
+Apply Rmult_mult_r.
+Pattern 2 x; Rewrite Rmult_sym.
+Repeat Rewrite Rmult_assoc.
+Apply Rmult_mult_r.
+Reflexivity.
+Assumption.
+Assumption.
+Qed.
+
+Lemma Rsqr_eq_0 : (x:R) ``(Rsqr x)==0`` -> ``x==0``.
+Unfold Rsqr; Intros; Generalize (without_div_Od x x H); Intro; Elim H0; Intro ; Assumption.
+Qed.
+
+Lemma Rsqr_minus_plus : (a,b:R) ``(a-b)*(a+b)==(Rsqr a)-(Rsqr b)``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_plus_minus : (a,b:R) ``(a+b)*(a-b)==(Rsqr a)-(Rsqr b)``.
+Intros; SqRing.
+Qed.
+
+Lemma Rsqr_incr_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=x`` -> ``0<=y`` -> ``x<=y``.
+Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H1 H1 H2 H2); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H3); Intro; Elim (Rlt_antirefl ``x*x`` H4) | Auto with real]].
+Qed.
+
+Lemma Rsqr_incr_0_var : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``0<=y`` -> ``x<=y``.
+Intros; Case (total_order_Rle x y); Intro; [Assumption | Cut ``y<x``; [Intro; Unfold Rsqr in H; Generalize (Rmult_lt2 y x y x H0 H0 H1 H1); Intro; Generalize (Rle_lt_trans ``x*x`` ``y*y`` ``x*x`` H H2); Intro; Elim (Rlt_antirefl ``x*x`` H3) | Auto with real]].
+Qed.
+
+Lemma Rsqr_incr_1 : (x,y:R) ``x<=y``->``0<=x``->``0<= y``->``(Rsqr x)<=(Rsqr y)``.
+Intros; Unfold Rsqr; Apply Rle_Rmult_comp; Assumption.
+Qed.
+
+Lemma Rsqr_incrst_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)``->``0<=x``->``0<=y``-> ``x<y``.
+Intros; Case (total_order x y); Intro; [Assumption | Elim H2; Intro; [Rewrite H3 in H; Elim (Rlt_antirefl (Rsqr y) H) | Generalize (Rmult_lt2 y x y x H1 H1 H3 H3); Intro; Unfold Rsqr in H; Generalize (Rlt_trans ``x*x`` ``y*y`` ``x*x`` H H4); Intro; Elim (Rlt_antirefl ``x*x`` H5)]].
+Qed.
+
+Lemma Rsqr_incrst_1 : (x,y:R) ``x<y``->``0<=x``->``0<=y``->``(Rsqr x)<(Rsqr y)``.
+Intros; Unfold Rsqr; Apply Rmult_lt2; Assumption.
+Qed.
+
+Lemma Rsqr_neg_pos_le_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)``->``0<=y``->``-y<=x``.
+Intros; Case (case_Rabsolu x); Intro.
+Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Rewrite (Rsqr_neg x) in H; Generalize (Rsqr_incr_0 (Ropp x) y H H2 H0); Intro; Rewrite <- (Ropp_Ropp x); Apply Rge_Ropp; Apply Rle_sym1; Assumption.
+Apply Rle_trans with ``0``; [Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption | Apply Rle_sym2; Assumption].
+Qed.
+
+Lemma Rsqr_neg_pos_le_1 : (x,y:R) ``(-y)<=x`` -> ``x<=y`` -> ``0<=y`` -> ``(Rsqr x)<=(Rsqr y)``.
+Intros; Case (case_Rabsolu x); Intro.
+Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H2); Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H4); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
+Generalize (Rle_sym2 ``0`` x r); Intro; Apply Rsqr_incr_1; Assumption.
+Qed.
+
+Lemma neg_pos_Rsqr_le : (x,y:R) ``(-y)<=x``->``x<=y``->``(Rsqr x)<=(Rsqr y)``.
+Intros; Case (case_Rabsolu x); Intro.
+Generalize (Rlt_Ropp x ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rle_Ropp ``-y`` x H); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-x`` y H2); Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Generalize (Rle_trans ``0`` ``-x`` y H4 H3); Intro; Rewrite (Rsqr_neg x); Apply Rsqr_incr_1; Assumption.
+Generalize (Rle_sym2 ``0`` x r); Intro; Generalize (Rle_trans ``0`` x y H1 H0); Intro; Apply Rsqr_incr_1; Assumption.
+Qed.
+
+Lemma Rsqr_abs : (x:R) ``(Rsqr x)==(Rsqr (Rabsolu x))``.
+Intro; Unfold Rabsolu; Case (case_Rabsolu x); Intro; [Apply Rsqr_neg | Reflexivity].
+Qed.
+
+Lemma Rsqr_le_abs_0 : (x,y:R) ``(Rsqr x)<=(Rsqr y)`` -> ``(Rabsolu x)<=(Rabsolu y)``.
+Intros; Apply Rsqr_incr_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
+Qed.
+
+Lemma Rsqr_le_abs_1 : (x,y:R) ``(Rabsolu x)<=(Rabsolu y)`` -> ``(Rsqr x)<=(Rsqr y)``.
+Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incr_1 (Rabsolu x) (Rabsolu y)  H (Rabsolu_pos x) (Rabsolu_pos y)).
+Qed.
+
+Lemma Rsqr_lt_abs_0 : (x,y:R) ``(Rsqr x)<(Rsqr y)`` -> ``(Rabsolu x)<(Rabsolu y)``.
+Intros; Apply Rsqr_incrst_0; Repeat Rewrite <- Rsqr_abs; [Assumption | Apply Rabsolu_pos | Apply Rabsolu_pos].
+Qed.
+
+Lemma Rsqr_lt_abs_1 : (x,y:R) ``(Rabsolu x)<(Rabsolu y)`` -> ``(Rsqr x)<(Rsqr y)``.
+Intros; Rewrite (Rsqr_abs x); Rewrite (Rsqr_abs y); Apply (Rsqr_incrst_1 (Rabsolu x) (Rabsolu y)  H (Rabsolu_pos x) (Rabsolu_pos y)).
+Qed.
+
+Lemma Rsqr_inj : (x,y:R) ``0<=x`` -> ``0<=y`` -> (Rsqr x)==(Rsqr y) -> x==y.
+Intros; Generalize (Rle_le_eq (Rsqr x) (Rsqr y)); Intro; Elim H2; Intros _ H3; Generalize (H3 H1); Intro; Elim H4; Intros; Apply Rle_antisym; Apply Rsqr_incr_0; Assumption.
+Qed.
+
+Lemma Rsqr_eq_abs_0 : (x,y:R) (Rsqr x)==(Rsqr y) -> (Rabsolu x)==(Rabsolu y).
+Intros; Unfold Rabsolu; Case (case_Rabsolu x); Case (case_Rabsolu y); Intros.
+Rewrite -> (Rsqr_neg x) in H; Rewrite -> (Rsqr_neg y) in H; Generalize (Rlt_Ropp y ``0`` r); Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intros; Generalize (Rlt_le ``0`` ``-x`` H0); Generalize (Rlt_le ``0`` ``-y`` H1); Intros; Apply Rsqr_inj; Assumption.
+Rewrite -> (Rsqr_neg x) in H; Generalize (Rle_sym2 ``0`` y r); Intro; Generalize (Rlt_Ropp x ``0`` r0); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-x`` H1); Intro; Apply Rsqr_inj; Assumption.
+Rewrite -> (Rsqr_neg y) in H; Generalize (Rle_sym2 ``0`` x r0); Intro; Generalize (Rlt_Ropp y ``0`` r); Rewrite Ropp_O; Intro; Generalize (Rlt_le ``0`` ``-y`` H1); Intro; Apply Rsqr_inj; Assumption.
+Generalize (Rle_sym2 ``0`` x r0); Generalize (Rle_sym2 ``0`` y r); Intros; Apply Rsqr_inj; Assumption.
+Qed.
+
+Lemma Rsqr_eq_asb_1 : (x,y:R) (Rabsolu x)==(Rabsolu y) -> (Rsqr x)==(Rsqr y).
+Intros; Cut ``(Rsqr (Rabsolu x))==(Rsqr (Rabsolu y))``.
+Intro; Repeat Rewrite <- Rsqr_abs in H0; Assumption.
+Rewrite H; Reflexivity.
+Qed.
+
+Lemma triangle_rectangle : (x,y,z:R) ``0<=z``->``(Rsqr x)+(Rsqr y)<=(Rsqr z)``->``-z<=x<=z`` /\``-z<=y<=z``.
+Intros; Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H0); Rewrite Rplus_sym in H0; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H0); Intros; Split; [Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption] | Split; [Apply Rsqr_neg_pos_le_0; Assumption | Apply Rsqr_incr_0_var; Assumption]].
+Qed.
+
+Lemma triangle_rectangle_lt : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<(Rsqr z)`` -> ``(Rabsolu x)<(Rabsolu z)``/\``(Rabsolu y)<(Rabsolu z)``.
+Intros; Split; [Generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_lt_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_lt_abs_0; Assumption].
+Qed.
+
+Lemma triangle_rectangle_le : (x,y,z:R) ``(Rsqr x)+(Rsqr y)<=(Rsqr z)`` -> ``(Rabsolu x)<=(Rabsolu z)``/\``(Rabsolu y)<=(Rabsolu z)``.
+Intros; Split; [Generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (pos_Rsqr y) H); Intro; Apply Rsqr_le_abs_0; Assumption | Rewrite Rplus_sym in H; Generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (pos_Rsqr x) H); Intro; Apply Rsqr_le_abs_0; Assumption].
+Qed.
+
+Lemma Rsqr_inv : (x:R) ~``x==0`` -> ``(Rsqr (/x))==/(Rsqr x)``.
+Intros; Unfold Rsqr.
+Rewrite Rinv_Rmult; Try Reflexivity Orelse Assumption.
+Qed.
+
+Lemma canonical_Rsqr : (a:nonzeroreal;b,c,x:R) ``a*(Rsqr x)+b*x+c == a* (Rsqr (x+b/(2*a))) + (4*a*c - (Rsqr b))/(4*a)``.
+Intros.
+Rewrite Rsqr_plus.
+Repeat Rewrite Rmult_Rplus_distr.
+Repeat Rewrite Rplus_assoc.
+Apply Rplus_plus_r.
+Unfold Rdiv Rminus.
+Replace ``2*1+2*1`` with ``4``; [Idtac | Ring].
+Rewrite (Rmult_Rplus_distrl ``4*a*c`` ``-(Rsqr b)`` ``/(4*a)``).
+Rewrite Rsqr_times.
+Repeat Rewrite Rinv_Rmult.
+Repeat Rewrite (Rmult_sym a).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym ``/2``).
+Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym a).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Repeat Rewrite Rplus_assoc.
+Rewrite (Rplus_sym ``(Rsqr b)*((Rsqr (/a*/2))*a)``).
+Repeat Rewrite Rplus_assoc.
+Rewrite (Rmult_sym x).
+Apply Rplus_plus_r.
+Rewrite (Rmult_sym ``/a``).
+Unfold Rsqr; Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Ring.
+Apply (cond_nonzero a).
+DiscrR.
+Apply (cond_nonzero a).
+DiscrR.
+DiscrR.
+Apply (cond_nonzero a).
+DiscrR.
+DiscrR.
+DiscrR.
+Apply (cond_nonzero a).
+DiscrR.
+Apply (cond_nonzero a).
+Qed.
+
+Lemma Rsqr_eq : (x,y:R) (Rsqr x)==(Rsqr y) -> x==y \/ x==``-y``.
+Intros; Unfold Rsqr in H; Generalize (Rplus_plus_r ``-(y*y)`` ``x*x`` ``y*y`` H); Rewrite Rplus_Ropp_l; Replace ``-(y*y)+x*x`` with ``(x-y)*(x+y)``.
+Intro; Generalize (without_div_Od ``x-y`` ``x+y`` H0); Intro; Elim H1; Intros.
+Left; Apply Rminus_eq; Assumption.
+Right; Apply Rminus_eq; Unfold Rminus; Rewrite Ropp_Ropp; Assumption.
+Ring.
+Qed.
diff --git a/theories7/Reals/R_sqrt.v b/theories7/Reals/R_sqrt.v
new file mode 100644
index 00000000..8c87659b
--- /dev/null
+++ b/theories7/Reals/R_sqrt.v
@@ -0,0 +1,251 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: R_sqrt.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rsqrt_def.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(* Here is a continuous extension of Rsqrt on R *)
+Definition sqrt : R->R := [x:R](Cases (case_Rabsolu x) of
+      (leftT _) => R0
+    | (rightT a) => (Rsqrt (mknonnegreal x (Rle_sym2 ? ? a))) end).
+
+Lemma sqrt_positivity : (x:R) ``0<=x`` -> ``0<=(sqrt x)``.
+Intros.
+Unfold sqrt.
+Case (case_Rabsolu x); Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
+Apply Rsqrt_positivity.
+Qed.
+
+Lemma sqrt_sqrt : (x:R) ``0<=x`` -> ``(sqrt x)*(sqrt x)==x``.
+Intros.
+Unfold sqrt.
+Case (case_Rabsolu x); Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? r H)).
+Rewrite Rsqrt_Rsqrt; Reflexivity.
+Qed.
+
+Lemma sqrt_0 : ``(sqrt 0)==0``.
+Apply Rsqr_eq_0; Unfold Rsqr; Apply sqrt_sqrt; Right; Reflexivity. 
+Qed.
+
+Lemma sqrt_1 : ``(sqrt 1)==1``.
+Apply (Rsqr_inj (sqrt R1) R1); [Apply sqrt_positivity; Left | Left | Unfold Rsqr; Rewrite -> sqrt_sqrt; [Ring | Left]]; Apply Rlt_R0_R1.
+Qed.
+
+Lemma sqrt_eq_0 : (x:R) ``0<=x``->``(sqrt x)==0``->``x==0``.
+Intros; Cut ``(Rsqr (sqrt x))==0``.
+Intro; Unfold Rsqr in H1; Rewrite -> sqrt_sqrt in H1; Assumption.
+Rewrite H0; Apply Rsqr_O.
+Qed.
+
+Lemma sqrt_lem_0 : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==y->``y*y==x``.
+Intros; Rewrite <- H1; Apply (sqrt_sqrt x H).
+Qed.
+
+Lemma sqtr_lem_1 : (x,y:R) ``0<=x``->``0<=y``->``y*y==x``->(sqrt x)==y.
+Intros; Apply Rsqr_inj; [Apply (sqrt_positivity x H) | Assumption | Unfold Rsqr; Rewrite -> H1; Apply (sqrt_sqrt x H)].
+Qed.
+
+Lemma sqrt_def : (x:R) ``0<=x``->``(sqrt x)*(sqrt x)==x``.
+Intros; Apply (sqrt_sqrt x H).
+Qed.
+
+Lemma sqrt_square : (x:R) ``0<=x``->``(sqrt (x*x))==x``.
+Intros; Apply (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (pos_Rsqr x)) H); Unfold Rsqr; Apply (sqrt_sqrt (Rsqr x) (pos_Rsqr x)).
+Qed.
+
+Lemma sqrt_Rsqr : (x:R) ``0<=x``->``(sqrt (Rsqr x))==x``.
+Intros; Unfold Rsqr; Apply sqrt_square; Assumption.
+Qed.
+
+Lemma sqrt_Rsqr_abs : (x:R) (sqrt (Rsqr x))==(Rabsolu x).
+Intro x; Rewrite -> Rsqr_abs; Apply sqrt_Rsqr; Apply Rabsolu_pos.
+Qed.
+
+Lemma Rsqr_sqrt : (x:R) ``0<=x``->(Rsqr (sqrt x))==x.
+Intros x H1; Unfold Rsqr; Apply (sqrt_sqrt x H1).
+Qed.
+
+Lemma sqrt_times : (x,y:R) ``0<=x``->``0<=y``->``(sqrt (x*y))==(sqrt x)*(sqrt y)``.
+Intros x y H1 H2; Apply (Rsqr_inj (sqrt (Rmult x y)) (Rmult (sqrt x) (sqrt y)) (sqrt_positivity (Rmult x y) (Rmult_le_pos x y H1 H2)) (Rmult_le_pos (sqrt x) (sqrt y) (sqrt_positivity x H1) (sqrt_positivity y H2))); Rewrite Rsqr_times; Repeat Rewrite Rsqr_sqrt; [Ring | Assumption |Assumption | Apply (Rmult_le_pos x y H1 H2)].
+Qed.
+
+Lemma sqrt_lt_R0 : (x:R) ``0<x`` -> ``0<(sqrt x)``.
+Intros x H1; Apply Rsqr_incrst_0; [Rewrite Rsqr_O; Rewrite Rsqr_sqrt ; [Assumption | Left; Assumption] | Right; Reflexivity | Apply (sqrt_positivity x (Rlt_le R0 x H1))].
+Qed.
+
+Lemma sqrt_div : (x,y:R) ``0<=x``->``0<y``->``(sqrt (x/y))==(sqrt x)/(sqrt y)``.
+Intros x y H1 H2; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply (Rmult_le_pos x (Rinv y)); [ Assumption | Generalize (Rlt_Rinv y H2); Clear H2; Intro H2; Left; Assumption] | Apply (Rmult_le_pos (sqrt x) (Rinv (sqrt y))) ; [ Apply (sqrt_positivity x H1) | Generalize (sqrt_lt_R0 y H2); Clear H2; Intro H2; Generalize (Rlt_Rinv (sqrt y) H2); Clear H2; Intro H2; Left; Assumption] | Rewrite Rsqr_div; Repeat Rewrite Rsqr_sqrt; [ Reflexivity | Left; Assumption | Assumption | Generalize (Rlt_Rinv y H2); Intro H3; Generalize (Rlt_le R0 (Rinv y) H3); Intro H4; Apply (Rmult_le_pos x (Rinv y) H1 H4) |Red; Intro H3; Generalize (Rlt_le R0 y H2); Intro H4; Generalize (sqrt_eq_0 y H4 H3); Intro H5; Rewrite H5 in H2; Elim (Rlt_antirefl R0 H2)]].
+Qed.
+
+Lemma sqrt_lt_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<(sqrt y)``->``x<y``.
+Intros x y H1 H2 H3; Generalize (Rsqr_incrst_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
+Qed.
+
+Lemma sqrt_lt_1 : (x,y:R) ``0<=x``->``0<=y``->``x<y``->``(sqrt x)<(sqrt y)``.
+Intros x y H1 H2 H3; Apply Rsqr_incrst_0; [Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
+Qed.
+
+Lemma sqrt_le_0 : (x,y:R) ``0<=x``->``0<=y``->``(sqrt x)<=(sqrt y)``->``x<=y``.
+Intros x y H1 H2 H3; Generalize (Rsqr_incr_1 (sqrt x) (sqrt y) H3 (sqrt_positivity x H1) (sqrt_positivity y H2)); Intro H4; Rewrite (Rsqr_sqrt x H1) in H4; Rewrite (Rsqr_sqrt y H2) in H4; Assumption.
+Qed.
+
+Lemma sqrt_le_1 : (x,y:R) ``0<=x``->``0<=y``->``x<=y``->``(sqrt x)<=(sqrt y)``.
+Intros x y H1 H2 H3; Apply Rsqr_incr_0; [ Rewrite (Rsqr_sqrt x H1); Rewrite (Rsqr_sqrt y H2); Assumption | Apply (sqrt_positivity x H1) | Apply (sqrt_positivity y H2)].
+Qed.
+
+Lemma sqrt_inj : (x,y:R) ``0<=x``->``0<=y``->(sqrt x)==(sqrt y)->x==y.
+Intros; Cut ``(Rsqr (sqrt x))==(Rsqr (sqrt y))``.
+Intro; Rewrite (Rsqr_sqrt x H) in H2; Rewrite (Rsqr_sqrt y H0) in H2; Assumption.
+Rewrite H1; Reflexivity.
+Qed.
+
+Lemma sqrt_less : (x:R)  ``0<=x``->``1<x``->``(sqrt x)<x``.
+Intros x H1 H2; Generalize (sqrt_lt_1 R1 x (Rlt_le R0 R1 (Rlt_R0_R1)) H1 H2); Intro H3; Rewrite  sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 2 x; Rewrite <- (sqrt_def x H1); Apply (Rlt_monotony (sqrt x) R1 (sqrt x) (sqrt_lt_R0 x (Rlt_trans R0 R1 x Rlt_R0_R1 H2)) H3).
+Qed.
+
+Lemma sqrt_more : (x:R) ``0<x``->``x<1``->``x<(sqrt x)``.
+Intros x H1 H2; Generalize (sqrt_lt_1 x R1 (Rlt_le R0 x H1) (Rlt_le R0 R1 (Rlt_R0_R1)) H2); Intro H3; Rewrite  sqrt_1 in H3; Generalize (Rmult_ne (sqrt x)); Intro H4; Elim H4; Intros H5 H6; Rewrite <- H5; Pattern 1 x; Rewrite <- (sqrt_def x (Rlt_le R0 x H1)); Apply (Rlt_monotony (sqrt x) (sqrt x) R1 (sqrt_lt_R0 x H1) H3).
+Qed.
+
+Lemma sqrt_cauchy : (a,b,c,d:R) ``a*c+b*d<=(sqrt ((Rsqr a)+(Rsqr b)))*(sqrt ((Rsqr c)+(Rsqr d)))``.
+Intros a b c d; Apply Rsqr_incr_0_var; [Rewrite Rsqr_times; 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 ``(a*a*c*c+b*b*d*d)+(a*a*d*d+b*b*c*c)``; [Apply Rle_compatibility; 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 1 ``2*a*b*c*d``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Replace ``a*a*d*d+b*b*c*c-2*a*b*c*d`` with (Rsqr (Rminus (Rmult a d) (Rmult b c))); [Apply pos_Rsqr | Unfold Rsqr; Ring] | Ring] | Ring] | Ring] | Apply (ge0_plus_ge0_is_ge0 (Rsqr c) (Rsqr d) (pos_Rsqr c) (pos_Rsqr d)) | Apply (ge0_plus_ge0_is_ge0 (Rsqr a) (Rsqr b) (pos_Rsqr a) (pos_Rsqr b))] | Apply Rmult_le_pos; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
+Qed.
+
+(************************************************************)
+(* Resolution of [a*X^2+b*X+c=0]                            *)
+(************************************************************)
+
+Definition Delta [a:nonzeroreal;b,c:R] : R := ``(Rsqr b)-4*a*c``.
+
+Definition Delta_is_pos [a:nonzeroreal;b,c:R] : Prop := ``0<=(Delta a b c)``.
+
+Definition sol_x1 [a:nonzeroreal;b,c:R] : R := ``(-b+(sqrt (Delta a b c)))/(2*a)``.
+
+Definition sol_x2 [a:nonzeroreal;b,c:R] : R := ``(-b-(sqrt (Delta a b c)))/(2*a)``.
+
+Lemma Rsqr_sol_eq_0_1 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)) -> ``a*(Rsqr x)+b*x+c==0``.
+Intros; Elim H0; Intro.
+Unfold sol_x1 in H1; Unfold Delta in H1; Rewrite H1; Unfold Rdiv; Repeat Rewrite Rsqr_times; Rewrite Rsqr_plus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
+Rewrite Rsqr_inv.
+Unfold Rsqr; Repeat Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite Rmult_Rplus_distrl.
+Repeat Rewrite Rmult_assoc.
+Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_Rplus_distrl ``-b`` ``(sqrt (b*b-(2*(2*(a*c)))))`` ``(/2*/a)``).
+Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
+Replace ``( -b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*((sqrt (b*b-(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
+Unfold Rminus; Repeat Rewrite <- Rplus_assoc.
+Replace ``b*b+b*b`` with ``2*(b*b)``.
+Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym a); Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite <- Ropp_mul2.
+Ring.
+Apply (cond_nonzero a).
+DiscrR.
+DiscrR.
+DiscrR.
+Ring.
+Ring.
+DiscrR.
+Apply (cond_nonzero a).
+DiscrR.
+Apply (cond_nonzero a).
+Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
+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; Repeat Rewrite Rsqr_times; Rewrite Rsqr_minus; Rewrite <- Rsqr_neg; Rewrite Rsqr_sqrt.
+Rewrite Rsqr_inv.
+Unfold Rsqr; Repeat Rewrite Rinv_Rmult; Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym a); Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Unfold Rminus; Rewrite Rmult_Rplus_distrl.
+Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite (Rmult_Rplus_distrl ``-b`` ``-(sqrt (b*b+ -(2*(2*(a*c))))) `` ``(/2*/a)``).
+Rewrite Rmult_Rplus_distr; Repeat Rewrite Rplus_assoc.
+Rewrite Ropp_mul1; Rewrite Ropp_Ropp.
+Replace ``(b*((sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+(b*( -b*(/2*/a))+(b*( -(sqrt (b*b+ -(2*(2*(a*c)))))*(/2*/a))+c)))`` with ``(b*( -b*(/2*/a)))+c``.
+Repeat Rewrite <- Rplus_assoc; Replace ``b*b+b*b`` with ``2*(b*b)``.
+Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Ropp_mul1; Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite (Rmult_sym ``/2``); Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym a); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite <- Ropp_mul2; Ring.
+Apply (cond_nonzero a).
+DiscrR.
+DiscrR.
+DiscrR.
+Ring.
+Ring.
+DiscrR.
+Apply (cond_nonzero a).
+DiscrR.
+DiscrR.
+Apply (cond_nonzero a).
+Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
+Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
+Apply prod_neq_R0; DiscrR Orelse Apply (cond_nonzero a).
+Assumption.
+Qed.
+
+Lemma Rsqr_sol_eq_0_0 : (a:nonzeroreal;b,c,x:R) (Delta_is_pos a b c) -> ``a*(Rsqr x)+b*x+c==0`` -> (x==(sol_x1 a b c))\/(x==(sol_x2 a b c)).
+Intros; Rewrite (canonical_Rsqr a b c x) in H0; Rewrite Rplus_sym in H0; Generalize (Rplus_Ropp  ``(4*a*c-(Rsqr b))/(4*a)`` ``a*(Rsqr (x+b/(2*a)))`` H0); Cut ``(Rsqr b)-4*a*c==(Delta a b c)``.
+Intro; Replace ``-((4*a*c-(Rsqr b))/(4*a))`` with ``((Rsqr b)-4*a*c)/(4*a)``.
+Rewrite H1; Intro; Generalize (Rmult_mult_r ``/a`` ``a*(Rsqr (x+b/(2*a)))`` ``(Delta a b c)/(4*a)`` H2); Replace ``/a*(a*(Rsqr (x+b/(2*a))))`` with ``(Rsqr (x+b/(2*a)))``.
+Replace ``/a*(Delta a b c)/(4*a)`` with ``(Rsqr ((sqrt (Delta a b c))/(2*a)))``.
+Intro; Generalize (Rsqr_eq ``(x+b/(2*a))`` ``((sqrt (Delta a b c))/(2*a))`` H3); Intro; Elim H4; Intro.
+Left; Unfold sol_x1; Generalize (Rplus_plus_r ``-(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; Ring.
+Ring.
+Right; Unfold sol_x2; Generalize (Rplus_plus_r ``-(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; Ring.
+Ring.
+Rewrite Rsqr_div.
+Rewrite Rsqr_sqrt.
+Unfold Rdiv.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym ``/a``).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_Rmult.
+Replace ``(2*(2*a))*a`` with ``(Rsqr (2*a))``.
+Reflexivity.
+SqRing.
+Rewrite <- Rmult_assoc; Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
+Apply (cond_nonzero a).
+Assumption.
+Apply prod_neq_R0; [DiscrR | Apply (cond_nonzero a)].
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Symmetry; Apply Rmult_1l.
+Apply (cond_nonzero a).
+Unfold Rdiv; Rewrite <- Ropp_mul1.
+Rewrite Ropp_distr2.
+Reflexivity.
+Reflexivity.
+Qed.
diff --git a/theories7/Reals/Ranalysis.v b/theories7/Reals/Ranalysis.v
new file mode 100644
index 00000000..d5d84f50
--- /dev/null
+++ b/theories7/Reals/Ranalysis.v
@@ -0,0 +1,477 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Ranalysis.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rtrigo.
+Require 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.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Axiom AppVar : R.
+
+(**********)
+Recursive Tactic Definition IntroHypG trm :=
+Match trm With
+|[(plus_fct ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
+ | _ -> Idtac)
+|[(minus_fct ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
+ | _ -> Idtac)
+|[(mult_fct ?1 ?2)] ->
+ (Match Context With
+ |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
+ | _ -> Idtac)
+|[(div_fct ?1 ?2)] -> Let aux = ?2 In
+ (Match Context With
+ |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
+ |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1; IntroHypG ?2 | Try Assumption]
+ | _ -> Idtac)
+|[(comp ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable ?)] -> IntroHypG ?1; IntroHypG ?2
+ |[|-(continuity ?)] -> IntroHypG ?1; IntroHypG ?2
+ | _ -> Idtac)
+|[(opp_fct ?1)] -> 
+ (Match Context With
+ |[|-(derivable ?)] -> IntroHypG ?1
+ |[|-(continuity ?)] -> IntroHypG ?1
+ | _ -> Idtac)
+|[(inv_fct ?1)] -> Let aux = ?1 In
+ (Match Context With
+ |[_:(x0:R)``(aux x0)<>0``|-(derivable ?)] -> IntroHypG ?1
+ |[_:(x0:R)``(aux x0)<>0``|-(continuity ?)] -> IntroHypG ?1
+ |[|-(derivable ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1 | Try Assumption]
+ |[|-(continuity ?)] -> Cut ((x0:R)``(aux x0)<>0``); [Intro; IntroHypG ?1| Try Assumption]
+ | _ -> Idtac)
+|[cos] -> Idtac
+|[sin] -> Idtac
+|[cosh] -> Idtac
+|[sinh] -> Idtac
+|[exp] -> Idtac
+|[Rsqr] -> Idtac
+|[sqrt] -> Idtac
+|[id] -> Idtac
+|[(fct_cte ?)] -> Idtac
+|[(pow_fct ?)] -> Idtac
+|[Rabsolu] -> Idtac
+|[?1] -> Let p = ?1 In
+ (Match Context 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).
+
+(**********)
+Recursive Tactic Definition IntroHypL trm pt :=
+Match trm With
+|[(plus_fct ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ | _ -> Idtac)
+|[(minus_fct ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ | _ -> Idtac)
+|[(mult_fct ?1 ?2)] ->
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ | _ -> Idtac)
+|[(div_fct ?1 ?2)] -> Let aux = ?2 In
+ (Match Context With
+ |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt; IntroHypL ?2 pt
+ |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
+ |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt; IntroHypL ?2 pt | Try Assumption]
+ | _ -> Idtac)
+|[(comp ?1 ?2)] -> 
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
+ |[|-(continuity_pt ? ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In IntroHypL ?1 pt_f1; IntroHypL ?2 pt
+ | _ -> Idtac)
+|[(opp_fct ?1)] -> 
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
+ |[|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
+ | _ -> Idtac)
+|[(inv_fct ?1)] -> Let aux = ?1 In
+ (Match Context With
+ |[_:``(aux pt)<>0``|-(derivable_pt ? ?)] -> IntroHypL ?1 pt
+ |[_:``(aux pt)<>0``|-(continuity_pt ? ?)] -> IntroHypL ?1 pt
+ |[_:``(aux pt)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> IntroHypL ?1 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(derivable_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(continuity_pt ? ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
+ |[id:(x0:R)``(aux x0)<>0``|-(eqT ? (derive_pt ? ? ?) ?)] -> Generalize (id pt); Intro; IntroHypL ?1 pt
+ |[|-(derivable_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
+ |[|-(continuity_pt ? ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt| Try Assumption]
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``(aux pt)<>0``; [Intro; IntroHypL ?1 pt | Try Assumption]
+ | _ -> Idtac)
+|[cos] -> Idtac
+|[sin] -> Idtac
+|[cosh] -> Idtac
+|[sinh] -> Idtac
+|[exp] -> Idtac
+|[Rsqr] -> Idtac
+|[id] -> Idtac
+|[(fct_cte ?)] -> Idtac
+|[(pow_fct ?)] -> Idtac
+|[sqrt] ->
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
+ |[|-(continuity_pt ? ?)] -> Cut ``0<=pt``; [Intro | Try Assumption]
+ |[|-(eqT ? (derive_pt ? ? ?) ?)] -> Cut ``0<pt``; [Intro | Try Assumption]
+ | _ -> Idtac)
+|[Rabsolu] ->
+ (Match Context With
+ |[|-(derivable_pt ? ?)] -> Cut ``pt<>0``; [Intro | Try Assumption]
+ | _ -> Idtac)
+|[?1] -> Let p = ?1 In
+ (Match Context 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]
+ |[|-(eqT ? (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).
+ 
+(**********)
+Recursive Tactic Definition IsDiff_pt :=
+Match Context With
+ (* fonctions de base *)
+ [|-(derivable_pt Rsqr ?)] -> Apply derivable_pt_Rsqr
+|[|-(derivable_pt id ?1)] -> Apply (derivable_pt_id ?1)
+|[|-(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; Apply derivable_pt_pow
+|[|-(derivable_pt sqrt ?1)] -> Apply (derivable_pt_sqrt ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
+|[|-(derivable_pt Rabsolu ?1)] -> Apply (derivable_pt_Rabsolu ?1); Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
+ (* regles de differentiabilite *)
+ (* PLUS *)
+|[|-(derivable_pt (plus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_plus ?1 ?2 ?3); IsDiff_pt
+ (* MOINS *)
+|[|-(derivable_pt (minus_fct ?1 ?2) ?3)] -> Apply (derivable_pt_minus ?1 ?2 ?3); IsDiff_pt
+ (* OPPOSE *)
+|[|-(derivable_pt (opp_fct ?1) ?2)] -> Apply (derivable_pt_opp ?1 ?2); IsDiff_pt
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+|[|-(derivable_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (derivable_pt_scal ?2 ?1 ?3); IsDiff_pt
+ (* MULTIPLICATION *)
+|[|-(derivable_pt (mult_fct ?1 ?2) ?3)] -> Apply (derivable_pt_mult ?1 ?2 ?3); IsDiff_pt
+  (* DIVISION *)
+ |[|-(derivable_pt (div_fct ?1 ?2) ?3)] -> Apply (derivable_pt_div ?1 ?2 ?3); [IsDiff_pt | IsDiff_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte]
+  (* INVERSION *)
+ |[|-(derivable_pt (inv_fct ?1) ?2)] -> Apply (derivable_pt_inv ?1 ?2); [Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp pow_fct id fct_cte | IsDiff_pt]
+ (* COMPOSITION *)
+|[|-(derivable_pt (comp ?1 ?2) ?3)] -> Apply (derivable_pt_comp ?2 ?1 ?3); IsDiff_pt
+|[_:(derivable_pt ?1 ?2)|-(derivable_pt ?1 ?2)] -> Assumption
+|[_:(derivable ?1) |- (derivable_pt ?1 ?2)] -> Cut (derivable ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
+|[|-True->(derivable_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_pt
+| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+
+(**********)
+Recursive Tactic Definition IsDiff_glob :=
+Match Context With
+ (* fonctions de base *)
+  [|-(derivable Rsqr)] -> 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; Apply derivable_pow
+  (* regles de differentiabilite *)
+  (* PLUS *)
+ |[|-(derivable (plus_fct ?1 ?2))] -> Apply (derivable_plus ?1 ?2); IsDiff_glob
+  (* MOINS *)
+ |[|-(derivable (minus_fct ?1 ?2))] -> Apply (derivable_minus ?1 ?2); IsDiff_glob
+  (* OPPOSE *)
+ |[|-(derivable (opp_fct ?1))] -> Apply (derivable_opp ?1); IsDiff_glob
+  (* MULTIPLICATION PAR UN SCALAIRE *)
+ |[|-(derivable (mult_real_fct ?1 ?2))] -> Apply (derivable_scal ?2 ?1); IsDiff_glob
+  (* MULTIPLICATION *)
+ |[|-(derivable (mult_fct ?1 ?2))] -> Apply (derivable_mult ?1 ?2); IsDiff_glob
+  (* DIVISION *)
+ |[|-(derivable (div_fct ?1 ?2))] -> Apply (derivable_div ?1 ?2); [IsDiff_glob | IsDiff_glob | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct]
+  (* INVERSION *)
+ |[|-(derivable (inv_fct ?1))] -> Apply (derivable_inv ?1); [Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct | IsDiff_glob]
+  (* COMPOSITION *)
+ |[|-(derivable (comp sqrt ?))] -> Unfold derivable; Intro; Try IsDiff_pt
+ |[|-(derivable (comp Rabsolu ?))] -> Unfold derivable; Intro; Try IsDiff_pt
+ |[|-(derivable (comp ?1 ?2))] -> Apply (derivable_comp ?2 ?1); IsDiff_glob
+ |[_:(derivable ?1)|-(derivable ?1)] -> Assumption
+ |[|-True->(derivable ?)] -> Intro HypTruE; Clear HypTruE; IsDiff_glob
+ | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+
+(**********)
+Recursive Tactic Definition IsCont_pt :=
+Match Context With
+ (* fonctions de base *)
+ [|-(continuity_pt Rsqr ?)] -> Apply derivable_continuous_pt; Apply derivable_pt_Rsqr
+|[|-(continuity_pt id ?1)] -> Apply derivable_continuous_pt; Apply (derivable_pt_id ?1)
+|[|-(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; Apply derivable_continuous_pt; Apply derivable_pt_pow
+|[|-(continuity_pt sqrt ?1)] -> Apply continuity_pt_sqrt; Assumption Orelse Unfold plus_fct minus_fct opp_fct mult_fct div_fct inv_fct comp id fct_cte pow_fct
+|[|-(continuity_pt Rabsolu ?1)] -> Apply (continuity_Rabsolu ?1)
+ (* regles de differentiabilite *)
+ (* PLUS *)
+|[|-(continuity_pt (plus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_plus ?1 ?2 ?3); IsCont_pt
+ (* MOINS *)
+|[|-(continuity_pt (minus_fct ?1 ?2) ?3)] -> Apply (continuity_pt_minus ?1 ?2 ?3); IsCont_pt
+ (* OPPOSE *)
+|[|-(continuity_pt (opp_fct ?1) ?2)] -> Apply (continuity_pt_opp ?1 ?2); IsCont_pt
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+|[|-(continuity_pt (mult_real_fct ?1 ?2) ?3)] -> Apply (continuity_pt_scal ?2 ?1 ?3); IsCont_pt
+ (* MULTIPLICATION *)
+|[|-(continuity_pt (mult_fct ?1 ?2) ?3)] -> Apply (continuity_pt_mult ?1 ?2 ?3); IsCont_pt
+  (* DIVISION *)
+ |[|-(continuity_pt (div_fct ?1 ?2) ?3)] -> Apply (continuity_pt_div ?1 ?2 ?3); [IsCont_pt | IsCont_pt | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
+  (* INVERSION *)
+ |[|-(continuity_pt (inv_fct ?1) ?2)] -> Apply (continuity_pt_inv ?1 ?2); [IsCont_pt | Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct comp id fct_cte pow_fct]
+ (* COMPOSITION *)
+|[|-(continuity_pt (comp ?1 ?2) ?3)] -> Apply (continuity_pt_comp ?2 ?1 ?3); IsCont_pt
+|[_:(continuity_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Assumption
+|[_:(continuity ?1) |- (continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Assumption]
+|[_:(derivable_pt ?1 ?2)|-(continuity_pt ?1 ?2)] -> Apply derivable_continuous_pt; Assumption
+|[_:(derivable ?1)|-(continuity_pt ?1 ?2)] -> Cut (continuity ?1); [Intro HypDDPT; Apply HypDDPT | Apply derivable_continuous; Assumption]
+|[|-True->(continuity_pt ? ?)] -> Intro HypTruE; Clear HypTruE; IsCont_pt
+| _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+
+(**********)
+Recursive Tactic Definition IsCont_glob :=
+Match Context With
+  (* fonctions de base *)
+  [|-(continuity Rsqr)] -> 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; Apply derivable_continuous; Apply derivable_pow
+ |[|-(continuity sinh)] -> Apply derivable_continuous; Apply derivable_sinh
+ |[|-(continuity cosh)] -> Apply derivable_continuous; Apply derivable_cosh
+ |[|-(continuity Rabsolu)] -> Apply continuity_Rabsolu
+ (* regles de continuite *)
+ (* PLUS *)
+|[|-(continuity (plus_fct ?1 ?2))] -> Apply (continuity_plus ?1 ?2); Try IsCont_glob Orelse Assumption
+ (* MOINS *)
+|[|-(continuity (minus_fct ?1 ?2))] -> Apply (continuity_minus ?1 ?2); Try IsCont_glob Orelse Assumption
+ (* OPPOSE *)
+|[|-(continuity (opp_fct ?1))] -> Apply (continuity_opp ?1); Try IsCont_glob Orelse Assumption
+ (* INVERSE *)
+|[|-(continuity (inv_fct ?1))] -> Apply (continuity_inv ?1); Try IsCont_glob Orelse Assumption
+ (* MULTIPLICATION PAR UN SCALAIRE *)
+|[|-(continuity (mult_real_fct ?1 ?2))] -> Apply (continuity_scal ?2 ?1); Try IsCont_glob Orelse Assumption
+ (* MULTIPLICATION *)
+|[|-(continuity (mult_fct ?1 ?2))] -> Apply (continuity_mult ?1 ?2); Try IsCont_glob Orelse Assumption
+  (* DIVISION *)
+ |[|-(continuity (div_fct ?1 ?2))] -> Apply (continuity_div ?1 ?2); [Try IsCont_glob Orelse Assumption | Try IsCont_glob Orelse Assumption | Try Assumption Orelse Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte pow_fct]
+  (* COMPOSITION *)
+ |[|-(continuity (comp sqrt ?))] -> Unfold continuity_pt; Intro; Try IsCont_pt
+ |[|-(continuity (comp ?1 ?2))] -> Apply (continuity_comp ?2 ?1); Try IsCont_glob Orelse Assumption
+ |[_:(continuity ?1)|-(continuity ?1)] -> Assumption
+ |[|-True->(continuity ?)] -> Intro HypTruE; Clear HypTruE; IsCont_glob
+ |[_:(derivable ?1)|-(continuity ?1)] -> Apply derivable_continuous; Assumption
+ | _ -> Try Unfold plus_fct mult_fct div_fct minus_fct opp_fct inv_fct id fct_cte comp pow_fct.
+
+(**********)
+Recursive Tactic Definition RewTerm trm :=
+Match trm With
+| [(Rplus ?1 ?2)] -> Let p1= (RewTerm ?1) And p2 = (RewTerm ?2) In 
+  (Match p1 With
+   [(fct_cte ?3)] -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(fct_cte (Rplus ?3 ?4))
+    | _ -> '(plus_fct p1 p2))
+  | _ -> '(plus_fct p1 p2))
+| [(Rminus ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
+  (Match p1 With
+   [(fct_cte ?3)] -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(fct_cte (Rminus ?3 ?4))
+    | _ -> '(minus_fct p1 p2))
+  | _ -> '(minus_fct p1 p2))
+| [(Rdiv ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
+  (Match p1 With
+   [(fct_cte ?3)] -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
+    | _ -> '(div_fct p1 p2))
+  | _ -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
+    | _ -> '(div_fct p1 p2)))
+| [(Rmult ?1 (Rinv ?2))] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
+  (Match p1 With
+   [(fct_cte ?3)] -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(fct_cte (Rdiv ?3 ?4))
+    | _ -> '(div_fct p1 p2))
+  | _ -> 
+   (Match p2 With
+   | [(fct_cte ?4)] -> '(mult_fct p1 (fct_cte (Rinv ?4)))
+   | _ -> '(div_fct p1 p2)))
+| [(Rmult ?1 ?2)] -> Let p1 = (RewTerm ?1) And p2 = (RewTerm ?2) In
+  (Match p1 With
+   [(fct_cte ?3)] -> 
+    (Match p2 With
+    | [(fct_cte ?4)] -> '(fct_cte (Rmult ?3 ?4))
+    | _ -> '(mult_fct p1 p2))
+  | _ -> '(mult_fct p1 p2))
+| [(Ropp ?1)] -> Let p = (RewTerm ?1) In 
+  (Match p With
+   [(fct_cte ?2)] -> '(fct_cte (Ropp ?2))
+   | _ -> '(opp_fct p))
+| [(Rinv ?1)] -> Let p = (RewTerm ?1) In 
+  (Match p With
+   [(fct_cte ?2)] -> '(fct_cte (Rinv ?2))
+   | _ -> '(inv_fct p))
+| [(?1 AppVar)] -> '?1
+| [(?1 ?2)] -> Let p = (RewTerm ?2) In 
+ (Match p With
+ | [(fct_cte ?3)] -> '(fct_cte (?1 ?3))
+ | _ -> '(comp ?1 p))
+| [AppVar] -> 'id
+| [(pow AppVar ?1)] -> '(pow_fct ?1)
+| [(pow ?1 ?2)] -> Let p = (RewTerm ?1) In 
+ (Match p With
+ | [(fct_cte ?3)] -> '(fct_cte (pow_fct ?2 ?3))
+ | _ -> '(comp (pow_fct ?2) p))
+| [?1]-> '(fct_cte ?1).
+
+(**********)
+Recursive Tactic Definition ConsProof trm pt :=
+Match trm With
+| [(plus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_plus ?1 ?2 pt p1 p2)
+| [(minus_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_minus ?1 ?2 pt p1 p2)
+| [(mult_fct ?1 ?2)] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_mult ?1 ?2 pt p1 p2)
+| [(div_fct ?1 ?2)] ->
+ (Match Context With
+ |[id:~((?2 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) And p2 = (ConsProof ?2 pt) In '(derivable_pt_div ?1 ?2 pt p1 p2 id)
+ | _ -> 'False)
+| [(inv_fct ?1)] ->
+ (Match Context With
+ |[id:~((?1 pt)==R0) |- ?] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_inv ?1 pt p1 id)
+ | _ -> 'False)
+| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Let p1 = (ConsProof ?1 pt_f1) And p2 = (ConsProof ?2 pt) In '(derivable_pt_comp ?2 ?1 pt p2 p1)
+| [(opp_fct ?1)] -> Let p1 = (ConsProof ?1 pt) In '(derivable_pt_opp ?1 pt p1)
+| [sin] -> '(derivable_pt_sin pt)
+| [cos] -> '(derivable_pt_cos pt)
+| [sinh] -> '(derivable_pt_sinh pt)
+| [cosh] -> '(derivable_pt_cosh pt)
+| [exp] -> '(derivable_pt_exp pt)
+| [id] -> '(derivable_pt_id pt)
+| [Rsqr] -> '(derivable_pt_Rsqr pt)
+| [sqrt] ->
+ (Match Context With
+ |[id:(Rlt R0 pt) |- ?] -> '(derivable_pt_sqrt pt id)
+ | _ -> 'False)
+| [(fct_cte ?1)] -> '(derivable_pt_const ?1 pt)
+| [?1] -> Let aux = ?1 In
+ (Match Context With
+    [ id : (derivable_pt aux pt) |- ?] -> 'id
+   |[ id : (derivable aux) |- ?] -> '(id pt)
+   | _ -> 'False).
+
+(**********)
+Recursive Tactic Definition SimplifyDerive trm pt :=
+Match trm With
+| [(plus_fct ?1 ?2)] -> Try Rewrite derive_pt_plus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
+| [(minus_fct ?1 ?2)] -> Try Rewrite derive_pt_minus; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
+| [(mult_fct ?1 ?2)] -> Try Rewrite derive_pt_mult; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
+| [(div_fct ?1 ?2)] -> Try Rewrite derive_pt_div; SimplifyDerive ?1 pt; SimplifyDerive ?2 pt
+| [(comp ?1 ?2)] -> Let pt_f1 = (Eval Cbv Beta in (?2 pt)) In Try Rewrite derive_pt_comp; SimplifyDerive ?1 pt_f1; SimplifyDerive ?2 pt
+| [(opp_fct ?1)] -> Try Rewrite derive_pt_opp; SimplifyDerive ?1 pt
+| [(inv_fct ?1)] -> Try Rewrite derive_pt_inv; SimplifyDerive ?1 pt
+| [(fct_cte ?1)] -> 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
+| [?1] -> Let aux = ?1 In
+  (Match Context With
+    [ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable aux) |- ? ] -> Try Replace (derive_pt aux pt (H pt)) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
+    |[ id : (eqT ? (derive_pt aux pt ?2) ?); H : (derivable_pt aux pt) |- ? ] -> Try Replace (derive_pt aux pt H) with (derive_pt aux pt ?2); [Rewrite id | Apply pr_nu]
+    | _ -> Idtac )
+| _ -> Idtac.
+
+(**********)
+Tactic Definition Reg :=
+Match Context With
+| [|-(derivable_pt ?1 ?2)] -> 
+Let trm = Eval Cbv Beta in (?1 AppVar) In
+Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (derivable_pt aux ?2); IsDiff_pt) Orelse IsDiff_pt
+| [|-(derivable ?1)] ->
+Let trm = Eval Cbv Beta in (?1 AppVar) In
+Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (derivable aux); IsDiff_glob) Orelse IsDiff_glob
+| [|-(continuity ?1)] ->
+Let trm = Eval Cbv Beta in (?1 AppVar) In
+Let aux = (RewTerm trm) In IntroHypG aux; Try (Change (continuity aux); IsCont_glob) Orelse IsCont_glob
+| [|-(continuity_pt ?1 ?2)] ->
+Let trm = Eval Cbv Beta in (?1 AppVar) In
+Let aux = (RewTerm trm) In IntroHypL aux ?2; Try (Change (continuity_pt aux ?2); IsCont_pt) Orelse IsCont_pt
+| [|-(eqT ? (derive_pt ?1 ?2 ?3) ?4)] -> 
+Let trm = Eval Cbv Beta in (?1 AppVar) In
+Let aux = (RewTerm trm) In
+IntroHypL aux ?2; Let aux2 = (ConsProof aux ?2) In Try (Replace (derive_pt ?1 ?2 ?3) with (derive_pt aux ?2 aux2); [SimplifyDerive aux ?2; Try Unfold plus_fct minus_fct mult_fct div_fct id fct_cte inv_fct opp_fct; Try Ring | Try Apply pr_nu]) Orelse IsDiff_pt.
diff --git a/theories7/Reals/Ranalysis1.v b/theories7/Reals/Ranalysis1.v
new file mode 100644
index 00000000..8cb4c358
--- /dev/null
+++ b/theories7/Reals/Ranalysis1.v
@@ -0,0 +1,1046 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Ranalysis1.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Export Rlimit.
+Require Export Rderiv.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+Implicit Variable Type f:R->R.
+
+(****************************************************)
+(**           Basic operations on functions         *)
+(****************************************************)
+Definition plus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)+(f2 x)``.
+Definition opp_fct [f:R->R] : R->R := [x:R] ``-(f x)``.
+Definition mult_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)*(f2 x)``.
+Definition mult_real_fct [a:R;f:R->R] : R->R := [x:R] ``a*(f x)``.
+Definition minus_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)-(f2 x)``.
+Definition div_fct [f1,f2:R->R] : R->R := [x:R] ``(f1 x)/(f2 x)``.
+Definition div_real_fct [a:R;f:R->R] : R->R := [x:R] ``a/(f x)``.
+Definition comp [f1,f2:R->R] : R->R := [x:R] ``(f1 (f2 x))``.
+Definition inv_fct [f:R->R] : R->R := [x:R]``/(f x)``.
+
+V8Infix "+" plus_fct : Rfun_scope.
+V8Notation "- x" := (opp_fct x) : Rfun_scope.
+V8Infix "*" mult_fct : Rfun_scope.
+V8Infix "-" minus_fct : Rfun_scope.
+V8Infix "/" div_fct : Rfun_scope.
+Notation Local "f1 'o' f2" := (comp f1 f2) (at level 2, right associativity)
+  : Rfun_scope 
+  V8only (at level 20, right associativity).
+V8Notation "/ x" := (inv_fct x) : Rfun_scope.
+
+Delimits Scope Rfun_scope with F.
+
+Definition fct_cte [a:R] : R->R := [x:R]a.
+Definition id := [x:R]x.
+
+(****************************************************)
+(**            Variations of functions              *)
+(****************************************************)
+Definition increasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f x)<=(f y)``.
+Definition decreasing [f:R->R] : Prop := (x,y:R) ``x<=y``->``(f y)<=(f x)``.
+Definition strict_increasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f x)<(f y)``.
+Definition strict_decreasing [f:R->R] : Prop := (x,y:R) ``x<y``->``(f y)<(f x)``.
+Definition constant [f:R->R] : Prop := (x,y:R) ``(f x)==(f y)``.
+  
+(**********) 
+Definition no_cond : R->Prop := [x:R] True.
+
+(**********)
+Definition constant_D_eq [f:R->R;D:R->Prop;c:R] : Prop := (x:R) (D x) -> (f x)==c.
+
+(***************************************************)
+(**      Definition of continuity as a limit       *)
+(***************************************************)
+
+(**********)
+Definition continuity_pt [f:R->R; x0:R] : Prop := (continue_in f no_cond x0).
+Definition continuity [f:R->R] : Prop := (x:R) (continuity_pt f x).
+
+Arguments Scope continuity_pt [Rfun_scope R_scope].
+Arguments Scope continuity [Rfun_scope].
+
+(**********)
+Lemma continuity_pt_plus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (plus_fct f1 f2) x0).
+Unfold continuity_pt plus_fct; Unfold continue_in; Intros; Apply limit_plus; Assumption.
+Qed.
+
+Lemma continuity_pt_opp : (f:R->R; x0:R) (continuity_pt f x0) -> (continuity_pt (opp_fct f) x0).
+Unfold continuity_pt opp_fct; Unfold continue_in; Intros; Apply limit_Ropp; Assumption.
+Qed.
+ 
+Lemma continuity_pt_minus : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (minus_fct f1 f2) x0).
+Unfold continuity_pt minus_fct; Unfold continue_in; Intros; Apply limit_minus; Assumption.
+Qed.
+
+Lemma continuity_pt_mult : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> (continuity_pt (mult_fct f1 f2) x0).
+Unfold continuity_pt mult_fct; Unfold continue_in; Intros; Apply limit_mul; Assumption.
+Qed.
+
+Lemma continuity_pt_const : (f:R->R; x0:R) (constant f) -> (continuity_pt f x0).
+Unfold constant continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split; [Apply Rlt_R0_R1 | Intros; Generalize (H x x0); Intro; Rewrite H2; Simpl; Rewrite R_dist_eq; Assumption].
+Qed.
+
+Lemma continuity_pt_scal : (f:R->R;a:R; x0:R) (continuity_pt f x0) -> (continuity_pt (mult_real_fct a f) x0).
+Unfold continuity_pt mult_real_fct; Unfold continue_in; Intros; Apply (limit_mul ([x:R] a) f (D_x no_cond x0) a (f x0) x0).
+Unfold limit1_in; Unfold limit_in; Intros; Exists ``1``; Split.
+Apply Rlt_R0_R1.
+Intros; Rewrite R_dist_eq; Assumption.
+Assumption.
+Qed.
+
+Lemma continuity_pt_inv : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (continuity_pt (inv_fct f) x0).
+Intros.
+Replace (inv_fct f) with [x:R]``/(f x)``.
+Unfold continuity_pt; Unfold continue_in; Intros; Apply limit_inv; Assumption.
+Unfold inv_fct; Reflexivity.
+Qed.
+ 
+Lemma div_eq_inv : (f1,f2:R->R) (div_fct f1 f2)==(mult_fct f1 (inv_fct f2)).
+Intros; Reflexivity.
+Qed.
+ 
+Lemma continuity_pt_div : (f1,f2:R->R; x0:R) (continuity_pt f1 x0) -> (continuity_pt f2 x0) -> ~``(f2 x0)==0`` -> (continuity_pt (div_fct f1 f2) x0).
+Intros; Rewrite -> (div_eq_inv f1 f2); Apply continuity_pt_mult; [Assumption | Apply continuity_pt_inv; Assumption].
+Qed.
+
+Lemma continuity_pt_comp : (f1,f2:R->R;x:R) (continuity_pt f1 x) -> (continuity_pt f2 (f1 x)) -> (continuity_pt (comp f2 f1) x).
+Unfold continuity_pt; Unfold continue_in; Intros; Unfold comp.
+Cut (limit1_in [x0:R](f2 (f1 x0)) (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1)
+(f2 (f1 x)) x) -> (limit1_in [x0:R](f2 (f1 x0)) (D_x no_cond x) (f2 (f1 x)) x).
+Intro; Apply H1.
+EApply limit_comp.
+Apply H.
+Apply H0.
+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_EM (f1 x) (f1 x1)); Intro.
+Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Elim H4; Intros; Apply H8.
+Split.
+Unfold Dgf D_x no_cond.
+Split.
+Split.
+Trivial.
+Elim H5; Unfold D_x no_cond; Intros.
+Elim H9; Intros; Assumption.
+Split.
+Trivial.
+Assumption.
+Elim H5; Intros; Assumption.
+Qed.
+
+(**********) 
+Lemma continuity_plus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (plus_fct f1 f2)).
+Unfold continuity; Intros; Apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
+Qed.
+
+Lemma continuity_opp : (f:R->R) (continuity f)->(continuity (opp_fct f)).
+Unfold continuity; Intros; Apply (continuity_pt_opp f x (H x)).
+Qed.
+
+Lemma continuity_minus : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (minus_fct f1 f2)).
+Unfold continuity; Intros; Apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
+Qed.
+ 
+Lemma continuity_mult : (f1,f2:R->R) (continuity f1)->(continuity f2)->(continuity (mult_fct f1 f2)).
+Unfold continuity; Intros; Apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
+Qed.
+
+Lemma continuity_const : (f:R->R) (constant f) -> (continuity f).
+Unfold continuity; Intros; Apply (continuity_pt_const f x H).
+Qed.
+
+Lemma continuity_scal : (f:R->R;a:R) (continuity f) -> (continuity (mult_real_fct a f)).
+Unfold continuity; Intros; Apply (continuity_pt_scal f a x (H x)).
+Qed.
+  
+Lemma continuity_inv : (f:R->R) (continuity f)->((x:R) ~``(f x)==0``)->(continuity (inv_fct f)).
+Unfold continuity; Intros; Apply (continuity_pt_inv f x (H x) (H0 x)).
+Qed.
+
+Lemma continuity_div : (f1,f2:R->R) (continuity f1)->(continuity f2)->((x:R) ~``(f2 x)==0``)->(continuity (div_fct f1 f2)).
+Unfold continuity; Intros; Apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
+Qed.
+ 
+Lemma continuity_comp : (f1,f2:R->R) (continuity f1) -> (continuity f2) -> (continuity (comp f2 f1)).
+Unfold continuity; Intros.
+Apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
+Qed.
+
+
+(*****************************************************)
+(**  Derivative's definition using Landau's kernel   *)
+(*****************************************************)
+
+Definition derivable_pt_lim [f:R->R;x,l:R] : Prop := ((eps:R) ``0<eps``->(EXT delta : posreal | ((h:R) ~``h==0``->``(Rabsolu h)<delta`` -> ``(Rabsolu ((((f (x+h))-(f x))/h)-l))<eps``))).
+
+Definition derivable_pt_abs [f:R->R;x:R] : R -> Prop := [l:R](derivable_pt_lim f x l).
+
+Definition derivable_pt [f:R->R;x:R] := (SigT R (derivable_pt_abs f x)).
+Definition derivable [f:R->R] := (x:R)(derivable_pt f x).
+
+Definition derive_pt [f:R->R;x:R;pr:(derivable_pt f x)] := (projT1 ? ? pr).
+Definition derive [f:R->R;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 _].
+
+Definition antiderivative [f,g:R->R;a,b:R] : Prop := ((x:R)``a<=x<=b``->(EXT pr : (derivable_pt g x) | (f x)==(derive_pt g x pr)))/\``a<=b``.
+(************************************)
+(** Class of differential functions *)
+(************************************)
+Record Differential : Type := mkDifferential {
+d1 :> R->R;
+cond_diff : (derivable d1) }.
+ 
+Record Differential_D2 : Type := mkDifferential_D2 {
+d2 :> R->R;
+cond_D1 : (derivable d2);
+cond_D2 : (derivable (derive d2 cond_D1)) }.
+
+(**********)
+Lemma unicite_step1 : (f:R->R;x,l1,l2:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 R0) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l2 R0) -> l1 == l2.
+Intros; Apply (single_limit [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l1 l2 R0); Try Assumption.
+Unfold adhDa; Intros; Exists ``alp/2``.
+Split.
+Unfold Rdiv; Apply prod_neq_R0.
+Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
+Apply Rinv_neq_R0; DiscrR.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rabsolu_mult.
+Replace ``(Rabsolu (/2))`` with ``/2``.
+Replace (Rabsolu alp) with alp.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Rewrite double; Pattern 1 alp; Replace alp with ``alp+0``; [Idtac | Ring]; Apply Rlt_compatibility; Assumption.
+Symmetry; Apply Rabsolu_right; Left; Assumption.
+Symmetry; Apply Rabsolu_right; Left; Change ``0</2``; Apply Rlt_Rinv; Sup0. 
+Qed.
+
+Lemma unicite_step2 : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0).
+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; Unfold R_dist; Intros.
+Elim H3; Intros.
+Apply H2; [Assumption |Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5; Assumption].
+Qed.
+
+Lemma unicite_step3 : (f:R->R;x,l:R) (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h<>0`` l R0) -> (derivable_pt_lim f x l).
+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; Intros; Unfold R_dist in H3; Apply (H3 h).
+Split; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assumption].
+Qed.
+
+Lemma unicite_limite : (f:R->R;x,l1,l2:R) (derivable_pt_lim f x l1) -> (derivable_pt_lim f x l2) -> l1==l2.
+Intros.
+Assert H1 := (unicite_step2 ? ? ? H).
+Assert H2 := (unicite_step2 ? ? ? H0).
+Assert H3 := (unicite_step1 ? ? ? ? H1 H2).
+Assumption.
+Qed.
+
+Lemma derive_pt_eq : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l <-> (derivable_pt_lim f x l).
+Intros; Split.
+Intro; Assert H1 := (projT2 ? ? pr); Unfold derive_pt in H; Rewrite H in H1; Assumption.
+Intro; Assert H1 := (projT2 ? ? pr); Unfold derivable_pt_abs in H1.
+Assert H2 := (unicite_limite ? ? ? ? H H1).
+Unfold derive_pt; Unfold derivable_pt_abs.
+Symmetry; Assumption.
+Qed.
+
+(**********)
+Lemma derive_pt_eq_0 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derivable_pt_lim f x l) -> (derive_pt f x pr)==l.
+Intros; Elim (derive_pt_eq f x l pr); Intros.
+Apply (H1 H).
+Qed.
+
+(**********)
+Lemma derive_pt_eq_1 : (f:R->R;x,l:R;pr:(derivable_pt f x)) (derive_pt f x pr)==l -> (derivable_pt_lim f x l).
+Intros; Elim (derive_pt_eq f x l pr); Intros.
+Apply (H0 H).
+Qed.
+
+
+(********************************************************************)
+(** Equivalence of this definition with the one using limit concept *)
+(********************************************************************)
+Lemma derive_pt_D_in : (f,df:R->R;x:R;pr:(derivable_pt f x)) (D_in f df no_cond x) <-> (derive_pt f x pr)==(df x).
+Intros; Split.
+Unfold D_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
+Apply derive_pt_eq_0. 
+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))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [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; 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).
+Intros; Elim H3; Intros; Unfold D_x in H4; Elim H4; Intros; Cut ``x0-x<>0``.
+Intro; Generalize (H2 ``x0-x`` H8 H5); Replace ``x+(x0-x)`` with x0.
+Intro; Assumption.
+Ring.
+Auto with real.
+Qed.
+
+Lemma derivable_pt_lim_D_in : (f,df:R->R;x:R) (D_in f df no_cond x) <-> (derivable_pt_lim f x (df x)).
+Intros; Split.
+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))``/\``(Rabsolu (x+h-x)) < alpha``; [Intro; Generalize (H6 H8); Rewrite H7; Intro; Assumption | Split; [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; 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).
+Intros.
+Elim H1; Intros; Unfold D_x in H3; Elim H3; Intros; Cut ``x0-x<>0``.
+Intro; Generalize (H2 ``x0-x`` H7 H4); Replace ``x+(x0-x)`` with x0.
+Intro; Assumption.
+Ring.
+Auto with real.
+Qed.
+
+
+(***********************************)
+(**   derivability -> continuity   *)
+(***********************************)
+(**********)
+Lemma derivable_derive : (f:R->R;x:R;pr:(derivable_pt f x)) (EXT l : R | (derive_pt f x pr)==l).
+Intros; Exists (projT1  ? ? pr).
+Unfold derive_pt; Reflexivity.
+Qed.
+
+Theorem derivable_continuous_pt : (f:R->R;x:R) (derivable_pt f x) -> (continuity_pt f x).
+Intros.
+Generalize (derivable_derive f x X); Intro.
+Elim H; Intros l H1.
+Cut l==((fct_cte l) x).
+Intro.
+Rewrite H0 in H1.
+Generalize (derive_pt_D_in f (fct_cte l) x); Intro.
+Elim (H2 X); Intros.
+Generalize (H4 H1); Intro.
+Unfold continuity_pt.
+Apply (cont_deriv f (fct_cte l) no_cond x H5).
+Unfold fct_cte; Reflexivity.
+Qed.
+
+Theorem derivable_continuous : (f:R->R) (derivable f) -> (continuity f).
+Unfold derivable continuity; Intros.
+Apply (derivable_continuous_pt f x (X x)).
+Qed.
+
+(****************************************************************)
+(**                      Main rules                             *)
+(****************************************************************)
+
+Lemma derivable_pt_lim_plus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (plus_fct f1 f2) x ``l1+l2``).
+Intros.
+Apply unicite_step3.
+Assert H1 := (unicite_step2 ? ? ? H).
+Assert H2 := (unicite_step2 ? ? ? H0).
+Unfold  plus_fct.
+Cut (h:R)``((f1 (x+h))+(f2 (x+h))-((f1 x)+(f2 x)))/h``==``((f1 (x+h))-(f1 x))/h+((f2 (x+h))-(f2 x))/h``.
+Intro.
+Generalize(limit_plus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
+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; Ring.
+Qed.
+
+Lemma derivable_pt_lim_opp : (f:R->R;x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (opp_fct f) x (Ropp l)).
+Intros.
+Apply unicite_step3.
+Assert H1 := (unicite_step2 ? ? ? H).
+Unfold opp_fct.
+Cut (h:R) ``( -(f (x+h))- -(f x))/h``==(Ropp ``((f (x+h))-(f x))/h``).
+Intro.
+Generalize (limit_Ropp [h:R]``((f (x+h))-(f x))/h``[h:R]``h <> 0`` l ``0`` H1).
+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; Ring.
+Qed.
+
+Lemma derivable_pt_lim_minus : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (minus_fct f1 f2) x ``l1-l2``).
+Intros.
+Apply unicite_step3.
+Assert H1 := (unicite_step2 ? ? ? H).
+Assert H2 := (unicite_step2 ? ? ? H0).
+Unfold  minus_fct.
+Cut (h:R)``((f1 (x+h))-(f1 x))/h-((f2 (x+h))-(f2 x))/h``==``((f1 (x+h))-(f2 (x+h))-((f1 x)-(f2 x)))/h``.
+Intro.
+Generalize (limit_minus [h':R]``((f1 (x+h'))-(f1 x))/h'`` [h':R]``((f2 (x+h'))-(f2 x))/h'`` [h:R]``h <> 0`` l1 l2 ``0`` H1 H2).
+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; Ring.
+Qed.
+
+Lemma derivable_pt_lim_mult : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> (derivable_pt_lim (mult_fct f1 f2) x ``l1*(f2 x)+(f1 x)*l2``).
+Intros.
+Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
+Elim H1; Intros.
+Assert H4 := (H3 H).
+Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 x).
+Elim H5; Intros.
+Assert H8 := (H7 H0).
+Clear H1 H2 H3 H5 H6 H7.
+Assert H1 := (derivable_pt_lim_D_in (mult_fct f1 f2) [y:R]``l1*(f2 x)+(f1 x)*l2`` x).
+Elim H1; Intros.
+Clear H1 H3.
+Apply H2.
+Unfold mult_fct.
+Apply (Dmult no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
+Qed.
+
+Lemma derivable_pt_lim_const : (a,x:R) (derivable_pt_lim (fct_cte a) x ``0``).
+Intros; Unfold fct_cte derivable_pt_lim.
+Intros; Exists (mkposreal ``1`` Rlt_R0_R1); Intros; Unfold Rminus; Rewrite Rplus_Ropp_r; Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Qed.
+
+Lemma derivable_pt_lim_scal : (f:R->R;a,x,l:R) (derivable_pt_lim f x l) -> (derivable_pt_lim (mult_real_fct a f) x ``a*l``).
+Intros.
+Assert H0 := (derivable_pt_lim_const a x).
+Replace (mult_real_fct a f) with (mult_fct (fct_cte a) 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; Reflexivity.
+Qed.
+
+Lemma derivable_pt_lim_id : (x:R) (derivable_pt_lim id x ``1``).
+Intro; Unfold derivable_pt_lim.
+Intros eps Heps; Exists (mkposreal eps Heps); Intros h H1 H2; Unfold id; Replace ``(x+h-x)/h-1`` with ``0``.
+Rewrite Rabsolu_R0; Apply Rle_lt_trans with ``(Rabsolu h)``.
+Apply Rabsolu_pos.
+Assumption.
+Unfold Rminus; Rewrite Rplus_assoc; Rewrite (Rplus_sym x); Rewrite Rplus_assoc.
+Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
+Symmetry; Apply Rplus_Ropp_r.
+Assumption.
+Qed.
+
+Lemma derivable_pt_lim_Rsqr : (x:R) (derivable_pt_lim Rsqr x ``2*x``).
+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; Rewrite Rmult_Rplus_distrl.
+Repeat Rewrite Rmult_assoc.
+Repeat Rewrite <- Rinv_r_sym; [Idtac | Assumption].
+Ring.
+Qed.
+
+Lemma derivable_pt_lim_comp : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 (f1 x) l2) -> (derivable_pt_lim (comp f2 f1) x ``l2*l1``).
+Intros; Assert H1 := (derivable_pt_lim_D_in f1 [y:R]l1 x).
+Elim H1; Intros.
+Assert H4 := (H3 H).
+Assert H5 := (derivable_pt_lim_D_in f2 [y:R]l2 (f1 x)).
+Elim H5; Intros.
+Assert H8 := (H7 H0).
+Clear H1 H2 H3 H5 H6 H7.
+Assert H1 := (derivable_pt_lim_D_in (comp f2 f1) [y:R]``l2*l1`` x).
+Elim H1; Intros.
+Clear H1 H3; Apply H2.
+Unfold comp; Cut (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` (Dgf no_cond no_cond f1) x) -> (D_in [x0:R](f2 (f1 x0)) [y:R]``l2*l1`` no_cond x).
+Intro; Apply H1.
+Rewrite Rmult_sym; Apply (Dcomp no_cond no_cond [y:R]l1 [y:R]l2 f1 f2 x); Assumption.
+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; Split.
+Split; Trivial.
+Elim H6; Intros; Unfold D_x in H10; Elim H10; Intros; Assumption.
+Elim H6; Intros; Assumption.
+Qed.
+
+Lemma derivable_pt_plus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (plus_fct f1 f2) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Elim X0; Intros.
+Apply Specif.existT with ``x0+x1``.
+Apply derivable_pt_lim_plus; Assumption.
+Qed.
+
+Lemma derivable_pt_opp : (f:R->R;x:R) (derivable_pt f x) -> (derivable_pt (opp_fct f) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Apply Specif.existT with ``-x0``.
+Apply derivable_pt_lim_opp; Assumption.
+Qed.
+
+Lemma derivable_pt_minus : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (minus_fct f1 f2) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Elim X0; Intros.
+Apply Specif.existT with ``x0-x1``.
+Apply derivable_pt_lim_minus; Assumption.
+Qed.
+
+Lemma derivable_pt_mult : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> (derivable_pt (mult_fct f1 f2) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Elim X0; Intros.
+Apply Specif.existT with ``x0*(f2 x)+(f1 x)*x1``.
+Apply derivable_pt_lim_mult; Assumption.
+Qed.
+
+Lemma derivable_pt_const : (a,x:R) (derivable_pt (fct_cte a) x).
+Intros; Unfold derivable_pt.
+Apply Specif.existT with ``0``.
+Apply derivable_pt_lim_const.
+Qed.
+
+Lemma derivable_pt_scal : (f:R->R;a,x:R) (derivable_pt f x) -> (derivable_pt (mult_real_fct a f) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Apply Specif.existT with ``a*x0``.
+Apply derivable_pt_lim_scal; Assumption.
+Qed.
+
+Lemma derivable_pt_id : (x:R) (derivable_pt id x).
+Unfold derivable_pt; Intro.
+Exists ``1``.
+Apply derivable_pt_lim_id.
+Qed.
+
+Lemma derivable_pt_Rsqr : (x:R) (derivable_pt Rsqr x).
+Unfold derivable_pt; Intro; Apply Specif.existT with ``2*x``.
+Apply derivable_pt_lim_Rsqr.
+Qed.
+
+Lemma derivable_pt_comp : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 (f1 x)) -> (derivable_pt (comp f2 f1) x).
+Unfold derivable_pt; Intros.
+Elim X; Intros.
+Elim X0 ;Intros.
+Apply Specif.existT with ``x1*x0``.
+Apply derivable_pt_lim_comp; Assumption.
+Qed.
+
+Lemma derivable_plus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (plus_fct f1 f2)).
+Unfold derivable; Intros.
+Apply (derivable_pt_plus ? ? x (X ?) (X0 ?)).
+Qed.
+
+Lemma derivable_opp : (f:R->R) (derivable f) -> (derivable (opp_fct f)).
+Unfold derivable; Intros.
+Apply (derivable_pt_opp ? x (X ?)).
+Qed.
+
+Lemma derivable_minus : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (minus_fct f1 f2)).
+Unfold derivable; Intros.
+Apply (derivable_pt_minus ? ? x (X ?) (X0 ?)).
+Qed.
+
+Lemma derivable_mult : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (mult_fct f1 f2)).
+Unfold derivable; Intros.
+Apply (derivable_pt_mult ? ? x (X ?) (X0 ?)).
+Qed.
+
+Lemma derivable_const : (a:R) (derivable (fct_cte a)).
+Unfold derivable; Intros.
+Apply derivable_pt_const.
+Qed.
+
+Lemma derivable_scal : (f:R->R;a:R) (derivable f) -> (derivable (mult_real_fct a f)).
+Unfold derivable; Intros.
+Apply (derivable_pt_scal ? a x (X ?)).
+Qed.
+
+Lemma derivable_id : (derivable id).
+Unfold derivable; Intro; Apply derivable_pt_id.
+Qed.
+
+Lemma derivable_Rsqr : (derivable Rsqr).
+Unfold derivable; Intro; Apply derivable_pt_Rsqr.
+Qed.
+
+Lemma derivable_comp : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> (derivable (comp f2 f1)).
+Unfold derivable; Intros.
+Apply (derivable_pt_comp ? ? x (X ?) (X0 ?)).
+Qed.
+
+Lemma derive_pt_plus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) + (derive_pt f2 x pr2)``.
+Intros.
+Assert H := (derivable_derive f1 x pr1).
+Assert H0 := (derivable_derive f2 x pr2).
+Assert H1 := (derivable_derive (plus_fct f1 f2) x (derivable_pt_plus ? ? ? pr1 pr2)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Elim H1; Clear H1; Intros l H1.
+Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Assert H4 := (projT2 ? ? pr2).
+Unfold derive_pt in H0; Rewrite H0 in H4.
+Apply derivable_pt_lim_plus; Assumption.
+Qed.
+
+Lemma derive_pt_opp : (f:R->R;x:R;pr1:(derivable_pt f x)) ``(derive_pt (opp_fct f) x (derivable_pt_opp ? ? pr1)) == -(derive_pt f x pr1)``.
+Intros.
+Assert H := (derivable_derive f x pr1).
+Assert H0 := (derivable_derive (opp_fct f) x (derivable_pt_opp ? ? pr1)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Rewrite H; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Apply derivable_pt_lim_opp; Assumption.
+Qed.
+
+Lemma derive_pt_minus : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)) == (derive_pt f1 x pr1) - (derive_pt f2 x pr2)``.
+Intros.
+Assert H := (derivable_derive f1 x pr1).
+Assert H0 := (derivable_derive f2 x pr2).
+Assert H1 := (derivable_derive (minus_fct f1 f2) x (derivable_pt_minus ? ? ? pr1 pr2)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Elim H1; Clear H1; Intros l H1.
+Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Assert H4 := (projT2 ? ? pr2).
+Unfold derive_pt in H0; Rewrite H0 in H4.
+Apply derivable_pt_lim_minus; Assumption.
+Qed.
+
+Lemma derive_pt_mult : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x)) ``(derive_pt (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)) == (derive_pt f1 x pr1)*(f2 x) + (f1 x)*(derive_pt f2 x pr2)``.
+Intros.
+Assert H := (derivable_derive f1 x pr1).
+Assert H0 := (derivable_derive f2 x pr2).
+Assert H1 := (derivable_derive (mult_fct f1 f2) x (derivable_pt_mult ? ? ? pr1 pr2)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Elim H1; Clear H1; Intros l H1.
+Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Assert H4 := (projT2 ? ? pr2).
+Unfold derive_pt in H0; Rewrite H0 in H4.
+Apply derivable_pt_lim_mult; Assumption.
+Qed.
+
+Lemma derive_pt_const : (a,x:R) (derive_pt (fct_cte a) x (derivable_pt_const a x)) == R0.
+Intros.
+Apply derive_pt_eq_0.
+Apply derivable_pt_lim_const.
+Qed.
+
+Lemma derive_pt_scal : (f:R->R;a,x:R;pr:(derivable_pt f x)) ``(derive_pt (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)) == a * (derive_pt f x pr)``.
+Intros.
+Assert H := (derivable_derive f x pr).
+Assert H0 := (derivable_derive (mult_real_fct a f) x (derivable_pt_scal ? ? ? pr)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Rewrite H; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr).
+Unfold derive_pt in H; Rewrite H in H3.
+Apply derivable_pt_lim_scal; Assumption.
+Qed.
+
+Lemma derive_pt_id : (x:R) (derive_pt id x (derivable_pt_id ?))==R1.
+Intros.
+Apply derive_pt_eq_0.
+Apply derivable_pt_lim_id.
+Qed.
+
+Lemma derive_pt_Rsqr : (x:R) (derive_pt Rsqr x (derivable_pt_Rsqr ?)) == ``2*x``.
+Intros.
+Apply derive_pt_eq_0.
+Apply derivable_pt_lim_Rsqr.
+Qed.
+
+Lemma derive_pt_comp : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 (f1 x))) ``(derive_pt (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)) == (derive_pt f2 (f1 x) pr2) * (derive_pt f1 x pr1)``.
+Intros.
+Assert H := (derivable_derive f1 x pr1).
+Assert H0 := (derivable_derive f2 (f1 x) pr2).
+Assert H1 := (derivable_derive (comp f2 f1) x (derivable_pt_comp ? ? ? pr1 pr2)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Elim H1; Clear H1; Intros l H1.
+Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Assert H4 := (projT2 ? ? pr2).
+Unfold derive_pt in H0; Rewrite H0 in H4.
+Apply derivable_pt_lim_comp; Assumption.
+Qed.
+
+(* Pow *)
+Definition pow_fct [n:nat] : R->R := [y:R](pow y n).
+
+Lemma derivable_pt_lim_pow_pos : (x:R;n:nat) (lt O n) -> (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
+Intros.
+Induction n.
+Elim (lt_n_n ? H).
+Cut n=O\/(lt O n).
+Intro; Elim H0; Intro.
+Rewrite H1; Simpl.
+Replace [y:R]``y*1`` with (mult_fct id (fct_cte R1)).
+Replace ``1*1`` with ``1*(fct_cte R1 x)+(id x)*0``.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Unfold fct_cte id; Ring.
+Reflexivity.
+Replace [y:R](pow y (S n)) with [y:R]``y*(pow y n)``.
+Replace (pred (S n)) with n; [Idtac | Reflexivity].
+Replace [y:R]``y*(pow y n)`` with (mult_fct id [y:R](pow y n)).
+Pose f := [y:R](pow y n).
+Replace ``(INR (S n))*(pow x n)`` with (Rplus (Rmult R1 (f x)) (Rmult (id x) (Rmult (INR n) (pow x (pred n))))).
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_id.
+Unfold f; Apply Hrecn; Assumption.
+Unfold f.
+Pattern 1 5 n; Replace n with (S (pred n)).
+Unfold id; Rewrite S_INR; Simpl.
+Ring.
+Symmetry; Apply S_pred with O; Assumption.
+Unfold mult_fct id; Reflexivity.
+Reflexivity.
+Inversion H.
+Left; Reflexivity.
+Right.
+Apply lt_le_trans with (1).
+Apply lt_O_Sn.
+Assumption.
+Qed.
+
+Lemma derivable_pt_lim_pow : (x:R; n:nat) (derivable_pt_lim [y:R](pow y n) x ``(INR n)*(pow x (pred n))``).
+Intros.
+Induction n.
+Simpl.
+Rewrite Rmult_Ol.
+Replace [_:R]``1`` with (fct_cte R1); [Apply derivable_pt_lim_const | Reflexivity].
+Apply derivable_pt_lim_pow_pos.
+Apply lt_O_Sn.
+Qed.
+
+Lemma derivable_pt_pow : (n:nat;x:R) (derivable_pt [y:R](pow y n) x).
+Intros; Unfold derivable_pt.
+Apply Specif.existT with ``(INR n)*(pow x (pred n))``.
+Apply derivable_pt_lim_pow.
+Qed.
+
+Lemma derivable_pow : (n:nat) (derivable [y:R](pow y n)).
+Intro; Unfold derivable; Intro; Apply derivable_pt_pow.
+Qed.
+
+Lemma derive_pt_pow : (n:nat;x:R) (derive_pt [y:R](pow y n) x (derivable_pt_pow n x))==``(INR n)*(pow x (pred n))``.
+Intros; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_pow.
+Qed.
+
+Lemma pr_nu : (f:R->R;x:R;pr1,pr2:(derivable_pt f x)) (derive_pt f x pr1)==(derive_pt f x pr2). 
+Intros.
+Unfold derivable_pt in pr1.
+Unfold derivable_pt in pr2.
+Elim pr1; Intros.
+Elim pr2; Intros.
+Unfold derivable_pt_abs in p.
+Unfold derivable_pt_abs in p0.
+Simpl.
+Apply (unicite_limite f x x0 x1 p p0).
+Qed.
+
+
+(************************************************************)
+(**             Local extremum's condition                  *)
+(************************************************************)
+
+Theorem deriv_maximum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)<=(f c)``)->``(derive_pt f c pr)==0``.
+Intros; Case (total_order R0 (derive_pt f c pr)); Intro.
+Assert H3 := (derivable_derive f c pr).
+Elim H3; Intros l H4; Rewrite H4 in H2.
+Assert H5 := (derive_pt_eq_1 f c l pr H4).
+Cut ``0<l/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]].
+Elim (H5 ``l/2`` H6); Intros delta H7.
+Cut ``0<(b-c)/2``.
+Intro; Cut ``(Rmin delta/2 ((b-c)/2))<>0``.
+Intro; Cut ``(Rabsolu (Rmin delta/2 ((b-c)/2)))<delta``.
+Intro.
+Assert H11 := (H7 ``(Rmin delta/2 ((b-c)/2))`` H9 H10).
+Cut ``0<(Rmin (delta/2) ((b-c)/2))``.
+Intro; Cut ``a<c+(Rmin (delta/2) ((b-c)/2))``.
+Intro; Cut ``c+(Rmin (delta/2) ((b-c)/2))<b``.
+Intro; Assert H15 := (H1 ``c+(Rmin (delta/2) ((b-c)/2))`` H13 H14).
+Cut ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))<=0``.
+Intro; Cut ``-l<0``.
+Intro; Unfold Rminus in H11.
+Cut ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l<0``.
+Intro; Cut ``(Rabsolu (((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)) < l/2``.
+Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l``); Intro.
+Replace `` -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l)`` with ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))``.
+Intro; Generalize (Rlt_compatibility ``-l`` ``l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``l/2`` H19); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Replace ``-l+l/2`` with ``-(l/2)``.
+Intro; Generalize (Rlt_Ropp ``-(((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2)))`` ``-(l/2)`` H20); Repeat Rewrite Ropp_Ropp; Intro; Generalize (Rlt_trans ``0`` ``l/2`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` H6 H21); Intro; Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))`` ``0`` H22 H16)).
+Pattern 2 l; Rewrite double_var.
+Ring.
+Ring.
+Intro.
+Assert H20 := (Rle_sym2 ``0`` ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` r).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H20 H18)). 
+Assumption.
+Rewrite <- Ropp_O; Replace ``((f (c+(Rmin (delta/2) ((b+ -c)/2))))+ -(f c))/(Rmin (delta/2) ((b+ -c)/2))+ -l`` with ``-(l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2))))``.
+Apply Rgt_Ropp; Change ``0<l+ -(((f (c+(Rmin (delta/2) ((b+ -c)/2))))-(f c))/(Rmin (delta/2) ((b+ -c)/2)))``; Apply gt0_plus_ge0_is_gt0; [Assumption | Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Assumption].
+Ring.
+Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Replace ``((f (c+(Rmin (delta/2) ((b-c)/2))))-(f c))/(Rmin (delta/2) ((b-c)/2))`` with ``- (((f c)-(f (c+(Rmin (delta/2) ((b-c)/2)))))/(Rmin (delta/2) ((b-c)/2)))``.
+Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos; [Generalize (Rle_compatibility_r ``-(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` ``(f (c+(Rmin (delta*/2) ((b-c)*/2))))`` (f c) H15); Rewrite Rplus_Ropp_r; Intro; Assumption | Left; Apply Rlt_Rinv; Assumption].
+Unfold Rdiv.
+Rewrite <- Ropp_mul1.
+Repeat Rewrite <- (Rmult_sym ``/(Rmin (delta*/2) ((b-c)*/2))``).
+Apply r_Rmult_mult with ``(Rmin (delta*/2) ((b-c)*/2))``.
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Repeat Rewrite Rmult_1l.
+Ring.
+Red; Intro.
+Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
+Red; Intro.
+Unfold Rdiv in H12; Rewrite H16 in H12; Elim (Rlt_antirefl ``0`` H12).
+Assert H14 := (Rmin_r ``(delta/2)`` ``((b-c)/2)``).
+Assert H15 := (Rle_compatibility ``c`` ``(Rmin (delta/2) ((b-c)/2))`` ``(b-c)/2`` H14).
+Apply Rle_lt_trans with ``c+(b-c)/2``.
+Assumption.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Replace ``2*(c+(b-c)/2)`` with ``c+b``.
+Replace ``2*b`` with ``b+b``.
+Apply Rlt_compatibility_r; Assumption.
+Ring.
+Unfold Rdiv; Rewrite Rmult_Rplus_distr.
+Repeat Rewrite (Rmult_sym ``2``).
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Ring.
+DiscrR.
+Apply Rlt_trans with c.
+Assumption.
+Pattern 1 c; Rewrite <- (Rplus_Or c); Apply Rlt_compatibility; Assumption.
+Cut ``0<delta/2``.
+Intro; Apply (Rmin_stable_in_posreal (mkposreal ``delta/2`` H12) (mkposreal ``(b-c)/2`` H8)).
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Unfold Rabsolu; Case (case_Rabsolu (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; Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rmin (delta/2) ((b-c)/2))`` ``0`` H11 r)).
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Intro; Apply Rle_lt_trans with ``delta/2``.
+Apply Rmin_l.
+Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Replace ``2*delta`` with ``delta+delta``. 
+Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility.
+Rewrite Rplus_Or; Apply (cond_pos delta).
+Symmetry; Apply double.
+DiscrR.
+Cut ``0<delta/2``.
+Intro; Generalize (Rmin_stable_in_posreal (mkposreal ``delta/2`` H9) (mkposreal ``(b-c)/2`` H8)); Simpl; Intro; Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``0`` H10).
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Unfold Rdiv; Apply Rmult_lt_pos.
+Generalize (Rlt_compatibility_r ``-c`` c b H0); Rewrite Rplus_Ropp_r; Intro; Assumption.
+Apply Rlt_Rinv; Sup0.
+Elim H2; Intro.
+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)``.
+Intro; Elim (H6 ``-(l/2)`` H7); Intros delta H9.
+Cut ``0<(c-a)/2``.
+Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<0``.
+Intro; Cut ``(Rmax (-(delta/2)) ((a-c)/2))<>0``.
+Intro; Cut ``(Rabsolu (Rmax (-(delta/2)) ((a-c)/2)))<delta``.
+Intro; Generalize (H9 ``(Rmax (-(delta/2)) ((a-c)/2))`` H11 H12); Intro; Cut ``a<c+(Rmax (-(delta/2)) ((a-c)/2))``.
+Cut ``c+(Rmax (-(delta/2)) ((a-c)/2))<b``.
+Intros; Generalize (H1 ``c+(Rmax (-(delta/2)) ((a-c)/2))`` H15 H14); Intro; Cut ``0<=((f (c+(Rmax (-(delta/2)) ((a-c)/2))))-(f c))/(Rmax (-(delta/2)) ((a-c)/2))``.
+Intro; Cut ``0< -l``.
+Intro; Unfold Rminus in H13; Cut ``0<((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``.
+Intro; Cut ``(Rabsolu (((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l)) < -(l/2)``.
+Unfold Rabsolu; Case (case_Rabsolu ``((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2))+ -l``).
+Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))+ -l`` ``0`` H19 r)).
+Intros; Generalize (Rlt_compatibility_r ``l`` ``(((f (c+(Rmax (-(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax (-(delta/2)) ((a+ -c)/2)))+ -l`` ``-(l/2)`` H20); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Replace ``-(l/2)+l`` with ``l/2``.
+Cut ``l/2<0``.
+Intros; Generalize (Rlt_trans ``((f (c+(Rmax ( -(delta/2)) ((a+ -c)/2))))+ -(f c))/(Rmax ( -(delta/2)) ((a+ -c)/2))`` ``l/2`` ``0`` H22 H21); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (c+(Rmax ( -(delta/2)) ((a-c)/2))))-(f c))/(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H17 H23)).
+Rewrite <- (Ropp_Ropp ``l/2``); Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Pattern 3 l; Rewrite double_var.
+Ring.
+Assumption.
+Apply ge0_plus_gt0_is_gt0; Assumption.
+Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Unfold Rdiv; Replace ``((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))*/(Rmax ( -(delta*/2)) ((a-c)*/2))`` with ``(-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c)))*/(-(Rmax ( -(delta*/2)) ((a-c)*/2)))``.
+Apply Rmult_le_pos.
+Generalize (Rle_compatibility ``-(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` ``(f (c+(Rmax (-(delta*/2)) ((a-c)*/2))))`` (f c) H16); Rewrite Rplus_Ropp_l; Replace ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2))))-(f c))`` with ``-((f (c+(Rmax ( -(delta*/2)) ((a-c)*/2)))))+(f c)``.
+Intro; Assumption.
+Ring.
+Left; Apply Rlt_Rinv; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Unfold Rdiv.
+Rewrite <- Ropp_Rinv.
+Rewrite Ropp_mul2.
+Reflexivity.
+Unfold Rdiv in H11; Assumption.
+Generalize (Rlt_compatibility c ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H10); Rewrite Rplus_Or; Intro; Apply Rlt_trans with ``c``; Assumption.
+Generalize (RmaxLess2 ``(-(delta/2))`` ``((a-c)/2)``); Intro; Generalize (Rle_compatibility c ``(a-c)/2`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H14); Intro; Apply Rlt_le_trans with ``c+(a-c)/2``.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Replace ``2*(c+(a-c)/2)`` with ``a+c``.
+Rewrite double.
+Apply Rlt_compatibility; Assumption.
+Ring.
+Rewrite <- Rplus_assoc.
+Rewrite <- double_var.
+Ring.
+Assumption.
+Unfold Rabsolu; Case (case_Rabsolu (Rmax ``-(delta/2)`` ``(a-c)/2``)).
+Intro; Generalize (RmaxLess1 ``-(delta/2)`` ``(a-c)/2``); Intro; Generalize (Rle_Ropp ``-(delta/2)`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` H12); Rewrite Ropp_Ropp; Intro; Generalize (Rle_sym2 ``-(Rmax ( -(delta/2)) ((a-c)/2))`` ``delta/2`` H13); Intro; Apply Rle_lt_trans with ``delta/2``.
+Assumption.
+Apply Rlt_monotony_contra with ``2``. 
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite double.
+Pattern 2 delta; Rewrite <- (Rplus_Or delta); Apply Rlt_compatibility; Rewrite Rplus_Or; Apply (cond_pos delta).
+DiscrR. 
+Cut ``-(delta/2) < 0``.
+Cut ``(a-c)/2<0``.
+Intros; Generalize (Rmax_stable_in_negreal (mknegreal ``-(delta/2)`` H13) (mknegreal ``(a-c)/2`` H12)); Simpl; Intro; Generalize (Rle_sym2 ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` r); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``(Rmax ( -(delta/2)) ((a-c)/2))`` ``0`` H15 H14)).
+Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
+Assumption.
+Unfold Rdiv.
+Rewrite <- Ropp_mul1. 
+Rewrite (Ropp_distr2 a c).
+Reflexivity.
+Rewrite <- Ropp_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
+Red; Intro; Rewrite H11 in H10; Elim (Rlt_antirefl ``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_O; Apply Rlt_Ropp; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
+Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp ``(a-c)/2``); Apply Rlt_Ropp; Replace ``-((a-c)/2)`` with ``(c-a)/2``.
+Assumption.
+Unfold Rdiv.
+Rewrite <- Ropp_mul1. 
+Rewrite (Ropp_distr2 a c).
+Reflexivity.
+Unfold Rdiv; Apply Rmult_lt_pos; [Generalize (Rlt_compatibility_r ``-a`` a c H); Rewrite Rplus_Ropp_r; Intro; Assumption | Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)]].
+Replace ``-(l/2)`` with ``(-l)/2``.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Assert Hyp : ``0<2``; [Sup0 | Apply (Rlt_Rinv ``2`` Hyp)].
+Unfold Rdiv; Apply Ropp_mul1.
+Qed.
+
+Theorem deriv_minimum : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f c)<=(f x)``)->``(derive_pt f c pr)==0``.
+Intros.
+Rewrite <- (Ropp_Ropp (derive_pt f c pr)).
+Apply eq_RoppO.
+Rewrite <- (derive_pt_opp f c pr).
+Cut (x:R)(``a<x``->``x<b``->``((opp_fct f) x)<=((opp_fct f) c)``).
+Intro.
+Apply (deriv_maximum (opp_fct f) a b c (derivable_pt_opp ? ? pr) H H0 H2).
+Intros; Unfold opp_fct; Apply Rge_Ropp; Apply Rle_sym1.
+Apply (H1 x H2 H3).
+Qed.
+ 
+Theorem deriv_constant2 : (f:R->R;a,b,c:R;pr:(derivable_pt f c)) ``a<c``->``c<b``->((x:R) ``a<x``->``x<b``->``(f x)==(f c)``)->``(derive_pt f c pr)==0``.
+Intros.
+EApply deriv_maximum with a b; Try Assumption.
+Intros; Right; Apply (H1 x H2 H3).
+Qed.
+
+(**********)
+Lemma nonneg_derivative_0 : (f:R->R;pr:(derivable f)) (increasing f) -> ((x:R) ``0<=(derive_pt f x (pr x))``).
+Intros; Unfold increasing in H.
+Assert H0 := (derivable_derive f x (pr x)).
+Elim H0; Intros l H1.
+Rewrite H1; Case (total_order R0 l); Intro.
+Left; Assumption.
+Elim H2; Intro.
+Right; Assumption.
+Assert H4 := (derive_pt_eq_1 f x l (pr x) H1).
+Cut ``0< -(l/2)``.
+Intro; Elim (H4 ``-(l/2)`` H5); Intros delta H6.
+Cut ``delta/2<>0``/\``0<delta/2``/\``(Rabsolu delta/2)<delta``.
+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 Rabsolu; Case (case_Rabsolu ``((f (x+delta/2))-(f x))/(delta/2)-l``).
+Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``0`` H12 r)).
+Intros; Generalize (Rlt_compatibility_r l ``((f (x+delta/2))-(f x))/(delta/2)-l`` ``-(l/2)`` H13); Unfold Rminus; Replace ``-(l/2)+l`` with ``l/2``.
+Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Generalize (Rle_lt_trans ``0`` ``((f (x+delta/2))-(f x))/(delta/2)`` ``l/2`` H9 H14); Intro; Cut ``l/2<0``.
+Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``l/2`` ``0`` H15 H16)).
+Rewrite <- Ropp_O in H5; Generalize (Rlt_Ropp ``-0`` ``-(l/2)`` H5); Repeat Rewrite Ropp_Ropp; Intro; Assumption.
+Pattern 3 l ; Rewrite double_var.
+Ring.
+Unfold Rminus; Apply ge0_plus_ge0_is_ge0.
+Unfold Rdiv; Apply Rmult_le_pos.
+Cut ``x<=(x+(delta*/2))``.
+Intro; Generalize (H x ``x+(delta*/2)`` H12); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H13); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
+Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption.
+Left; Apply Rlt_Rinv; Assumption.
+Left; Rewrite <- Ropp_O; Apply Rlt_Ropp; Assumption.
+Unfold Rdiv; Apply Rmult_le_pos.
+Cut ``x<=(x+(delta*/2))``.
+Intro; Generalize (H x ``x+(delta*/2)`` H9); Intro; Generalize (Rle_compatibility ``-(f x)`` ``(f x)`` ``(f (x+delta*/2))`` H12); Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Intro; Assumption.
+Pattern 1 x; Rewrite <- (Rplus_Or x); Apply Rle_compatibility; Left; Assumption. 
+Left; Apply Rlt_Rinv; Assumption.
+Split.
+Unfold Rdiv; Apply prod_neq_R0.
+Generalize (cond_pos delta); Intro; Red; Intro H9; Rewrite H9 in H7; Elim (Rlt_antirefl ``0`` H7).
+Apply Rinv_neq_R0; DiscrR.
+Split.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Replace ``(Rabsolu delta/2)`` with ``delta/2``.
+Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite (Rmult_sym ``2``).
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
+Rewrite Rmult_1r.
+Rewrite double.
+Pattern 1 (pos delta); Rewrite <- Rplus_Or.
+Apply Rlt_compatibility; Apply (cond_pos delta).
+Symmetry; Apply Rabsolu_right.
+Left; Change ``0<delta/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos delta) | Apply Rlt_Rinv; Sup0].
+Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_lt_pos.
+Apply Rlt_anti_compatibility with l.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
+Apply Rlt_Rinv; Sup0.
+Qed.
diff --git a/theories7/Reals/Ranalysis2.v b/theories7/Reals/Ranalysis2.v
new file mode 100644
index 00000000..35fa58d5
--- /dev/null
+++ b/theories7/Reals/Ranalysis2.v
@@ -0,0 +1,302 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Ranalysis2.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis1.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(**********)
+Lemma formule : (x,h,l1,l2:R;f1,f2:R->R) ``h<>0`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ``((f1 (x+h))/(f2 (x+h))-(f1 x)/(f2 x))/h-(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))`` == ``/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1) + l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))) - (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))``.
+Intros; Unfold Rdiv Rminus Rsqr.
+Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rinv_Rmult; Try Assumption.
+Replace ``l1*(f2 x)*(/(f2 x)*/(f2 x))`` with ``l1*/(f2 x)*((f2 x)*/(f2 x))``; [Idtac | Ring].
+Replace ``l1*(/(f2 x)*/(f2 (x+h)))*(f2 x)`` with ``l1*/(f2 (x+h))*((f2 x)*/(f2 x))``; [Idtac | Ring].
+Replace ``l1*(/(f2 x)*/(f2 (x+h)))* -(f2 (x+h))`` with ``-(l1*/(f2 x)*((f2 (x+h))*/(f2 (x+h))))``; [Idtac | Ring].
+Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*((f2 (x+h))*/h)`` with ``(f1 x)*/(f2 x)*/h*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
+Replace ``(f1 x)*(/(f2 x)*/(f2 (x+h)))*( -(f2 x)*/h)`` with ``-((f1 x)*/(f2 (x+h))*/h*((f2 x)*/(f2 x)))``; [Idtac | Ring].
+Replace ``(l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))*(f2 (x+h)))`` with ``l2*(f1 x)*/(f2 x)*/(f2 x)*((f2 (x+h))*/(f2 (x+h)))``; [Idtac | Ring].
+Replace ``l2*(f1 x)*(/(f2 x)*/(f2 x)*/(f2 (x+h)))* -(f2 x)`` with ``-(l2*(f1 x)*/(f2 x)*/(f2 (x+h))*((f2 x)*/(f2 x)))``; [Idtac | Ring].
+Repeat Rewrite <- Rinv_r_sym; Try Assumption Orelse Ring.
+Apply prod_neq_R0; Assumption.
+Qed.
+
+Lemma Rmin_pos : (x,y:R) ``0<x`` -> ``0<y`` -> ``0 < (Rmin x y)``.
+Intros; Unfold Rmin.
+Case (total_order_Rle x y); Intro; Assumption.
+Qed.
+
+Lemma maj_term1 : (x,h,eps,l1,alp_f2:R;eps_f2,alp_f1d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f1d``->``(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < (Rabsolu ((eps*(f2 x))/8))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f1d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) < eps/4``.
+Intros.
+Assert H7 := (H3 h H6).
+Assert H8 := (H2 h H4 H5).
+Apply Rle_lt_trans with ``2/(Rabsolu (f2 x))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1))``.
+Rewrite Rabsolu_mult.
+Apply Rle_monotony_r.
+Apply Rabsolu_pos.
+Rewrite Rabsolu_Rinv; [Left; Exact H7 | Assumption].
+Apply Rlt_le_trans with ``2/(Rabsolu (f2 x))*(Rabsolu ((eps*(f2 x))/8))``.
+Apply Rlt_monotony.
+Unfold Rdiv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption].
+Exact H8.
+Right; Unfold Rdiv.
+Repeat Rewrite Rabsolu_mult.
+Rewrite Rabsolu_Rinv; DiscrR.
+Replace ``(Rabsolu 8)`` with ``8``.
+Replace ``8`` with ``2*4``; [Idtac | Ring].
+Rewrite Rinv_Rmult; [Idtac | DiscrR | DiscrR].
+Replace ``2*/(Rabsolu (f2 x))*((Rabsolu eps)*(Rabsolu (f2 x))*(/2*/4))`` with ``(Rabsolu eps)*/4*(2*/2)*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))``; [Idtac | Ring].
+Replace (Rabsolu eps) with eps.
+Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
+Ring.
+Symmetry; Apply Rabsolu_right; Left; Assumption.
+Symmetry; Apply Rabsolu_right; Left; Sup.
+Qed.
+
+Lemma maj_term2 : (x,h,eps,l1,alp_f2,alp_f2t2:R;eps_f2:posreal;f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2t2``->``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``)-> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2t2`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``l1<>0`` -> ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) < eps/4``.
+Intros.
+Assert H8 := (H3 h H6).
+Assert H9 := (H2 h H5).
+Apply Rle_lt_trans with ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Rewrite Rabsolu_mult; Apply Rle_monotony.
+Apply Rabsolu_pos.
+Rewrite <- (Rabsolu_Ropp ``(f2 x)-(f2 (x+h))``); Rewrite Ropp_distr2.
+Left; Apply H9.
+Apply Rlt_le_trans with ``(Rabsolu (2*l1/((f2 x)*(f2 x))))*(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Apply Rlt_monotony_r.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR.
+Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
+Apply Rinv_neq_R0; Apply prod_neq_R0; Try Assumption Orelse DiscrR.
+Unfold Rdiv.
+Repeat Rewrite Rinv_Rmult; Try Assumption.
+Repeat Rewrite Rabsolu_mult.
+Replace ``(Rabsolu 2)`` with ``2``.
+Rewrite (Rmult_sym ``2``).
+Replace ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu l1)*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
+Repeat Apply Rlt_monotony.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
+Repeat Rewrite Rabsolu_Rinv; Try Assumption.
+Rewrite <- (Rmult_sym ``2``).
+Unfold Rdiv in H8; Exact H8.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Right.
+Unfold Rsqr Rdiv.
+Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Do 1 Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Repeat Rewrite Rabsolu_mult.
+Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
+Replace (Rabsolu eps) with eps.
+Replace ``(Rabsolu (8))`` with ``8``.
+Replace ``(Rabsolu 2)`` with ``2``.
+Replace ``8`` with ``4*2``; [Idtac | Ring].
+Rewrite Rinv_Rmult; DiscrR.
+Replace ``2*((Rabsolu l1)*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*(eps*((Rabsolu (f2 x))*(Rabsolu (f2 x)))*(/4*/2*/(Rabsolu l1)))`` with ``eps*/4*((Rabsolu l1)*/(Rabsolu l1))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
+Repeat Rewrite <- Rinv_r_sym; Try (Apply Rabsolu_no_R0; Assumption) Orelse DiscrR.
+Ring.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Symmetry; Apply Rabsolu_right; Left; Sup.
+Symmetry; Apply Rabsolu_right; Left; Assumption.
+Qed.
+
+Lemma maj_term3 : (x,h,eps,l2,alp_f2:R;eps_f2,alp_f2d:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((h:R)``h <> 0``->``(Rabsolu h) < alp_f2d``->``(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < (Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``) -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2d`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) < eps/4``.
+Intros.
+Assert H8 := (H2 h H4 H5).
+Assert H9 := (H3 h H6).
+Apply Rle_lt_trans with ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
+Rewrite Rabsolu_mult.
+Apply Rle_monotony.
+Apply Rabsolu_pos.
+Left; Apply H8.
+Apply Rlt_le_trans with ``(Rabsolu (2*(f1 x)/((f2 x)*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*eps)/(8*(f1 x))))``.
+Apply Rlt_monotony_r.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Try Assumption.
+Red; Intro H10; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
+Apply Rinv_neq_R0; Apply prod_neq_R0; DiscrR Orelse Assumption.
+Unfold Rdiv.
+Repeat Rewrite Rinv_Rmult; Try Assumption.
+Repeat Rewrite Rabsolu_mult.
+Replace ``(Rabsolu 2)`` with ``2``.
+Rewrite (Rmult_sym ``2``).
+Replace ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*(Rabsolu (/(f2 x))))*2`` with ``(Rabsolu (f1 x))*((Rabsolu (/(f2 x)))*((Rabsolu (/(f2 x)))*2))``; [Idtac | Ring].
+Repeat Apply Rlt_monotony.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Assumption.
+Repeat Rewrite Rabsolu_Rinv; Assumption Orelse Idtac.
+Rewrite <- (Rmult_sym ``2``).
+Unfold Rdiv in H9; Exact H9.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Right.
+Unfold Rsqr Rdiv.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Repeat Rewrite Rabsolu_mult.
+Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
+Replace (Rabsolu eps) with eps.
+Replace ``(Rabsolu (8))`` with ``8``.
+Replace ``(Rabsolu 2)`` with ``2``.
+Replace ``8`` with ``4*2``; [Idtac | Ring].
+Rewrite Rinv_Rmult; DiscrR.
+Replace ``2*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))))`` with ``eps*/4*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*(2*/2)``; [Idtac | Ring].
+Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
+Ring.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Symmetry; Apply Rabsolu_right; Left; Sup.
+Symmetry; Apply Rabsolu_right; Left; Assumption.
+Qed.
+
+Lemma maj_term4 : (x,h,eps,l2,alp_f2,alp_f2c:R;eps_f2:posreal;f1,f2:R->R) ``0 < eps`` -> ``(f2 x)<>0`` -> ``(f2 (x+h))<>0`` -> ((a:R)``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``)  -> ((a:R)``(Rabsolu a) < (Rmin eps_f2 alp_f2)``->``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``) -> ``h<>0`` -> ``(Rabsolu h)<alp_f2c`` -> ``(Rabsolu h) < (Rmin eps_f2 alp_f2)`` -> ``(f1 x)<>0`` -> ``l2<>0`` -> ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x)))) < eps/4``.
+Intros.
+Assert H9 := (H2 h H5).
+Assert H10 := (H3 h H6).
+Apply Rle_lt_trans with ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
+Rewrite Rabsolu_mult.
+Apply Rle_monotony.
+Apply Rabsolu_pos.
+Left; Apply H9.
+Apply Rlt_le_trans with ``(Rabsolu (2*l2*(f1 x)/((Rsqr (f2 x))*(f2 x))))*(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
+Apply Rlt_monotony_r.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv; Unfold Rsqr; Repeat Apply prod_neq_R0; Assumption Orelse Idtac.
+Red; Intro H11; Rewrite H11 in H; Elim (Rlt_antirefl ? H).
+Apply Rinv_neq_R0; Apply prod_neq_R0.
+Apply prod_neq_R0.
+DiscrR.
+Assumption.
+Assumption.
+Unfold Rdiv.
+Repeat Rewrite Rinv_Rmult; Try Assumption Orelse (Unfold Rsqr; Apply prod_neq_R0; Assumption).
+Repeat Rewrite Rabsolu_mult.
+Replace ``(Rabsolu 2)`` with ``2``.
+Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 x)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*((Rabsolu (/(f2 x)))*2)))``; [Idtac | Ring].
+Replace ``(Rabsolu l2)*(Rabsolu (f1 x))*((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))`` with ``(Rabsolu l2)*((Rabsolu (f1 x))*(((Rabsolu (/(Rsqr (f2 x))))*(Rabsolu (/(f2 (x+h)))))))``; [Idtac | Ring].
+Repeat Apply Rlt_monotony.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rabsolu_pos_lt; Apply Rinv_neq_R0; Unfold Rsqr; Apply prod_neq_R0;  Assumption.
+Repeat Rewrite Rabsolu_Rinv; [Idtac | Assumption | Assumption].
+Rewrite <- (Rmult_sym ``2``).
+Unfold Rdiv in H10; Exact H10.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Right; Unfold Rsqr Rdiv.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Repeat Rewrite Rabsolu_mult.
+Repeat Rewrite Rabsolu_Rinv; Try Assumption Orelse DiscrR.
+Replace (Rabsolu eps) with eps.
+Replace ``(Rabsolu (8))`` with ``8``.
+Replace ``(Rabsolu 2)`` with ``2``.
+Replace ``8`` with ``4*2``; [Idtac | Ring].
+Rewrite Rinv_Rmult; DiscrR.
+Replace ``2*(Rabsolu l2)*((Rabsolu (f1 x))*(/(Rabsolu (f2 x))*/(Rabsolu (f2 x))*/(Rabsolu (f2 x))))*((Rabsolu (f2 x))*(Rabsolu (f2 x))*(Rabsolu (f2 x))*eps*(/4*/2*/(Rabsolu (f1 x))*/(Rabsolu l2)))`` with ``eps*/4*((Rabsolu l2)*/(Rabsolu l2))*((Rabsolu (f1 x))*/(Rabsolu (f1 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*((Rabsolu (f2 x))*/(Rabsolu (f2 x)))*(2*/2)``; [Idtac | Ring].
+Repeat Rewrite <- Rinv_r_sym; Try DiscrR Orelse (Apply Rabsolu_no_R0; Assumption).
+Ring.
+Symmetry; Apply Rabsolu_right; Left; Sup0.
+Symmetry; Apply Rabsolu_right; Left; Sup.
+Symmetry; Apply Rabsolu_right; Left; Assumption.
+Apply prod_neq_R0; Assumption Orelse DiscrR.
+Apply prod_neq_R0; Assumption.
+Qed.
+
+Lemma D_x_no_cond : (x,a:R) ``a<>0`` -> (D_x no_cond x ``x+a``).
+Intros.
+Unfold D_x no_cond.
+Split.
+Trivial.
+Apply Rminus_not_eq.
+Unfold Rminus.
+Rewrite Ropp_distr1.
+Rewrite <- Rplus_assoc.
+Rewrite Rplus_Ropp_r.
+Rewrite Rplus_Ol.
+Apply Ropp_neq; Assumption.
+Qed.
+
+Lemma Rabsolu_4 : (a,b,c,d:R) ``(Rabsolu (a+b+c+d)) <= (Rabsolu a) + (Rabsolu b) + (Rabsolu c) + (Rabsolu d)``.
+Intros.
+Apply Rle_trans with ``(Rabsolu (a+b)) + (Rabsolu (c+d))``.
+Replace ``a+b+c+d`` with ``(a+b)+(c+d)``; [Apply Rabsolu_triang | Ring].
+Apply Rle_trans with ``(Rabsolu a) + (Rabsolu b) + (Rabsolu (c+d))``.
+Apply Rle_compatibility_r.
+Apply Rabsolu_triang.
+Repeat Rewrite Rplus_assoc; Repeat Apply Rle_compatibility.
+Apply Rabsolu_triang.
+Qed.
+
+Lemma Rlt_4 : (a,b,c,d,e,f,g,h:R) ``a < b`` -> ``c < d`` -> ``e < f `` -> ``g < h`` -> ``a+c+e+g < b+d+f+h``.
+Intros; Apply Rlt_trans with ``b+c+e+g``.
+Repeat Apply Rlt_compatibility_r; Assumption.
+Repeat Rewrite Rplus_assoc; Apply Rlt_compatibility.
+Apply Rlt_trans with ``d+e+g``.
+Rewrite Rplus_assoc; Apply Rlt_compatibility_r; Assumption.
+Rewrite Rplus_assoc; Apply Rlt_compatibility; Apply Rlt_trans with ``f+g``.
+Apply Rlt_compatibility_r; Assumption.
+Apply Rlt_compatibility; Assumption.
+Qed.
+
+Lemma Rmin_2 : (a,b,c:R) ``a < b`` -> ``a < c`` -> ``a < (Rmin b c)``.
+Intros; Unfold Rmin; Case (total_order_Rle b c); Intro; Assumption.
+Qed.
+
+Lemma quadruple : (x:R) ``4*x == x + x + x + x``.
+Intro; Ring.
+Qed.
+
+Lemma quadruple_var : (x:R) `` x == x/4 + x/4 + x/4 + x/4``.
+Intro; Rewrite <- quadruple.
+Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m; DiscrR.
+Reflexivity.
+Qed.
+
+(**********)
+Lemma continuous_neq_0 : (f:R->R; x0:R) (continuity_pt f x0) -> ~``(f x0)==0`` -> (EXT eps : posreal | (h:R) ``(Rabsolu h) < eps`` -> ~``(f (x0+h))==0``).
+Intros; Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Elim (H ``(Rabsolu ((f x0)/2))``).
+Intros; Elim H1; Intros.
+Exists (mkposreal x H2).
+Intros; Assert H5 := (H3 ``x0+h``).
+Cut ``(dist R_met (x0+h) x0) < x`` -> ``(dist R_met (f (x0+h)) (f x0)) < (Rabsolu ((f x0)/2))``.
+Unfold dist; Simpl; Unfold R_dist; Replace ``x0+h-x0`` with h.
+Intros; Assert H7 := (H6 H4).
+Red; Intro.
+Rewrite H8 in H7; Unfold Rminus in H7; Rewrite Rplus_Ol in H7; Rewrite Rabsolu_Ropp in H7; Unfold Rdiv in H7; Rewrite Rabsolu_mult in H7; Pattern 1 ``(Rabsolu (f x0)) `` in H7; Rewrite <- Rmult_1r in H7.
+Cut ``0<(Rabsolu (f x0))``.
+Intro; Assert H10 := (Rlt_monotony_contra ? ? ? H9 H7).
+Cut ``(Rabsolu (/2))==/2``.
+Assert Hyp:``0<2``.
+Sup0.
+Intro; Rewrite H11 in H10; Assert H12 := (Rlt_monotony ``2`` ? ? Hyp H10); Rewrite Rmult_1r in H12; Rewrite <- Rinv_r_sym in H12; [Idtac | DiscrR].
+Cut (Rlt (IZR `1`) (IZR `2`)).
+Unfold IZR; Unfold INR convert; Simpl; Intro; Elim (Rlt_antirefl ``1`` (Rlt_trans ? ? ? H13 H12)).
+Apply IZR_lt; Omega.
+Unfold Rabsolu; Case (case_Rabsolu ``/2``); Intro.
+Assert Hyp:``0<2``.
+Sup0.
+Assert H11 := (Rlt_monotony ``2`` ? ? Hyp r); Rewrite Rmult_Or in H11; Rewrite <- Rinv_r_sym in H11; [Idtac | DiscrR].
+Elim (Rlt_antirefl ``0`` (Rlt_trans ? ? ? Rlt_R0_R1 H11)).
+Reflexivity.
+Apply (Rabsolu_pos_lt ? H0).
+Ring.
+Assert H6 := (Req_EM ``x0`` ``x0+h``); Elim H6; Intro.
+Intro; Rewrite <- H7; Unfold dist R_met; Unfold R_dist; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
+Unfold Rdiv; Apply prod_neq_R0; [Assumption | Apply Rinv_neq_R0; DiscrR].
+Intro; Apply H5.
+Split.
+Unfold D_x no_cond.
+Split; Trivial Orelse Assumption.
+Assumption.
+Change ``0 < (Rabsolu ((f x0)/2))``.
+Apply Rabsolu_pos_lt; Unfold Rdiv; Apply prod_neq_R0.
+Assumption.
+Apply Rinv_neq_R0; DiscrR.
+Qed.
diff --git a/theories7/Reals/Ranalysis3.v b/theories7/Reals/Ranalysis3.v
new file mode 100644
index 00000000..6ce63bbc
--- /dev/null
+++ b/theories7/Reals/Ranalysis3.v
@@ -0,0 +1,617 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Ranalysis3.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis1.
+Require Ranalysis2.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(* Division *)
+Theorem derivable_pt_lim_div : (f1,f2:R->R;x,l1,l2:R) (derivable_pt_lim f1 x l1) -> (derivable_pt_lim f2 x l2) -> ~``(f2 x)==0``-> (derivable_pt_lim (div_fct f1 f2) x ``(l1*(f2 x)-l2*(f1 x))/(Rsqr (f2 x))``).
+Intros.
+Cut (derivable_pt f2 x); [Intro | Unfold derivable_pt; Apply Specif.existT with l2; Exact H0].
+Assert H2 := ((continuous_neq_0 ? ? (derivable_continuous_pt ? ? X)) H1).
+Elim H2; Clear H2; Intros eps_f2 H2.
+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 ``(Rabsolu (f2 x))/2``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (f2 x))*/2``; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0]].
+Clear H3; Intros alp_f2 H3.
+Cut (x0:R) ``(Rabsolu (x0-x)) < alp_f2`` ->``(Rabsolu ((f2 x0)-(f2 x))) < (Rabsolu (f2 x))/2``.
+Intro H4.
+Cut (a:R) ``(Rabsolu (a-x)) < alp_f2``->``(Rabsolu (f2 x))/2 < (Rabsolu (f2 a))``.
+Intro H5.
+Cut (a:R) ``(Rabsolu (a)) < (Rmin eps_f2 alp_f2)`` -> ``/(Rabsolu (f2 (x+a))) < 2/(Rabsolu (f2 x))``.
+Intro Maj.
+Unfold derivable_pt_lim; Intros.
+Elim (H ``(Rabsolu ((eps*(f2 x))/8))``); [Idtac | Unfold Rdiv; Change ``0 < (Rabsolu (eps*(f2 x)*/8))``; Apply Rabsolu_pos_lt; Repeat Apply prod_neq_R0; [Red; Intro H7; Rewrite H7 in H6; Elim (Rlt_antirefl ? H6) | Assumption | Apply Rinv_neq_R0; DiscrR]].
+Intros alp_f1d H7.
+Case (Req_EM (f1 x) R0); Intro.
+Case (Req_EM l1 R0); Intro.
+(***********************************)
+(*              Cas n° 1           *)
+(*           (f1 x)=0  l1 =0       *)
+(***********************************)
+Cut ``0 < (Rmin eps_f2 (Rmin alp_f2 alp_f1d))``; [Intro | Repeat Apply Rmin_pos; [Apply (cond_pos eps_f2) | Elim H3; Intros; Assumption | Apply (cond_pos alp_f1d)]].
+Exists (mkposreal (Rmin eps_f2 (Rmin alp_f2 alp_f1d)) H10).
+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 ? ?)).
+Assert H16 := (Rlt_le_trans ? ? ? H13 (Rmin_l ? ?)).
+Assert H17 := (H7 ? H11 H15).
+Rewrite formule; [Idtac | Assumption | Assumption | Apply H2; Apply H14].
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite H8.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite H8.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite H9.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_mult.
+Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Try Assumption Orelse Apply H2.
+Apply H14.
+Apply Rmin_2; Assumption.
+Right; Symmetry; Apply quadruple_var.
+(***********************************)
+(*              Cas n° 2           *)
+(*           (f1 x)=0  l1<>0       *)
+(***********************************)
+Assert H10 := (derivable_continuous_pt ? ? X).
+Unfold continuity_pt in H10.
+Unfold continue_in in H10.
+Unfold limit1_in in H10.
+Unfold limit_in in H10.
+Unfold dist in H10.
+Simpl in H10.
+Unfold R_dist in H10.
+Elim (H10 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
+Clear H10; Intros alp_f2t2 H10.
+Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a)) - (f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Intro H11.
+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.
+Intros.
+Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
+Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
+Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
+Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
+Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
+Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
+Clear H14 H15 H16.
+Rewrite formule; Try Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite H8.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite H8.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_mult.
+Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_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; Apply quadruple_var.
+Apply H2; Assumption.
+Repeat Apply Rmin_pos.
+Apply (cond_pos eps_f2).
+Apply (cond_pos alp_f1d).
+Elim H3; Intros; Assumption.
+Elim H10; Intros; Assumption.
+Intros.
+Elim H10; Intros.
+Case (Req_EM a R0); Intro.
+Rewrite H14; Rewrite Rplus_Or.
+Unfold Rminus; Rewrite Rplus_Ropp_r.
+Rewrite Rabsolu_R0.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc.
+Repeat Apply prod_neq_R0; Try Assumption.
+Red; Intro; Rewrite H15 in H6; Elim (Rlt_antirefl ? H6).
+Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse Assumption.
+Apply H13.
+Split.
+Apply D_x_no_cond; Assumption.
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Change ``0<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0.
+Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6).
+Assumption. 
+Assumption.
+Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; [DiscrR | DiscrR | DiscrR | Assumption].
+(***********************************)
+(*              Cas n° 3           *)
+(*     (f1 x)<>0  l1=0  l2=0       *)
+(***********************************)
+Case (Req_EM l1 R0); Intro.
+Case (Req_EM l2 R0); Intro.
+Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rdiv Rsqr; Repeat Rewrite Rmult_assoc; Repeat Apply prod_neq_R0; [Assumption | Assumption | Red; Intro; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6) | Apply Rinv_neq_R0; Repeat Apply prod_neq_R0; DiscrR Orelse 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.
+Intros.
+Assert H15 := (Rlt_le_trans ? ? ? H14 (Rmin_l ? ?)).
+Assert H16 := (Rlt_le_trans ? ? ? H14 (Rmin_r ? ?)).
+Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
+Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
+Assert H19 := (Rlt_le_trans ? ? ? H16 (Rmin_l ? ?)).
+Assert H20 := (Rlt_le_trans ? ? ? H16 (Rmin_r ? ?)).
+Clear H15 H16.
+Rewrite formule; Try Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite H10.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_mult.
+Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite H9.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_mult.
+Apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); Assumption Orelse Idtac.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Right; Symmetry; Apply quadruple_var.
+Apply H2; Assumption.
+Repeat Apply Rmin_pos.
+Apply (cond_pos eps_f2).
+Elim H3; Intros; Assumption.
+Apply (cond_pos alp_f1d).
+Apply (cond_pos alp_f2d).
+(***********************************)
+(*              Cas n° 4           *)
+(*    (f1 x)<>0  l1=0  l2<>0       *)
+(***********************************)
+Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``); [Idtac | Apply Rabsolu_pos_lt; Unfold Rsqr Rdiv; Repeat Rewrite Rinv_Rmult; Repeat Apply prod_neq_R0; Try Assumption Orelse DiscrR].
+Intros alp_f2d H11.
+Assert H12 := (derivable_continuous_pt ? ? X).
+Unfold continuity_pt in H12.
+Unfold continue_in in H12.
+Unfold limit1_in in H12.
+Unfold limit_in in H12.
+Unfold dist in H12.
+Simpl in H12.
+Unfold R_dist in H12.
+Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
+Intros alp_f2c H13.
+Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c)))``.
+Intro.
+Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2c))) H14).
+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 ? ?)).
+Assert H20 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
+Assert H21 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
+Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
+Assert H23 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
+Assert H24 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
+Clear H16 H17 H18 H19.
+Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
+Intro.
+Rewrite formule; Try Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite H9.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_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; Apply quadruple_var.
+Apply H2; Assumption.
+Intros.
+Case (Req_EM a R0); Intro.
+Rewrite H17; Rewrite Rplus_Or.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr.
+Repeat Rewrite Rinv_Rmult; Try Assumption.
+Repeat Apply prod_neq_R0; Try Assumption.
+Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6). 
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; Assumption.
+Apply Rinv_neq_R0; Assumption.
+DiscrR.
+DiscrR.
+DiscrR.
+DiscrR.
+DiscrR.
+Apply prod_neq_R0; [DiscrR | Assumption].
+Elim H13; Intros.
+Apply H19.
+Split.
+Apply D_x_no_cond; Assumption.
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Repeat Apply Rmin_pos.
+Apply (cond_pos eps_f2).
+Elim H3; Intros; Assumption.
+Apply (cond_pos alp_f1d).
+Apply (cond_pos alp_f2d).
+Elim H13; Intros; Assumption.
+Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
+Apply Rabsolu_pos_lt.
+Unfold Rsqr Rdiv.
+Repeat Rewrite Rinv_Rmult; Try Assumption Orelse DiscrR.
+Repeat Apply prod_neq_R0; Try Assumption.
+Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6). 
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; Assumption.
+Apply Rinv_neq_R0; Assumption.
+Apply prod_neq_R0; [DiscrR | Assumption].
+Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6). 
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rinv_neq_R0; Assumption.
+(***********************************)
+(*              Cas n° 5           *)
+(*    (f1 x)<>0  l1<>0  l2=0       *)
+(***********************************)
+Case (Req_EM l2 R0); Intro.
+Assert H11 := (derivable_continuous_pt ? ? X).
+Unfold continuity_pt in H11.
+Unfold continue_in in H11.
+Unfold limit1_in in H11.
+Unfold limit_in in H11.
+Unfold dist in H11.
+Simpl in H11.
+Unfold R_dist in H11.
+Elim (H11 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
+Clear H11; Intros alp_f2t2 H11.
+Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
+Intros alp_f2d H12.
+Cut ``0 < (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2)))``.
+Intro.
+Exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d (Rmin alp_f2d alp_f2t2))) H13).
+Simpl.
+Intros.
+Cut (a:R) ``(Rabsolu a)<alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x)))<(Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Intro.
+Assert H17 := (Rlt_le_trans ? ? ? H15 (Rmin_l ? ?)).
+Assert H18 := (Rlt_le_trans ? ? ? H15 (Rmin_r ? ?)).
+Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
+Assert H20 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
+Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
+Assert H22 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
+Assert H23 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
+Assert H24 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
+Clear H15 H17 H18 H21.
+Rewrite formule; Try Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite H10.
+Unfold Rdiv; Repeat Rewrite Rmult_Or Orelse Rewrite Rmult_Ol.
+Rewrite Rabsolu_R0; Rewrite Rmult_Ol.
+Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup].
+Rewrite <- Rabsolu_mult.
+Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_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; Apply quadruple_var.
+Apply H2; Assumption.
+Intros.
+Case (Req_EM a R0); Intro.
+Rewrite H17; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
+Unfold Rsqr.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H18; Rewrite H18 in H6; Elim (Rlt_antirefl ? H6)).
+Elim H11; Intros.
+Apply H19.
+Split.
+Apply D_x_no_cond; Assumption.
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Repeat Apply Rmin_pos.
+Apply (cond_pos eps_f2).
+Elim H3; Intros; Assumption.
+Apply (cond_pos alp_f1d). 
+Apply (cond_pos alp_f2d).
+Elim H11; Intros; Assumption.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
+Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H12; Rewrite H12 in H6; Elim (Rlt_antirefl ? H6)).
+(***********************************)
+(*              Cas n° 6           *)
+(*    (f1 x)<>0  l1<>0  l2<>0      *)
+(***********************************)
+Elim (H0 ``(Rabsolu ((Rsqr (f2 x))*eps)/(8*(f1 x)))``).
+Intros alp_f2d H11.
+Assert H12 := (derivable_continuous_pt ? ? X).
+Unfold continuity_pt in H12.
+Unfold continue_in in H12.
+Unfold limit1_in in H12.
+Unfold limit_in in H12.
+Unfold dist in H12.
+Simpl in H12.
+Unfold R_dist in H12.
+Elim (H12 ``(Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``).
+Intros alp_f2c H13.
+Elim (H12 ``(Rabsolu (eps*(Rsqr (f2 x)))/(8*l1))``).
+Intros alp_f2t2 H14.
+Cut ``0 < (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2))``.
+Intro.
+Exists (mkposreal (Rmin (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) (Rmin alp_f2c alp_f2t2)) H15).
+Simpl.
+Intros.
+Assert H18 := (Rlt_le_trans ? ? ? H17 (Rmin_l ? ?)).
+Assert H19 := (Rlt_le_trans ? ? ? H17 (Rmin_r ? ?)).
+Assert H20 := (Rlt_le_trans ? ? ? H18 (Rmin_l ? ?)).
+Assert H21 := (Rlt_le_trans ? ? ? H18 (Rmin_r ? ?)).
+Assert H22 := (Rlt_le_trans ? ? ? H19 (Rmin_l ? ?)).
+Assert H23 := (Rlt_le_trans ? ? ? H19 (Rmin_r ? ?)).
+Assert H24 := (Rlt_le_trans ? ? ? H20 (Rmin_l ? ?)).
+Assert H25 := (Rlt_le_trans ? ? ? H20 (Rmin_r ? ?)).
+Assert H26 := (Rlt_le_trans ? ? ? H21 (Rmin_l ? ?)).
+Assert H27 := (Rlt_le_trans ? ? ? H21 (Rmin_r ? ?)).
+Clear H17 H18 H19 H20 H21.
+Cut (a:R) ``(Rabsolu a) < alp_f2t2`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``.
+Cut (a:R) ``(Rabsolu a) < alp_f2c`` -> ``(Rabsolu ((f2 (x+a))-(f2 x))) < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``.
+Intros.
+Rewrite formule; Try Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (/(f2 (x+h))*(((f1 (x+h))-(f1 x))/h-l1))) + (Rabsolu (l1/((f2 x)*(f2 (x+h)))*((f2 x)-(f2 (x+h))))) + (Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))-(f2 x))/h-l2))) + (Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))*((f2 (x+h))-(f2 x))))``.
+Unfold Rminus.
+Rewrite <- (Rabsolu_Ropp ``(f1 x)/((f2 x)*(f2 (x+h)))*(((f2 (x+h))+ -(f2 x))/h+ -l2)``).
+Apply Rabsolu_4.
+Repeat Rewrite Rabsolu_mult.
+Apply Rlt_le_trans with ``eps/4+eps/4+eps/4+eps/4``.
+Cut ``(Rabsolu (/(f2 (x+h))))*(Rabsolu (((f1 (x+h))-(f1 x))/h-l1)) < eps/4``.
+Cut ``(Rabsolu (l1/((f2 x)*(f2 (x+h)))))*(Rabsolu ((f2 x)-(f2 (x+h)))) < eps/4``.
+Cut ``(Rabsolu ((f1 x)/((f2 x)*(f2 (x+h)))))*(Rabsolu (((f2 (x+h))-(f2 x))/h-l2)) < eps/4``.
+Cut ``(Rabsolu ((l2*(f1 x))/((Rsqr (f2 x))*(f2 (x+h)))))*(Rabsolu ((f2 (x+h))-(f2 x))) < eps/4``.
+Intros.
+Apply Rlt_4; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term4 x h eps l2 alp_f2 alp_f2c eps_f2 f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_mult.
+Apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); Try Assumption.
+Apply H2; Assumption.
+Apply Rmin_2; Assumption.
+Rewrite <- Rabsolu_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; Apply quadruple_var.
+Apply H2; Assumption.
+Intros.
+Case (Req_EM a R0); Intro.
+Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
+Apply prod_neq_R0; [DiscrR | Assumption].
+Apply prod_neq_R0; [DiscrR | Assumption].
+Assumption.
+Elim H13; Intros.
+Apply H20.
+Split.
+Apply D_x_no_cond; Assumption.
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Intros.
+Case (Req_EM a R0); Intro.
+Rewrite H18; Rewrite Rplus_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H28; Rewrite H28 in H6; Elim (Rlt_antirefl ? H6)).
+DiscrR.
+Assumption.
+Elim H14; Intros.
+Apply H20.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Apply Rminus_not_eq_right.
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Replace ``x+a-x`` with a; [Assumption | Ring].
+Repeat Apply Rmin_pos.
+Apply (cond_pos eps_f2).
+Elim H3; Intros; Assumption.
+Apply (cond_pos alp_f1d).
+Apply (cond_pos alp_f2d).
+Elim H13; Intros; Assumption.
+Elim H14; Intros; Assumption.
+Change ``0 < (Rabsolu ((eps*(Rsqr (f2 x)))/(8*l1)))``; Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; Try DiscrR Orelse Assumption.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H14; Rewrite H14 in H6; Elim (Rlt_antirefl ? H6)).
+Change ``0 < (Rabsolu (((Rsqr (f2 x))*(f2 x)*eps)/(8*(f1 x)*l2)))``; Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult.
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H13; Rewrite H13 in H6; Elim (Rlt_antirefl ? H6)).
+Apply prod_neq_R0; [DiscrR | Assumption].
+Apply prod_neq_R0; [DiscrR | Assumption].
+Assumption.
+Apply Rabsolu_pos_lt.
+Unfold Rdiv Rsqr; Rewrite Rinv_Rmult; [Idtac | DiscrR | Assumption].
+Repeat Apply prod_neq_R0; Assumption Orelse (Apply Rinv_neq_R0; Assumption) Orelse (Apply Rinv_neq_R0; DiscrR) Orelse (Red; Intro H11; Rewrite H11 in H6; Elim (Rlt_antirefl ? H6)).
+Intros.
+Unfold Rdiv.
+Apply Rlt_monotony_contra with ``(Rabsolu (f2 (x+a)))``.
+Apply Rabsolu_pos_lt; Apply H2.
+Apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
+Assumption.
+Apply Rmin_l.
+Rewrite <- Rinv_r_sym.
+Apply Rlt_monotony_contra with (Rabsolu (f2 x)).
+Apply Rabsolu_pos_lt; Assumption.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym (Rabsolu (f2 x))).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Apply Rlt_monotony_contra with ``/2``.
+Apply Rlt_Rinv; Sup0.
+Repeat Rewrite (Rmult_sym ``/2``).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r.
+Unfold Rdiv in H5; Apply H5.
+Replace ``x+a-x`` with a.
+Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_r ? ?)); Assumption.
+Ring.
+DiscrR.
+Apply Rabsolu_no_R0; Assumption.
+Apply Rabsolu_no_R0; Apply H2.
+Assert H7 := (Rlt_le_trans ? ? ? H6 (Rmin_l ? ?)); Assumption.
+Intros.
+Assert H6 := (H4 a H5).
+Rewrite <- (Rabsolu_Ropp ``(f2 a)-(f2 x)``) in H6.
+Rewrite Ropp_distr2 in H6.
+Assert H7 := (Rle_lt_trans ? ? ? (Rabsolu_triang_inv ? ?) H6).
+Apply Rlt_anti_compatibility with ``-(Rabsolu (f2 a)) + (Rabsolu (f2 x))/2``.
+Rewrite Rplus_assoc.
+Rewrite <- double_var.
+Do 2 Rewrite (Rplus_sym ``-(Rabsolu (f2 a))``).
+Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Unfold Rminus in H7; Assumption.
+Intros.
+Case (Req_EM x x0); Intro.
+Rewrite <- H5; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Sup0].
+Elim H3; Intros.
+Apply H7.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Assumption.
+Assumption.
+Qed.
+
+Lemma derivable_pt_div : (f1,f2:R->R;x:R) (derivable_pt f1 x) -> (derivable_pt f2 x) -> ``(f2 x)<>0`` -> (derivable_pt (div_fct f1 f2) x).
+Unfold derivable_pt.
+Intros.
+Elim X; Intros.
+Elim X0; Intros.
+Apply Specif.existT with ``(x0*(f2 x)-x1*(f1 x))/(Rsqr (f2 x))``.
+Apply derivable_pt_lim_div; Assumption.
+Qed.
+
+Lemma derivable_div : (f1,f2:R->R) (derivable f1) -> (derivable f2) -> ((x:R)``(f2 x)<>0``) -> (derivable (div_fct f1 f2)).
+Unfold derivable; Intros.
+Apply (derivable_pt_div ? ? ? (X x) (X0 x) (H x)).
+Qed.
+
+Lemma derive_pt_div : (f1,f2:R->R;x:R;pr1:(derivable_pt f1 x);pr2:(derivable_pt f2 x);na:``(f2 x)<>0``) ``(derive_pt (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)) == ((derive_pt f1 x pr1)*(f2 x)-(derive_pt f2 x pr2)*(f1 x))/(Rsqr (f2 x))``.
+Intros.
+Assert H := (derivable_derive f1 x pr1).
+Assert H0 := (derivable_derive f2 x pr2).
+Assert H1 := (derivable_derive (div_fct f1 f2) x (derivable_pt_div ? ? ? pr1 pr2 na)).
+Elim H; Clear H; Intros l1 H.
+Elim H0; Clear H0; Intros l2 H0.
+Elim H1; Clear H1; Intros l H1.
+Rewrite H; Rewrite H0; Apply derive_pt_eq_0.
+Assert H3 := (projT2 ? ? pr1).
+Unfold derive_pt in H; Rewrite H in H3.
+Assert H4 := (projT2 ? ? pr2).
+Unfold derive_pt in H0; Rewrite H0 in H4.
+Apply derivable_pt_lim_div; Assumption.
+Qed.
diff --git a/theories7/Reals/Ranalysis4.v b/theories7/Reals/Ranalysis4.v
new file mode 100644
index 00000000..061854dc
--- /dev/null
+++ b/theories7/Reals/Ranalysis4.v
@@ -0,0 +1,313 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Ranalysis4.v,v 1.1.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require Ranalysis1.
+Require Ranalysis3.
+Require Exp_prop.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(**********)
+Lemma derivable_pt_inv : (f:R->R;x:R) ``(f x)<>0`` -> (derivable_pt f x) -> (derivable_pt (inv_fct f) x).
+Intros; Cut (derivable_pt (div_fct (fct_cte R1) f) x) -> (derivable_pt (inv_fct f) x).
+Intro; Apply X0.
+Apply derivable_pt_div.
+Apply derivable_pt_const.
+Assumption.
+Assumption.
+Unfold div_fct inv_fct fct_cte; Intro; Elim X0; Intros; Unfold derivable_pt; Apply Specif.existT with 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; Rewrite <- (Rmult_1l ``/(f x)``); Rewrite <- (Rmult_1l ``/(f (x+h))``).
+Apply H1; Assumption.
+Qed.
+
+(**********)
+Lemma pr_nu_var : (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).
+Unfold derivable_pt derive_pt; Intros.
+Elim pr1; Intros.
+Elim pr2; Intros.
+Simpl.
+Rewrite H in p.
+Apply unicite_limite with g x; Assumption.
+Qed.
+
+(**********)
+Lemma pr_nu_var2 : (f,g:R->R;x:R;pr1:(derivable_pt f x);pr2:(derivable_pt g x)) ((h:R)(f h)==(g h)) -> (derive_pt f x pr1) == (derive_pt g x pr2).
+Unfold derivable_pt derive_pt; Intros.
+Elim pr1; Intros.
+Elim pr2; Intros.
+Simpl.
+Assert H0 := (unicite_step2 ? ? ? p). 
+Assert H1 := (unicite_step2 ? ? ? p0). 
+Cut (limit1_in [h:R]``((f (x+h))-(f x))/h`` [h:R]``h <> 0`` x1 ``0``).
+Intro; Assert H3 := (unicite_step1 ? ? ? ? H0 H2). 
+Assumption.
+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.
+Elim H3; Intros.
+Exists x2.
+Split.
+Assumption.
+Intros; Do 2 Rewrite H; Apply H5; Assumption.
+Qed.
+
+(**********)
+Lemma derivable_inv : (f:R->R) ((x:R)``(f x)<>0``)->(derivable f)->(derivable (inv_fct f)).
+Intros.
+Unfold derivable; Intro.
+Apply derivable_pt_inv.
+Apply (H x).
+Apply (X x).
+Qed.
+
+Lemma derive_pt_inv : (f:R->R;x:R;pr:(derivable_pt f x);na:``(f x)<>0``) (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) == ``-(derive_pt f x pr)/(Rsqr (f x))``.
+Intros; Replace (derive_pt (inv_fct f) x (derivable_pt_inv f x na pr)) with (derive_pt (div_fct (fct_cte R1) f) x (derivable_pt_div (fct_cte R1) f x (derivable_pt_const R1 x) pr na)).
+Rewrite derive_pt_div; Rewrite derive_pt_const; Unfold fct_cte; Rewrite Rmult_Ol; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_Ol; Reflexivity.
+Apply pr_nu_var2.
+Intro; Unfold div_fct fct_cte inv_fct.
+Unfold Rdiv; Ring.
+Qed.
+
+(* Rabsolu *)
+Lemma Rabsolu_derive_1 : (x:R) ``0<x`` -> (derivable_pt_lim Rabsolu x ``1``).
+Intros.
+Unfold derivable_pt_lim; Intros.
+Exists (mkposreal x H); Intros.
+Rewrite (Rabsolu_right x).
+Rewrite (Rabsolu_right ``x+h``).
+Rewrite Rplus_sym.
+Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r.
+Rewrite Rplus_Or; Unfold Rdiv; Rewrite <- Rinv_r_sym.
+Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
+Apply H1.
+Apply Rle_sym1.
+Case (case_Rabsolu h); Intro.
+Rewrite (Rabsolu_left h r) in H2.
+Left; Rewrite Rplus_sym; Apply Rlt_anti_compatibility with ``-h``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H2.
+Apply ge0_plus_ge0_is_ge0.
+Left; Apply H.
+Apply Rle_sym2; Apply r.
+Left; Apply H.
+Qed.
+
+Lemma Rabsolu_derive_2 : (x:R) ``x<0`` -> (derivable_pt_lim Rabsolu x ``-1``).
+Intros.
+Unfold derivable_pt_lim; Intros.
+Cut ``0< -x``.
+Intro; Exists (mkposreal ``-x`` H1); Intros.
+Rewrite (Rabsolu_left x).
+Rewrite (Rabsolu_left ``x+h``).
+Rewrite Rplus_sym.
+Rewrite Ropp_distr1.
+Unfold Rminus; Rewrite Ropp_Ropp; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l.
+Rewrite Rplus_Or; Unfold Rdiv.
+Rewrite Ropp_mul1.
+Rewrite <- Rinv_r_sym.
+Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_l; Rewrite Rabsolu_R0; Apply H0.
+Apply H2.
+Case (case_Rabsolu h); Intro.
+Apply Ropp_Rlt.
+Rewrite Ropp_O; Rewrite Ropp_distr1; Apply gt0_plus_gt0_is_gt0.
+Apply H1.
+Apply Rgt_RO_Ropp; Apply r.
+Rewrite (Rabsolu_right h r) in H3.
+Apply Rlt_anti_compatibility with ``-x``; Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Apply H3.
+Apply H.
+Apply Rgt_RO_Ropp; Apply H.
+Qed.
+
+(* Rabsolu is derivable for all x <> 0 *)
+Lemma derivable_pt_Rabsolu : (x:R) ``x<>0`` -> (derivable_pt Rabsolu x).
+Intros.
+Case (total_order_T x R0); Intro.
+Elim s; Intro.
+Unfold derivable_pt; Apply Specif.existT with ``-1``.
+Apply (Rabsolu_derive_2 x a).
+Elim H; Exact b.
+Unfold derivable_pt; Apply Specif.existT with ``1``.
+Apply (Rabsolu_derive_1 x r).
+Qed.
+
+(* Rabsolu is continuous for all x *)
+Lemma continuity_Rabsolu : (continuity Rabsolu).
+Unfold continuity; Intro.
+Case (Req_EM x R0); Intro.
+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 Rabsolu_R0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Elim H1; Intros; Rewrite H in H3; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
+Apply derivable_continuous_pt; Apply (derivable_pt_Rabsolu x H).
+Qed.
+
+(* Finite sums : Sum a_k x^k *)
+Lemma continuity_finite_sum : (An:nat->R;N:nat) (continuity [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
+Intros; Unfold continuity; Intro.
+Induction N.
+Simpl.
+Apply continuity_pt_const.
+Unfold constant; Intros; Reflexivity.
+Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
+Apply continuity_pt_plus.
+Apply HrecN.
+Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
+Apply continuity_pt_scal.
+Apply derivable_continuous_pt.
+Apply derivable_pt_pow.
+Reflexivity.
+Reflexivity.
+Qed.
+
+Lemma derivable_pt_lim_fs : (An:nat->R;x:R;N:nat) (lt O N) -> (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N))).
+Intros; Induction N.
+Elim (lt_n_n ? H).
+Cut N=O\/(lt O N).
+Intro; Elim H0; Intro.
+Rewrite H1.
+Simpl.
+Replace [y:R]``(An O)*1+(An (S O))*(y*1)`` with (plus_fct (fct_cte ``(An O)*1``) (mult_real_fct ``(An (S O))`` (mult_fct id (fct_cte R1)))).
+Replace ``1*(An (S O))*1`` with ``0+(An (S O))*(1*(fct_cte R1 x)+(id x)*0)``.
+Apply derivable_pt_lim_plus.
+Apply derivable_pt_lim_const.
+Apply derivable_pt_lim_scal.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Unfold fct_cte id; Ring.
+Reflexivity.
+Replace [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` (S N)) with (plus_fct [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) [y:R]``(An (S N))*(pow y (S N))``).
+Replace (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))) with (Rplus (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) ``(An (S N))*((INR (S (pred (S N))))*(pow x (pred (S N))))``).
+Apply derivable_pt_lim_plus.
+Apply HrecN.
+Assumption.
+Replace [y:R]``(An (S N))*(pow y (S N))`` with (mult_real_fct (An (S N)) [y:R](pow y (S N))).
+Apply derivable_pt_lim_scal.
+Replace (pred (S N)) with N; [Idtac | Reflexivity].
+Pattern 3 N; Replace N with (pred (S N)).
+Apply derivable_pt_lim_pow.
+Reflexivity.
+Reflexivity.
+Cut (pred (S N)) = (S (pred N)).
+Intro; Rewrite H2.
+Rewrite tech5.
+Apply Rplus_plus_r.
+Rewrite <- H2.
+Replace (pred (S N)) with N; [Idtac | Reflexivity].
+Ring.
+Simpl.
+Apply S_pred with O; Assumption.
+Unfold plus_fct.
+Simpl; Reflexivity.
+Inversion H.
+Left; Reflexivity.
+Right; Apply lt_le_trans with (1); [Apply lt_O_Sn | Assumption].
+Qed.
+
+Lemma derivable_pt_lim_finite_sum : (An:(nat->R); x:R; N:nat) (derivable_pt_lim [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x (Cases N of O => R0 | _ => (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred N)) end)).
+Intros.
+Induction N.
+Simpl.
+Rewrite Rmult_1r.
+Replace [_:R]``(An O)`` with (fct_cte (An O)); [Apply derivable_pt_lim_const | Reflexivity].
+Apply derivable_pt_lim_fs; Apply lt_O_Sn.
+Qed.
+
+Lemma derivable_pt_finite_sum : (An:nat->R;N:nat;x:R) (derivable_pt [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N) x).
+Intros.
+Unfold derivable_pt.
+Assert H := (derivable_pt_lim_finite_sum An x N).
+Induction N.
+Apply Specif.existT with R0; Apply H.
+Apply Specif.existT with (sum_f_R0 [k:nat]``(INR (S k))*(An (S k))*(pow x k)`` (pred (S N))); Apply H.
+Qed.
+
+Lemma derivable_finite_sum : (An:nat->R;N:nat) (derivable [y:R](sum_f_R0 [k:nat]``(An k)*(pow y k)`` N)).
+Intros; Unfold derivable; Intro; Apply derivable_pt_finite_sum.
+Qed.
+
+(* Regularity of hyperbolic functions *)
+Lemma derivable_pt_lim_cosh : (x:R) (derivable_pt_lim cosh x ``(sinh x)``).
+Intro.
+Unfold cosh sinh; Unfold Rdiv.
+Replace [x0:R]``((exp x0)+(exp ( -x0)))*/2`` with (mult_fct (plus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
+Replace ``((exp x)-(exp ( -x)))*/2`` with ``((exp x)+((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((plus_fct exp (comp exp (opp_fct id))) x)*0``. 
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_plus.
+Apply derivable_pt_lim_exp.
+Apply derivable_pt_lim_comp.
+Apply derivable_pt_lim_opp.
+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; Ring.
+Qed.
+
+Lemma derivable_pt_lim_sinh : (x:R) (derivable_pt_lim sinh x ``(cosh x)``).
+Intro.
+Unfold cosh sinh; Unfold Rdiv.
+Replace [x0:R]``((exp x0)-(exp ( -x0)))*/2`` with (mult_fct (minus_fct exp (comp exp (opp_fct id))) (fct_cte ``/2``)); [Idtac | Reflexivity].
+Replace ``((exp x)+(exp ( -x)))*/2`` with ``((exp x)-((exp (-x))*-1))*((fct_cte (Rinv 2)) x)+((minus_fct exp (comp exp (opp_fct id))) x)*0``. 
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_minus.
+Apply derivable_pt_lim_exp.
+Apply derivable_pt_lim_comp.
+Apply derivable_pt_lim_opp.
+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; Ring.
+Qed.
+
+Lemma derivable_pt_exp : (x:R) (derivable_pt exp x).
+Intro.
+Unfold derivable_pt.
+Apply Specif.existT with (exp x).
+Apply derivable_pt_lim_exp.
+Qed.
+
+Lemma derivable_pt_cosh : (x:R) (derivable_pt cosh x).
+Intro.
+Unfold derivable_pt.
+Apply Specif.existT with (sinh x).
+Apply derivable_pt_lim_cosh.
+Qed.
+
+Lemma derivable_pt_sinh : (x:R) (derivable_pt sinh x).
+Intro.
+Unfold derivable_pt.
+Apply Specif.existT with (cosh x).
+Apply derivable_pt_lim_sinh.
+Qed.
+
+Lemma derivable_exp : (derivable exp).
+Unfold derivable; Apply derivable_pt_exp.
+Qed.
+
+Lemma derivable_cosh : (derivable cosh).
+Unfold derivable; Apply derivable_pt_cosh.
+Qed.
+
+Lemma derivable_sinh : (derivable sinh).
+Unfold derivable; Apply derivable_pt_sinh.
+Qed.
+
+Lemma derive_pt_exp : (x:R) (derive_pt exp x (derivable_pt_exp x))==(exp x).
+Intro; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_exp.
+Qed.
+
+Lemma derive_pt_cosh : (x:R) (derive_pt cosh x (derivable_pt_cosh x))==(sinh x).
+Intro; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_cosh.
+Qed.
+
+Lemma derive_pt_sinh : (x:R) (derive_pt sinh x (derivable_pt_sinh x))==(cosh x).
+Intro; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_sinh.
+Qed.
diff --git a/theories7/Reals/Raxioms.v b/theories7/Reals/Raxioms.v
new file mode 100644
index 00000000..caf8524c
--- /dev/null
+++ b/theories7/Reals/Raxioms.v
@@ -0,0 +1,172 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Raxioms.v,v 1.2.2.1 2004/07/16 19:31:33 herbelin Exp $ i*)
+
+(*********************************************************)
+(**    Axiomatisation of the classical reals             *)
+(*********************************************************)
+
+Require Export ZArith_base.
+V7only [
+Require Export Rsyntax.
+Import R_scope.
+].
+Open Local Scope R_scope.
+
+V7only [
+(*********************************************************)
+(*   Compatibility                                       *)
+(*********************************************************)
+Notation sumboolT := Specif.sumbool.
+Notation leftT := Specif.left.
+Notation rightT := Specif.right.
+Notation sumorT := Specif.sumor.
+Notation inleftT := Specif.inleft.
+Notation inrightT := Specif.inright.
+Notation sigTT := Specif.sigT.
+Notation existTT := Specif.existT.
+Notation SigT := Specif.sigT.
+].
+
+(*********************************************************)
+(*               Field axioms                            *)
+(*********************************************************)
+
+(*********************************************************)
+(**      Addition                                        *)
+(*********************************************************)
+
+(**********)
+Axiom Rplus_sym:(r1,r2:R)``r1+r2==r2+r1``.
+Hints Resolve Rplus_sym : real.
+
+(**********)
+Axiom Rplus_assoc:(r1,r2,r3:R)``(r1+r2)+r3==r1+(r2+r3)``.
+Hints Resolve Rplus_assoc : real.
+
+(**********)
+Axiom Rplus_Ropp_r:(r:R)``r+(-r)==0``.
+Hints Resolve Rplus_Ropp_r : real v62.
+
+(**********)
+Axiom Rplus_Ol:(r:R)``0+r==r``.
+Hints Resolve Rplus_Ol : real.
+
+(***********************************************************)       
+(**       Multiplication                                   *)
+(***********************************************************)
+
+(**********)
+Axiom Rmult_sym:(r1,r2:R)``r1*r2==r2*r1``.
+Hints Resolve Rmult_sym : real v62. 
+
+(**********)
+Axiom Rmult_assoc:(r1,r2,r3:R)``(r1*r2)*r3==r1*(r2*r3)``.
+Hints Resolve Rmult_assoc : real v62.
+
+(**********)
+Axiom Rinv_l:(r:R)``r<>0``->``(/r)*r==1``.
+Hints Resolve Rinv_l : real.
+
+(**********)
+Axiom Rmult_1l:(r:R)``1*r==r``.
+Hints Resolve Rmult_1l : real.
+
+(**********)
+Axiom R1_neq_R0:``1<>0``.
+Hints Resolve R1_neq_R0 : real.
+
+(*********************************************************)
+(**      Distributivity                                  *)
+(*********************************************************)
+
+(**********)
+Axiom Rmult_Rplus_distr:(r1,r2,r3:R)``r1*(r2+r3)==(r1*r2)+(r1*r3)``.
+Hints Resolve Rmult_Rplus_distr : real v62.
+
+(*********************************************************)
+(**      Order axioms                                    *)
+(*********************************************************)
+(*********************************************************)
+(**      Total Order                                     *)
+(*********************************************************)
+
+(**********)
+Axiom total_order_T:(r1,r2:R)(sumorT (sumboolT ``r1<r2`` r1==r2) ``r1>r2``).
+
+(*********************************************************)
+(**      Lower                                           *)
+(*********************************************************)
+
+(**********)
+Axiom Rlt_antisym:(r1,r2:R)``r1<r2`` -> ~ ``r2<r1``.
+
+(**********)
+Axiom Rlt_trans:(r1,r2,r3:R)
+  ``r1<r2``->``r2<r3``->``r1<r3``.
+
+(**********)
+Axiom Rlt_compatibility:(r,r1,r2:R)``r1<r2``->``r+r1<r+r2``.
+
+(**********)
+Axiom Rlt_monotony:(r,r1,r2:R)``0<r``->``r1<r2``->``r*r1<r*r2``.
+
+Hints Resolve Rlt_antisym Rlt_compatibility Rlt_monotony : real.
+
+(**********************************************************) 
+(**      Injection from N to R                            *)
+(**********************************************************)
+
+(**********)
+Fixpoint INR [n:nat]:R:=(Cases n of
+                          O      => ``0``
+                         |(S O)  => ``1``
+                         |(S n)  => ``(INR n)+1``
+                        end).  
+Arguments Scope INR [nat_scope].
+
+
+(**********************************************************) 
+(**      Injection from [Z] to [R]                        *)
+(**********************************************************)
+
+(**********)
+Definition IZR:Z->R:=[z:Z](Cases z of
+                         ZERO      => ``0``
+                        |(POS n) => (INR (convert n))
+                        |(NEG n) => ``-(INR (convert n))``
+                           end).  
+Arguments Scope IZR [Z_scope].
+
+(**********************************************************)
+(**      [R] Archimedian                                  *)
+(**********************************************************)
+
+(**********)
+Axiom archimed:(r:R)``(IZR (up r)) > r``/\``(IZR (up r))-r <= 1``.
+
+(**********************************************************)
+(**      [R] Complete                                     *)
+(**********************************************************)
+
+(**********)
+Definition is_upper_bound:=[E:R->Prop][m:R](x:R)(E x)->``x <= m``.
+
+(**********)
+Definition bound:=[E:R->Prop](ExT [m:R](is_upper_bound E m)).
+
+(**********)
+Definition is_lub:=[E:R->Prop][m:R]
+    (is_upper_bound E m)/\(b:R)(is_upper_bound E b)->``m <= b``.
+
+(**********)
+Axiom complet:(E:R->Prop)(bound E)->
+              (ExT [x:R] (E x))->
+              (sigTT R [m:R](is_lub E m)).
+
diff --git a/theories7/Reals/Rbase.v b/theories7/Reals/Rbase.v
new file mode 100644
index 00000000..54226206
--- /dev/null
+++ b/theories7/Reals/Rbase.v
@@ -0,0 +1,14 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rbase.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+Require Export Rdefinitions.
+Require Export Raxioms.
+Require Export RIneq.
+Require Export DiscrR.
diff --git a/theories7/Reals/Rbasic_fun.v b/theories7/Reals/Rbasic_fun.v
new file mode 100644
index 00000000..3d143e34
--- /dev/null
+++ b/theories7/Reals/Rbasic_fun.v
@@ -0,0 +1,476 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rbasic_fun.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+(*********************************************************)
+(**          Complements for the real numbers            *)
+(*                                                       *)
+(*********************************************************)
+
+Require Rbase.
+Require R_Ifp.
+Require Fourier.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Implicit Variable Type r:R.
+
+(*******************************)
+(**          Rmin              *)
+(*******************************)
+
+(*********)
+Definition Rmin :R->R->R:=[x,y:R]
+  Cases (total_order_Rle x y) of 
+    (leftT _)  => x
+  | (rightT _) => y
+  end.
+
+(*********)
+Lemma Rmin_Rgt_l:(r1,r2,r:R)(Rgt (Rmin r1 r2) r) ->
+    ((Rgt r1 r)/\(Rgt r2 r)).
+Intros r1 r2 r;Unfold Rmin;Case (total_order_Rle r1 r2);Intros.
+Split.
+Assumption.
+Unfold Rgt;Unfold Rgt in H;Exact (Rlt_le_trans r r1 r2 H r0).
+Split.
+Generalize (not_Rle r1 r2 n);Intro;Exact (Rgt_trans r1 r2 r H0 H).
+Assumption.
+Qed.
+
+(*********)
+Lemma Rmin_Rgt_r:(r1,r2,r:R)(((Rgt r1 r)/\(Rgt r2 r)) -> 
+         (Rgt (Rmin r1 r2) r)).
+Intros;Unfold Rmin;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;
+ Assumption.
+Qed.
+
+(*********)
+Lemma Rmin_Rgt:(r1,r2,r:R)(Rgt (Rmin r1 r2) r)<->
+    ((Rgt r1 r)/\(Rgt r2 r)).
+Intros; Split.
+Exact (Rmin_Rgt_l r1 r2 r).
+Exact (Rmin_Rgt_r r1 r2 r).
+Qed.
+
+(*********)
+Lemma Rmin_l : (x,y:R) ``(Rmin x y)<=x``.
+Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Right; Reflexivity | Auto with real].
+Qed.
+ 
+(*********)
+Lemma Rmin_r : (x,y:R) ``(Rmin x y)<=y``.
+Intros; Unfold Rmin; Case (total_order_Rle x y); Intro H1; [Assumption | Auto with real].
+Qed.
+
+(*********)
+Lemma Rmin_sym : (a,b:R) (Rmin a b)==(Rmin b a).
+Intros; Unfold Rmin; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse (Apply Rle_antisym; Assumption Orelse Auto with real).
+Qed.
+
+(*********)
+Lemma Rmin_stable_in_posreal : (x,y:posreal) ``0<(Rmin x y)``.
+Intros; Apply Rmin_Rgt_r; Split; [Apply (cond_pos x) | Apply (cond_pos y)].
+Qed.
+
+(*******************************)
+(**          Rmax              *)
+(*******************************)
+
+(*********)
+Definition Rmax :R->R->R:=[x,y:R]
+  Cases (total_order_Rle x y) of 
+    (leftT _)  => y
+  | (rightT _) => x
+  end.
+
+(*********)
+Lemma Rmax_Rle:(r1,r2,r:R)(Rle r (Rmax r1 r2))<->
+    ((Rle r r1)\/(Rle r r2)).
+Intros;Split.
+Unfold Rmax;Case (total_order_Rle r1 r2);Intros;Auto.
+Intro;Unfold Rmax;Case (total_order_Rle r1 r2);Elim H;Clear H;Intros;Auto.
+Apply (Rle_trans r r1 r2);Auto.
+Generalize (not_Rle r1 r2 n);Clear n;Intro;Unfold Rgt in H0;
+ Apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
+Qed.
+
+Lemma RmaxLess1: (r1, r2 : R)  (Rle r1 (Rmax r1 r2)).
+Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
+Qed.
+ 
+Lemma RmaxLess2: (r1, r2 : R)  (Rle r2 (Rmax r1 r2)).
+Intros r1 r2; Unfold Rmax; Case (total_order_Rle r1 r2); Auto with real.
+Qed.
+ 
+Lemma RmaxSym: (p, q : R)  (Rmax p q) == (Rmax q p).
+Intros p q; Unfold Rmax;
+ Case (total_order_Rle p q); Case (total_order_Rle q p); Auto; Intros H1 H2;
+ Apply Rle_antisym; Auto with real.
+Qed.
+
+Lemma RmaxRmult:
+ (p, q, r : R)
+ (Rle R0 r) ->  (Rmax (Rmult r p) (Rmult r q)) == (Rmult r (Rmax p q)).
+Intros p q r H; Unfold Rmax.
+Case (total_order_Rle p q); Case (total_order_Rle (Rmult r p) (Rmult r q));
+ Auto; Intros H1 H2; Auto.
+Case H; Intros E1.
+Case H1; Auto with real.
+Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
+Case H; Intros E1.
+Case H2; Auto with real.
+Apply Rle_monotony_contra with z := r; Auto.
+Rewrite <- E1; Repeat Rewrite Rmult_Ol; Auto.
+Qed.
+
+Lemma Rmax_stable_in_negreal : (x,y:negreal) ``(Rmax x y)<0``.
+Intros; Unfold Rmax; Case (total_order_Rle x y); Intro; [Apply (cond_neg y) | Apply (cond_neg x)].
+Qed.
+
+(*******************************)
+(**          Rabsolu           *)
+(*******************************)
+
+(*********)
+Lemma case_Rabsolu:(r:R)(sumboolT (Rlt r R0) (Rge r R0)). 
+Intro;Generalize (total_order_Rle R0 r);Intro X;Elim X;Intro;Clear X.
+Right;Apply (Rle_sym1 R0 r a).
+Left;Fold (Rgt R0 r);Apply (not_Rle R0 r b).
+Qed.
+
+(*********)
+Definition Rabsolu:R->R:=
+      [r:R](Cases (case_Rabsolu r) of
+              (leftT  _) => (Ropp r)
+             |(rightT _) => r
+            end).
+
+(*********)
+Lemma Rabsolu_R0:(Rabsolu R0)==R0.
+Unfold Rabsolu;Case (case_Rabsolu R0);Auto;Intro.
+Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
+Qed.
+
+Lemma Rabsolu_R1: (Rabsolu R1)==R1.
+Unfold Rabsolu; Case (case_Rabsolu R1); Auto with real.
+Intros H; Absurd ``1 < 0``;Auto with real.
+Qed.
+
+(*********)
+Lemma Rabsolu_no_R0:(r:R)~r==R0->~(Rabsolu r)==R0.
+Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro;Auto.
+Apply Ropp_neq;Auto.
+Qed.
+
+(*********)
+Lemma Rabsolu_left: (r:R)(Rlt r R0)->((Rabsolu r) == (Ropp r)).
+Intros;Unfold Rabsolu;Case (case_Rabsolu r);Trivial;Intro;Absurd (Rge r R0).
+Exact (Rlt_ge_not r R0 H).
+Assumption.
+Qed.
+
+(*********)
+Lemma Rabsolu_right: (r:R)(Rge r R0)->((Rabsolu r) == r).
+Intros;Unfold Rabsolu;Case (case_Rabsolu r);Intro.
+Absurd (Rge r R0).
+Exact (Rlt_ge_not r R0 r0).
+Assumption.
+Trivial.
+Qed.
+
+Lemma Rabsolu_left1: (a : R) (Rle a R0) ->  (Rabsolu a) == (Ropp a).
+Intros a H; Case H; Intros H1.
+Apply Rabsolu_left; Auto.
+Rewrite H1; Simpl; Rewrite Rabsolu_right; Auto with real.
+Qed.
+
+(*********)
+Lemma Rabsolu_pos:(x:R)(Rle R0 (Rabsolu x)).
+Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro.
+Generalize (Rlt_Ropp x R0 r);Intro;Unfold Rgt in H;
+ Rewrite Ropp_O in H;Unfold Rle;Left;Assumption.
+Apply Rle_sym2;Assumption.
+Qed.
+
+Lemma Rle_Rabsolu:
+ (x:R) (Rle x (Rabsolu x)).
+Intro; Unfold Rabsolu;Case (case_Rabsolu x);Intros;Fourier.
+Qed.
+
+(*********)
+Lemma Rabsolu_pos_eq:(x:R)(Rle R0 x)->(Rabsolu x)==x.
+Intros;Unfold Rabsolu;Case (case_Rabsolu x);Intro;
+ [Generalize (Rle_not R0 x r);Intro;ElimType False;Auto|Trivial].
+Qed.
+
+(*********)
+Lemma Rabsolu_Rabsolu:(x:R)(Rabsolu (Rabsolu x))==(Rabsolu x).
+Intro;Apply (Rabsolu_pos_eq (Rabsolu x) (Rabsolu_pos x)).
+Qed.
+
+(*********)
+Lemma Rabsolu_pos_lt:(x:R)(~x==R0)->(Rlt R0 (Rabsolu x)).
+Intros;Generalize (Rabsolu_pos x);Intro;Unfold Rle in H0;
+ Elim H0;Intro;Auto.
+ElimType False;Clear H0;Elim H;Clear H;Generalize H1;
+ Unfold Rabsolu;Case (case_Rabsolu x);Intros;Auto.
+Clear r H1; Generalize (Rplus_plus_r x R0 (Ropp x) H0);
+ Rewrite (let (H1,H2)=(Rplus_ne x) in H1);Rewrite (Rplus_Ropp_r x);Trivial.
+Qed.
+
+(*********)
+Lemma Rabsolu_minus_sym:(x,y:R)
+ (Rabsolu (Rminus x y))==(Rabsolu (Rminus y x)).
+Intros;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y)); 
+ Case (case_Rabsolu (Rminus y x));Intros.
+ Generalize (Rminus_lt y x r);Generalize (Rminus_lt x y r0);Intros;
+ Generalize (Rlt_antisym x y H);Intro;ElimType False;Auto.
+Rewrite (Ropp_distr2 x y);Trivial.
+Rewrite (Ropp_distr2 y x);Trivial.
+Unfold Rge in r r0;Elim r;Elim r0;Intros;Clear r r0.
+Generalize (Rgt_RoppO (Rminus x y) H);Rewrite (Ropp_distr2 x y);
+ Intro;Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rminus y x) H0);
+ Intro;ElimType False;Auto.
+Rewrite (Rminus_eq x y H);Trivial.
+Rewrite (Rminus_eq y x H0);Trivial.
+Rewrite (Rminus_eq y x H0);Trivial.
+Qed.
+
+(*********)
+Lemma Rabsolu_mult:(x,y:R)
+ (Rabsolu (Rmult x y))==(Rmult (Rabsolu x) (Rabsolu y)).
+Intros;Unfold Rabsolu;Case (case_Rabsolu (Rmult x y));
+ Case (case_Rabsolu x);Case (case_Rabsolu y);Intros;Auto.
+Generalize (Rlt_anti_monotony y x R0 r r0);Intro;
+ Rewrite (Rmult_Or y) in H;Generalize (Rlt_antisym (Rmult x y) R0 r1);
+ Intro;Unfold Rgt in H;ElimType False;Rewrite (Rmult_sym y x) in H;
+ Auto.
+Rewrite (Ropp_mul1 x y);Trivial. 
+Rewrite (Rmult_sym x (Ropp y));Rewrite (Ropp_mul1 y x);
+ Rewrite (Rmult_sym  x y);Trivial.
+Unfold Rge in r r0;Elim r;Elim r0;Clear r r0;Intros;Unfold Rgt in H H0.
+Generalize (Rlt_monotony x R0 y H H0);Intro;Rewrite (Rmult_Or x) in H1;
+ Generalize (Rlt_antisym (Rmult x y) R0 r1);Intro;ElimType False;Auto.
+Rewrite H in r1;Rewrite (Rmult_Ol y) in r1;Generalize (Rlt_antirefl R0);
+ Intro;ElimType False;Auto.
+Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
+ Intro;ElimType False;Auto.
+Rewrite H0 in r1;Rewrite (Rmult_Or x) in r1;Generalize (Rlt_antirefl R0);
+ Intro;ElimType False;Auto.
+Rewrite (Ropp_mul2 x y);Trivial.
+Unfold Rge in r r1;Elim r;Elim r1;Clear r r1;Intros;Unfold Rgt in H0 H.
+Generalize (Rlt_monotony y x R0 H0 r0);Intro;Rewrite (Rmult_Or y) in H1;
+ Rewrite (Rmult_sym y x) in H1; 
+ Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
+Generalize (imp_not_Req x R0 (or_introl (Rlt x R0) (Rgt x R0) r0));
+ Generalize (imp_not_Req y R0 (or_intror (Rlt y R0) (Rgt y R0) H0));Intros;
+ Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
+ Auto.  
+Rewrite H0 in H;Rewrite (Rmult_Or x) in H;Unfold Rgt in H;
+ Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
+Rewrite H0;Rewrite (Rmult_Or x);Rewrite (Rmult_Or (Ropp x));Trivial.
+Unfold Rge in r0 r1;Elim r0;Elim r1;Clear r0 r1;Intros;Unfold Rgt in H0 H.
+Generalize (Rlt_monotony x y R0 H0 r);Intro;Rewrite (Rmult_Or x) in H1;
+ Generalize (Rlt_antisym (Rmult x y) R0 H1);Intro;ElimType False;Auto.
+Generalize (imp_not_Req y R0 (or_introl (Rlt y R0) (Rgt y R0) r));
+ Generalize (imp_not_Req R0 x (or_introl (Rlt R0 x) (Rgt R0 x) H0));Intros;
+ Generalize (without_div_Od x y H);Intro;Elim H3;Intro;ElimType False;
+ Auto.  
+Rewrite H0 in H;Rewrite (Rmult_Ol y) in H;Unfold Rgt in H;
+ Generalize (Rlt_antirefl R0);Intro;ElimType False;Auto.
+Rewrite H0;Rewrite (Rmult_Ol y);Rewrite (Rmult_Ol (Ropp y));Trivial.
+Qed.
+
+(*********)
+Lemma Rabsolu_Rinv:(r:R)(~r==R0)->(Rabsolu (Rinv r))==
+                                  (Rinv (Rabsolu r)).
+Intro;Unfold Rabsolu;Case (case_Rabsolu r);
+ Case (case_Rabsolu (Rinv r));Auto;Intros.
+Apply Ropp_Rinv;Auto.
+Generalize (Rlt_Rinv2 r r1);Intro;Unfold Rge in r0;Elim r0;Intros.
+Unfold Rgt in H1;Generalize (Rlt_antisym R0 (Rinv r) H1);Intro; 
+ ElimType False;Auto.
+Generalize 
+  (imp_not_Req (Rinv r) R0 
+   (or_introl (Rlt (Rinv r) R0) (Rgt (Rinv r) R0) H0));Intro;
+ ElimType False;Auto.
+Unfold Rge in r1;Elim r1;Clear r1;Intro.
+Unfold Rgt in H0;Generalize (Rlt_antisym R0 (Rinv r)  
+     (Rlt_Rinv r H0));Intro;ElimType False;Auto.
+ElimType False;Auto.
+Qed. 
+
+Lemma Rabsolu_Ropp:
+  (x:R) (Rabsolu (Ropp x))==(Rabsolu x).
+Intro;Cut (Ropp x)==(Rmult (Ropp R1) x).
+Intros; Rewrite H.
+Rewrite Rabsolu_mult.
+Cut (Rabsolu (Ropp R1))==R1.
+Intros; Rewrite H0.
+Ring.
+Unfold Rabsolu; Case (case_Rabsolu (Ropp R1)).
+Intro; Ring.
+Intro H0;Generalize (Rle_sym2 R0 (Ropp R1) H0);Intros.
+Generalize (Rle_Ropp R0 (Ropp R1) H1).
+Rewrite Ropp_Ropp; Rewrite Ropp_O.
+Intro;Generalize (Rle_not R1 R0 Rlt_R0_R1);Intro;
+ Generalize (Rle_sym2 R1 R0 H2);Intro;
+ ElimType False;Auto.  
+Ring.
+Qed.
+
+(*********)
+Lemma Rabsolu_triang:(a,b:R)(Rle (Rabsolu (Rplus a b)) 
+                                (Rplus (Rabsolu a) (Rabsolu b))).
+Intros a b;Unfold Rabsolu;Case (case_Rabsolu (Rplus a b));
+ Case (case_Rabsolu a);Case (case_Rabsolu b);Intros.
+Apply (eq_Rle (Ropp (Rplus a b)) (Rplus (Ropp a) (Ropp b)));
+ Rewrite (Ropp_distr1 a b);Reflexivity.
+(**)
+Rewrite (Ropp_distr1 a b);
+ Apply (Rle_compatibility (Ropp a) (Ropp b) b);
+ Unfold Rle;Unfold Rge in r;Elim r;Intro.
+Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp b) R0 b H);
+ Intro;Elim (Rplus_ne (Ropp b));Intros v w;Rewrite v in H0;Clear v w;
+ Rewrite (Rplus_Ropp_l b) in H0;Apply (Rlt_trans (Ropp b) R0 b H0 H).
+Right;Rewrite H;Apply Ropp_O.
+(**)
+Rewrite (Ropp_distr1 a b);
+ Rewrite (Rplus_sym (Ropp a) (Ropp b));
+ Rewrite (Rplus_sym a (Ropp b));
+ Apply (Rle_compatibility (Ropp b) (Ropp a) a);
+ Unfold Rle;Unfold Rge in r0;Elim r0;Intro.
+Left;Unfold Rgt in H;Generalize (Rlt_compatibility (Ropp a) R0 a H);
+ Intro;Elim (Rplus_ne (Ropp a));Intros v w;Rewrite v in H0;Clear v w;
+ Rewrite (Rplus_Ropp_l a) in H0;Apply (Rlt_trans (Ropp a) R0 a H0 H).
+Right;Rewrite H;Apply Ropp_O.
+(**)
+ElimType False;Generalize (Rge_plus_plus_r a b R0 r);Intro;
+ Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w; 
+ Generalize (Rge_trans (Rplus a b) a R0 H r0);Intro;Clear H;
+ Unfold Rge in H0;Elim H0;Intro;Clear H0.
+Unfold Rgt in H;Generalize (Rlt_antisym (Rplus a b) R0 r1);Intro;Auto.
+Absurd (Rplus a b)==R0;Auto.
+Apply (imp_not_Req (Rplus a b) R0);Left;Assumption.
+(**)
+ElimType False;Generalize (Rlt_compatibility a b R0 r);Intro;
+ Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
+ Generalize (Rlt_trans (Rplus a b) a R0 H r0);Intro;Clear H;
+ Unfold Rge in r1;Elim r1;Clear r1;Intro.
+Unfold Rgt in H;
+ Generalize (Rlt_trans (Rplus a b) R0 (Rplus a b) H0 H);Intro;
+ Apply (Rlt_antirefl (Rplus a b));Assumption.
+Rewrite H in H0;Apply (Rlt_antirefl R0);Assumption.
+(**)
+Rewrite (Rplus_sym a b);Rewrite (Rplus_sym (Ropp a) b);
+ Apply (Rle_compatibility b a (Ropp a));
+ Apply (Rminus_le a (Ropp a));Unfold Rminus;Rewrite (Ropp_Ropp a);
+ Generalize (Rlt_compatibility a a R0 r0);Clear r r1;Intro;
+ Elim (Rplus_ne a);Intros v w;Rewrite v in H;Clear v w;
+ Generalize (Rlt_trans (Rplus a a) a R0 H r0);Intro;
+ Apply (Rlt_le (Rplus a a) R0 H0).
+(**)
+Apply (Rle_compatibility a b (Ropp b));
+ Apply (Rminus_le b (Ropp b));Unfold Rminus;Rewrite (Ropp_Ropp b);
+ Generalize (Rlt_compatibility b b R0 r);Clear r0 r1;Intro;
+ Elim (Rplus_ne b);Intros v w;Rewrite v in H;Clear v w;
+ Generalize (Rlt_trans (Rplus b b) b R0 H r);Intro;
+ Apply (Rlt_le (Rplus b b) R0 H0).
+(**)
+Unfold Rle;Right;Reflexivity.
+Qed.
+
+(*********)
+Lemma Rabsolu_triang_inv:(a,b:R)(Rle (Rminus (Rabsolu a) (Rabsolu b))
+                                     (Rabsolu (Rminus a b))).
+Intros;
+ Apply (Rle_anti_compatibility (Rabsolu b)
+        (Rminus (Rabsolu a) (Rabsolu b)) (Rabsolu (Rminus a b)));
+ Unfold Rminus;
+ Rewrite <- (Rplus_assoc (Rabsolu b) (Rabsolu a) (Ropp (Rabsolu b)));
+ Rewrite (Rplus_sym (Rabsolu b) (Rabsolu a));
+ Rewrite (Rplus_assoc (Rabsolu a) (Rabsolu b) (Ropp (Rabsolu b)));
+ Rewrite (Rplus_Ropp_r (Rabsolu b));
+ Rewrite (proj1 ? ? (Rplus_ne (Rabsolu a)));
+ Replace (Rabsolu a) with (Rabsolu (Rplus a R0)).
+ Rewrite <- (Rplus_Ropp_r b);
+ Rewrite <- (Rplus_assoc a b (Ropp b)); 
+ Rewrite (Rplus_sym a b);
+ Rewrite (Rplus_assoc b a (Ropp b)).
+ Exact (Rabsolu_triang b (Rplus a (Ropp b))).
+ Rewrite (proj1 ? ? (Rplus_ne a));Trivial.
+Qed.
+
+(* ||a|-|b||<=|a-b| *)
+Lemma Rabsolu_triang_inv2 : (a,b:R) ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))<=(Rabsolu (a-b))``. 
+Cut (a,b:R) ``(Rabsolu b)<=(Rabsolu a)``->``(Rabsolu ((Rabsolu a)-(Rabsolu b))) <= (Rabsolu (a-b))``. 
+Intros; NewDestruct (total_order (Rabsolu a) (Rabsolu b)) as [Hlt|[Heq|Hgt]].
+Rewrite <- (Rabsolu_Ropp ``(Rabsolu a)-(Rabsolu b)``); Rewrite <- (Rabsolu_Ropp ``a-b``); Do 2 Rewrite Ropp_distr2. 
+Apply H; Left; Assumption. 
+Rewrite Heq; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rabsolu_pos. 
+Apply H; Left; Assumption. 
+Intros; Replace ``(Rabsolu ((Rabsolu a)-(Rabsolu b)))`` with ``(Rabsolu a)-(Rabsolu b)``. 
+Apply Rabsolu_triang_inv. 
+Rewrite (Rabsolu_right ``(Rabsolu a)-(Rabsolu b)``); [Reflexivity | Apply Rle_sym1; Apply Rle_anti_compatibility with (Rabsolu b); Rewrite Rplus_Or; Replace ``(Rabsolu b)+((Rabsolu a)-(Rabsolu b))`` with (Rabsolu a); [Assumption | Ring]]. 
+Qed. 
+
+(*********)
+Lemma Rabsolu_def1:(x,a:R)(Rlt x a)->(Rlt (Ropp a) x)->(Rlt (Rabsolu x) a).
+Unfold Rabsolu;Intros;Case (case_Rabsolu x);Intro.
+Generalize (Rlt_Ropp (Ropp a) x H0);Unfold Rgt;Rewrite Ropp_Ropp;Intro;
+ Assumption.
+Assumption.
+Qed.
+
+(*********)
+Lemma Rabsolu_def2:(x,a:R)(Rlt (Rabsolu x) a)->(Rlt x a)/\(Rlt (Ropp a) x).
+Unfold Rabsolu;Intro x;Case (case_Rabsolu x);Intros.
+Generalize (Rlt_RoppO x r);Unfold Rgt;Intro;
+ Generalize (Rlt_trans R0 (Ropp x) a H0 H);Intro;Split. 
+Apply (Rlt_trans x R0 a r H1).
+Generalize (Rlt_Ropp (Ropp x) a H);Rewrite (Ropp_Ropp x);Unfold Rgt;Trivial.
+Fold (Rgt a x) in H;Generalize (Rgt_ge_trans a x R0 H r);Intro;
+ Generalize (Rgt_RoppO a H0);Intro;Fold (Rgt R0 (Ropp a));
+ Generalize (Rge_gt_trans x R0 (Ropp a) r H1);Unfold Rgt;Intro;Split;
+ Assumption.
+Qed.
+
+Lemma RmaxAbs:
+ (p, q, r : R)
+ (Rle p q) -> (Rle q r) ->  (Rle (Rabsolu q) (Rmax (Rabsolu p) (Rabsolu r))).
+Intros p q r H' H'0; Case (Rle_or_lt R0 p); Intros H'1.
+Repeat Rewrite Rabsolu_right; Auto with real.
+Apply Rle_trans with r; Auto with real.
+Apply RmaxLess2; Auto.
+Apply Rge_trans with p; Auto with real; Apply Rge_trans with q; Auto with real.
+Apply Rge_trans with p; Auto with real.
+Rewrite (Rabsolu_left p); Auto.
+Case (Rle_or_lt R0 q); Intros H'2.
+Repeat Rewrite Rabsolu_right; Auto with real.
+Apply Rle_trans with r; Auto.
+Apply RmaxLess2; Auto.
+Apply Rge_trans with q; Auto with real.
+Rewrite (Rabsolu_left q); Auto.
+Case (Rle_or_lt R0 r); Intros H'3.
+Repeat Rewrite Rabsolu_right; Auto with real.
+Apply Rle_trans with (Ropp p); Auto with real.
+Apply RmaxLess1; Auto.
+Rewrite (Rabsolu_left r); Auto.
+Apply Rle_trans with (Ropp p); Auto with real.
+Apply RmaxLess1; Auto.
+Qed.
+
+Lemma Rabsolu_Zabs: (z : Z)  (Rabsolu (IZR z)) == (IZR (Zabs z)).
+Intros z; Case z; Simpl; Auto with real.
+Apply Rabsolu_right; Auto with real.
+Intros p0; Apply Rabsolu_right; Auto with real zarith.
+Intros p0; Rewrite Rabsolu_Ropp.
+Apply Rabsolu_right; Auto with real zarith.
+Qed.
+ 
diff --git a/theories7/Reals/Rcomplete.v b/theories7/Reals/Rcomplete.v
new file mode 100644
index 00000000..5985a382
--- /dev/null
+++ b/theories7/Reals/Rcomplete.v
@@ -0,0 +1,175 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rcomplete.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require SeqProp.
+Require Max.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(****************************************************)
+(*              R is complete :                     *)
+(*        Each sequence which satisfies             *)
+(*       the Cauchy's criterion converges           *)
+(*                                                  *)
+(*    Proof with adjacent sequences (Vn and Wn)     *)
+(****************************************************)
+
+Theorem R_complete : (Un:nat->R) (Cauchy_crit Un) -> (sigTT R [l:R](Un_cv Un l)).
+Intros.
+Pose Vn := (sequence_minorant Un (cauchy_min Un H)).
+Pose Wn := (sequence_majorant Un (cauchy_maj Un H)).
+Assert H0 := (maj_cv Un H).
+Fold Wn in H0.
+Assert H1 := (min_cv Un H).
+Fold Vn in H1.
+Elim H0; Intros.
+Elim H1; Intros.
+Cut x==x0.
+Intros.
+Apply existTT with x.
+Rewrite <- H2 in p0.
+Unfold Un_cv.
+Intros.
+Unfold Un_cv in p; Unfold Un_cv in p0.
+Cut ``0<eps/3``.
+Intro.
+Elim (p ``eps/3`` H4); Intros.
+Elim (p0 ``eps/3`` H4); Intros.
+Exists (max x1 x2).
+Intros.
+Unfold R_dist.
+Apply Rle_lt_trans with ``(Rabsolu ((Un n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
+Replace ``(Un n)-x`` with ``((Un n)-(Vn n))+((Vn n)-x)``; [Apply Rabsolu_triang | Ring].
+Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-(Vn n)))+(Rabsolu ((Vn n)-x))``.
+Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
+Apply Rle_compatibility.
+Repeat Rewrite Rabsolu_right.
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-(Vn n)``); Apply Rle_compatibility.
+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_sym1.
+Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
+Rewrite Rplus_Or.
+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)).
+Fold Vn Wn in H8.
+Elim (H8 n); Intros.
+Apply Rle_trans with (Un n); Assumption.
+Apply Rle_sym1.
+Unfold Rminus; Apply Rle_anti_compatibility with (Vn n).
+Rewrite Rplus_Or.
+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)).
+Fold Vn Wn in H8.
+Elim (H8 n); Intros.
+Assumption.
+Apply Rle_lt_trans with ``(Rabsolu ((Wn n)-x))+(Rabsolu (x-(Vn n)))+(Rabsolu ((Vn n)-x))``.
+Do 2 Rewrite <- (Rplus_sym ``(Rabsolu ((Vn n)-x))``).
+Apply Rle_compatibility.
+Replace ``(Wn n)-(Vn n)`` with ``((Wn n)-x)+(x-(Vn n))``; [Apply Rabsolu_triang | Ring].
+Apply Rlt_le_trans with ``eps/3+eps/3+eps/3``.
+Repeat Apply Rplus_lt.
+Unfold R_dist in H5.
+Apply H5.
+Unfold ge; Apply le_trans with (max x1 x2).
+Apply le_max_l.
+Assumption.
+Rewrite <- Rabsolu_Ropp.
+Replace ``-(x-(Vn n))`` with ``(Vn n)-x``; [Idtac | Ring].
+Unfold R_dist in H6.
+Apply H6.
+Unfold ge; Apply le_trans with (max x1 x2).
+Apply le_max_r.
+Assumption.
+Unfold R_dist in H6.
+Apply H6.
+Unfold ge; Apply le_trans with (max x1 x2).
+Apply le_max_r.
+Assumption.
+Right.
+Pattern 4 eps; Replace ``eps`` with ``3*eps/3``.
+Ring.
+Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m; DiscrR.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Apply cond_eq.
+Intros.
+Cut ``0<eps/5``.
+Intro.
+Unfold Un_cv in p; Unfold Un_cv in p0.
+Unfold R_dist in p; Unfold R_dist in p0.
+Elim (p ``eps/5`` H3); Intros N1 H4.
+Elim (p0 ``eps/5`` H3); Intros N2 H5.
+Unfold Cauchy_crit in H.
+Unfold R_dist in H.
+Elim (H ``eps/5`` H3); Intros N3 H6.
+Pose N := (max (max N1 N2) N3).
+Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-x0))``.
+Replace ``x-x0`` with ``(x-(Wn N))+((Wn N)-x0)``; [Apply Rabsolu_triang | Ring].
+Apply Rle_lt_trans with ``(Rabsolu (x-(Wn N)))+(Rabsolu ((Wn N)-(Vn N)))+(Rabsolu (((Vn N)-x0)))``.
+Rewrite Rplus_assoc.
+Apply Rle_compatibility.
+Replace ``(Wn N)-x0`` with ``((Wn N)-(Vn N))+((Vn N)-x0)``; [Apply Rabsolu_triang | Ring].
+Replace ``eps`` with ``eps/5+3*eps/5+eps/5``.
+Repeat Apply Rplus_lt.
+Rewrite <- Rabsolu_Ropp.
+Replace ``-(x-(Wn N))`` with ``(Wn N)-x``; [Apply H4 | Ring].
+Unfold ge N.
+Apply le_trans with (max N1 N2); Apply le_max_l.
+Unfold Wn Vn.
+Unfold sequence_majorant sequence_minorant.
+Assert H7 := (approx_maj [k:nat](Un (plus N k)) (maj_ss Un N (cauchy_maj Un H))).
+Assert H8 := (approx_min [k:nat](Un (plus N k)) (min_ss Un N (cauchy_min Un H))).
+Cut (Wn N)==(majorant ([k:nat](Un (plus N k))) (maj_ss Un N (cauchy_maj Un H))).
+Cut (Vn N)==(minorant ([k:nat](Un (plus N k))) (min_ss Un N (cauchy_min Un H))).
+Intros.
+Rewrite <- H9; Rewrite <- H10.
+Rewrite <- H9 in H8.
+Rewrite <- H10 in H7.
+Elim (H7 ``eps/5`` H3); Intros k2 H11.
+Elim (H8 ``eps/5`` H3); Intros k1 H12.
+Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Vn N)))``.
+Replace ``(Wn N)-(Vn N)`` with ``((Wn N)-(Un (plus N k2)))+((Un (plus N k2))-(Vn N))``; [Apply Rabsolu_triang | Ring].
+Apply Rle_lt_trans with ``(Rabsolu ((Wn N)-(Un (plus N k2))))+(Rabsolu ((Un (plus N k2))-(Un (plus N k1))))+(Rabsolu ((Un (plus N k1))-(Vn N)))``.
+Rewrite Rplus_assoc.
+Apply Rle_compatibility.
+Replace ``(Un (plus N k2))-(Vn N)`` with ``((Un (plus N k2))-(Un (plus N k1)))+((Un (plus N k1))-(Vn N))``; [Apply Rabsolu_triang | Ring].
+Replace ``3*eps/5`` with ``eps/5+eps/5+eps/5``; [Repeat Apply Rplus_lt | Ring].
+Assumption.
+Apply H6.
+Unfold ge.
+Apply le_trans with N.
+Unfold N; Apply le_max_r.
+Apply le_plus_l.
+Unfold ge.
+Apply le_trans with N.
+Unfold N; Apply le_max_r.
+Apply le_plus_l.
+Rewrite <- Rabsolu_Ropp.
+Replace ``-((Un (plus N k1))-(Vn N))`` with ``(Vn N)-(Un (plus N k1))``; [Assumption | Ring].
+Reflexivity.
+Reflexivity.
+Apply H5.
+Unfold ge; Apply le_trans with (max N1 N2).
+Apply le_max_r.
+Unfold N; Apply le_max_l.
+Pattern 4 eps; Replace ``eps`` with ``5*eps/5``.
+Ring.
+Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
+DiscrR.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv.
+Sup0; Try Apply lt_O_Sn.
+Qed.
diff --git a/theories7/Reals/Rdefinitions.v b/theories7/Reals/Rdefinitions.v
new file mode 100644
index 00000000..79be0176
--- /dev/null
+++ b/theories7/Reals/Rdefinitions.v
@@ -0,0 +1,69 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: Rdefinitions.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+
+(*********************************************************)
+(**          Definitions for the axiomatization          *)
+(*                                                       *)
+(*********************************************************)
+
+Require Export ZArith_base.
+
+Parameter R:Set.
+
+(* Declare Scope positive_scope with Key R *)
+Delimits Scope R_scope with R.
+
+(* Automatically open scope R_scope for arguments of type R *)
+Bind Scope R_scope with R.
+
+Parameter R0:R.
+Parameter R1:R.
+Parameter Rplus:R->R->R.
+Parameter Rmult:R->R->R.
+Parameter Ropp:R->R.
+Parameter Rinv:R->R. 
+Parameter Rlt:R->R->Prop.    
+Parameter up:R->Z.
+
+V8Infix "+" Rplus : R_scope.
+V8Infix "*" Rmult : R_scope.
+V8Notation "- x" := (Ropp x) : R_scope.
+V8Notation "/ x" := (Rinv x) : R_scope.
+
+V8Infix "<"  Rlt : R_scope.
+
+(*i*******************************************************i*)
+
+(**********)
+Definition Rgt:R->R->Prop:=[r1,r2:R](Rlt r2 r1).
+
+(**********)
+Definition Rle:R->R->Prop:=[r1,r2:R]((Rlt r1 r2)\/(r1==r2)).
+
+(**********)
+Definition Rge:R->R->Prop:=[r1,r2:R]((Rgt r1 r2)\/(r1==r2)).
+
+(**********)
+Definition Rminus:R->R->R:=[r1,r2:R](Rplus r1 (Ropp r2)).
+
+(**********)
+Definition Rdiv:R->R->R:=[r1,r2:R](Rmult r1 (Rinv r2)).
+
+V8Infix "-" Rminus : R_scope.
+V8Infix "/" Rdiv : R_scope.
+
+V8Infix "<=" Rle : R_scope.
+V8Infix ">=" Rge : R_scope.
+V8Infix ">" Rgt : R_scope.
+
+V8Notation "x <= y <= z" := (Rle x y)/\(Rle y z) : R_scope.
+V8Notation "x <= y < z" := (Rle x y)/\(Rlt y z) : R_scope.
+V8Notation "x < y < z" := (Rlt x y)/\(Rlt y z) : R_scope.
+V8Notation "x < y <= z" := (Rlt x y)/\(Rle y z) : R_scope.
diff --git a/theories7/Reals/Rderiv.v b/theories7/Reals/Rderiv.v
new file mode 100644
index 00000000..b55aa6ea
--- /dev/null
+++ b/theories7/Reals/Rderiv.v
@@ -0,0 +1,453 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rderiv.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+(*********************************************************)
+(**     Definition of the derivative,continuity          *)
+(*                                                       *)
+(*********************************************************)
+
+Require Rbase.
+Require Rfunctions.
+Require Rlimit.
+Require Fourier.
+Require Classical_Prop.
+Require Classical_Pred_Type.
+Require Omega.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(*********)
+Definition D_x:(R->Prop)->R->R->Prop:=[D:R->Prop][y:R][x:R]
+       (D x)/\(~y==x).
+
+(*********)
+Definition continue_in:(R->R)->(R->Prop)->R->Prop:=
+       [f:R->R; D:R->Prop; x0:R](limit1_in f (D_x D x0) (f x0) x0).
+
+(*********)
+Definition D_in:(R->R)->(R->R)->(R->Prop)->R->Prop:=
+  [f:R->R; d:R->R; D:R->Prop; x0:R](limit1_in 
+    [x:R] (Rdiv (Rminus (f x) (f x0)) (Rminus x x0)) 
+    (D_x D x0) (d x0) x0).
+
+(*********)
+Lemma cont_deriv:(f,d:R->R;D:R->Prop;x0:R)
+         (D_in f d D x0)->(continue_in f D x0).
+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_EM (d x0) R0);Intro.
+Split with (Rmin R1 x);Split.
+Elim (Rmin_Rgt R1 x R0);Intros a b;
+ Apply (b (conj (Rgt R1 R0) (Rgt x R0) Rlt_R0_R1 H)).
+Intros;Elim H3;Clear H3;Intros;
+Generalize (let (H1,H2)=(Rmin_Rgt R1 x (R_dist x1 x0)) in H1);
+ Unfold Rgt;Intro;Elim (H5 H4);Clear H5;Intros;
+ Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H6));
+ Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros.
+Rewrite H2 in H1;Unfold R_dist; Unfold R_dist in H1;
+ Cut (Rlt (Rabsolu (Rminus (f x1) (f x0))) 
+          (Rmult eps (Rabsolu (Rminus x1 x0)))).
+Intro;Unfold R_dist in H5;
+  Generalize (Rlt_monotony eps ``(Rabsolu (x1-x0))`` ``1`` H0 H5);
+Rewrite Rmult_1r;Intro;Apply Rlt_trans with r2:=``eps*(Rabsolu (x1-x0))``;
+ Assumption.
+Rewrite (minus_R0 ``((f x1)-(f x0))*/(x1-x0)``) in H1;
+ Rewrite Rabsolu_mult in H1; Cut ``x1-x0 <> 0``.
+Intro;Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9) in H1;
+ Generalize (Rlt_monotony ``(Rabsolu (x1-x0))`` 
+ ``(Rabsolu ((f x1)-(f x0)))*/(Rabsolu (x1-x0))`` eps 
+ (Rabsolu_pos_lt ``x1-x0`` H9) H1);Intro; Rewrite Rmult_sym in H10;
+ Rewrite Rmult_assoc in H10;Rewrite Rinv_l in H10.
+Rewrite Rmult_1r in H10;Rewrite Rmult_sym;Assumption.
+Apply Rabsolu_no_R0;Auto.
+Apply Rminus_eq_contra;Auto.
+(**)
+ Split with (Rmin (Rmin (Rinv (Rplus R1 R1)) x) 
+              (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))));
+ Split.
+Cut (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0).
+Cut (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0).
+Intros;Elim (Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x) 
+            (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0);
+ Intros a b;
+ Apply (b (conj (Rgt (Rmin (Rinv (Rplus R1 R1)) x) R0)
+       (Rgt (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) R0)
+        H4 H3)).
+Apply Rmult_gt;Auto.
+Unfold Rgt;Apply Rlt_Rinv;Apply Rabsolu_pos_lt;Apply mult_non_zero;
+ Split.
+DiscrR.
+Assumption.
+Elim (Rmin_Rgt (Rinv (Rplus R1 R1)) x R0);Intros a b;
+ Cut (Rlt R0 (Rplus R1 R1)).
+Intro;Generalize (Rlt_Rinv (Rplus R1 R1) H3);Intro;
+ Fold (Rgt (Rinv (Rplus R1 R1)) R0) in H4;
+ Apply (b (conj (Rgt (Rinv (Rplus R1 R1)) R0) (Rgt x R0) H4 H)).
+Fourier.
+Intros;Elim H3;Clear H3;Intros;
+ Generalize (let (H1,H2)=(Rmin_Rgt (Rmin (Rinv (Rplus R1 R1)) x)
+       (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0)))))
+       (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H5 H4);Clear H5;
+ Intros;
+ Generalize (let (H1,H2)=(Rmin_Rgt (Rinv (Rplus R1 R1)) x
+          (R_dist x1 x0)) in H1);Unfold Rgt;Intro;Elim (H7 H5);Clear H7;
+ Intros;Clear H4 H5;
+ Generalize (H1 x1 (conj (D_x D x0 x1) (Rlt (R_dist x1 x0) x) H3 H8));
+ Clear H1;Intro;Unfold D_x in H3;Elim H3;Intros;
+ Generalize (sym_not_eqT R x0 x1 H5);Clear H5;Intro H5;
+ Generalize (Rminus_eq_contra x1 x0 H5);
+ Intro;Generalize H1;Pattern 1 (d x0); 
+ Rewrite <-(let (H1,H2)=(Rmult_ne (d x0)) in H2);
+ Rewrite <-(Rinv_l (Rminus x1 x0) H9); Unfold R_dist;Unfold 1 Rminus;
+ Rewrite (Rmult_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0)));
+ Rewrite (Rmult_sym (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)) (d x0));
+ Rewrite <-(Ropp_mul1 (d x0) (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
+ Rewrite (Rmult_sym (Ropp (d x0))
+                    (Rmult (Rinv (Rminus x1 x0)) (Rminus x1 x0)));
+ Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus x1 x0) (Ropp (d x0)));
+ Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
+                   (Rmult (Rminus x1 x0) (Ropp (d x0))));
+ Rewrite (Rabsolu_mult (Rinv (Rminus x1 x0))
+                       (Rplus (Rminus (f x1) (f x0))
+                              (Rmult (Rminus x1 x0) (Ropp (d x0)))));
+ Clear H1;Intro;Generalize (Rlt_monotony (Rabsolu (Rminus x1 x0)) 
+        (Rmult (Rabsolu (Rinv (Rminus x1 x0)))
+           (Rabsolu
+             (Rplus (Rminus (f x1) (f x0))
+               (Rmult (Rminus x1 x0) (Ropp (d x0)))))) eps 
+        (Rabsolu_pos_lt (Rminus x1 x0) H9) H1); 
+ Rewrite <-(Rmult_assoc (Rabsolu (Rminus x1 x0)) 
+                 (Rabsolu (Rinv (Rminus x1 x0)))
+               (Rabsolu
+           (Rplus (Rminus (f x1) (f x0))
+             (Rmult (Rminus x1 x0) (Ropp (d x0)))))); 
+ Rewrite (Rabsolu_Rinv (Rminus x1 x0) H9);
+ Rewrite (Rinv_r (Rabsolu (Rminus x1 x0)) 
+                 (Rabsolu_no_R0 (Rminus x1 x0) H9));
+ Rewrite (let (H1,H2)=(Rmult_ne (Rabsolu
+         (Rplus (Rminus (f x1) (f x0))
+           (Rmult (Rminus x1 x0) (Ropp (d x0)))))) in H2);
+ Generalize (Rabsolu_triang_inv (Rminus (f x1) (f x0))
+         (Rmult (Rminus x1 x0) (d x0)));Intro;
+ Rewrite (Rmult_sym (Rminus x1 x0) (Ropp (d x0)));
+ Rewrite (Ropp_mul1 (d x0) (Rminus x1 x0));
+ Fold (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0)));
+ Rewrite (Rmult_sym (Rminus x1 x0) (d x0)) in H10;
+ Clear H1;Intro;Generalize (Rle_lt_trans 
+           (Rminus (Rabsolu (Rminus (f x1) (f x0)))
+           (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
+          (Rabsolu
+           (Rminus (Rminus (f x1) (f x0)) (Rmult (d x0) (Rminus x1 x0))))
+          (Rmult (Rabsolu (Rminus x1 x0)) eps) H10 H1);
+ Clear H1;Intro;
+ Generalize (Rlt_compatibility (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
+   (Rminus (Rabsolu (Rminus (f x1) (f x0)))
+           (Rabsolu (Rmult (d x0) (Rminus x1 x0))))
+   (Rmult (Rabsolu (Rminus x1 x0)) eps) H1);
+ Unfold 2 Rminus;Rewrite (Rplus_sym (Rabsolu (Rminus (f x1) (f x0)))
+    (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))));
+ Rewrite <-(Rplus_assoc (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
+  (Ropp (Rabsolu (Rmult (d x0) (Rminus x1 x0)))) 
+  (Rabsolu (Rminus (f x1) (f x0))));
+ Rewrite (Rplus_Ropp_r (Rabsolu (Rmult (d x0) (Rminus x1 x0))));
+ Rewrite (let (H1,H2)=(Rplus_ne (Rabsolu (Rminus (f x1) (f x0)))) in H2);
+ Clear H1;Intro;Cut (Rlt (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
+           (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps).
+Intro;Apply (Rlt_trans (Rabsolu (Rminus (f x1) (f x0))) 
+    (Rplus (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
+            (Rmult (Rabsolu (Rminus x1 x0)) eps)) eps H1 H11). 
+Clear H1 H5 H3 H10;Generalize (Rabsolu_pos_lt (d x0) H2);
+ Intro;Unfold Rgt in H0;Generalize (Rlt_monotony eps (R_dist x1 x0)
+       (Rinv (Rplus R1 R1)) H0 H7);Clear H7;Intro;
+ Generalize (Rlt_monotony (Rabsolu (d x0)) (R_dist x1 x0) 
+    (Rmult eps (Rinv (Rabsolu (Rmult (Rplus R1 R1) (d x0))))) H1 H6);
+ Clear H6;Intro;Rewrite (Rmult_sym eps (R_dist x1 x0)) in H3; 
+ Unfold R_dist in H3 H5;
+ Rewrite <-(Rabsolu_mult (d x0) (Rminus x1 x0)) in H5;
+ Rewrite (Rabsolu_mult (Rplus R1 R1) (d x0)) in H5;
+ Cut ~(Rabsolu (Rplus R1 R1))==R0.
+Intro;Fold (Rgt (Rabsolu (d x0)) R0) in H1;
+ Rewrite (Rinv_Rmult (Rabsolu (Rplus R1 R1)) (Rabsolu (d x0))
+ H6 (imp_not_Req (Rabsolu (d x0)) R0 
+  (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) 
+  in H5;
+ Rewrite (Rmult_sym (Rabsolu (d x0)) (Rmult eps
+             (Rmult (Rinv (Rabsolu (Rplus R1 R1)))
+               (Rinv (Rabsolu (d x0)))))) in H5;
+ Rewrite <-(Rmult_assoc eps (Rinv (Rabsolu (Rplus R1 R1))) 
+   (Rinv (Rabsolu (d x0)))) in H5;
+ Rewrite (Rmult_assoc (Rmult eps (Rinv (Rabsolu (Rplus R1 R1))))
+    (Rinv (Rabsolu (d x0))) (Rabsolu (d x0))) in H5;
+ Rewrite (Rinv_l (Rabsolu (d x0)) (imp_not_Req (Rabsolu (d x0)) R0 
+  (or_intror (Rlt (Rabsolu (d x0)) R0) (Rgt (Rabsolu (d x0)) R0) H1))) 
+  in H5;
+ Rewrite (let (H1,H2)=(Rmult_ne (Rmult eps (Rinv (Rabsolu (Rplus R1 R1)))))
+   in H1) in H5;Cut (Rabsolu (Rplus R1 R1))==(Rplus R1 R1).
+Intro;Rewrite H7 in H5;
+ Generalize (Rplus_lt (Rabsolu (Rmult (d x0) (Rminus x1 x0)))
+        (Rmult eps (Rinv (Rplus R1 R1)))
+        (Rmult (Rabsolu (Rminus x1 x0)) eps)
+        (Rmult eps (Rinv (Rplus R1 R1))) H5 H3);Intro;
+ Rewrite eps2 in H10;Assumption.
+Unfold Rabsolu;Case (case_Rabsolu (Rplus R1 R1));Auto.
+ Intro;Cut (Rlt R0 (Rplus R1 R1)).
+Intro;Generalize (Rlt_antisym R0 (Rplus R1 R1) H7);Intro;ElimType False;
+ Auto.
+Fourier.
+Apply Rabsolu_no_R0.
+DiscrR.
+Qed.
+
+
+(*********)
+Lemma Dconst:(D:R->Prop)(y:R)(x0:R)(D_in [x:R]y [x:R]R0 D x0).
+Unfold D_in;Intros;Unfold limit1_in;Unfold limit_in;Unfold Rdiv;Intros;Simpl;
+ Split with eps;Split;Auto.
+Intros;Rewrite (eq_Rminus y y (refl_eqT R y));
+ Rewrite Rmult_Ol;Unfold R_dist; 
+ Rewrite (eq_Rminus R0 R0 (refl_eqT R R0));Unfold Rabsolu;
+ Case (case_Rabsolu R0);Intro.
+Absurd (Rlt R0 R0);Auto.
+Red;Intro;Apply (Rlt_antirefl R0 H1).
+Unfold Rgt in H0;Assumption.
+Qed.
+
+(*********)
+Lemma Dx:(D:R->Prop)(x0:R)(D_in [x:R]x [x:R]R1 D x0).
+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 (Rminus x x0) (Rminus_eq_contra x x0 
+      (sym_not_eqT R x0 x H3)));
+ Unfold R_dist; 
+ Rewrite (eq_Rminus R1 R1 (refl_eqT R R1));Unfold Rabsolu;
+ Case (case_Rabsolu R0);Intro.
+Absurd (Rlt R0 R0);Auto.
+Red;Intro;Apply (Rlt_antirefl R0 r).
+Unfold Rgt in H;Assumption.
+Qed. 
+
+(*********)
+Lemma Dadd:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
+  (D_in f df D x0)->(D_in g dg D x0)->
+  (D_in [x:R](Rplus (f x) (g x)) [x:R](Rplus (df x) (dg x)) D x0).
+Unfold D_in;Intros;Generalize (limit_plus 
+   [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
+   [x:R](Rmult  (Rminus (g x) (g x0)) (Rinv (Rminus x x0))) 
+   (D_x D x0) (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_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
+ Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
+ Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0)) 
+                    (Rminus (f x1) (f x0)) 
+                    (Rminus (g x1) (g x0))) in H1;
+ Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
+           (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))) in H1;
+ Cut (Rplus (Rminus (f x1) (f x0)) (Rminus (g x1) (g x0)))==
+      (Rminus (Rplus (f x1) (g x1)) (Rplus (f x0) (g x0))).
+Intro;Rewrite H3 in H1;Assumption.
+Ring.
+Qed.
+
+(*********)
+Lemma Dmult:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
+  (D_in f df D x0)->(D_in g dg D x0)->
+  (D_in [x:R](Rmult (f x) (g x))  
+             [x:R](Rplus (Rmult (df x) (g x)) (Rmult (f x) (dg x))) D x0).
+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 
+   [x:R](Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
+   [x:R](f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3);Intro;
+ Cut (limit1_in [x:R](g x0) (D_x D x0) (g x0) x0).
+Intro;Generalize (limit_mul 
+  [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
+  [_:R](g x0) (D_x D x0) (df x0) (g x0) x0 H H5);Clear H H0 H1 H2 H3 H5;
+ Intro;Generalize (limit_plus 
+  [x:R](Rmult (Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) (g x0))
+  [x:R](Rmult (Rmult (Rminus (g x) (g x0)) (Rinv (Rminus x x0)))
+                (f x)) (D_x D x0) (Rmult (df x0) (g x0)) 
+                               (Rmult (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;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_sym (Rminus (f x1) (f x0)) (Rinv (Rminus x1 x0))) in H1;
+ Rewrite (Rmult_sym (Rminus (g x1) (g x0)) (Rinv (Rminus x1 x0))) in H1;
+ Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (f x1) (f x0))
+       (g x0)) in H1;
+ Rewrite (Rmult_assoc (Rinv (Rminus x1 x0)) (Rminus (g x1) (g x0))
+       (f x1)) in H1;
+ Rewrite <-(Rmult_Rplus_distr (Rinv (Rminus x1 x0))
+                (Rmult (Rminus (f x1) (f x0)) (g x0))
+                (Rmult (Rminus (g x1) (g x0)) (f x1))) in H1;
+ Rewrite (Rmult_sym (Rinv (Rminus x1 x0))
+       (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
+               (Rmult (Rminus (g x1) (g x0)) (f x1)))) in H1;
+ Rewrite (Rmult_sym (dg x0) (f x0)) in H1;
+ Cut (Rplus (Rmult (Rminus (f x1) (f x0)) (g x0))
+               (Rmult (Rminus (g x1) (g x0)) (f x1)))==
+      (Rminus (Rmult (f x1) (g x1)) (Rmult (f x0) (g x0))).
+Intro;Rewrite H3 in H1;Assumption.
+Ring.
+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_eqT R (g x0)));Unfold Rgt in H;Assumption.
+Qed.
+
+(*********)
+Lemma Dmult_const:(D:R->Prop)(f,df:R->R)(x0:R)(a:R)(D_in f df D x0)->
+  (D_in [x:R](Rmult a (f x)) ([x:R](Rmult a (df x))) D x0).
+Intros;Generalize (Dmult D [_:R]R0 df [_:R]a f x0 (Dconst D a x0) H);
+ Unfold D_in;Intros;
+ Rewrite (Rmult_Ol (f x0)) in H0;
+ Rewrite (let (H1,H2)=(Rplus_ne (Rmult a (df x0))) in H2) in H0;
+ Assumption.
+Qed.
+
+(*********)
+Lemma Dopp:(D:R->Prop)(f,df:R->R)(x0:R)(D_in f df D x0)->
+  (D_in [x:R](Ropp (f x)) ([x:R](Ropp (df x))) D x0).
+Intros;Generalize (Dmult_const D f df x0 (Ropp R1) 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;Intros;Split with x;Split;Auto.
+Intros;Generalize (H2 x1 H3);Clear H2;Intro;Rewrite Ropp_mul1 in H2;
+ Rewrite Ropp_mul1 in H2;Rewrite Ropp_mul1 in H2;
+ Rewrite (let (H1,H2)=(Rmult_ne (f x1)) in H2) in H2; 
+ Rewrite (let (H1,H2)=(Rmult_ne (f x0)) in H2) in H2;
+ Rewrite (let (H1,H2)=(Rmult_ne (df x0)) in H2) in H2;Assumption.
+Qed.
+
+(*********)
+Lemma Dminus:(D:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
+  (D_in f df D x0)->(D_in g dg D x0)->
+  (D_in [x:R](Rminus (f x) (g x)) [x:R](Rminus (df x) (dg x)) D x0).
+Unfold Rminus;Intros;Generalize (Dopp D g dg x0 H0);Intro;
+ Apply (Dadd D df [x:R](Ropp (dg x)) f [x:R](Ropp (g x)) x0);Assumption. 
+Qed.
+
+(*********)
+Lemma Dx_pow_n:(n:nat)(D:R->Prop)(x0:R)
+  (D_in [x:R](pow x n)  
+        [x:R](Rmult (INR n) (pow x (minus n (1)))) D x0).
+Induction n;Intros.
+Simpl; Rewrite Rmult_Ol; Apply Dconst.
+Intros;Cut n0=(minus (S n0) (1));
+  [ Intro a; Rewrite <- a;Clear a | Simpl; Apply minus_n_O ].
+Generalize (Dmult D [_:R]R1 
+   [x:R](Rmult (INR n0) (pow x (minus n0 (1)))) [x:R]x [x:R](pow x n0) 
+   x0 (Dx D x0) (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;
+ Rewrite (let (H1,H2)=(Rmult_ne (pow x0 n0)) in H2) in H2;
+ Rewrite (tech_pow_Rmult x1 n0) in H2;
+ Rewrite (tech_pow_Rmult x0 n0) in H2;
+ Rewrite (Rmult_sym (INR n0) (pow x0 (minus n0 (1)))) in H2;
+ Rewrite <-(Rmult_assoc x0 (pow x0 (minus n0 (1))) (INR n0)) in H2;
+ Rewrite (tech_pow_Rmult x0 (minus n0 (1))) in H2;
+ Elim (classic (n0=O));Intro cond.
+Rewrite cond in H2;Rewrite cond;Simpl in H2;Simpl;
+ Cut (Rplus R1 (Rmult (Rmult x0 R1) R0))==(Rmult R1 R1);
+ [Intro A; Rewrite A in H2; Assumption|Ring].
+Cut ~(n0=O)->(S (minus n0 (1)))=n0;[Intro|Omega];
+ Rewrite (H3 cond) in H2; Rewrite (Rmult_sym (pow x0 n0) (INR n0)) in H2;
+ Rewrite (tech_pow_Rplus x0 n0 n0) in H2; Assumption.
+Qed.
+
+(*********)
+Lemma Dcomp:(Df,Dg:R->Prop)(df,dg:R->R)(f,g:R->R)(x0:R)
+  (D_in f df Df x0)->(D_in g dg Dg (f x0))->
+  (D_in [x:R](g (f x)) [x:R](Rmult (df x) (dg (f x))) 
+                       (Dgf Df Dg f) x0).
+Intros Df Dg df dg f g x0 H H0;Generalize H H0;Unfold D_in;Unfold Rdiv;Intros;
+Generalize (limit_comp f [x:R](Rmult (Rminus (g x) (g (f x0)))
+                               (Rinv (Rminus x (f x0)))) (D_x Df x0)
+              (D_x Dg (f x0)) 
+              (f x0) (dg (f x0)) x0);Intro;
+ Generalize (cont_deriv f df Df x0 H);Intro;Unfold continue_in in H4;
+ Generalize (H3 H4 H2);Clear H3;Intro;
+ Generalize (limit_mul [x:R](Rmult (Rminus (g (f x)) (g (f x0)))
+                                   (Rinv (Rminus (f x) (f x0))))
+                       [x:R](Rmult (Rminus (f x) (f x0))
+                                   (Rinv (Rminus x x0))) 
+                       (Dgf (D_x Df x0) (D_x Dg (f x0)) f) 
+                       (dg (f x0)) (df x0) x0 H3);Intro;
+ Cut (limit1_in
+         [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0)))
+         (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (df x0) x0).
+Intro;Generalize (H5 H6);Clear H5;Intro;
+ Generalize (limit_mul 
+        [x:R](Rmult (Rminus (f x) (f x0)) (Rinv (Rminus x x0))) 
+        [x:R](dg (f x0))
+       (D_x Df x0) (df x0) (dg (f x0)) x0 H1
+    (limit_free [x:R](dg (f x0)) (D_x Df x0) x0 x0));
+ 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.
+Elim (Rmin_Rgt x x1 R0);Intros a b;
+ Apply (b (conj (Rgt x R0) (Rgt x1 R0) H9 H5));Clear a b.
+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.
+Elim H11;Clear H11;Intros;Elim H11;Clear H11;Intros;
+ Generalize (H10 x2 (conj (Df x2)/\~x0==x2 (Rlt (R_dist x2 x0) x)
+        (conj (Df x2) ~x0==x2 H11 H14) H5));Intro;
+ Rewrite (eq_Rminus (f x2) (f x0) H12) in H16;
+ Rewrite (Rmult_Ol (Rinv (Rminus x2 x0))) in H16;
+ Rewrite (Rmult_Ol (dg (f x0))) in H16;
+ Rewrite H12;
+ Rewrite (eq_Rminus (g (f x0)) (g (f x0)) (refl_eqT R (g (f x0))));
+ Rewrite (Rmult_Ol (Rinv (Rminus x2 x0)));Assumption.
+Clear H10 H5;Elim H11;Clear H11;Intros;Elim H5;Clear H5;Intros;
+Cut (((Df x2)/\~x0==x2)/\(Dg (f x2))/\~(f x0)==(f x2))
+        /\(Rlt (R_dist x2 x0) x1);Auto;Intro;
+ Generalize (H7 x2 H14);Intro;
+ Generalize (Rminus_eq_contra (f x2) (f x0) H12);Intro;
+ Rewrite (Rmult_assoc (Rminus (g (f x2)) (g (f x0))) 
+           (Rinv (Rminus (f x2) (f x0)))
+          (Rmult (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0)))) in H15;
+ Rewrite <-(Rmult_assoc (Rinv (Rminus (f x2) (f x0))) 
+             (Rminus (f x2) (f x0)) (Rinv (Rminus x2 x0))) in H15;
+ Rewrite (Rinv_l (Rminus (f x2) (f x0)) H16) in H15;
+ Rewrite (let (H1,H2)=(Rmult_ne (Rinv (Rminus x2 x0))) in H2) in H15;
+ Rewrite (Rmult_sym (df x0) (dg (f x0)));Assumption.
+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;Intros;Elim H4;Clear H4;Intros;
+ Exact (H3 x1 (conj (Df x1)/\~x0==x1 (Rlt (R_dist x1 x0) x) H4 H5)).
+Qed.   
+
+(*********)
+Lemma D_pow_n:(n:nat)(D:R->Prop)(x0:R)(expr,dexpr:R->R)
+ (D_in expr dexpr D x0)-> (D_in [x:R](pow (expr x) n) 
+     [x:R](Rmult (Rmult (INR n) (pow (expr x) (minus n (1)))) (dexpr x)) 
+          (Dgf D D expr) x0).
+Intros n D x0 expr dexpr H; 
+ Generalize (Dcomp D D dexpr [x:R](Rmult (INR n) (pow x (minus n (1)))) 
+         expr [x:R](pow x n) x0  H (Dx_pow_n n D (expr x0)));
+ 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.
+Cut ``((dexpr x0)*((INR n)*(pow (expr x0) (minus n (S O)))))==
+            ((INR n)*(pow (expr x0) (minus n (S O)))*(dexpr x0))``;
+ [Intro Rew;Rewrite <- Rew;Exact (H2 x1 H3)|Ring].
+Qed.
+
diff --git a/theories7/Reals/Reals.v b/theories7/Reals/Reals.v
new file mode 100644
index 00000000..d0f879ab
--- /dev/null
+++ b/theories7/Reals/Reals.v
@@ -0,0 +1,32 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Reals.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+(* The library REALS is divided in 6 parts :
+   - Rbase: basic lemmas on R
+            equalities and inequalities
+            Ring and Field are instantiated on R
+   - Rfunctions: some useful functions (Rabsolu, Rmin, Rmax, fact...)
+   - SeqSeries: theory of sequences and series
+   - Rtrigo: theory of trigonometric functions
+   - Ranalysis: some topology and general results of real analysis (mean value theorem, intermediate value theorem,...)
+   - Integration: Newton and Riemann' integrals
+
+  Tactics are:
+  - DiscrR: for goals like ``?1<>0``
+  - Sup: for goals like ``?1<?2``
+  - RCompute: for equalities with constants like ``10*10==100``
+  - Reg: for goals like (continuity_pt ?1 ?2) or (derivable_pt ?1 ?2) *)
+  
+Require Export Rbase.
+Require Export Rfunctions.
+Require Export SeqSeries.
+Require Export Rtrigo.
+Require Export Ranalysis.
+Require Export Integration.
diff --git a/theories7/Reals/Rfunctions.v b/theories7/Reals/Rfunctions.v
new file mode 100644
index 00000000..fe6ccd96
--- /dev/null
+++ b/theories7/Reals/Rfunctions.v
@@ -0,0 +1,832 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rfunctions.v,v 1.2.2.1 2004/07/16 19:31:34 herbelin Exp $ 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*)
+
+(********************************************************)
+(**          Definition of the sum functions            *)
+(*                                                      *)
+(********************************************************)
+
+Require Rbase.
+Require Export R_Ifp.
+Require Export Rbasic_fun.
+Require Export R_sqr.
+Require Export SplitAbsolu.
+Require Export SplitRmult.
+Require Export ArithProp.
+Require Omega.
+Require Zpower.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope nat_scope.
+Open Local Scope R_scope.
+
+(*******************************)
+(**  Lemmas about factorial    *)
+(*******************************)
+(*********)
+Lemma INR_fact_neq_0:(n:nat)~(INR (fact n))==R0.
+Proof.
+Intro;Red;Intro;Apply (not_O_INR (fact n) (fact_neq_0 n));Assumption.
+Qed.    
+
+(*********)
+Lemma fact_simpl : (n:nat) (fact (S n))=(mult (S n) (fact n)).
+Proof.
+Intro; Reflexivity.
+Qed. 
+
+(*********)
+Lemma simpl_fact:(n:nat)(Rmult (Rinv (INR (fact (S n)))) 
+         (Rinv (Rinv (INR (fact n)))))==
+         (Rinv (INR (S n))).
+Proof.
+Intro;Rewrite (Rinv_Rinv (INR (fact n)) (INR_fact_neq_0 n)); 
+ Unfold 1 fact;Cbv Beta Iota;Fold fact;
+ Rewrite (mult_INR (S n) (fact n));
+ Rewrite (Rinv_Rmult (INR (S n)) (INR (fact n))).
+Rewrite (Rmult_assoc (Rinv (INR (S n))) (Rinv (INR (fact n))) 
+  (INR (fact n)));Rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
+ Apply (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1).
+Apply not_O_INR;Auto.
+Apply INR_fact_neq_0.
+Qed.
+
+(*******************************)
+(*          Power              *)
+(*******************************)
+(*********)
+Fixpoint pow [r:R;n:nat]:R:=
+  Cases n of
+     O     => R1
+    |(S n) => (Rmult r (pow r n))
+  end.
+
+V8Infix "^" pow : R_scope.
+
+Lemma pow_O: (x : R)  (pow x O) == R1.
+Proof.
+Reflexivity.
+Qed.
+ 
+Lemma pow_1: (x : R)  (pow x (1)) == x.
+Proof.
+Simpl; Auto with real.
+Qed.
+ 
+Lemma pow_add:
+ (x : R) (n, m : nat)  (pow x (plus n m)) == (Rmult (pow x n) (pow x m)).
+Proof.
+Intros x n; Elim n; Simpl; Auto with real.
+Intros n0 H' m; Rewrite H'; Auto with real.
+Qed.
+
+Lemma pow_nonzero:
+  (x:R) (n:nat) ~(x==R0) -> ~((pow x n)==R0).
+Proof.
+Intro; Induction n; Simpl.
+Intro; Red;Intro;Apply R1_neq_R0;Assumption.
+Intros;Red; Intro;Elim (without_div_Od x (pow x n0) H1).
+Intro; Auto.
+Apply H;Assumption.
+Qed.
+
+Hints Resolve pow_O pow_1 pow_add pow_nonzero:real.
+ 
+Lemma pow_RN_plus:
+ (x : R)
+ (n, m : nat)
+ ~ x == R0 ->  (pow x n) == (Rmult (pow x (plus n m)) (Rinv (pow x m))).
+Proof.
+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: (x : R) (n : nat) (Rlt R0 x) ->  (Rlt R0 (pow x n)).
+Proof.
+Intros x n; Elim n; Simpl; Auto with real.
+Intros n0 H' H'0; Replace R0 with (Rmult x R0); Auto with real.
+Qed.
+Hints Resolve pow_lt :real.
+
+Lemma Rlt_pow_R1:
+ (x : R) (n : nat) (Rlt R1 x) -> (lt O n) ->  (Rlt R1 (pow x n)).
+Proof.
+Intros x n; Elim n; Simpl; Auto with real.
+Intros H' H'0; ElimType False; Omega.
+Intros n0; Case n0.
+Simpl; Rewrite Rmult_1r; Auto.
+Intros n1 H' H'0 H'1.
+Replace R1 with (Rmult R1 R1); Auto with real.
+Apply Rlt_trans with r2 := (Rmult x R1); Auto with real.
+Apply Rlt_monotony; Auto with real.
+Apply Rlt_trans with r2 := R1; Auto with real.
+Apply H'; Auto with arith.
+Qed.
+Hints Resolve Rlt_pow_R1 :real.
+
+Lemma Rlt_pow:
+ (x : R) (n, m : nat) (Rlt R1 x) -> (lt n m) ->  (Rlt (pow x n) (pow x m)).
+Proof.
+Intros x n m H' H'0; Replace m with (plus (minus m n) n).
+Rewrite pow_add.
+Pattern 1 (pow x n); Replace (pow x n) with (Rmult R1 (pow x n)); 
+ Auto with real.
+Apply Rminus_lt.
+Repeat Rewrite [y : R]  (Rmult_sym y (pow x n)); Rewrite <- Rminus_distr.
+Replace R0 with (Rmult (pow x n) R0); Auto with real.
+Apply Rlt_monotony; Auto with real.
+Apply pow_lt; Auto with real.
+Apply Rlt_trans with r2 := R1; Auto with real.
+Apply Rlt_minus; Auto with real.
+Apply Rlt_pow_R1; Auto with arith.
+Apply simpl_lt_plus_l with p := n; Auto with arith.
+Rewrite le_plus_minus_r; Auto with arith; Rewrite <- plus_n_O; Auto.
+Rewrite plus_sym; Auto with arith.
+Qed.
+Hints Resolve Rlt_pow :real.
+
+(*********)
+Lemma tech_pow_Rmult:(x:R)(n:nat)(Rmult x (pow x n))==(pow x (S n)).
+Proof.
+Induction n; Simpl; Trivial.
+Qed.
+
+(*********)
+Lemma tech_pow_Rplus:(x:R)(a,n:nat)
+  (Rplus (pow x a) (Rmult (INR n) (pow x a)))==
+           (Rmult (INR (S n)) (pow x a)).
+Proof.
+Intros; Pattern 1 (pow x a);  
+ Rewrite <-(let (H1,H2)=(Rmult_ne (pow x a)) in H1); 
+ Rewrite (Rmult_sym (INR n) (pow x a));
+ Rewrite <- (Rmult_Rplus_distr (pow x a) R1 (INR n));
+ Rewrite (Rplus_sym R1 (INR n)); Rewrite <-(S_INR n);
+ Apply Rmult_sym.
+Qed.
+
+Lemma poly: (n:nat)(x:R)(Rlt R0 x)->
+ (Rle (Rplus R1 (Rmult (INR n) x)) (pow  (Rplus R1 x) n)).
+Proof.
+Intros;Elim n.
+Simpl;Cut (Rplus R1 (Rmult R0 x))==R1.
+Intro;Rewrite H0;Unfold Rle;Right; Reflexivity.
+Ring.
+Intros;Unfold pow; Fold pow;
+ Apply (Rle_trans (Rplus R1 (Rmult (INR (S n0)) x))
+    (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x))) 
+    (Rmult (Rplus R1 x) (pow (Rplus R1 x) n0))).
+Cut (Rmult (Rplus R1 x) (Rplus R1 (Rmult (INR n0) x)))== 
+  (Rplus (Rplus R1 (Rmult (INR (S n0)) x)) 
+         (Rmult (INR n0) (Rmult x x))).
+Intro;Rewrite H1;Pattern 1 (Rplus R1 (Rmult (INR (S n0)) x));
+ Rewrite <-(let (H1,H2)=
+   (Rplus_ne (Rplus R1 (Rmult (INR (S n0)) x))) in H1);
+ Apply Rle_compatibility;Elim n0;Intros.
+Simpl;Rewrite Rmult_Ol;Unfold Rle;Right;Auto.
+Unfold Rle;Left;Generalize Rmult_gt;Unfold Rgt;Intro;
+ Fold (Rsqr x);Apply (H3 (INR (S n1)) (Rsqr x) 
+        (lt_INR_0 (S n1) (lt_O_Sn n1)));Fold (Rgt x R0) in H;
+ Apply (pos_Rsqr1 x (imp_not_Req x R0 
+  (or_intror (Rlt x R0) (Rgt x R0) H))).
+Rewrite (S_INR n0);Ring.
+Unfold Rle in H0;Elim H0;Intro. 
+Unfold Rle;Left;Apply Rlt_monotony.
+Rewrite Rplus_sym;
+ Apply (Rlt_r_plus_R1 x (Rlt_le R0 x H)).
+Assumption.
+Rewrite H1;Unfold Rle;Right;Trivial.
+Qed.
+
+Lemma Power_monotonic:
+ (x:R) (m,n:nat) (Rgt (Rabsolu x) R1) 
+        -> (le m n)
+           -> (Rle (Rabsolu (pow x m)) (Rabsolu (pow x n))).
+Proof.
+Intros x m n H;Induction n;Intros;Inversion H0.
+Unfold Rle; Right; Reflexivity.
+Unfold Rle; Right; Reflexivity.
+Apply (Rle_trans (Rabsolu (pow x m))
+                 (Rabsolu (pow x n))
+                 (Rabsolu (pow x (S n)))).
+Apply Hrecn; Assumption.
+Simpl;Rewrite Rabsolu_mult.
+Pattern 1 (Rabsolu (pow x n)).
+Rewrite <-Rmult_1r.
+Rewrite (Rmult_sym (Rabsolu x) (Rabsolu (pow x n))).
+Apply Rle_monotony.
+Apply Rabsolu_pos.
+Unfold Rgt in H.
+Apply Rlt_le; Assumption.
+Qed.
+
+Lemma Pow_Rabsolu: (x:R) (n:nat)
+     (pow (Rabsolu x) n)==(Rabsolu (pow x n)).
+Proof.
+Intro;Induction n;Simpl.
+Apply sym_eqT;Apply Rabsolu_pos_eq;Apply Rlt_le;Apply Rlt_R0_R1.
+Intros; Rewrite H;Apply sym_eqT;Apply Rabsolu_mult.
+Qed.
+
+
+Lemma Pow_x_infinity:
+  (x:R) (Rgt (Rabsolu x) R1)
+        -> (b:R) (Ex [N:nat] ((n:nat) (ge n N) 
+                     -> (Rge (Rabsolu (pow x n)) b ))).
+Proof.
+Intros;Elim (archimed (Rmult b (Rinv (Rminus (Rabsolu x) R1))));Intros;
+  Clear H1;
+  Cut (Ex[N:nat] (Rge (INR N) (Rmult b (Rinv (Rminus (Rabsolu x) R1))))).
+Intro; Elim H1;Clear H1;Intros;Exists x0;Intros;
+ Apply (Rge_trans (Rabsolu (pow x n)) (Rabsolu (pow x x0)) b).
+Apply Rle_sym1;Apply Power_monotonic;Assumption.
+Rewrite <- Pow_Rabsolu;Cut (Rabsolu x)==(Rplus R1 (Rminus (Rabsolu x) R1)).
+Intro; Rewrite H3;
+ Apply (Rge_trans (pow (Rplus R1 (Rminus (Rabsolu x) R1)) x0)
+                 (Rplus R1 (Rmult (INR x0)  
+                                  (Rminus (Rabsolu x) R1)))
+                 b).
+Apply Rle_sym1;Apply poly;Fold (Rgt (Rminus (Rabsolu x) R1) R0);
+ Apply Rgt_minus;Assumption.
+Apply (Rge_trans 
+         (Rplus R1 (Rmult (INR x0) (Rminus (Rabsolu x) R1)))
+         (Rmult (INR x0) (Rminus (Rabsolu x) R1))
+         b).
+Apply Rle_sym1; Apply Rlt_le;Rewrite (Rplus_sym R1 
+                   (Rmult (INR x0) (Rminus (Rabsolu x) R1)));
+ Pattern 1 (Rmult (INR x0) (Rminus (Rabsolu x) R1));
+ Rewrite <- (let (H1,H2) = (Rplus_ne 
+            (Rmult (INR x0) (Rminus (Rabsolu x) R1))) in
+         H1);
+ Apply Rlt_compatibility;
+ Apply Rlt_R0_R1.
+Cut b==(Rmult (Rmult b (Rinv (Rminus (Rabsolu x) R1)))
+              (Rminus (Rabsolu x) R1)).
+Intros; Rewrite H4;Apply Rge_monotony.
+Apply Rge_minus;Unfold Rge; Left; Assumption.
+Assumption.
+Rewrite Rmult_assoc;Rewrite Rinv_l.
+Ring.
+Apply imp_not_Req; Right;Apply Rgt_minus;Assumption.
+Ring.
+Cut `0<= (up (Rmult b (Rinv (Rminus (Rabsolu x) R1))))`\/
+     `(up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) <=  0`.
+Intros;Elim H1;Intro.
+Elim (IZN (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))) H2);Intros;Exists x0;
+ Apply (Rge_trans 
+   (INR x0)
+   (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
+   (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
+Rewrite INR_IZR_INZ;Apply IZR_ge;Omega.
+Unfold Rge; Left; Assumption.
+Exists O;Apply (Rge_trans (INR (0))
+          (IZR (up (Rmult b (Rinv (Rminus (Rabsolu x) R1)))))
+          (Rmult b (Rinv (Rminus (Rabsolu x) R1)))).
+Rewrite INR_IZR_INZ;Apply IZR_ge;Simpl;Omega.
+Unfold Rge; Left; Assumption.
+Omega.
+Qed.
+
+Lemma pow_ne_zero:
+  (n:nat) ~(n=(0))-> (pow R0 n) == R0.
+Proof.
+Induction n.
+Simpl;Auto.
+Intros;Elim H;Reflexivity.
+Intros; Simpl;Apply Rmult_Ol.
+Qed.
+
+Lemma Rinv_pow:
+  (x:R) (n:nat) ~(x==R0) -> (Rinv (pow x n))==(pow (Rinv x) n).
+Proof.
+Intros; Elim n; Simpl.
+Apply Rinv_R1.
+Intro m;Intro;Rewrite Rinv_Rmult.
+Rewrite H0; Reflexivity;Assumption.
+Assumption.
+Apply pow_nonzero;Assumption.
+Qed.
+
+Lemma pow_lt_1_zero:
+  (x:R) (Rlt (Rabsolu x) R1)
+        -> (y:R) (Rlt R0 y) 
+                 -> (Ex[N:nat] (n:nat) (ge n N)
+                         -> (Rlt (Rabsolu (pow x n)) y)).
+Proof.
+Intros;Elim (Req_EM x R0);Intro. 
+Exists (1);Rewrite H1;Intros n GE;Rewrite pow_ne_zero.
+Rewrite Rabsolu_R0;Assumption.
+Inversion GE;Auto.
+Cut (Rgt (Rabsolu (Rinv x)) R1).
+Intros;Elim (Pow_x_infinity (Rinv x) H2 (Rplus (Rinv y) R1));Intros N.
+Exists N;Intros;Rewrite <- (Rinv_Rinv y).
+Rewrite <- (Rinv_Rinv (Rabsolu (pow x n))).
+Apply Rinv_lt.
+Apply Rmult_lt_pos.
+Apply Rlt_Rinv.
+Assumption.
+Apply Rlt_Rinv.
+Apply Rabsolu_pos_lt.
+Apply pow_nonzero.
+Assumption.
+Rewrite <- Rabsolu_Rinv.
+Rewrite Rinv_pow.
+Apply (Rlt_le_trans (Rinv y)
+                    (Rplus (Rinv y) R1)
+                    (Rabsolu (pow (Rinv x) n))).
+Pattern 1 (Rinv y).
+Rewrite <- (let (H1,H2) = 
+                (Rplus_ne (Rinv y)) in H1).
+Apply Rlt_compatibility.
+Apply Rlt_R0_R1.
+Apply Rle_sym2.
+Apply H3.
+Assumption.
+Assumption.
+Apply pow_nonzero.
+Assumption.
+Apply Rabsolu_no_R0.
+Apply pow_nonzero.
+Assumption.
+Apply imp_not_Req.
+Right; Unfold Rgt; Assumption.
+Rewrite <- (Rinv_Rinv R1).
+Rewrite Rabsolu_Rinv.
+Unfold Rgt; Apply Rinv_lt.
+Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt.
+Assumption.
+Rewrite Rinv_R1; Apply Rlt_R0_R1.
+Rewrite Rinv_R1; Assumption.
+Assumption.
+Red;Intro; Apply R1_neq_R0;Assumption.
+Qed.
+
+Lemma pow_R1:
+ (r : R) (n : nat) (pow r n) == R1 ->  (Rabsolu r) == R1 \/ n = O.
+Proof.
+Intros r n H'.
+Case (Req_EM (Rabsolu r) R1); Auto; Intros H'1.
+Case (not_Req ? ? H'1); Intros H'2.
+Generalize H'; Case n; Auto.
+Intros n0 H'0.
+Cut ~ r == R0; [Intros Eq1 | Idtac].
+Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
+Absurd (Rlt (pow (Rabsolu (Rinv r)) O) (pow (Rabsolu (Rinv r)) (S n0))); Auto.
+Replace (pow (Rabsolu (Rinv r)) (S n0)) with R1.
+Simpl; Apply Rlt_antirefl; Auto.
+Rewrite Rabsolu_Rinv; Auto.
+Rewrite <- Rinv_pow; Auto.
+Rewrite Pow_Rabsolu; Auto.
+Rewrite H'0; Rewrite Rabsolu_right; Auto with real.
+Apply Rle_ge; Auto with real.
+Apply Rlt_pow; Auto with arith.
+Rewrite Rabsolu_Rinv; Auto.
+Apply Rlt_monotony_contra with z := (Rabsolu r).
+Case (Rabsolu_pos r); Auto.
+Intros H'3; Case Eq2; Auto.
+Rewrite Rmult_1r; Rewrite Rinv_r; Auto with real.
+Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
+Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
+Generalize H'; Case n; Auto.
+Intros n0 H'0.
+Cut ~ r == R0; [Intros Eq1 | Auto with real].
+Cut ~ (Rabsolu r) == R0; [Intros Eq2 | Apply Rabsolu_no_R0]; Auto.
+Absurd (Rlt (pow (Rabsolu r) O) (pow (Rabsolu r) (S n0))); 
+  Auto with real arith.
+Repeat Rewrite Pow_Rabsolu; Rewrite H'0; Simpl; Auto with real.
+Red;Intro;Absurd ``(pow r (S n0)) == 1``;Auto.
+Simpl; Rewrite H; Rewrite Rmult_Ol; Auto with real.
+Qed.
+
+Lemma pow_Rsqr : (x:R;n:nat) (pow x (mult (2) n))==(pow (Rsqr x) n).
+Proof.
+Intros; Induction n.
+Reflexivity.
+Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Replace (pow x (S (S (mult (2) n)))) with ``x*x*(pow x (mult (S (S O)) n))``.
+Rewrite Hrecn; Reflexivity.
+Simpl; Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Qed.
+
+Lemma pow_le : (a:R;n:nat) ``0<=a`` -> ``0<=(pow a n)``.
+Proof.
+Intros; Induction n.
+Simpl; Left; Apply Rlt_R0_R1.
+Simpl; Apply Rmult_le_pos; Assumption.
+Qed.
+
+(**********)
+Lemma pow_1_even : (n:nat) ``(pow (-1) (mult (S (S O)) n))==1``.
+Proof.
+Intro; Induction n.
+Reflexivity.
+Replace (mult (2) (S n)) with (plus (2) (mult (2) n)).
+Rewrite pow_add; Rewrite Hrecn; Simpl; Ring.
+Replace (S n) with (plus n (1)); [Ring | Ring].
+Qed.
+
+(**********)
+Lemma pow_1_odd : (n:nat) ``(pow (-1) (S (mult (S (S O)) n)))==-1``.
+Proof.
+Intro; Replace (S (mult (2) n)) with (plus (mult (2) n) (1)); [Idtac | Ring].
+Rewrite pow_add; Rewrite pow_1_even; Simpl; Ring.
+Qed.
+
+(**********)
+Lemma pow_1_abs : (n:nat) ``(Rabsolu (pow (-1) n))==1``.
+Proof.
+Intro; Induction n.
+Simpl; Apply Rabsolu_R1.
+Replace (S n) with (plus n (1)); [Rewrite pow_add | Ring].
+Rewrite Rabsolu_mult.
+Rewrite Hrecn; Rewrite Rmult_1l; Simpl; Rewrite Rmult_1r; Rewrite Rabsolu_Ropp; Apply Rabsolu_R1.
+Qed.
+
+Lemma pow_mult : (x:R;n1,n2:nat) (pow x (mult n1 n2))==(pow (pow x n1) n2).
+Proof.
+Intros; Induction n2.
+Simpl; Replace (mult n1 O) with O; [Reflexivity | Ring].
+Replace (mult n1 (S n2)) with (plus (mult n1 n2) n1).
+Replace (S n2) with (plus n2 (1)); [Idtac | Ring].
+Do 2 Rewrite pow_add.
+Rewrite Hrecn2.
+Simpl.
+Ring.
+Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite mult_INR; Rewrite S_INR; Ring.
+Qed.
+
+Lemma pow_incr : (x,y:R;n:nat) ``0<=x<=y`` -> ``(pow x n)<=(pow y n)``.
+Proof.
+Intros.
+Induction n.
+Right; Reflexivity.
+Simpl.
+Elim H; Intros.
+Apply Rle_trans with ``y*(pow x n)``.
+Do 2 Rewrite <- (Rmult_sym (pow x n)).
+Apply Rle_monotony.
+Apply pow_le; Assumption.
+Assumption.
+Apply Rle_monotony.
+Apply Rle_trans with x; Assumption.
+Apply Hrecn.
+Qed.
+
+Lemma pow_R1_Rle : (x:R;k:nat) ``1<=x`` -> ``1<=(pow x k)``.
+Proof.
+Intros.
+Induction k.
+Right; Reflexivity.
+Simpl.
+Apply Rle_trans with ``x*1``.
+Rewrite Rmult_1r; Assumption.
+Apply Rle_monotony.
+Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
+Exact Hreck.
+Qed.
+
+Lemma Rle_pow : (x:R;m,n:nat) ``1<=x`` -> (le m n) -> ``(pow x m)<=(pow x n)``.
+Proof.
+Intros.
+Replace n with (plus (minus n m) m).
+Rewrite pow_add.
+Rewrite Rmult_sym.
+Pattern 1 (pow x m); Rewrite <- Rmult_1r.
+Apply Rle_monotony.
+Apply pow_le; Left; Apply Rlt_le_trans with R1; [Apply Rlt_R0_R1 | Assumption].
+Apply pow_R1_Rle; Assumption.
+Rewrite plus_sym.
+Symmetry; Apply le_plus_minus; Assumption.
+Qed.
+
+Lemma pow1 : (n:nat) (pow R1 n)==R1.
+Proof.
+Intro; Induction n.
+Reflexivity.
+Simpl; Rewrite Hrecn; Rewrite Rmult_1r; Reflexivity.
+Qed.
+
+Lemma pow_Rabs : (x:R;n:nat) ``(pow x n)<=(pow (Rabsolu x) n)``.
+Proof.
+Intros; Induction n.
+Right; Reflexivity.
+Simpl; Case (case_Rabsolu x); Intro.
+Apply Rle_trans with (Rabsolu ``x*(pow x n)``).
+Apply Rle_Rabsolu.
+Rewrite Rabsolu_mult.
+Apply Rle_monotony.
+Apply Rabsolu_pos.
+Right; Symmetry; Apply Pow_Rabsolu.
+Pattern 1 (Rabsolu x); Rewrite (Rabsolu_right x r); Apply Rle_monotony.
+Apply Rle_sym2; Exact r.
+Apply Hrecn.
+Qed.
+
+Lemma pow_maj_Rabs : (x,y:R;n:nat) ``(Rabsolu y)<=x`` -> ``(pow y n)<=(pow x n)``.
+Proof.
+Intros; Cut ``0<=x``.
+Intro; Apply Rle_trans with (pow (Rabsolu y) n).
+Apply pow_Rabs.
+Induction n.
+Right; Reflexivity.
+Simpl; Apply Rle_trans with ``x*(pow (Rabsolu y) n)``.
+Do 2 Rewrite <- (Rmult_sym (pow (Rabsolu y) n)).
+Apply Rle_monotony.
+Apply pow_le; Apply Rabsolu_pos.
+Assumption.
+Apply Rle_monotony.
+Apply H0.
+Apply Hrecn.
+Apply Rle_trans with (Rabsolu y); [Apply Rabsolu_pos | Exact H].
+Qed.
+
+(*******************************)
+(**         PowerRZ            *)
+(*******************************)
+(*i Due to L.Thery i*)
+
+Tactic Definition CaseEqk name :=
+Generalize (refl_equal ? name); Pattern -1 name; Case name.
+
+Definition powerRZ :=
+   [x : R] [n : Z]  Cases n of
+                      ZERO => R1
+                     | (POS p) => (pow x (convert p))
+                     | (NEG p) => (Rinv (pow x (convert p)))
+                    end.
+
+Infix Local "^Z" powerRZ (at level 2, left associativity) : R_scope.
+
+Lemma Zpower_NR0:
+ (x : Z) (n : nat) (Zle ZERO x) ->  (Zle ZERO (Zpower_nat x n)).
+Proof.
+NewInduction n; Unfold Zpower_nat; Simpl; Auto with zarith.
+Qed.
+
+Lemma powerRZ_O: (x : R)  (powerRZ x ZERO) == R1.
+Proof.
+Reflexivity.
+Qed.
+ 
+Lemma powerRZ_1: (x : R)  (powerRZ x (Zs ZERO)) == x.
+Proof.
+Simpl; Auto with real.
+Qed.
+ 
+Lemma powerRZ_NOR: (x : R) (z : Z) ~ x == R0 ->  ~ (powerRZ x z) == R0.
+Proof.
+NewDestruct z; Simpl; Auto with real.
+Qed.
+ 
+Lemma powerRZ_add:
+ (x : R)
+ (n, m : Z)
+ ~ x == R0 ->  (powerRZ x (Zplus n m)) == (Rmult (powerRZ x n) (powerRZ x m)).
+Proof.
+Intro x; NewDestruct n as [|n1|n1]; NewDestruct m as [|m1|m1]; Simpl;
+  Auto with real.
+(* POS/POS *)
+Rewrite convert_add; Auto with real.
+(* POS/NEG *)
+(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
+Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
+Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
+Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
+ Auto with real.
+Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
+Rewrite Rinv_Rmult; Auto with real.
+Rewrite Rinv_Rinv; Auto with real.
+Apply lt_le_weak.
+Apply compare_convert_INFERIEUR; Auto.
+Apply ZC2; Auto.
+Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
+Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
+ Auto with real.
+Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
+Apply lt_le_weak.
+Change (gt (convert n1) (convert m1)).
+Apply compare_convert_SUPERIEUR; Auto.
+(* NEG/POS *)
+(CaseEqk '(compare n1 m1 EGAL)); Simpl; Auto with real.
+Intros H' H'0; Rewrite compare_convert_EGAL with 1 := H'; Auto with real.
+Intros H' H'0; Rewrite (true_sub_convert m1 n1); Auto with real.
+Rewrite (pow_RN_plus x (minus (convert m1) (convert n1)) (convert n1));
+ Auto with real.
+Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
+Apply lt_le_weak.
+Apply compare_convert_INFERIEUR; Auto.
+Apply ZC2; Auto.
+Intros H' H'0; Rewrite (true_sub_convert n1 m1); Auto with real.
+Rewrite (pow_RN_plus x (minus (convert n1) (convert m1)) (convert m1));
+ Auto with real.
+Rewrite plus_sym; Rewrite le_plus_minus_r; Auto with real.
+Rewrite Rinv_Rmult; Auto with real.
+Apply lt_le_weak.
+Change (gt (convert n1) (convert m1)).
+Apply compare_convert_SUPERIEUR; Auto.
+(* NEG/NEG *)
+Rewrite convert_add; Auto with real.
+Intros H'; Rewrite pow_add; Auto with real.
+Apply Rinv_Rmult; Auto.
+Apply pow_nonzero; Auto.
+Apply pow_nonzero; Auto.
+Qed.
+Hints Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add :real.
+ 
+Lemma Zpower_nat_powerRZ:
+ (n, m : nat)
+  (IZR (Zpower_nat (inject_nat n) m)) == (powerRZ (INR n) (inject_nat m)).
+Proof.
+Intros n m; Elim m; Simpl; Auto with real.
+Intros m1 H'; Rewrite bij1; Simpl.
+Replace (Zpower_nat (inject_nat n) (S m1))
+     with (Zmult (inject_nat n) (Zpower_nat (inject_nat n) m1)).
+Rewrite mult_IZR; Auto with real.
+Repeat Rewrite <- INR_IZR_INZ; Simpl.
+Rewrite H'; Simpl.
+Case m1; Simpl; Auto with real.
+Intros m2; Rewrite bij1; Auto.
+Unfold Zpower_nat; Auto.
+Qed.
+ 
+Lemma powerRZ_lt: (x : R) (z : Z) (Rlt R0 x) ->  (Rlt R0 (powerRZ x z)).
+Proof.
+Intros x z; Case z; Simpl; Auto with real.
+Qed.
+Hints Resolve powerRZ_lt :real.
+ 
+Lemma powerRZ_le: (x : R) (z : Z) (Rlt R0 x) ->  (Rle R0 (powerRZ x z)).
+Proof.
+Intros x z H'; Apply Rlt_le; Auto with real.
+Qed.
+Hints Resolve powerRZ_le :real.
+ 
+Lemma Zpower_nat_powerRZ_absolu:
+ (n, m : Z)
+ (Zle ZERO m) ->  (IZR (Zpower_nat n (absolu m))) == (powerRZ (IZR n) m).
+Proof.
+Intros n m; Case m; Simpl; Auto with zarith.
+Intros p H'; Elim (convert 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 <= (NEG p)`;Auto with zarith.
+Qed.
+
+Lemma powerRZ_R1: (n : Z)  (powerRZ R1 n) == R1.
+Proof.
+Intros n; Case n; Simpl; Auto.
+Intros p; Elim (convert p); Simpl; Auto; Intros n0 H'; Rewrite H'; Ring.
+Intros p; Elim (convert p); Simpl.
+Exact Rinv_R1.
+Intros n1 H'; Rewrite Rinv_Rmult; Try Rewrite Rinv_R1; Try Rewrite H';
+ Auto with real.
+Qed.
+
+(*******************************)
+(** Sum of n first naturals    *)
+(*******************************)
+(*********)
+Fixpoint sum_nat_f_O [f:nat->nat;n:nat]:nat:=       
+  Cases n of                            
+    O => (f O)                               
+   |(S n') => (plus (sum_nat_f_O f n') (f (S n'))) 
+  end.
+
+(*********)
+Definition sum_nat_f [s,n:nat;f:nat->nat]:nat:=      
+  (sum_nat_f_O [x:nat](f (plus x s)) (minus n s)).
+
+(*********)
+Definition sum_nat_O [n:nat]:nat:=
+  (sum_nat_f_O [x:nat]x n).
+
+(*********)
+Definition sum_nat [s,n:nat]:nat:=
+  (sum_nat_f s n [x:nat]x).
+
+(*******************************)
+(**            Sum             *)
+(*******************************)
+(*********)
+Fixpoint sum_f_R0 [f:nat->R;N:nat]:R:=
+  Cases N of
+     O     => (f O)
+    |(S i) => (Rplus (sum_f_R0 f i) (f (S i)))
+  end.
+
+(*********)
+Definition sum_f [s,n:nat;f:nat->R]:R:=      
+  (sum_f_R0 [x:nat](f (plus x s)) (minus n s)).
+
+Lemma GP_finite:
+  (x:R) (n:nat) (Rmult (sum_f_R0 [n:nat] (pow x n) n)
+                       (Rminus x R1)) ==
+                (Rminus (pow x (plus n (1))) R1).
+Proof.
+Intros; Induction n; Simpl.
+Ring.
+Rewrite Rmult_Rplus_distrl;Rewrite Hrecn;Cut (plus n (1))=(S n).
+Intro H;Rewrite H;Simpl;Ring.
+Omega.
+Qed.
+
+Lemma sum_f_R0_triangle:
+  (x:nat->R)(n:nat) (Rle (Rabsolu (sum_f_R0 x n))
+                         (sum_f_R0 [i:nat] (Rabsolu (x i)) n)).
+Proof.
+Intro; Induction n; Simpl.
+Unfold Rle; Right; Reflexivity.
+Intro m; Intro;Apply (Rle_trans
+          (Rabsolu (Rplus (sum_f_R0 x m) (x (S m))))
+          (Rplus (Rabsolu (sum_f_R0 x m))
+                 (Rabsolu (x (S m))))
+          (Rplus (sum_f_R0 [i:nat](Rabsolu (x i)) m) 
+                 (Rabsolu (x (S m))))).
+Apply Rabsolu_triang.
+Rewrite Rplus_sym;Rewrite (Rplus_sym 
+  (sum_f_R0 [i:nat](Rabsolu (x i)) m) (Rabsolu (x (S m))));
+  Apply Rle_compatibility;Assumption.
+Qed.
+
+(*******************************)
+(*        Distance  in R       *)
+(*******************************)
+
+(*********)
+Definition R_dist:R->R->R:=[x,y:R](Rabsolu (Rminus x y)).
+
+(*********)
+Lemma R_dist_pos:(x,y:R)(Rge (R_dist x y) R0).
+Proof.
+Intros;Unfold R_dist;Unfold Rabsolu;Case (case_Rabsolu (Rminus x y));Intro l.
+Unfold Rge;Left;Apply (Rlt_RoppO (Rminus x y) l).
+Trivial.
+Qed.
+
+(*********)
+Lemma R_dist_sym:(x,y:R)(R_dist x y)==(R_dist y x).
+Proof.
+Unfold R_dist;Intros;SplitAbsolu;Ring.
+Generalize (Rlt_RoppO (Rminus y x) r); Intro;
+ Rewrite (Ropp_distr2 y x) in H;
+ Generalize (Rlt_antisym (Rminus x y) R0 r0); Intro;Unfold Rgt in H;
+ ElimType False; Auto.
+Generalize (minus_Rge y x r); Intro;
+ Generalize (minus_Rge x y r0); Intro;
+ Generalize (Rge_ge_eq x y H0 H); Intro;Rewrite H1;Ring.
+Qed.
+
+(*********)
+Lemma R_dist_refl:(x,y:R)((R_dist x y)==R0<->x==y).
+Proof.
+Unfold R_dist;Intros;SplitAbsolu;Split;Intros.
+Rewrite (Ropp_distr2 x y) in H;Apply sym_eqT;
+ Apply (Rminus_eq y x H).
+Rewrite (Ropp_distr2 x y);Generalize (sym_eqT R x y H);Intro;
+ Apply (eq_Rminus y x H0).
+Apply (Rminus_eq x y H).
+Apply (eq_Rminus x y H). 
+Qed.
+
+Lemma R_dist_eq:(x:R)(R_dist x x)==R0.
+Proof.
+Unfold R_dist;Intros;SplitAbsolu;Intros;Ring.
+Qed.
+
+(***********)
+Lemma R_dist_tri:(x,y,z:R)(Rle (R_dist x y) 
+                   (Rplus (R_dist x z) (R_dist z y))).
+Proof.
+Intros;Unfold R_dist; Replace ``x-y`` with ``(x-z)+(z-y)``;
+  [Apply (Rabsolu_triang ``x-z`` ``z-y``)|Ring].
+Qed.
+
+(*********)
+Lemma R_dist_plus: (a,b,c,d:R)(Rle (R_dist (Rplus a c) (Rplus b d))
+                   (Rplus (R_dist a b) (R_dist c d))).
+Proof.
+Intros;Unfold R_dist;
+ Replace (Rminus (Rplus a c) (Rplus b d))
+  with (Rplus (Rminus a b) (Rminus c d)).
+Exact (Rabsolu_triang (Rminus a b) (Rminus c d)).
+Ring.
+Qed.
+
+(*******************************)
+(**       Infinit Sum          *)
+(*******************************)
+(*********)
+Definition infinit_sum:(nat->R)->R->Prop:=[s:nat->R;l:R]
+  (eps:R)(Rgt eps R0)->
+  (Ex[N:nat](n:nat)(ge n N)->(Rlt (R_dist (sum_f_R0 s n) l) eps)).
diff --git a/theories7/Reals/Rgeom.v b/theories7/Reals/Rgeom.v
new file mode 100644
index 00000000..12c52e37
--- /dev/null
+++ b/theories7/Reals/Rgeom.v
@@ -0,0 +1,84 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rgeom.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require R_sqrt.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Definition dist_euc [x0,y0,x1,y1:R] : R := ``(sqrt ((Rsqr (x0-x1))+(Rsqr (y0-y1))))``.
+
+Lemma distance_refl : (x0,y0:R) ``(dist_euc x0 y0 x0 y0)==0``.
+Intros x0 y0; Unfold dist_euc; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr] | Right; Reflexivity | Rewrite Rsqr_O; Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0; [Apply pos_Rsqr | Apply pos_Rsqr]]].
+Qed.
+
+Lemma distance_symm : (x0,y0,x1,y1:R) ``(dist_euc x0 y0 x1 y1) == (dist_euc x1 y1 x0 y0)``. 
+Intros x0 y0 x1 y1; Unfold dist_euc; Apply Rsqr_inj; [ Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 |Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
+Qed.
+
+Lemma law_cosines : (x0,y0,x1,y1,x2,y2,ac:R) let a = (dist_euc x1 y1 x0 y0) in let b=(dist_euc x2 y2 x0 y0) in let c=(dist_euc x2 y2 x1 y1) in ( ``a*c*(cos ac) == ((x0-x1)*(x2-x1) + (y0-y1)*(y2-y1))`` -> ``(Rsqr b)==(Rsqr c)+(Rsqr a)-2*(a*c*(cos ac))`` ).
+Unfold dist_euc; Intros; Repeat Rewrite -> Rsqr_sqrt; [ Rewrite H; Unfold Rsqr; Ring | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]; Apply pos_Rsqr.
+Qed.
+
+Lemma triangle : (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)``.
+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)``; [Replace ``(Rsqr (y0-y1))`` with ``(Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)``; [Apply Rle_anti_compatibility with ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))``; Replace `` -(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (x2-x1))+2*(x0-x2)*(x2-x1)+((Rsqr (y0-y2))+(Rsqr (y2-y1))+2*(y0-y2)*(y2-y1)))`` with ``2*((x0-x2)*(x2-x1)+(y0-y2)*(y2-y1))``; [Replace ``-(Rsqr (x0-x2))-(Rsqr (x2-x1))-(Rsqr (y0-y2))-(Rsqr (y2-y1))+((Rsqr (x0-x2))+(Rsqr (y0-y2))+((Rsqr (x2-x1))+(Rsqr (y2-y1)))+2*(sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))`` with ``2*((sqrt ((Rsqr (x0-x2))+(Rsqr (y0-y2))))*(sqrt ((Rsqr (x2-x1))+(Rsqr (y2-y1)))))``; [Apply Rle_monotony; [Left; Cut ~(O=(2)); [Intros; Generalize (lt_INR_0 (2) (neq_O_lt (2) H)); Intro H0; Assumption | Discriminate] | Apply sqrt_cauchy] | Ring] | Ring] | SqRing] | SqRing] | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr] | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr | Apply ge0_plus_ge0_is_ge0; Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0; Apply pos_Rsqr].
+Qed.
+
+(******************************************************************)
+(**                         Translation                           *)
+(******************************************************************)
+
+Definition xt[x,tx:R] : R := ``x+tx``.
+Definition yt[y,ty:R] : R := ``y+ty``.
+
+Lemma translation_0 : (x,y:R) ``(xt x 0)==x``/\``(yt y 0)==y``.
+Intros x y; Split; [Unfold xt | Unfold yt]; Ring.
+Qed.
+
+Lemma isometric_translation : (x1,x2,y1,y2,tx,ty:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2))==(Rsqr ((xt x1 tx)-(xt x2 tx)))+(Rsqr ((yt y1 ty)-(yt y2 ty)))``.
+Intros; Unfold Rsqr xt yt; Ring.
+Qed.
+
+(******************************************************************)
+(**                           Rotation                            *)
+(******************************************************************)
+
+Definition xr [x,y,theta:R] : R := ``x*(cos theta)+y*(sin theta)``.
+Definition yr [x,y,theta:R] : R := ``-x*(sin theta)+y*(cos theta)``.
+
+Lemma rotation_0 : (x,y:R) ``(xr x y 0)==x`` /\ ``(yr x y 0)==y``.
+Intros x y; Unfold xr yr; Split; Rewrite cos_0; Rewrite sin_0; Ring.
+Qed.
+
+Lemma rotation_PI2 : (x,y:R) ``(xr x y PI/2)==y`` /\ ``(yr x y PI/2)==-x``.
+Intros  x y; Unfold xr yr; Split; Rewrite cos_PI2; Rewrite sin_PI2; Ring.
+Qed.
+
+Lemma isometric_rotation_0 : (x1,y1,x2,y2,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr x1 y1 theta))-(xr x2 y2 theta)) + (Rsqr ((yr x1 y1 theta))-(yr x2 y2 theta))``.
+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)``; [Replace ``-x1*(sin theta)+y1*(cos theta)-( -x2*(sin theta)+y2*(cos theta))`` with ``(cos theta)*(y1-y2)+(sin theta)*(x2-x1)``; [Repeat Rewrite Rsqr_plus; Repeat Rewrite Rsqr_times; Repeat Rewrite cos2; Ring; Replace ``x2-x1`` with ``-(x1-x2)``; [Rewrite <- Rsqr_neg; Ring | Ring] |Ring] | Ring].
+Qed.
+
+Lemma isometric_rotation : (x1,y1,x2,y2,theta:R) ``(dist_euc x1 y1 x2 y2) == (dist_euc (xr x1 y1 theta) (yr x1 y1 theta) (xr x2 y2 theta) (yr x2 y2 theta))``.
+Unfold dist_euc; Intros; Apply Rsqr_inj; [Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Apply sqrt_positivity; Apply ge0_plus_ge0_is_ge0 | Repeat Rewrite Rsqr_sqrt; [ Apply isometric_rotation_0 | Apply ge0_plus_ge0_is_ge0 | Apply ge0_plus_ge0_is_ge0]]; Apply pos_Rsqr.
+Qed.
+
+(******************************************************************)
+(**                         Similarity                            *)
+(******************************************************************)
+
+Lemma isometric_rot_trans : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xr (xt x1 tx) (yt y1 ty) theta)-(xr (xt x2 tx) (yt y2 ty) theta))) + (Rsqr ((yr (xt x1 tx) (yt y1 ty) theta)-(yr (xt x2 tx) (yt y2 ty) theta)))``. 
+Intros; Rewrite <- isometric_rotation_0; Apply isometric_translation.
+Qed.
+
+Lemma isometric_trans_rot : (x1,y1,x2,y2,tx,ty,theta:R) ``(Rsqr (x1-x2))+(Rsqr (y1-y2)) == (Rsqr ((xt (xr x1 y1 theta) tx)-(xt (xr x2 y2 theta) tx))) + (Rsqr ((yt (yr x1 y1 theta) ty)-(yt (yr x2 y2 theta) ty)))``. 
+Intros; Rewrite <- isometric_translation; Apply isometric_rotation_0.
+Qed.
diff --git a/theories7/Reals/RiemannInt.v b/theories7/Reals/RiemannInt.v
new file mode 100644
index 00000000..c9301b56
--- /dev/null
+++ b/theories7/Reals/RiemannInt.v
@@ -0,0 +1,1699 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: RiemannInt.v,v 1.1.2.1 2004/07/16 19:31:34 herbelin Exp $ i*)
+
+Require Rfunctions.
+Require SeqSeries.
+Require Ranalysis.
+Require Rbase.
+Require RiemannInt_SF.
+Require Classical_Prop.
+Require Classical_Pred_Type.
+Require Max.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Implicit Arguments On.
+
+(********************************************)
+(*            Riemann's Integral            *)
+(********************************************)
+
+Definition Riemann_integrable [f:R->R;a,b:R] : Type := (eps:posreal) (SigT ? [phi:(StepFun a b)](SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi t)))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<eps``)).
+
+Definition phi_sequence [un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b)] := [n:nat](projT1 ? ? (pr (un n))).
+
+Lemma phi_sequence_prop : (un:nat->posreal;f:R->R;a,b:R;pr:(Riemann_integrable f a b);N:nat) (SigT ? [psi:(StepFun a b)]((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-[(phi_sequence un pr N t)]))<=(psi t)``)/\``(Rabsolu (RiemannInt_SF psi))<(un N)``).
+Intros; Apply (projT2 ? ? (pr (un N))).
+Qed.
+
+Lemma RiemannInt_P1 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable f b a).
+Unfold Riemann_integrable; Intros; Elim (X eps); Clear X; Intros; Elim p; Clear p; Intros; Apply Specif.existT with (mkStepFun (StepFun_P6 (pre x))); Apply Specif.existT with (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 | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
+Generalize H0; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre x0)))) (subdivision (mkStepFun (StepFun_P6 (pre x0))))) with (Int_SF (subdivision_val x0) (subdivision x0)); [Idtac | Apply StepFun_P17 with (fe x0) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre x0))))]]).
+Apply H1.
+Rewrite Rabsolu_Ropp; Apply H1.
+Rewrite Rabsolu_Ropp in H1; Apply H1.
+Apply H1.
+Qed.
+
+Lemma RiemannInt_P2 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ``a<=b`` -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (vn N)) l)).
+Intros; Apply R_complete; Unfold Un_cv in H; Unfold Cauchy_crit; Intros; Assert H3 : ``0<eps/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+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))``; [Idtac | Ring]; Rewrite <- StepFun_P30; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (vn n) (vn m)))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (wn n) (wn m)))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((vn n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring].
+Assert H12 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H13 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Rewrite <- H12 in H11; Pattern 2 b in H11; Rewrite <- H13 in H11; Rewrite Rmult_1l; Apply Rplus_le.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9.
+Elim H11; Intros; Split; Left; Assumption.
+Apply H7.
+Elim H11; Intros; Split; Left; Assumption.
+Rewrite StepFun_P30; Rewrite Rmult_1l; Apply Rlt_trans with ``(un n)+(un m)``.
+Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (wn n)))+(Rabsolu (RiemannInt_SF (wn m)))``.
+Apply Rplus_le; Apply Rle_Rabsolu.
+Apply Rplus_lt; Assumption.
+Apply Rle_lt_trans with ``(Rabsolu (un n))+(Rabsolu (un m))``.
+Apply Rplus_le; Apply Rle_Rabsolu.
+Replace (pos (un n)) with ``(un n)-0``; [Idtac | Ring]; Replace (pos (un m)) with ``(un m)-0``; [Idtac | Ring]; Rewrite (double_var eps); Apply Rplus_lt; Apply H4; Assumption.
+Qed.
+
+Lemma RiemannInt_P3 : (f:R->R;a,b:R;un:nat->posreal;vn,wn:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(vn n t)))<=(wn n t)``)/\``(Rabsolu (RiemannInt_SF (wn n)))<(un n)``)->(sigTT R ([l:R](Un_cv ([N:nat](RiemannInt_SF (vn N))) l))).
+Intros; Case (total_order_Rle a b); Intro.
+Apply RiemannInt_P2 with f un wn; Assumption.
+Assert H1 : ``b<=a``; Auto with real.
+Pose vn' := [n:nat](mkStepFun (StepFun_P6 (pre (vn n)))); Pose wn' := [n:nat](mkStepFun (StepFun_P6 (pre (wn n)))); Assert H2 : (n:nat)((t:R)``(Rmin b a)<=t<=(Rmax b a)``->``(Rabsolu ((f t)-(vn' n t)))<=(wn' n t)``)/\``(Rabsolu (RiemannInt_SF (wn' n)))<(un n)``.
+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 | Apply Rle_trans with (Rmax b a); Try Assumption; Right; Unfold Rmax]; (Case (total_order_Rle a b); Case (total_order_Rle b a); Intros; Try Reflexivity Orelse Apply Rle_antisym; [Assumption | Assumption | Auto with real | Auto with real]).
+Generalize H3; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Unfold wn'; Intros; (Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (wn n0))))) (subdivision (mkStepFun (StepFun_P6 (pre (wn n0)))))) with (Int_SF (subdivision_val (wn n0)) (subdivision (wn n0))); [Idtac | Apply StepFun_P17 with (fe (wn n0)) a b; [Apply StepFun_P1 | Apply StepFun_P2; Apply (StepFun_P1 (mkStepFun (StepFun_P6 (pre (wn n0)))))]]).
+Apply H4.
+Rewrite Rabsolu_Ropp; Apply H4.
+Rewrite Rabsolu_Ropp in H4; Apply H4.
+Apply H4.
+Assert H3 := (RiemannInt_P2 H H1 H2); Elim H3; Intros; Apply existTT with ``-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; Case (total_order_Rle b a); Case (total_order_Rle 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; Rewrite Ropp_Ropp; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Apply H7 | 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)))))]].
+Elim n1; Assumption.
+Elim n2; Assumption.
+Qed.
+
+Lemma RiemannInt_exists : (f:R->R;a,b:R;pr:(Riemann_integrable f a b);un:nat->posreal) (Un_cv un R0) -> (sigTT ? [l:R](Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr N)) l)).
+Intros f; Intros; Apply RiemannInt_P3 with f un [n:nat](projT1 ? ? (phi_sequence_prop un pr n)); [Apply H | Intro; Apply (projT2 ? ? (phi_sequence_prop un pr n))].
+Qed.
+
+Lemma RiemannInt_P4 : (f:R->R;a,b,l:R;pr1,pr2:(Riemann_integrable f a b);un,vn:nat->posreal) (Un_cv un R0) -> (Un_cv vn R0) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence un pr1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi_sequence vn pr2 N)) l).
+Unfold Un_cv; Unfold R_dist; Intros f; Intros; Assert H3 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; 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; Pose N := (max (max N0 N1) N2); Exists N; Intros; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence un pr1 n)])-l))``.
+Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-l`` with ``((RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)]))+((RiemannInt_SF [(phi_sequence un pr1 n)])-l)``; [Apply Rabsolu_triang | Ring].
+Replace ``eps`` with ``2*eps/3+eps/3``.
+Apply Rplus_lt.
+Elim (phi_sequence_prop vn pr2 n); Intros psi_vn H5; Elim (phi_sequence_prop un pr1 n); Intros psi_un H6; Replace ``(RiemannInt_SF [(phi_sequence vn pr2 n)])-(RiemannInt_SF [(phi_sequence un pr1 n)])`` with ``(RiemannInt_SF [(phi_sequence vn pr2 n)])+(-1)*(RiemannInt_SF [(phi_sequence un pr1 n)])``; [Idtac | Ring]; Rewrite <- StepFun_P30.
+Case (total_order_Rle a b); Intro.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n)))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 psi_un psi_vn))).
+Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
+Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
+Assert H10 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H11 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Rewrite (Rplus_sym (psi_un x)); Apply Rplus_le.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
+Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
+Elim H6; Intros; Apply H8.
+Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
+Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
+Apply Rlt_trans with (pos (un n)).
+Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
+Apply Rle_Rabsolu.
+Assumption.
+Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
+Apply Rlt_trans with (pos (vn n)).
+Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
+Apply Rle_Rabsolu; Assumption.
+Assumption.
+Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
+Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi_sequence vn pr2 n) (phi_sequence un pr1 n))))))))).
+Apply StepFun_P34; Try Auto with real.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un)))))).
+Apply StepFun_P37.
+Auto with real.
+Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ([(phi_sequence vn pr2 n x)]-(f x)))+(Rabsolu ((f x)-[(phi_sequence un pr1 n x)]))``.
+Replace ``[(phi_sequence vn pr2 n x)]+-1*[(phi_sequence un pr1 n x)]`` with ``([(phi_sequence vn pr2 n x)]-(f x))+((f x)-[(phi_sequence un pr1 n x)])``; [Apply Rabsolu_triang | Ring].
+Assert H10 : (Rmin a b)==b.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
+Assert H11 : (Rmax a b)==a.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
+Apply Rplus_le.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim H5; Intros; Apply H8.
+Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
+Elim H6; Intros; Apply H8.
+Rewrite H10; Rewrite H11; Elim H7; Intros; Split; Left; Assumption.
+Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 psi_vn psi_un))))))); Rewrite <- StepFun_P39; Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Rewrite Ropp_distr1; Apply Rplus_lt.
+Apply Rlt_trans with (pos (vn n)).
+Elim H5; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_vn)).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Assumption.
+Replace (pos (vn n)) with (Rabsolu ``(vn n)-0``); [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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (vn n))].
+Apply Rlt_trans with (pos (un n)).
+Elim H6; Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi_un)).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
+Assumption.
+Replace (pos (un n)) with (Rabsolu ``(un n)-0``); [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; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n))].
+Apply H1; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Qed.
+
+Lemma RinvN_pos : (n:nat) ``0</((INR n)+1)``.
+Intro; Apply Rlt_Rinv; Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
+Qed.
+
+Definition RinvN : nat->posreal := [N:nat](mkposreal ? (RinvN_pos N)).
+ 
+Lemma RinvN_cv : (Un_cv RinvN R0).
+Unfold Un_cv; Intros; Assert H0 := (archimed ``/eps``); Elim H0; Clear H0; Intros; Assert H2 : `0<=(up (Rinv eps))`.
+Apply le_IZR; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
+Elim (IZN ? H2); Intros; Exists x; Intros; Unfold R_dist; Simpl; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Assert H5 : ``0<(INR n)+1``.
+Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
+Rewrite Rabsolu_right; [Idtac | Left; Change ``0</((INR n)+1)``; Apply Rlt_Rinv; Assumption]; Apply Rle_lt_trans with ``/((INR x)+1)``.
+Apply Rle_Rinv.
+Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
+Assumption.
+Do 2 Rewrite <- (Rplus_sym R1); Apply Rle_compatibility; Apply le_INR; Apply H4.
+Rewrite <- (Rinv_Rinv eps).
+Apply Rinv_lt.
+Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Assumption.
+Apply ge0_plus_gt0_is_gt0; [Apply pos_INR | Apply Rlt_R0_R1].
+Apply Rlt_trans with (INR x); [Rewrite INR_IZR_INZ; Rewrite <- H3; Apply H0 | Pattern 1 (INR x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1].
+Red; Intro; Rewrite H6 in H; Elim (Rlt_antirefl ? H).
+Qed.
+
+(**********) 
+Definition RiemannInt [f:R->R;a,b:R;pr:(Riemann_integrable f a b)] : R := Cases
+(RiemannInt_exists pr 5!RinvN RinvN_cv) of (existTT a' b') => a' end.
+
+Lemma RiemannInt_P5 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f a b)) (RiemannInt pr1)==(RiemannInt pr2).
+Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Apply RiemannInt_P4 with pr2 RinvN; Apply RinvN_cv Orelse Assumption].
+Qed.
+
+(**************************************)
+(* C°([a,b]) is included in L1([a,b]) *)
+(**************************************)
+
+Lemma maxN : (a,b:R;del:posreal) ``a<b`` -> (sigTT ? [n:nat]``a+(INR n)*del<b``/\``b<=a+(INR (S n))*del``).
+Intros; Pose I := [n:nat]``a+(INR n)*del < b``; Assert H0 : (EX n:nat | (I n)).
+Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Assumption.
+Cut (Nbound I).
+Intro; Assert H2 := (Nzorn H0 H1); Elim H2; Intros; Exists x; Elim p; Intros; Split.
+Apply H3.
+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; Assumption.
+Left; Apply r.
+Assert H1 : ``0<=(b-a)/del``.
+Unfold Rdiv; Apply Rmult_le_pos; [Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Left; Apply H | Left; Apply Rlt_Rinv; Apply (cond_pos del)].
+Elim (archimed ``(b-a)/del``); Intros; Assert H4 : `0<=(up (Rdiv (Rminus 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; 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 Rle_monotony_contra with (pos del); [Apply (cond_pos del) | Unfold Rdiv; Rewrite <- (Rmult_sym ``/del``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite Rmult_sym; Apply Rle_anti_compatibility with a; Replace ``a+(b-a)`` with b; [Left; Assumption | Ring] | Assert H7 := (cond_pos del); Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7)]].
+Qed.
+
+Fixpoint SubEquiN [N:nat] : R->R->posreal->Rlist :=
+[x:R][y:R][del:posreal] Cases N of
+| O => (cons y nil)
+| (S p) => (cons x (SubEquiN p ``x+del`` y del))
+end.
+
+Definition max_N [a,b:R;del:posreal;h:``a<b``] : nat := Cases (maxN del h) of (existTT N H0) => N end.
+
+Definition SubEqui [a,b:R;del:posreal;h:``a<b``] :Rlist := (SubEquiN (S (max_N del h)) a b del).
+
+Lemma Heine_cor1 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (eps:posreal) (sigTT ? [delta:posreal]``delta<=b-a``/\(x,y:R)``a<=x<=b``->``a<=y<=b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``).
+Intro f; Intros; Pose E := [l:R]``0<l<=b-a``/\(x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < l``->``(Rabsolu ((f x)-(f y))) < eps``; Assert H1 : (bound E).
+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 : (EXT x:R | (E x)).
+Assert H2 := (Heine f [x:R]``a<=x<=b`` (compact_P3 a b) H0 eps); Elim H2; Intros; Exists (Rmin x ``b-a``); Unfold E; Split; [Split; [Unfold Rmin; Case (total_order_Rle 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``); [Assumption | Apply Rmin_l]].
+Assert H3 := (complet E H1 H2); Elim H3; Intros; Cut ``0<x<=b-a``.
+Intro; Elim H4; Clear H4; Intros; Apply existTT with (mkposreal ? H4); Split.
+Apply H5.
+Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H6; Pose D := ``(Rabsolu (x0-y))``; Elim (classic (EXT y:R | ``D<y``/\(E y))); Intro.
+Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15; Assumption.
+Assert H12 := (not_ex_all_not ? [y:R]``D < y``/\(E y) H11); Assert H13 : (is_upper_bound E D).
+Unfold is_upper_bound; Intros; Assert H14 := (H12 x1); Elim (not_and_or ``D<x1`` (E x1) H14); Intro.
+Case (total_order_Rle x1 D); Intro.
+Assumption.
+Elim H15; Auto with real.
+Elim H15; Assumption.
+Assert H14 := (H7 ? H13); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H10)).
+Unfold is_lub in p; Unfold is_upper_bound in p; Elim p; Clear p; Intros; Split.
+Elim H2; Intros; Assert H7 := (H4 ? H6); Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Apply Rlt_le_trans with x0; Assumption.
+Apply H5; Intros; Unfold E in H6; Elim H6; Clear H6; Intros H6 _; Elim H6; Intros; Assumption.
+Qed.
+
+Lemma Heine_cor2 : (f:(R->R); a,b:R) ((x:R)``a <= x <= b``->(continuity_pt f x))->(eps:posreal)(sigTT posreal [delta:posreal]((x,y:R)``a <= x <= b``->``a <= y <= b``->``(Rabsolu (x-y)) < delta``->``(Rabsolu ((f x)-(f y))) < eps``)).
+Intro f; Intros; Case (total_order_T a b); Intro.
+Elim s; Intro.
+Assert H0 := (Heine_cor1 a0 H eps); Elim H0; Intros; Apply existTT with x; Elim p; Intros; Apply H2; Assumption.
+Apply existTT with (mkposreal ? Rlt_R0_R1); 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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
+Apply existTT with (mkposreal ? Rlt_R0_R1); Intros; Elim H0; Intros; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (Rle_trans ? ? ? H3 H4) r)).
+Qed.
+
+Lemma SubEqui_P1 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) O)==a.
+Intros; Unfold SubEqui; Case (maxN del h); Intros; Reflexivity.
+Qed.
+
+Lemma SubEqui_P2 : (a,b:R;del:posreal;h:``a<b``) (pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))))==b.
+Intros; Unfold SubEqui; Case (maxN del h); Intros; Clear a0; Cut (x:nat)(a:R)(del:posreal)(pos_Rl (SubEquiN (S x) a b del) (pred (Rlength (SubEquiN (S x) a b del)))) == b; [Intro; Apply H | Induction x0; [Intros; Reflexivity | Intros; Change (pos_Rl (SubEquiN (S n) ``a0+del0`` b del0) (pred (Rlength (SubEquiN (S n) ``a0+del0`` b del0))))==b; Apply H]].
+Qed.
+
+Lemma SubEqui_P3 : (N:nat;a,b:R;del:posreal) (Rlength (SubEquiN N a b del))=(S N).
+Induction N; Intros; [Reflexivity | Simpl; Rewrite H; Reflexivity].
+Qed.
+
+Lemma SubEqui_P4 : (N:nat;a,b:R;del:posreal;i:nat) (lt i (S N)) -> (pos_Rl (SubEquiN (S N) a b del) i)==``a+(INR i)*del``.
+Induction N; [Intros; Inversion H; [Simpl; Ring | Elim (le_Sn_O ? H1)] | Intros; Induction i; [Simpl; Ring | Change (pos_Rl (SubEquiN (S n) ``a+del`` b del) i)==``a+(INR (S i))*del``; Rewrite H; [Rewrite S_INR; Ring | Apply lt_S_n; Apply H0]]].
+Qed.
+
+Lemma SubEqui_P5 : (a,b:R;del:posreal;h:``a<b``) (Rlength (SubEqui del h))=(S (S (max_N del h))).
+Intros; Unfold SubEqui; Apply SubEqui_P3.
+Qed.
+
+Lemma SubEqui_P6 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (S (max_N del h))) -> (pos_Rl (SubEqui del h) i)==``a+(INR i)*del``.
+Intros; Unfold SubEqui; Apply SubEqui_P4; Assumption.
+Qed.
+
+Lemma SubEqui_P7 : (a,b:R;del:posreal;h:``a<b``) (ordered_Rlist (SubEqui del h)).
+Intros; Unfold ordered_Rlist; Intros; Rewrite SubEqui_P5 in H; Simpl in H; Inversion H.
+Rewrite (SubEqui_P6 3!del 4!h 5!(max_N del h)).
+Replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
+Rewrite SubEqui_P2; Unfold max_N; Case (maxN del h); Intros; Left; Elim a0; Intros; Assumption.
+Rewrite SubEqui_P5; Reflexivity.
+Apply lt_n_Sn.
+Repeat Rewrite SubEqui_P6.
+3:Assumption.
+2:Apply le_lt_n_Sm; Assumption.
+Apply Rle_compatibility; Rewrite S_INR; Rewrite Rmult_Rplus_distrl; Pattern 1 ``(INR i)*del``; Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite Rmult_1l; Left; Apply (cond_pos del).
+Qed.
+
+Lemma SubEqui_P8 : (a,b:R;del:posreal;h:``a<b``;i:nat) (lt i (Rlength (SubEqui del h))) -> ``a<=(pos_Rl (SubEqui del h) i)<=b``.
+Intros; Split.
+Pattern 1 a; 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 2 b; 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]].
+Qed.
+
+Lemma SubEqui_P9 : (a,b:R;del:posreal;f:R->R;h:``a<b``) (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength (SubEqui del h))))->(constant_D_eq g (co_interval (pos_Rl (SubEqui del h) i) (pos_Rl (SubEqui del h) (S i))) (f (pos_Rl (SubEqui del h) i)))).
+Intros; Apply StepFun_P38; [Apply SubEqui_P7 | Apply SubEqui_P1 | Apply SubEqui_P2].
+Qed.
+
+Lemma  RiemannInt_P6 : (f:R->R;a,b:R) ``a<b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
+Intros; Unfold Riemann_integrable; Intro; Assert H1 : ``0<eps/(2*(b-a))``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rlt_Rminus; Assumption]].
+Assert H2 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption].
+Assert H3 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle 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; Rewrite Rinv_Rmult.
+2:Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+2:Rewrite Rmult_1r; Rewrite Rabsolu_right.
+2:Apply Rlt_monotony_contra with ``2``.
+2:Sup0.
+2:Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+2:Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
+2:DiscrR.
+2:Apply Rle_sym1; Left; Apply Rmult_lt_pos.
+2:Apply (cond_pos eps).
+2:Apply Rlt_Rinv; Sup0.
+2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
+2:DiscrR.
+2:Apply Rminus_eq_contra; Red; Intro; Clear H6; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
+Intros; Rewrite H2 in H7; Rewrite H3 in H7; Simpl; Unfold fct_cte; Cut (t:R)``a<=t<=b``->t==b\/(EX i:nat | (lt i (pred (Rlength (SubEqui del H))))/\(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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_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; Intro; Rewrite <- H12 in H9; Elim (lt_n_O ? H9).
+Unfold co_interval in H10; Elim H10; Clear H10; Intros; Rewrite Rabsolu_right.
+Rewrite SubEqui_P5 in H9; Simpl in H9; Inversion H9.
+Apply Rlt_anti_compatibility with (pos_Rl (SubEqui del H) (max_N del H)).
+Replace ``(pos_Rl (SubEqui del H) (max_N del H))+(t-(pos_Rl (SubEqui del H) (max_N del H)))`` with t; [Idtac | Ring]; Apply Rlt_le_trans with b.
+Rewrite H14 in H12; Assert H13 : (S (max_N del H))=(pred (Rlength (SubEqui del H))).
+Rewrite SubEqui_P5; Reflexivity.
+Rewrite H13 in H12; Rewrite SubEqui_P2 in H12; Apply H12.
+Rewrite SubEqui_P6.
+2:Apply lt_n_Sn.
+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 Rlt_anti_compatibility with (pos_Rl (SubEqui del H) I); Replace ``(pos_Rl (SubEqui del H) I)+(t-(pos_Rl (SubEqui del H) I))`` with t; [Idtac | Ring]; Replace ``(pos_Rl (SubEqui del H) I)+del`` with (pos_Rl (SubEqui del H) (S I)).
+Assumption.
+Repeat Rewrite SubEqui_P6.
+Rewrite S_INR; Ring.
+Assumption.
+Apply le_lt_n_Sm; Assumption.
+Apply Rge_minus; Apply Rle_sym1; Assumption.
+Intros; Clear H0 H1 H4 phi H5 H6 t H7; Case (Req_EM t0 b); Intro.
+Left; Assumption.
+Right; Pose I := [j:nat]``a+(INR j)*del<=t0``; Assert H1 : (EX n:nat | (I n)).
+Exists O; Unfold I; Rewrite Rmult_Ol; Rewrite Rplus_Or; Elim H8; Intros; Assumption.
+Assert H4 : (Nbound I).
+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 Rle_monotony_contra with (pos del).
+Apply (cond_pos del).
+Apply Rle_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_trans with t0; Unfold I in H4; Try Assumption; Apply Rle_trans with b; Try Assumption; Elim H8; Intros; Assumption.
+Elim (Nzorn H1 H4); Intros N [H5 H6]; Assert H7 : (lt N (S (max_N del H))).
+Unfold max_N; Case (maxN del H); Intros; Apply INR_lt; Apply Rlt_monotony_contra with (pos del).
+Apply (cond_pos del).
+Apply Rlt_anti_compatibility with a; Do 2 Rewrite (Rmult_sym del); Apply Rle_lt_trans with t0; Unfold I in H5; Try Assumption; Elim a0; Intros; Apply Rlt_le_trans with b; Try Assumption; Elim H8; Intros.
+Elim H11; Intro.
+Assumption.
+Elim H0; Assumption.
+Exists N; Split.
+Rewrite SubEqui_P5; Simpl; Assumption.
+Unfold co_interval; Split.
+Rewrite SubEqui_P6.
+Apply H5.
+Assumption.
+Inversion H7.
+Replace (S (max_N del H)) with (pred (Rlength (SubEqui del H))).
+Rewrite (SubEqui_P2 del H); Elim H8; Intros.
+Elim H11; Intro.
+Assumption.
+Elim H0; Assumption.
+Rewrite SubEqui_P5; Reflexivity.
+Rewrite SubEqui_P6.
+Case (total_order_Rle ``a+(INR (S N))*del`` t0); Intro.
+Assert H11 := (H6 (S N) r); Elim (le_Sn_n ? H11).
+Auto with real.
+Apply le_lt_n_Sm; Assumption.
+Qed.
+
+Lemma RiemannInt_P7 : (f:R->R;a:R) (Riemann_integrable f a a).
+Unfold Riemann_integrable; Intro f; Intros; Split with (mkStepFun (StepFun_P4 a a (f a))); Split with (mkStepFun (StepFun_P4 a a R0)); Split.
+Intros; Simpl; Unfold fct_cte; Replace t with a.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
+Generalize H; Unfold Rmin Rmax; Case (total_order_Rle a a); Intros; Elim H0; Intros; Apply Rle_antisym; Assumption.
+Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps).
+Qed.
+
+Lemma continuity_implies_RiemannInt : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (Riemann_integrable f a b).
+Intros; Case (total_order_T a b); Intro; [Elim s; Intro; [Apply RiemannInt_P6; Assumption | Rewrite b0; Apply RiemannInt_P7] | Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r))].
+Qed.
+
+Lemma RiemannInt_P8 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b a)) ``(RiemannInt pr1)==-(RiemannInt pr2)``.
+Intro f; Intros; EApply UL_sequence.
+Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; Apply u.
+Unfold RiemannInt; Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Intros; Cut (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
+Cut (EXT psi2:nat->(StepFun b a) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (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; Intros; Assert H3 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Unfold Un_cv in H1; Elim (H1 ? H3); Clear H1; Intros N0 H1; Unfold R_dist in H1; Simpl in H1; Assert H4 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
+Intros; Assert H5 := (H1 ? H4); Replace (pos (RinvN n)) with ``(Rabsolu (/((INR n)+1)-0))``; [Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_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; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
+Rewrite <- (Rabsolu_Ropp ``(RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x``); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])- -x`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))+ -((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)``; [Apply Rabsolu_triang | Ring].
+Replace eps with ``2*eps/3+eps/3``.
+Apply Rplus_lt.
+Rewrite (StepFun_P39 (phi_sequence RinvN pr2 n)); Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+ -(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(-1)*(RiemannInt_SF (mkStepFun (StepFun_P6 (pre [(phi_sequence RinvN pr2 n)]))))``; [Idtac | Ring]; Rewrite <- StepFun_P30.
+Case (total_order_Rle a b); Intro.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n))))))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (psi1 n) (mkStepFun (StepFun_P6 (pre (psi2 n))))))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
+Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
+Assert H7 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H8 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Apply Rplus_le.
+Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
+Elim H6; Intros; Split; Left; Assumption.
+Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8.
+Elim H6; Intros; Split; Left; Assumption.
+Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
+Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
+Elim (H n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | Apply H4; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Assumption]]].
+Assert Hyp : ``b<=a``.
+Auto with real.
+Rewrite StepFun_P39; Rewrite Rabsolu_Ropp; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (StepFun_P28 ``-1`` (phi_sequence RinvN pr1 n) (mkStepFun (StepFun_P6 (pre (phi_sequence RinvN pr2 n)))))))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 ``1`` (mkStepFun (StepFun_P6 (pre (psi1 n)))) (psi2 n)))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr1 n)] x0)-(f x0)))+(Rabsolu ((f x0)-([(phi_sequence RinvN pr2 n)] x0)))``.
+Replace ``([(phi_sequence RinvN pr1 n)] x0)+ -1*([(phi_sequence RinvN pr2 n)] x0)`` with ``(([(phi_sequence RinvN pr1 n)] x0)-(f x0))+((f x0)-([(phi_sequence RinvN pr2 n)] x0))``; [Apply Rabsolu_triang | Ring].
+Assert H7 : (Rmin a b)==b.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
+Assert H8 : (Rmax a b)==a.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim n0; Assumption | Reflexivity].
+Apply Rplus_le.
+Elim (H0 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H9; Rewrite H7; Rewrite H8.
+Elim H6; Intros; Split; Left; Assumption.
+Elim (H n); Intros; Apply H9; Rewrite H7; Rewrite H8; Elim H6; Intros; Split; Left; Assumption.
+Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
+Elim (H0 n); Intros; Rewrite <- (Ropp_Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n)))))); Rewrite <- StepFun_P39; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | 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 (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Apply Rlt_trans with (pos (RinvN n)); [Assumption | 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; Apply le_trans with (max N0 N1); [Apply le_max_r | Assumption].
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Rewrite Rmin_sym; Rewrite RmaxSym; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)).
+Qed.
+
+Lemma RiemannInt_P9 : (f:R->R;a:R;pr:(Riemann_integrable f a a)) ``(RiemannInt pr)==0``.
+Intros; Assert H := (RiemannInt_P8 pr pr); Apply r_Rmult_mult with ``2``; [Rewrite Rmult_Or; Rewrite double; Pattern 2 (RiemannInt pr); Rewrite H; Apply Rplus_Ropp_r | DiscrR].
+Qed.
+
+Lemma Req_EM_T :(r1,r2:R) (sumboolT (r1==r2) ``r1<>r2``).
+Intros; Elim (total_order_T r1 r2);Intros; [Elim a;Intro; [Right; Red; Intro; Rewrite H in a0; Elim (Rlt_antirefl ``r2`` a0) | Left;Assumption] | Right; Red; Intro; Rewrite H in b; Elim (Rlt_antirefl ``r2`` b)].
+Qed.
+
+(* L1([a,b]) is a vectorial space *)
+Lemma RiemannInt_P10 : (f,g:R->R;a,b,l:R) (Riemann_integrable f a b) -> (Riemann_integrable g a b) -> (Riemann_integrable [x:R]``(f x)+l*(g x)`` a b).
+Unfold Riemann_integrable; Intros f g; Intros; Case (Req_EM_T l R0); 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_Ol; Rewrite Rplus_Or; Apply H; Assumption.
+Assert H : ``0<eps/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
+Assert H0 : ``0<eps/(2*(Rabsolu l))``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
+Elim (X (mkposreal ? H)); Intros; Elim (X0 (mkposreal ? H0)); Intros; Split with (mkStepFun (StepFun_P28 l x x0)); Elim p0; Elim p; Intros; Split with (mkStepFun (StepFun_P28 (Rabsolu l) x1 x2)); Elim p1; Elim p2; Clear p1 p2 p0 p X X0; Intros; Split.
+Intros; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-(x t)))+(Rabsolu (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 Rabsolu_triang | Ring].
+Apply Rplus_le; [Apply H3; Assumption | Rewrite Rabsolu_mult; Apply Rle_monotony; [Apply Rabsolu_pos | Apply H1; Assumption]].
+Rewrite StepFun_P30; Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF x1))+(Rabsolu ((Rabsolu l)*(RiemannInt_SF x2)))``.
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Apply Rplus_lt.
+Apply H4.
+Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/2`` with ``eps/(2*(Rabsolu l))``; [Apply H2 | Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption]] | Apply Rabsolu_no_R0; Assumption].
+Qed.
+
+Lemma RiemannInt_P11 : (f:R->R;a,b,l:R;un:nat->posreal;phi1,phi2,psi1,psi2:nat->(StepFun a b)) (Un_cv un R0) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi1 n t)))<=(psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n)))<(un n)``) -> ((n:nat)((t:R)``(Rmin a b)<=t<=(Rmax a b)``->``(Rabsolu ((f t)-(phi2 n t)))<=(psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n)))<(un n)``) -> (Un_cv [N:nat](RiemannInt_SF (phi1 N)) l) -> (Un_cv [N:nat](RiemannInt_SF (phi2 N)) l).
+Unfold Un_cv; Intro f; Intros; Intros.
+Case (total_order_Rle a b); Intro Hyp.
+Assert H4 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H ? H4); Clear H; Intros N0 H.
+Elim (H2 ? H4); Clear H2; Intros N1 H2.
+Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
+Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
+Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
+Replace ``eps`` with ``2*eps/3+eps/3``.
+Apply Rplus_lt.
+Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
+Rewrite <- StepFun_P30.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n)))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))).
+Apply StepFun_P37; Try Assumption; Intros; Simpl; Rewrite Rmult_1l.
+Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring].
+Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
+Assert H10 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H11 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H11 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
+Rewrite StepFun_P30; Rewrite Rmult_1l; Rewrite double; Apply Rplus_lt.
+Apply Rlt_trans with (pos (un n)).
+Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
+Apply Rle_Rabsolu.
+Assumption.
+Replace (pos (un n)) with (R_dist (un n) R0).
+Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
+Unfold N; Apply le_max_l.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
+Apply Rle_sym1; Left; Apply (cond_pos (un n)).
+Apply Rlt_trans with (pos (un n)).
+Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
+Apply Rle_Rabsolu; Assumption.
+Assumption.
+Replace (pos (un n)) with (R_dist (un n) R0).
+Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
+Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Assert H4 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H ? H4); Clear H; Intros N0 H.
+Elim (H2 ? H4); Clear H2; Intros N1 H2.
+Pose N := (max N0 N1); Exists N; Intros; Unfold R_dist.
+Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))))+(Rabsolu ((RiemannInt_SF (phi1 n))-l))``.
+Replace ``(RiemannInt_SF (phi2 n))-l`` with ``((RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n)))+((RiemannInt_SF (phi1 n))-l)``; [Apply Rabsolu_triang | Ring].
+Assert Hyp_b : ``b<=a``.
+Auto with real.
+Replace ``eps`` with ``2*eps/3+eps/3``.
+Apply Rplus_lt.
+Replace ``(RiemannInt_SF (phi2 n))-(RiemannInt_SF (phi1 n))`` with ``(RiemannInt_SF (phi2 n))+(-1)*(RiemannInt_SF (phi1 n))``; [Idtac | Ring].
+Rewrite <- StepFun_P30.
+Rewrite StepFun_P39.
+Rewrite Rabsolu_Ropp.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 ``-1`` (phi2 n) (phi1 n))))))))).
+Apply StepFun_P34; Try Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n))))))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l.
+Apply Rle_trans with ``(Rabsolu ((phi2 n x)-(f x)))+(Rabsolu ((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 Rabsolu_triang | Ring].
+Rewrite (Rplus_sym (psi1 n x)); Apply Rplus_le.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Elim (H1 n); Intros; Apply H7.
+Assert H10 : (Rmin a b)==b.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
+Assert H11 : (Rmax a b)==a.
+Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
+Assert H11 : (Rmax a b)==a.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Elim Hyp; Assumption | Reflexivity].
+Rewrite H10; Rewrite H11; Elim H6; Intros; Split; Left; Assumption.
+Rewrite <- (Ropp_Ropp (RiemannInt_SF
+     (mkStepFun
+     (StepFun_P6 (pre (mkStepFun (StepFun_P28 R1 (psi1 n) (psi2 n)))))))).
+Rewrite <- StepFun_P39.
+Rewrite StepFun_P30.
+Rewrite Rmult_1l; Rewrite double.
+Rewrite Ropp_distr1; Apply Rplus_lt.
+Apply Rlt_trans with (pos (un n)).
+Elim (H0 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Assumption.
+Replace (pos (un n)) with (R_dist (un n) R0).
+Apply H; Unfold ge; Apply le_trans with N; Try Assumption.
+Unfold N; Apply le_max_l.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right.
+Apply Rle_sym1; Left; Apply (cond_pos (un n)).
+Apply Rlt_trans with (pos (un n)).
+Elim (H1 n); Intros; Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu; Assumption.
+Assumption.
+Replace (pos (un n)) with (R_dist (un n) R0).
+Apply H; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_l.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; Left; Apply (cond_pos (un n)).
+Unfold R_dist in H2; Apply H2; Unfold ge; Apply le_trans with N; Try Assumption; Unfold N; Apply le_max_r.
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Qed.
+
+Lemma RiemannInt_P12 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``a<=b`` -> ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
+Intro f; Intros; Case (Req_EM l R0); Intro.
+Pattern 2 l; Rewrite H0; Rewrite Rmult_Ol; Rewrite Rplus_Or; Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Intros; EApply UL_sequence; [Apply u0 | Pose psi1 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Pose psi2 := [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Apply RiemannInt_P11 with f RinvN (phi_sequence RinvN pr1) psi1 psi2; [Apply RinvN_cv | Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)) | Intro; Assert H1 : ((t:R) ``(Rmin a b) <= t``/\``t <= (Rmax a b)`` -> (Rle (Rabsolu (Rminus ``(f t)+l*(g t)`` (phi_sequence RinvN pr3 n t))) (psi2 n t))) /\ ``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``; [Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n)) | Elim H1; Intros; Split; Try Assumption; Intros; Replace (f t) with ``(f t)+l*(g t)``; [Apply H2; Assumption | Rewrite H0; Ring]] | Assumption]].
+EApply UL_sequence.
+Unfold RiemannInt; Case (RiemannInt_exists pr3 5!RinvN RinvN_cv); Intros; Apply u.
+Unfold Un_cv; Intros; Unfold RiemannInt; Case (RiemannInt_exists pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists pr2 5!RinvN RinvN_cv); Unfold Un_cv; Intros; Assert H2 : ``0<eps/5``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; 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*(Rabsolu l))``. 
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]].
+Elim (u ? H5); Clear u; Intros N2 H6; Assert H7 := RinvN_cv; Unfold Un_cv in H7; Elim (H7 ? H5); Clear H7 H5; Intros N3 H5; Unfold R_dist in H3 H4 H5 H6; Pose N := (max (max N0 N1) (max N2 N3)).
+Assert H7 : (n:nat) (ge n N1)->``(RinvN n)< eps/5``.
+Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H4; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
+Clear H4; Assert H4 := H7; Clear H7; Assert H7 : (n:nat) (ge n N3)->``(RinvN n)< eps/(5*(Rabsolu l))``.
+Intros; Replace (pos (RinvN n)) with ``(Rabsolu ((RinvN n)-0))``; [Unfold RinvN; Apply H5; Assumption | Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Left; Apply (cond_pos (RinvN n))].
+Clear H5; Assert H5 := H7; Clear H7; Exists N; Intros; Unfold R_dist.
+Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0))+(Rabsolu l)*(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``.
+Apply Rle_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)))``.
+Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x0+l*x)`` with ``(((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
+Rewrite Rplus_assoc; Apply Rle_compatibility; Rewrite <- Rabsolu_mult; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0+l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x0)+(l*((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x))``; [Apply Rabsolu_triang | Ring].
+Replace eps with ``3*eps/5+eps/5+eps/5``.
+Repeat Apply Rplus_lt.
+Assert H7 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n0)).
+Assert H8 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n0)).
+Assert H9 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu (((f t)+l*(g t))-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr3 n0)).
+Elim H7; Clear H7; Intros psi1 H7; Elim H8; Clear H8; Intros psi2 H8; Elim H9; Clear H9; Intros psi3 H9; Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+l*(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` with ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])+(-1)*((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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Assert H11 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle 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; Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (phi_sequence RinvN pr3 n) (mkStepFun (StepFun_P28 l (phi_sequence RinvN pr1 n) (phi_sequence RinvN pr2 n)))))))).
+Apply StepFun_P34; Assumption.
+Apply Rle_lt_trans with (RiemannInt_SF (mkStepFun (StepFun_P28 R1 (psi3 n) (mkStepFun (StepFun_P28 (Rabsolu l) (psi1 n) (psi2 n)))))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l.
+Apply Rle_trans with ``(Rabsolu (([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1))))+(Rabsolu (((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))``.
+Replace ``([(phi_sequence RinvN pr3 n)] x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))`` with ``(([(phi_sequence RinvN pr3 n)] x1)-((f x1)+l*(g x1)))+(((f x1)+l*(g x1))+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1)))``; [Apply Rabsolu_triang | Ring].
+Rewrite Rplus_assoc; Apply Rplus_le.
+Elim (H9 n); Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H13.
+Elim H12; Intros; Split; Left; Assumption. 
+Apply Rle_trans with ``(Rabsolu ((f x1)-([(phi_sequence RinvN pr1 n)] x1)))+(Rabsolu l)*(Rabsolu ((g x1)-([(phi_sequence RinvN pr2 n)] x1)))``.
+Rewrite <- Rabsolu_mult; Replace ``((f x1)+(l*(g x1)+ -1*(([(phi_sequence RinvN pr1 n)] x1)+l*([(phi_sequence RinvN pr2 n)] x1))))`` with ``((f x1)-([(phi_sequence RinvN pr1 n)] x1))+l*((g x1)-([(phi_sequence RinvN pr2 n)] x1))``; [Apply Rabsolu_triang | Ring].
+Apply Rplus_le.
+Elim (H7 n); Intros; Apply H13.
+Elim H12; Intros; Split; Left; Assumption.
+Apply Rle_monotony; [Apply Rabsolu_pos | Elim (H8 n); Intros; Apply H13; Elim H12; Intros; Split; Left; Assumption].
+Do 2 Rewrite StepFun_P30; Rewrite Rmult_1l; Replace ``3*eps/5`` with ``eps/5+(eps/5+eps/5)``; [Repeat Apply Rplus_lt | Ring].
+Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))); [Apply Rle_Rabsolu | Elim (H9 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
+Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))); [Apply Rle_Rabsolu | Elim (H7 n); Intros; Assumption] | Apply H4; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N0 N1); [Apply le_max_r | Unfold N; Apply le_max_l] | Assumption]].
+Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
+Apply Rlt_trans with (pos (RinvN n)); [Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))); [Apply Rle_Rabsolu | Elim (H8 n); Intros; Assumption] | Apply H5; Unfold ge; Apply le_trans with N; [Apply le_trans with (max N2 N3); [Apply le_max_r | Unfold N; Apply le_max_r] | Assumption]].
+Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
+Apply Rabsolu_no_R0; Assumption.
+Apply H3; Unfold ge; Apply le_trans with (max N0 N1); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_l | Assumption]].
+Apply Rlt_monotony_contra with ``/(Rabsolu l)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Replace ``/(Rabsolu l)*eps/5`` with ``eps/(5*(Rabsolu l))``.
+Apply H6; Unfold ge; Apply le_trans with (max N2 N3); [Apply le_max_l | Apply le_trans with N; [Unfold N; Apply le_max_r | Assumption]].
+Unfold Rdiv; Rewrite Rinv_Rmult; [Ring | DiscrR | Apply Rabsolu_no_R0; Assumption].
+Apply Rabsolu_no_R0; Assumption.
+Apply r_Rmult_mult with ``5``; [Unfold Rdiv; Do 2 Rewrite Rmult_Rplus_distr; Do 3 Rewrite (Rmult_sym ``5``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR]. 
+Qed.
+
+Lemma RiemannInt_P13 : (f,g:R->R;a,b,l:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b);pr3:(Riemann_integrable [x:R]``(f x)+l*(g x)`` a b)) ``(RiemannInt pr3)==(RiemannInt pr1)+l*(RiemannInt pr2)``.
+Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P12; Assumption | Assert H : ``b<=a``; [Auto with real | Replace (RiemannInt pr3) with (Ropp (RiemannInt (RiemannInt_P1 pr3))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr2) with (Ropp (RiemannInt (RiemannInt_P1 pr2))); [Idtac | Symmetry; Apply RiemannInt_P8]; Replace (RiemannInt pr1) with (Ropp (RiemannInt (RiemannInt_P1 pr1))); [Idtac | Symmetry; Apply RiemannInt_P8]; Rewrite (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2) (RiemannInt_P1 pr3) H); Ring]].
+Qed.
+
+Lemma RiemannInt_P14 : (a,b,c:R) (Riemann_integrable (fct_cte c) a b).
+Unfold Riemann_integrable; Intros; Split with (mkStepFun (StepFun_P4 a b c)); Split with (mkStepFun (StepFun_P4 a b R0)); Split; [Intros; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity | Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos eps)].
+Qed.
+
+Lemma RiemannInt_P15 : (a,b,c:R;pr:(Riemann_integrable (fct_cte c) a b)) ``(RiemannInt pr)==c*(b-a)``.
+Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!(fct_cte c) 2!a 3!b pr 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
+Apply u.
+Pose phi1 := [N:nat](phi_sequence RinvN 2!(fct_cte c) 3!a 4!b pr N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) ``c*(b-a)``); Pose f := (fct_cte c); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr n)).
+Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [n:nat](mkStepFun (StepFun_P4 a b c)); Pose psi2 := [n:nat](mkStepFun (StepFun_P4 a b R0)); Apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; Try Assumption.
+Apply RinvN_cv.
+Intro; Split.
+Intros; Unfold f; Simpl; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold fct_cte; Right; Reflexivity.
+Unfold psi2; Rewrite StepFun_P18; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Apply (cond_pos (RinvN n)).
+Unfold Un_cv; Intros; Split with O; Intros; Unfold R_dist; Unfold phi2; Rewrite StepFun_P18; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H.
+Qed.
+
+Lemma RiemannInt_P16 : (f:R->R;a,b:R) (Riemann_integrable f a b) -> (Riemann_integrable [x:R](Rabsolu (f x)) a b).
+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; Apply Rle_trans with ``(Rabsolu ((f t)-(phi t)))``; [Apply Rabsolu_triang_inv2 | Apply H; Assumption].
+Qed.
+
+Lemma Rle_cv_lim : (Un,Vn:nat->R;l1,l2:R) ((n:nat)``(Un n)<=(Vn n)``) -> (Un_cv Un l1) -> (Un_cv Vn l2) -> ``l1<=l2``.
+Intros; Case (total_order_Rle l1 l2); Intro.
+Assumption.
+Assert H2 : ``l2<l1``.
+Auto with real.
+Clear n; Assert H3 : ``0<(l1-l2)/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rlt_Rminus; Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H1 ? H3); Elim (H0 ? H3); Clear H0 H1; Unfold R_dist; Intros; Pose N := (max x x0); Cut ``(Vn N)<(Un N)``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? (H N) H4)).
+Apply Rlt_trans with ``(l1+l2)/2``.
+Apply Rlt_anti_compatibility with ``-l2``; Replace ``-l2+(l1+l2)/2`` with ``(l1-l2)/2``.
+Rewrite Rplus_sym; Apply Rle_lt_trans with ``(Rabsolu ((Vn N)-l2))``.
+Apply Rle_Rabsolu.
+Apply H1; Unfold ge; Unfold N; Apply le_max_r.
+Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``-l2`` ``(l1+l2)*/2`` ``2``); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
+Apply Ropp_Rlt; Apply Rlt_anti_compatibility with l1; Replace ``l1+ -((l1+l2)/2)`` with ``(l1-l2)/2``.
+Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l1))``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
+Apply H0; Unfold ge; Unfold N; Apply le_max_l.
+Apply r_Rmult_mult with ``2``; [Unfold Rdiv; Do 2 Rewrite -> (Rmult_sym ``2``); Rewrite (Rmult_Rplus_distrl ``l1`` ``-((l1+l2)*/2)`` ``2``); Rewrite <- Ropp_mul1; Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [ Ring | DiscrR ] | DiscrR].
+Qed.
+
+Lemma RiemannInt_P17 : (f:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable [x:R](Rabsolu (f x)) a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt pr1))<=(RiemannInt pr2)``.
+Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!([x0:R](Rabsolu (f x0))) 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; Pose phi1 := (phi_sequence RinvN pr1); Pose phi2 := [N:nat](mkStepFun (StepFun_P32 (phi1 N))); Apply Rle_cv_lim with [N:nat](Rabsolu (RiemannInt_SF (phi1 N))) [N:nat](RiemannInt_SF (phi2 N)).
+Intro; Unfold phi2; Apply StepFun_P34; Assumption.
+Fold phi1 in u0; Apply (continuity_seq Rabsolu [N:nat](RiemannInt_SF (phi1 N)) x0); Try Assumption.
+Apply continuity_Rabsolu.
+Pose phi3 := (phi_sequence RinvN pr2); Assert H0 : (EXT psi3:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi3 n) t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
+Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((Rabsolu (f t))-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
+Assert H1 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (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; Simpl; Apply Rle_trans with ``(Rabsolu ((f t)-((phi1 n) t)))``.
+Apply Rabsolu_triang_inv2.
+Apply H1; Assumption.
+Elim H0; Clear H0; Intros psi3 H0; Elim H1; Clear H1; Intros psi2 H1; Apply RiemannInt_P11 with [x:R](Rabsolu (f x)) RinvN phi3 psi3 psi2; Try Assumption; Apply RinvN_cv.
+Qed.
+
+Lemma RiemannInt_P18 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)==(g x)``) -> ``(RiemannInt pr1)==(RiemannInt pr2)``.
+Intro f; Intros; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!g 2!a 3!b pr2 5!RinvN RinvN_cv); Intros; EApply UL_sequence.
+Apply u0.
+Pose phi1 := [N:nat](phi_sequence RinvN 2!f 3!a 4!b pr1 N); Change (Un_cv [N:nat](RiemannInt_SF (phi1 N)) x); Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-((phi1 n) t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). 
+Elim H1; Clear H1; Intros psi1 H1; Pose phi2 := [N:nat](phi_sequence RinvN 2!g 3!a 4!b pr2 N).
+Pose phi2_aux := [N:nat][x:R](Cases (Req_EM_T x a) of
+    | (leftT _) => (f a)
+    | (rightT _) => (Cases (Req_EM_T x b) of
+	| (leftT _) => (f b)
+	| (rightT _) => (phi2 N x) end) end).
+Cut (N:nat)(IsStepFun (phi2_aux N) a b).
+Intro; Pose phi2_m := [N:nat](mkStepFun (X N)).
+Assert H2 : (EXT psi2:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((g t)-((phi2 n) t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
+Elim H2; Clear H2; Intros psi2 H2; Apply RiemannInt_P11 with f RinvN phi2_m psi2 psi1; Try Assumption. 
+Apply RinvN_cv.
+Intro; Elim (H2 n); Intros; Split; Try Assumption.
+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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
+Apply Rabsolu_pos.
+Pattern 3 a; Rewrite <- e0; Apply H3; Assumption.
+Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
+Apply Rabsolu_pos.
+Pattern 3 a; Rewrite <- e; Apply H3; Assumption.
+Rewrite e; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply Rle_trans with ``(Rabsolu ((g t)-((phi2 n) t)))``.
+Apply Rabsolu_pos.
+Pattern 3 b; Rewrite <- e; Apply H3; Assumption.
+Replace (f t) with (g t).
+Apply H3; Assumption.
+Symmetry; Apply H0; Elim H5; Clear H5; Intros.
+Assert H7 : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
+Assert H8 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n2; Assumption].
+Rewrite H7 in H5; Rewrite H8 in H6; Split.
+Elim H5; Intro; [Assumption | Elim n1; Symmetry; Assumption].
+Elim H6; Intro; [Assumption | Elim n0; Assumption].
+Cut (N:nat)(RiemannInt_SF (phi2_m N))==(RiemannInt_SF (phi2 N)).
+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; 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_antirefl ? H4).
+Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
+Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
+Right; Reflexivity.
+Apply StepFun_P37; Try Assumption.
+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_antirefl ? H4).
+Elim H3; Intros; Rewrite e in H4; Elim (Rlt_antirefl ? H4).
+Elim H3; Intros; Rewrite e in H5; Elim (Rlt_antirefl ? H5).
+Right; Reflexivity.
+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; Repeat Split; Try Assumption.
+Intros; Assert H9 := (H8 i H2); Unfold constant_D_eq open_interval in H9; 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.
+Assumption.
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert H11 : ``(pos_Rl l (S i))<=b``.
+Replace b with (Rmax a b).
+Rewrite <- H4; Elim (RList_P6 l); Intros; Apply H11.
+Assumption.
+Apply lt_le_S; Assumption.
+Apply lt_pred_n_n; Apply neq_O_lt; Intro; Rewrite <- H13 in H6; Discriminate.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+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_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
+Rewrite e in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H7)).
+Rewrite e in H12; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H11 H12)).
+Reflexivity.
+Qed.
+
+Lemma RiemannInt_P19 : (f,g:R->R;a,b:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable g a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt pr1)<=(RiemannInt pr2)``.
+Intro f; Intros; Apply Rle_anti_compatibility with ``-(RiemannInt pr1)``; Rewrite Rplus_Ropp_l; Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1))).
+Apply Rabsolu_pos.
+Replace ``(RiemannInt pr2)+ -(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))).
+Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` pr2 pr1) (RiemannInt_P16 (RiemannInt_P10 ``-1`` pr2 pr1))); Assumption.
+Replace ``(RiemannInt pr2)+-(RiemannInt pr1)`` with (RiemannInt (RiemannInt_P10 ``-1`` pr2 pr1)).
+Apply RiemannInt_P18; Try Assumption.
+Intros; Apply Rabsolu_right.
+Apply Rle_sym1; Apply Rle_anti_compatibility with (f x); Rewrite Rplus_Or; Replace ``(f x)+((g x)+ -1*(f x))`` with (g x); [Apply H0; Assumption | Ring].
+Rewrite (RiemannInt_P12 pr2 pr1 (RiemannInt_P10 ``-1`` pr2 pr1)); [Ring | Assumption].
+Qed.
+
+Lemma FTC_P1 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> ((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x)).
+Intros; Apply continuity_implies_RiemannInt; [Assumption | Intros; Apply H0; Elim H3; Intros; Split; Assumption Orelse Apply Rle_trans with x; Assumption].
+Qed.
+V7only [Notation FTC_P2 := Rle_refl.].
+
+Definition primitive [f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x))] : R->R := [x:R] Cases (total_order_Rle a x) of
+   | (leftT r) => Cases (total_order_Rle x b) of
+          | (leftT r0) => (RiemannInt (pr x r r0))
+          | (rightT _) => ``(f b)*(x-b)+(RiemannInt (pr b h (FTC_P2 b)))`` end
+   | (rightT _) => ``(f a)*(x-a)`` end.
+
+Lemma RiemannInt_P20 : (f:R->R;a,b:R;h:``a<=b``;pr:((x:R)``a<=x``->``x<=b``->(Riemann_integrable f a x));pr0:(Riemann_integrable f a b)) ``(RiemannInt pr0)==(primitive h pr b)-(primitive h pr a)``.
+Intros; Replace (primitive h pr a) with R0.
+Replace (RiemannInt pr0) with (primitive h pr b).
+Ring.
+Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Assumption | Elim n0; Assumption].
+Symmetry; Unfold primitive; Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; [Apply RiemannInt_P9 | Elim n; Assumption | Elim n; Right; Reflexivity | Elim n0; Right; Reflexivity].
+Qed.
+
+Lemma RiemannInt_P21 : (f:R->R;a,b,c:R) ``a<=b``-> ``b<=c`` -> (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
+Unfold Riemann_integrable; Intros f a b c Hyp1 Hyp2 X X0 eps.
+Assert H : ``0<eps/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
+Elim (X (mkposreal ? H)); Clear X; Intros phi1 [psi1 H1]; Elim (X0 (mkposreal ? H)); Clear X0; Intros phi2 [psi2 H2].
+Pose phi3 := [x:R] Cases (total_order_Rle a x) of
+  | (leftT _) => Cases (total_order_Rle x b) of
+    | (leftT _) => (phi1 x)
+    | (rightT _) => (phi2 x) end
+  | (rightT _) => R0 end.
+Pose psi3 := [x:R] Cases (total_order_Rle a x) of
+  | (leftT _) => Cases (total_order_Rle x b) of
+    | (leftT _) => (psi1 x)
+    | (rightT _) => (psi2 x) end
+  | (rightT _) => R0 end.
+Cut (IsStepFun phi3 a c).
+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; Split.
+Intros; Unfold phi3 psi3; Case (total_order_Rle t b); Case (total_order_Rle a t); Intros.
+Elim H1; Intros; Apply H3.
+Replace (Rmin a b) with a.
+Replace (Rmax a b) with b.
+Split; Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Elim n; Replace a with (Rmin a c).
+Elim H0; Intros; Assumption.
+Unfold Rmin; Case (total_order_Rle 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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
+Unfold Rmax; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; Try (Elim n0; Assumption Orelse Elim n0; Apply Rle_trans with b; Assumption).
+Reflexivity.
+Elim n; Replace a with (Rmin a c).
+Elim H0; Intros; Assumption.
+Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n1; Apply Rle_trans with b; Assumption].
+Rewrite <- (StepFun_P43 X0 X1 X2).
+Apply Rle_lt_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun X0)))+(Rabsolu (RiemannInt_SF (mkStepFun X1)))``.
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Replace (RiemannInt_SF (mkStepFun X0)) with (RiemannInt_SF psi1).
+Replace (RiemannInt_SF (mkStepFun X1)) with (RiemannInt_SF psi2).
+Apply Rplus_lt.
+Elim H1; Intros; Assumption.
+Elim H2; Intros; Assumption.
+Apply Rle_antisym.
+Apply StepFun_P37; Try Assumption.
+Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (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; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (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 Rle_antisym.
+Apply StepFun_P37; Try Assumption.
+Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
+Apply StepFun_P37; Try Assumption.
+Simpl; Intros; Unfold psi3; Elim H0; Clear H0; Intros; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Right; Reflexivity | Elim n; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
+Apply StepFun_P46 with b; Assumption.
+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; Repeat Split; Try Assumption.
+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; 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; Intro; Rewrite <- H12 in H6; Discriminate. 
+Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
+Elim H7; Intros; Assumption.
+Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
+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; Repeat Split; Try Assumption.
+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; 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; Intro; Rewrite <- H12 in H6; Discriminate. 
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert H11 : ``a<=x``.
+Apply Rle_trans with (pos_Rl l1 i).
+Replace a with (Rmin a b).
+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; Intro; Rewrite <- H13 in H6; Discriminate. 
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Left; Elim H7; Intros; Assumption.
+Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse Elim n; Assumption.
+Apply StepFun_P46 with b.
+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; Repeat Split; Try Assumption.
+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; 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; Intro; Rewrite <- H12 in H6; Discriminate. 
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert H11 : ``a<=x``.
+Apply Rle_trans with (pos_Rl l1 i).
+Replace a with (Rmin a b).
+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; Intro; Rewrite <- H13 in H6; Discriminate. 
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Left; Elim H7; Intros; Assumption.
+Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Reflexivity Orelse 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; Repeat Split; Try Assumption.
+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; 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; Intro; Rewrite <- H12 in H6; Discriminate. 
+Unfold Rmin; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Assumption].
+Elim H7; Intros; Assumption.
+Unfold phi3; Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)) | Reflexivity | Elim n; Apply Rle_trans with b; [Assumption | Left; Assumption] | Elim n0; Apply Rle_trans with b; [Assumption | Left; Assumption]].
+Qed.
+
+Lemma RiemannInt_P22 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f a c).
+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.
+Apply (pre phi).
+Split; Assumption.
+Assert H4 : (IsStepFun psi a c).
+Apply StepFun_P44 with b.
+Apply (pre psi).
+Split; Assumption.
+Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
+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; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmin; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
+Rewrite Rabsolu_right.
+Assert H5 : (IsStepFun psi c b).
+Apply StepFun_P46 with a.
+Apply StepFun_P6; Assumption.
+Apply (pre psi).
+Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
+Apply Rle_lt_trans with (RiemannInt_SF psi).
+Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
+Apply Rabsolu_pos.
+Apply H.
+Replace (Rmin a b) with a.
+Replace (Rmax a b) with b.
+Elim H6; Intros; Split; Left.
+Apply Rle_lt_trans with c; Assumption.
+Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Rewrite StepFun_P18; Ring.
+Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
+Apply Rle_Rabsolu.
+Assumption.
+Assert H6 : (IsStepFun psi a b).
+Apply (pre psi).
+Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
+Rewrite <- (StepFun_P43 H4 H5 H6); Ring.
+Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
+EApply StepFun_P17.
+Apply StepFun_P1.
+Simpl; Apply StepFun_P1.
+Apply eq_Ropp; EApply StepFun_P17.
+Apply StepFun_P1.
+Simpl; Apply StepFun_P1.
+Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
+Apply Rabsolu_pos.
+Apply H.
+Replace (Rmin a b) with a.
+Replace (Rmax a b) with b.
+Elim H5; Intros; Split; Left.
+Assumption.
+Apply Rlt_le_trans with c; Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Rewrite StepFun_P18; Ring.
+Qed.
+
+Lemma RiemannInt_P23 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> ``a<=c<=b`` -> (Riemann_integrable f c b).
+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.
+Apply (pre phi).
+Split; Assumption.
+Assert H4 : (IsStepFun psi c b).
+Apply StepFun_P45 with a.
+Apply (pre psi).
+Split; Assumption.
+Split with (mkStepFun H3); Split with (mkStepFun H4); Split.
+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; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmax; Case (total_order_Rle c b); Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption | Elim n; Assumption | Elim n0; Assumption].
+Rewrite Rabsolu_right.
+Assert H5 : (IsStepFun psi a c).
+Apply StepFun_P46 with b.
+Apply (pre psi).
+Apply StepFun_P6; Assumption.
+Replace (RiemannInt_SF (mkStepFun H4)) with ``(RiemannInt_SF psi)-(RiemannInt_SF (mkStepFun H5))``.
+Apply Rle_lt_trans with (RiemannInt_SF psi).
+Unfold Rminus; Pattern 2 (RiemannInt_SF psi); Rewrite <- Rplus_Or; Apply Rle_compatibility; Rewrite <- Ropp_O; Apply Rge_Ropp; Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c R0))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
+Apply Rabsolu_pos.
+Apply H.
+Replace (Rmin a b) with a.
+Replace (Rmax a b) with b.
+Elim H6; Intros; Split; Left.
+Assumption.
+Apply Rlt_le_trans with c; Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Rewrite StepFun_P18; Ring.
+Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF psi)).
+Apply Rle_Rabsolu.
+Assumption.
+Assert H6 : (IsStepFun psi a b).
+Apply (pre psi).
+Replace (RiemannInt_SF psi) with (RiemannInt_SF (mkStepFun H6)).
+Rewrite <- (StepFun_P43 H5 H4 H6); Ring.
+Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
+EApply StepFun_P17.
+Apply StepFun_P1.
+Simpl; Apply StepFun_P1.
+Apply eq_Ropp; EApply StepFun_P17.
+Apply StepFun_P1.
+Simpl; Apply StepFun_P1.
+Apply Rle_sym1; Replace R0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b R0))).
+Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Unfold fct_cte; Apply Rle_trans with ``(Rabsolu ((f x)-(phi x)))``.
+Apply Rabsolu_pos.
+Apply H.
+Replace (Rmin a b) with a.
+Replace (Rmax a b) with b.
+Elim H5; Intros; Split; Left.
+Apply Rle_lt_trans with c; Assumption.
+Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Apply Rle_trans with c; Assumption].
+Rewrite StepFun_P18; Ring.
+Qed.
+
+Lemma RiemannInt_P24 : (f:R->R;a,b,c:R) (Riemann_integrable f a b) -> (Riemann_integrable f b c) -> (Riemann_integrable f a c).
+Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
+Apply RiemannInt_P21 with b; Assumption.
+Case (total_order_Rle a c); Intro.
+Apply RiemannInt_P22 with b; Try Assumption.
+Split; [Assumption | Auto with real].
+Apply RiemannInt_P1; Apply RiemannInt_P22 with b.
+Apply RiemannInt_P1; Assumption.
+Split; Auto with real.
+Case (total_order_Rle a c); Intro.
+Apply RiemannInt_P23 with b; Try Assumption.
+Split; Auto with real.
+Apply RiemannInt_P1; Apply RiemannInt_P23 with b.
+Apply RiemannInt_P1; Assumption.
+Split; [Assumption | Auto with real].
+Apply RiemannInt_P1; Apply RiemannInt_P21 with b; Auto with real Orelse Apply RiemannInt_P1; Assumption.
+Qed.
+
+Lemma RiemannInt_P25 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``a<=b``->``b<=c``->``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
+Intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; Unfold RiemannInt; Case (RiemannInt_exists 1!f 2!a 3!b pr1 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!b 3!c pr2 5!RinvN RinvN_cv); Case (RiemannInt_exists 1!f 2!a 3!c pr3 5!RinvN RinvN_cv); Intros; Symmetry; EApply UL_sequence.
+Apply u.
+Unfold Un_cv; Intros; Assert H0 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (u1 ? H0); Clear u1; Intros N1 H1; Elim (u0 ? H0); Clear u0; Intros N2 H2; Cut (Un_cv [n:nat]``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))`` R0).
+Intro; Elim (H3 ? H0); Clear H3; Intros N3 H3; Pose N0 := (max (max N1 N2) N3); Exists N0; Intros; Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))))+(Rabsolu (((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)))``.
+Replace ``(RiemannInt_SF [(phi_sequence RinvN pr3 n)])-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr3 n)])-((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)])))+(((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0))``; [Apply Rabsolu_triang | Ring].
+Replace eps with ``eps/3+eps/3+eps/3``.
+Rewrite Rplus_assoc; Apply Rplus_lt.
+Unfold R_dist in H3; Cut (ge n N3).
+Intro; Assert H6 := (H3 ? H5); Unfold Rminus in H6; Rewrite Ropp_O in H6; Rewrite Rplus_Or in H6; Apply H6.
+Unfold ge; Apply le_trans with N0; [Unfold N0; Apply le_max_r | Assumption].
+Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1))+(Rabsolu ((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0))``.
+Replace ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])+(RiemannInt_SF [(phi_sequence RinvN pr2 n)]))-(x1+x0)`` with ``((RiemannInt_SF [(phi_sequence RinvN pr1 n)])-x1)+((RiemannInt_SF [(phi_sequence RinvN pr2 n)])-x0)``; [Apply Rabsolu_triang | Ring].
+Apply Rplus_lt.
+Unfold R_dist in H1; Apply H1.
+Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_l | Unfold N0; Apply le_max_l] | Assumption].
+Unfold R_dist in H2; Apply H2.
+Unfold ge; Apply le_trans with N0; [Apply le_trans with (max N1 N2); [Apply le_max_r | Unfold N0; Apply le_max_l] | Assumption].
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Clear x u x0 x1 eps H H0 N1 H1 N2 H2; Assert H1 : (EXT psi1:nat->(StepFun a b) | (n:nat) ((t:R)``(Rmin a b) <= t``/\``t <= (Rmax a b)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr1 n)] t)))<= (psi1 n t)``)/\``(Rabsolu (RiemannInt_SF (psi1 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr1 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr1 n)). 
+Assert H2 : (EXT psi2:nat->(StepFun b c) | (n:nat) ((t:R)``(Rmin b c) <= t``/\``t <= (Rmax b c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr2 n)] t)))<= (psi2 n t)``)/\``(Rabsolu (RiemannInt_SF (psi2 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr2 n)); Intro; Apply (projT2 ? ? (phi_sequence_prop RinvN pr2 n)). 
+Assert H3 : (EXT psi3:nat->(StepFun a c) | (n:nat) ((t:R)``(Rmin a c) <= t``/\``t <= (Rmax a c)``->``(Rabsolu ((f t)-([(phi_sequence RinvN pr3 n)] t)))<= (psi3 n t)``)/\``(Rabsolu (RiemannInt_SF (psi3 n))) < (RinvN n)``).
+Split with [n:nat](projT1 ? ? (phi_sequence_prop RinvN pr3 n)); Intro; Apply (projT2 ? ? (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; Intros; Assert H4 : ``0<eps/3``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H ? H4); Clear H; Intros N0 H; Assert H5 : (n:nat)(ge n N0)->``(RinvN n)<eps/3``.
+Intros; Replace (pos (RinvN n)) with ``(R_dist (mkposreal (/((INR n)+1)) (RinvN_pos n)) 0)``.
+Apply H; Assumption.
+Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rabsolu_right; Apply Rle_sym1; 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; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Pose phi1 := (phi_sequence RinvN pr1 n); Fold phi1 in H8; Pose phi2 := (phi_sequence RinvN pr2 n); Fold phi2 in H3; Pose phi3 := (phi_sequence RinvN pr3 n); Fold phi2 in H1; Assert H10 : (IsStepFun phi3 a b).
+Apply StepFun_P44 with c.
+Apply (pre phi3).
+Split; Assumption.
+Assert H11 : (IsStepFun (psi3 n) a b).
+Apply StepFun_P44 with c.
+Apply (pre (psi3 n)).
+Split; Assumption.
+Assert H12 : (IsStepFun phi3 b c).
+Apply StepFun_P45 with a.
+Apply (pre phi3).
+Split; Assumption.
+Assert H13 : (IsStepFun (psi3 n) b c).
+Apply StepFun_P45 with a.
+Apply (pre (psi3 n)).
+Split; Assumption.
+Replace (RiemannInt_SF phi3) with ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))``.
+Apply Rle_lt_trans with ``(Rabsolu ((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)))+(Rabsolu ((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)))``.
+Replace ``(RiemannInt_SF (mkStepFun H10))+(RiemannInt_SF (mkStepFun H12))+ -((RiemannInt_SF phi1)+(RiemannInt_SF phi2))`` with ``((RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1))+((RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2))``; [Apply Rabsolu_triang | Ring].
+Replace ``(RiemannInt_SF (mkStepFun H10))-(RiemannInt_SF phi1)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H10) phi1))).
+Replace ``(RiemannInt_SF (mkStepFun H12))-(RiemannInt_SF phi2)`` with (RiemannInt_SF (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2))).
+Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
+Apply Rle_trans with ``(Rabsolu (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))))+(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2)))))``.
+Apply Rle_compatibility.
+Apply StepFun_P34; Try Assumption.
+Do 2 Rewrite <- (Rplus_sym (RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 ``-1`` (mkStepFun H12) phi2)))))); Apply Rle_compatibility; Apply StepFun_P34; Try Assumption.
+Apply Rle_lt_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H11) (psi1 n))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
+Apply Rle_trans with ``(RiemannInt_SF (mkStepFun (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1)))))+(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``.
+Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi2 x)))``.
+Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi2 x)`` with ``((phi3 x)-(f x))+((f x)-(phi2 x))``; [Apply Rabsolu_triang | Ring].
+Apply Rplus_le.
+Fold phi3 in H1; Apply H1.
+Elim H14; Intros; Split.
+Replace (Rmin a c) with a.
+Apply Rle_trans with b; Try Assumption.
+Left; Assumption.
+Unfold Rmin; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n0; Apply Rle_trans with b; Assumption].
+Replace (Rmax a c) with c.
+Left; Assumption.
+Unfold Rmax; Case (total_order_Rle 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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
+Replace (Rmax b c) with c.
+Left; Assumption.
+Unfold Rmax; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n0; Assumption].
+Do 2 Rewrite <- (Rplus_sym ``(RiemannInt_SF (mkStepFun (StepFun_P28 R1 (mkStepFun H13) (psi2 n))))``); Apply Rle_compatibility; Apply StepFun_P37; Try Assumption.
+Intros; Simpl; Rewrite Rmult_1l; Apply Rle_trans with ``(Rabsolu ((f x)-(phi3 x)))+(Rabsolu ((f x)-(phi1 x)))``.
+Rewrite <- (Rabsolu_Ropp ``(f x)-(phi3 x)``); Rewrite Ropp_distr2; Replace ``(phi3 x)+ -1*(phi1 x)`` with ``((phi3 x)-(f x))+((f x)-(phi1 x))``; [Apply Rabsolu_triang | Ring].
+Apply Rplus_le.
+Apply H1.
+Elim H14; Intros; Split.
+Replace (Rmin a c) with a.
+Left; Assumption.
+Unfold Rmin; Case (total_order_Rle 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; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Replace (Rmax a b) with b.
+Left; Assumption.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n0; Assumption].
+Do 2 Rewrite StepFun_P30.
+Do 2 Rewrite Rmult_1l; Replace ``(RiemannInt_SF (mkStepFun H11))+(RiemannInt_SF (psi1 n))+((RiemannInt_SF (mkStepFun H13))+(RiemannInt_SF (psi2 n)))`` with ``(RiemannInt_SF (psi3 n))+(RiemannInt_SF (psi1 n))+(RiemannInt_SF (psi2 n))``.
+Replace eps with ``eps/3+eps/3+eps/3``.
+Repeat Rewrite Rplus_assoc; Repeat Apply Rplus_lt.
+Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi3 n))).
+Apply Rle_Rabsolu.
+Apply Rlt_trans with (pos (RinvN n)).
+Assumption.
+Apply H5; Assumption.
+Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi1 n))).
+Apply Rle_Rabsolu.
+Apply Rlt_trans with (pos (RinvN n)).
+Assumption.
+Apply H5; Assumption.
+Apply Rle_lt_trans with (Rabsolu (RiemannInt_SF (psi2 n))).
+Apply Rle_Rabsolu.
+Apply Rlt_trans with (pos (RinvN n)).
+Assumption.
+Apply H5; Assumption.
+Apply r_Rmult_mult with ``3``; [Unfold Rdiv; Repeat Rewrite Rmult_Rplus_distr; Do 2 Rewrite (Rmult_sym ``3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | DiscrR] | DiscrR].
+Replace (RiemannInt_SF (psi3 n)) with (RiemannInt_SF (mkStepFun (pre (psi3 n)))).
+Rewrite <- (StepFun_P43 H11 H13 (pre (psi3 n))); Ring.
+Reflexivity.
+Rewrite StepFun_P30; Ring.
+Rewrite StepFun_P30; Ring.
+Apply (StepFun_P43 H10 H12 (pre phi3)).
+Qed.
+
+Lemma RiemannInt_P26 : (f:R->R;a,b,c:R;pr1:(Riemann_integrable f a b);pr2:(Riemann_integrable f b c);pr3:(Riemann_integrable f a c)) ``(RiemannInt pr1)+(RiemannInt pr2)==(RiemannInt pr3)``.
+Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
+Apply RiemannInt_P25; Assumption.
+Case (total_order_Rle a c); Intro.
+Assert H : ``c<=b``.
+Auto with real.
+Rewrite <- (RiemannInt_P25 pr3 (RiemannInt_P1 pr2) pr1 r0 H); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Ring.
+Assert H : ``c<=a``.
+Auto with real.
+Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr3) pr1 (RiemannInt_P1 pr2) H r); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
+Assert H : ``b<=a``.
+Auto with real.
+Case (total_order_Rle a c); Intro.
+Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr1) pr3 pr2 H r0); Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Ring.
+Assert H0 : ``c<=a``.
+Auto with real.
+Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite <- (RiemannInt_P25 pr2 (RiemannInt_P1 pr3) (RiemannInt_P1 pr1) r  H0); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Ring.
+Rewrite (RiemannInt_P8 pr1 (RiemannInt_P1 pr1)); Rewrite (RiemannInt_P8 pr2 (RiemannInt_P1 pr2)); Rewrite (RiemannInt_P8 pr3 (RiemannInt_P1 pr3)); Rewrite <- (RiemannInt_P25 (RiemannInt_P1 pr2) (RiemannInt_P1 pr1) (RiemannInt_P1 pr3)); [Ring | Auto with real | Auto with real].
+Qed.
+
+Lemma RiemannInt_P27 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<x<b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
+Intro f; Intros; Elim H; Clear H; Intros; Assert H1 : (continuity_pt f x).
+Apply C0; Split; Left; Assumption.
+Unfold derivable_pt_lim; Intros; Assert Hyp : ``0<eps/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H1 ? Hyp); Unfold dist D_x no_cond; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin ``b-x`` ``x-a``)); Assert H4 : ``0<del``.
+Unfold del; Unfold Rmin; Case (total_order_Rle ``b-x`` ``x-a``); Intro.
+Case (total_order_Rle x0 ``b-x``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
+Case (total_order_Rle x0 ``x-a``); Intro; [Elim H3; Intros; Assumption | Apply Rlt_Rminus; Assumption].
+Split with (mkposreal ? H4); Intros; Assert H7 : (Riemann_integrable f x ``x+h0``).
+Case (total_order_Rle x ``x+h0``); Intro.
+Apply continuity_implies_RiemannInt; Try Assumption.
+Intros; Apply C0; Elim H7; Intros; Split.
+Apply Rle_trans with x; [Left; Assumption | Assumption].
+Apply Rle_trans with ``x+h0``.
+Assumption.
+Left; Apply Rlt_le_trans with ``x+del``.
+Apply Rlt_compatibility; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Apply H6].
+Unfold del; Apply Rle_trans with ``x+(Rmin (b-x) (x-a))``.
+Apply Rle_compatibility; Apply Rmin_r.
+Pattern 2 b; Replace b with ``x+(b-x)``; [Apply Rle_compatibility; 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; Apply Rle_trans with ``x-(Rmin (b-x) (x-a))``.
+Pattern 1 a; Replace a with ``x+(a-x)``; [Idtac | Ring].
+Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
+Rewrite Ropp_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Rewrite (Rplus_sym x); Apply Rmin_r.
+Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
+Do 2 Rewrite Ropp_Ropp; Apply Rmin_r.
+Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt.
+Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply H6].
+Assumption.
+Apply Rle_trans with x; [Assumption | Left; Assumption].
+Replace ``(primitive h (FTC_P1 h C0) (x+h0))-(primitive h (FTC_P1 h C0) x)`` with (RiemannInt H7).
+Replace (f x) with ``(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0``.
+Replace ``(RiemannInt H7)/h0-(RiemannInt (RiemannInt_P14 x (x+h0) (f x)))/h0`` 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; Rewrite Rabsolu_mult; Case (total_order_Rle x ``x+h0``); Intro.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x))))); Assumption.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 x (x+h0) (eps/2)))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply RiemannInt_P19; Try Assumption.
+Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
+Unfold fct_cte; Case (Req_EM x x1); Intro.
+Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
+Elim H3; Intros; Left; Apply H11.
+Repeat Split.
+Assumption.
+Rewrite Rabsolu_right.
+Apply Rlt_anti_compatibility with x; Replace ``x+(x1-x)`` with x1; [Idtac | Ring].
+Apply Rlt_le_trans with ``x+h0``.
+Elim H8; Intros; Assumption.
+Apply Rle_compatibility; Apply Rle_trans with del.
+Left; Apply Rle_lt_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Assumption].
+Unfold del; Apply Rmin_l.
+Apply Rge_minus; Apply Rle_sym1; Left; Elim H8; Intros; Assumption.
+Unfold fct_cte; Ring.
+Rewrite RiemannInt_P15.
+Rewrite Rmult_assoc; Replace ``(x+h0-x)*(Rabsolu (/h0))`` with R1.
+Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite Rabsolu_right.
+Replace ``x+h0-x`` with h0; [Idtac | Ring].
+Apply Rinv_r_sym.
+Assumption.
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Elim r; Intro.
+Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
+Elim H5; Symmetry; Apply r_Rplus_plus with x; Rewrite Rplus_Or; Assumption.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x))))))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Replace (RiemannInt (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) with ``-(RiemannInt (RiemannInt_P1 (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x+h0) (f x)))))``.
+Rewrite Rabsolu_Ropp; Apply (RiemannInt_P17 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))) (RiemannInt_P16 (RiemannInt_P1 (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))))); Auto with real.
+Symmetry; Apply RiemannInt_P8.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (x+h0) x (eps/2)))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply RiemannInt_P19.
+Auto with real.
+Intros; Replace ``(f x1)+ -1*(fct_cte (f x) x1)`` with ``(f x1)-(f x)``.
+Unfold fct_cte; Case (Req_EM x x1); Intro.
+Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
+Elim H3; Intros; Left; Apply H11.
+Repeat Split.
+Assumption.
+Rewrite Rabsolu_left.
+Apply Rlt_anti_compatibility with ``x1-x0``; Replace ``x1-x0+x0`` with x1; [Idtac | Ring].
+Replace ``x1-x0+ -(x1-x)`` with ``x-x0``; [Idtac | Ring].
+Apply Rle_lt_trans with ``x+h0``.
+Unfold Rminus; Apply Rle_compatibility; Apply Ropp_Rle.
+Rewrite Ropp_Ropp; Apply Rle_trans with (Rabsolu h0).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rmin_l].
+Elim H8; Intros; Assumption.
+Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Replace ``x+(x1-x)`` with x1; [Elim H8; Intros; Assumption | Ring].
+Unfold fct_cte; Ring.
+Rewrite RiemannInt_P15.
+Rewrite Rmult_assoc; Replace ``(x-(x+h0))*(Rabsolu (/h0))`` with R1.
+Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite Rabsolu_left.
+Replace ``x-(x+h0)`` with ``-h0``; [Idtac | Ring].
+Rewrite Ropp_mul1; Rewrite Ropp_mul3; Rewrite Ropp_Ropp; Apply Rinv_r_sym.
+Assumption.
+Apply Rlt_Rinv2.
+Assert H8 : ``x+h0<x``.
+Auto with real.
+Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or; Assumption.
+Rewrite (RiemannInt_P13 H7 (RiemannInt_P14 x ``x+h0`` (f x)) (RiemannInt_P10 ``-1`` H7 (RiemannInt_P14 x ``x+h0`` (f x)))).
+Ring.
+Unfold Rdiv Rminus; Rewrite Rmult_Rplus_distrl; Ring.
+Rewrite RiemannInt_P15; Apply r_Rmult_mult with h0; [Unfold Rdiv; Rewrite -> (Rmult_sym h0); Repeat Rewrite -> Rmult_assoc; Rewrite <- Rinv_l_sym; [Ring | Assumption] | Assumption].
+Cut ``a<=x+h0``.
+Cut ``x+h0<=b``.
+Intros; Unfold primitive.
+Case (total_order_Rle a ``x+h0``); Case (total_order_Rle ``x+h0`` b); Case (total_order_Rle a x); Case (total_order_Rle x b); Intros; Try (Elim n; Assumption Orelse Left; Assumption).
+Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); Ring.
+Apply Rle_anti_compatibility with ``-x``; Replace ``-x+(x+h0)`` with h0; [Idtac | Ring].
+Rewrite Rplus_sym; Apply Rle_trans with (Rabsolu h0).
+Apply Rle_Rabsolu.
+Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; [Apply Rmin_r | Apply Rmin_l]].
+Apply Ropp_Rle; Apply Rle_anti_compatibility with ``x``; Replace ``x+-(x+h0)`` with ``-h0``; [Idtac | Ring].
+Apply Rle_trans with (Rabsolu h0); [Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu | Apply Rle_trans with del; [Left; Assumption | Unfold del; Apply Rle_trans with ``(Rmin (b-x) (x-a))``; Apply Rmin_r]].
+Qed.
+
+Lemma RiemannInt_P28 : (f:R->R;a,b,x:R;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) ``a<=x<=b`` -> (derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x)).
+Intro f; Intros; Elim h; Intro.
+Elim H; Clear H; Intros; Elim H; Intro.
+Elim H1; Intro.
+Apply RiemannInt_P27; Split; Assumption.
+Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt [(FTC_P1 h C0 h (FTC_P2 b))])``; Rewrite H3.
+Assert H4 : (derivable_pt_lim f_b b (f b)).
+Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
+Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). 
+Apply derivable_pt_lim_plus.
+Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_const.
+Replace R1 with ``1-0``; [Idtac | Ring].
+Apply derivable_pt_lim_minus.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Unfold fct_cte; Ring.
+Apply derivable_pt_lim_const.
+Ring.
+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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H7 ? H8); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros; Pose del := (Rmin x0 (Rmin x1 ``b-a``)); Assert H10 : ``0<del``.
+Unfold del; Unfold Rmin; Case (total_order_Rle x1 ``b-a``); Intros.
+Case (total_order_Rle x0 x1); Intro; [Apply (cond_pos x0) | Elim H9; Intros; Assumption].
+Case (total_order_Rle x0 ``b-a``); Intro; [Apply (cond_pos x0) | Apply Rlt_Rminus; Assumption].
+Split with (mkposreal ? H10); Intros; Case (case_Rabsolu h0); Intro.
+Assert H14 : ``b+h0<b``.
+Pattern 2 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Assert H13 : (Riemann_integrable f ``b+h0`` b).
+Apply continuity_implies_RiemannInt.
+Left; Assumption.
+Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
+Apply Rle_trans with ``b+h0``; Try Assumption.
+Apply Rle_anti_compatibility with ``-a-h0``.
+Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
+Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
+Apply Rle_trans with del.
+Apply Rle_trans with (Rabsolu h0).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Left; Assumption.
+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 <- Rabsolu_Ropp; Unfold Rminus; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Ropp_distr1; Repeat Rewrite Ropp_Ropp; Replace ``(RiemannInt H13)*/h0+ -(RiemannInt (RiemannInt_P14 (b+h0) b (f b)))*/h0`` with ``((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; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b+h0) b (f b)))))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 ``b+h0`` b (f b))))); Left; Assumption.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 (b+h0) b (eps/2)))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply RiemannInt_P19.
+Left; Assumption.
+Intros; Replace ``(f x2)+ -1*(fct_cte (f b) x2)`` with ``(f x2)-(f b)``.
+Unfold fct_cte; Case (Req_EM b x2); Intro.
+Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
+Elim H9; Intros; Left; Apply H18.
+Repeat Split.
+Assumption.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
+Apply Rlt_anti_compatibility with ``x2-x1``; Replace ``x2-x1+(b-x2)`` with ``b-x1``; [Idtac | Ring].
+Replace ``x2-x1+x1`` with x2; [Idtac | Ring].
+Apply Rlt_le_trans with ``b+h0``.
+2:Elim H15; Intros; Left; Assumption.
+Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Apply Rle_lt_trans with (Rabsolu h0).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
+Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H15; Intros; Assumption.
+Unfold fct_cte; Ring.
+Rewrite RiemannInt_P15.
+Rewrite Rmult_assoc; Replace ``(b-(b+h0))*(Rabsolu (/h0))`` with R1.
+Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite Rabsolu_left.
+Apply r_Rmult_mult with h0; [Do 2 Rewrite (Rmult_sym h0); Rewrite Rmult_assoc; Rewrite Ropp_mul1; Rewrite <- Rinv_l_sym; [ Ring | Assumption ] | Assumption].
+Apply Rlt_Rinv2; Assumption.
+Rewrite (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; Rewrite Rmult_Rplus_distrl; Ring.
+Rewrite RiemannInt_P15.
+Rewrite <- Ropp_mul1; Apply r_Rmult_mult with h0; [Repeat Rewrite (Rmult_sym 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; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
+Rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); Ring.
+Elim n; Assumption.
+Left; Assumption.
+Apply Rle_anti_compatibility with ``-a-h0``.
+Replace ``-a-h0+a`` with ``-h0``; [Idtac | Ring].
+Replace ``-a-h0+(b+h0)`` with ``b-a``; [Idtac | Ring].
+Apply Rle_trans with del.
+Apply Rle_trans with (Rabsolu h0).
+Rewrite <- Rabsolu_Ropp; Apply Rle_Rabsolu.
+Left; Assumption.
+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; Apply Rmin_l].
+Assert H14 : ``b<b+h0``.
+Pattern 1 b; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
+Assumption.
+Elim H11; Symmetry; Assumption.
+Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Intros; [Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H14)) | 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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Unfold primitive; Case (total_order_Rle a b); Case (total_order_Rle b b); Intros; [Apply RiemannInt_P5 | Elim n; Right; Reflexivity | Elim n; Left; Assumption | Elim n; Right; Reflexivity].
+(*****)
+Pose f_a := [x:R]``(f a)*(x-a)``; Rewrite <- H2; Assert H3 : (derivable_pt_lim f_a a (f a)).
+Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_const.
+Replace R1 with ``1-0``; [Idtac | Ring].
+Apply derivable_pt_lim_minus.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+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; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Elim (H6 ? H7); Unfold D_x no_cond dist; Simpl; Unfold R_dist; Intros.
+Pose del := (Rmin x0 (Rmin x1 ``b-a``)).
+Assert H9 : ``0<del``.
+Unfold del; Unfold Rmin.
+Case (total_order_Rle x1 ``b-a``); Intros.
+Case (total_order_Rle x0 x1); Intro.
+Apply (cond_pos x0).
+Elim H8; Intros; Assumption.
+Case (total_order_Rle x0 ``b-a``); Intro.
+Apply (cond_pos x0).
+Apply Rlt_Rminus; Assumption.
+Split with (mkposreal ? H9).
+Intros; Case (case_Rabsolu h0); Intro.
+Assert H12 : ``a+h0<a``.
+Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Unfold primitive.
+Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Left; Assumption) Orelse (Elim n; Right; Reflexivity).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H12)).
+Elim n; Left; Apply Rlt_trans with a; Assumption.
+Rewrite RiemannInt_P9; Replace R0 with (f_a a).
+Replace ``(f a)*(a+h0-a)`` with (f_a ``a+h0``).
+Apply H5; Try Assumption.
+Apply Rlt_le_trans with del; [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 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Assert H12 := (Rle_sym2 ? ? r); Elim H12; Intro.
+Assumption.
+Elim H10; Symmetry; Assumption.
+Assert H13 : (Riemann_integrable f a ``a+h0``).
+Apply continuity_implies_RiemannInt.
+Left; Assumption.
+Intros; Apply C0; Elim H13; Intros; Split; Try Assumption.
+Apply Rle_trans with ``a+h0``; Try Assumption.
+Apply Rle_anti_compatibility with ``-b-h0``.
+Replace ``-b-h0+b`` with ``-h0``; [Idtac | Ring].
+Replace ``-b-h0+(a+h0)`` with ``a-b``; [Idtac | Ring].
+Apply Ropp_Rle; Rewrite Ropp_Ropp; Rewrite Ropp_distr2; Apply Rle_trans with del.
+Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption].
+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``.
+Replace ``(RiemannInt H13)/h0-(RiemannInt (RiemannInt_P14 a (a+h0) (f a)))/h0`` 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; Rewrite Rabsolu_mult; Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P16 (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a+h0) (f a)))))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply (RiemannInt_P17 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))) (RiemannInt_P16 (RiemannInt_P10 ``-1`` H13 (RiemannInt_P14 a ``a+h0`` (f a))))); Left; Assumption.
+Apply Rle_lt_trans with ``(RiemannInt (RiemannInt_P14 a (a+h0) (eps/2)))*(Rabsolu (/h0))``.
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu (/h0))``); Apply Rle_monotony.
+Apply Rabsolu_pos.
+Apply RiemannInt_P19.
+Left; Assumption.
+Intros; Replace ``(f x2)+ -1*(fct_cte (f a) x2)`` with ``(f x2)-(f a)``.
+Unfold fct_cte; Case (Req_EM a x2); Intro.
+Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Left; Assumption.
+Elim H8; Intros; Left; Apply H17; Repeat Split.
+Assumption.
+Rewrite Rabsolu_right.
+Apply Rlt_anti_compatibility with a; Replace ``a+(x2-a)`` with x2; [Idtac | Ring].
+Apply Rlt_le_trans with ``a+h0``.
+Elim H14; Intros; Assumption.
+Apply Rle_compatibility; Left; Apply Rle_lt_trans with (Rabsolu h0).
+Apply Rle_Rabsolu.
+Apply Rlt_le_trans with del; [Assumption | Unfold del; Apply Rle_trans with (Rmin x1 ``b-a``); [Apply Rmin_r | Apply Rmin_l]].
+Apply Rle_sym1; Left; Apply Rlt_Rminus; Elim H14; Intros; Assumption.
+Unfold fct_cte; Ring.
+Rewrite RiemannInt_P15.
+Rewrite Rmult_assoc; Replace ``((a+h0)-a)*(Rabsolu (/h0))`` with R1.
+Rewrite Rmult_1r; Unfold Rdiv; Apply Rlt_monotony_contra with ``2``; [Sup0 | Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Pattern 1 eps; Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite Rabsolu_right.
+Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym; [ Reflexivity | Assumption ].
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Assert H14 := (Rle_sym2 ? ? r); Elim H14; Intro.
+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; Rewrite Rmult_Rplus_distrl; Ring.
+Rewrite RiemannInt_P15.
+Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym; [ Ring | Assumption ].
+Cut ``a<=a+h0``.
+Cut ``a+h0<=b``.
+Intros; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros; Try (Elim n; Right; Reflexivity) Orelse (Elim n; Left; Assumption).
+Rewrite RiemannInt_P9; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply RiemannInt_P5.
+Elim n; Assumption.
+Elim n; Assumption.
+2:Left; Assumption.
+Apply Rle_anti_compatibility with ``-a``; Replace ``-a+(a+h0)`` with h0; [Idtac | Ring].
+Rewrite Rplus_sym; Apply Rle_trans with del; [Apply Rle_trans with (Rabsolu h0); [Apply Rle_Rabsolu | Left; Assumption] | 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.
+Pose f_a := [x:R]``(f a)*(x-a)``.
+Assert H2 : (derivable_pt_lim f_a a (f a)).
+Unfold f_a; Change (derivable_pt_lim (mult_fct (fct_cte (f a)) (minus_fct id (fct_cte a))) a (f a)); Pattern 2 (f a); Replace (f a) with ``0*((minus_fct id (fct_cte a)) a)+((fct_cte (f a)) a)*1``.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_const.
+Replace R1 with ``1-0``; [Idtac | Ring].
+Apply derivable_pt_lim_minus.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Unfold fct_cte; Ring.
+Pose f_b := [x:R]``(f b)*(x-b)+(RiemannInt (FTC_P1 h C0 b h (FTC_P2 b)))``.
+Assert H3 : (derivable_pt_lim f_b b (f b)).
+Unfold f_b; Pattern 2 (f b); Replace (f b) with ``(f b)+0``.
+Change (derivable_pt_lim (plus_fct (mult_fct (fct_cte (f b)) (minus_fct id (fct_cte b))) (fct_cte (RiemannInt (FTC_P1 h C0 h (FTC_P2 b))))) b ``(f b)+0``). 
+Apply derivable_pt_lim_plus.
+Pattern 2 (f b); Replace (f b) with ``0*((minus_fct id (fct_cte b)) b)+((fct_cte (f b)) b)*1``.
+Apply derivable_pt_lim_mult.
+Apply derivable_pt_lim_const.
+Replace R1 with ``1-0``; [Idtac | Ring].
+Apply derivable_pt_lim_minus.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Unfold fct_cte; Ring.
+Apply derivable_pt_lim_const.
+Ring.
+Unfold derivable_pt_lim; Intros; Elim (H2 ? H4); Intros; Elim (H3 ? H4); Intros; Pose del := (Rmin x0 x1).
+Assert H7 : ``0<del``.
+Unfold del; Unfold Rmin; Case (total_order_Rle x0 x1); Intro.
+Apply (cond_pos x0).
+Apply (cond_pos x1).
+Split with (mkposreal ? H7); Intros; Case (case_Rabsolu h0); Intro.
+Assert H10 : ``a+h0<a``.
+Pattern 2 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Rewrite H1; Unfold primitive; Case (total_order_Rle a ``a+h0``); Case (total_order_Rle ``a+h0`` b); Case (total_order_Rle a a); Case (total_order_Rle a b); Intros;  Try (Elim n; Right; Assumption Orelse Reflexivity).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H10)).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r2 H10)).
+Rewrite RiemannInt_P9; Replace R0 with (f_a a).
+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; Apply Rmin_l.
+Unfold f_a; Ring.
+Unfold f_a; Ring.
+Elim n; Rewrite <- H0; Left; Assumption.
+Assert H10 : ``a<a+h0``.
+Pattern 1 a; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Assert H10 := (Rle_sym2 ? ? r); Elim H10; Intro.
+Assumption.
+Elim H8; Symmetry; Assumption.
+Rewrite H0 in H1; Rewrite H1; Unfold primitive; Case (total_order_Rle a ``b+h0``); Case (total_order_Rle ``b+h0`` b); Case (total_order_Rle a b); Case (total_order_Rle b b); Intros;  Try (Elim n; Right; Assumption Orelse Reflexivity).
+Rewrite H0 in H10; Elim (Rlt_antirefl ? (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``).
+Apply H6; Try Assumption.
+Apply Rlt_le_trans with del; Try Assumption.
+Unfold del; Apply Rmin_r.
+Unfold f_b; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Apply RiemannInt_P5.
+Elim n; Rewrite <- H0; Left; Assumption.
+Elim n0; Rewrite <- H0; Left; Assumption.
+Qed.
+
+Lemma RiemannInt_P29 : (f:R->R;a,b;h:``a<=b``;C0:((x:R)``a<=x<=b``->(continuity_pt f x))) (antiderivative f (primitive h (FTC_P1 h C0)) a b).
+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; Split with (f x); Apply H0 | Split with H1; Symmetry; Apply derive_pt_eq_0; Apply H0].
+Qed.
+
+Lemma RiemannInt_P30 : (f:R->R;a,b:R) ``a<=b`` -> ((x:R)``a<=x<=b``->(continuity_pt f x)) -> (sigTT ? [g:R->R](antiderivative f g a b)).
+Intros; Split with (primitive H (FTC_P1 H H0)); Apply RiemannInt_P29.
+Qed.
+
+Record C1_fun : Type := mkC1 {
+c1 :> R->R;
+diff0 : (derivable c1);
+cont1 : (continuity (derive c1 diff0)) }.
+
+Lemma RiemannInt_P31 : (f:C1_fun;a,b:R) ``a<=b`` -> (antiderivative (derive f (diff0 f)) f a b).
+Intro f; Intros; Unfold antiderivative; Split; Try Assumption; Intros; Split with (diff0 f x); Reflexivity.
+Qed.
+
+Lemma RiemannInt_P32 : (f:C1_fun;a,b:R) (Riemann_integrable (derive f (diff0 f)) a b).
+Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f) | Assert H : ``b<=a``; [Auto with real | Apply RiemannInt_P1; Apply continuity_implies_RiemannInt; Try Assumption; Intros; Apply (cont1 f)]].
+Qed.
+
+Lemma RiemannInt_P33 : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) ``a<=b`` -> (RiemannInt pr)==``(f b)-(f a)``.
+Intro f; Intros; Assert H0 : (x:R)``a<=x<=b``->(continuity_pt (derive f (diff0 f)) x).
+Intros; Apply (cont1 f).
+Rewrite (RiemannInt_P20 H (FTC_P1 H H0) pr); Assert H1 := (RiemannInt_P29 H H0); Assert H2 := (RiemannInt_P31 f H); Elim (antiderivative_Ucte (derive f (diff0 f)) ? ? ? ? H1 H2); Intros C H3; Repeat Rewrite H3; [Ring | Split; [Right; Reflexivity | Assumption] | Split; [Assumption | Right; Reflexivity]].
+Qed.
+
+Lemma FTC_Riemann : (f:C1_fun;a,b:R;pr:(Riemann_integrable (derive f (diff0 f)) a b)) (RiemannInt pr)==``(f b)-(f a)``.
+Intro f; Intros; Case (total_order_Rle a b); Intro; [Apply RiemannInt_P33; Assumption | Assert H : ``b<=a``; [Auto with real | Assert H0 := (RiemannInt_P1 pr); Rewrite (RiemannInt_P8 pr H0); Rewrite (RiemannInt_P33 H0 H); Ring]].
+Qed.
diff --git a/theories7/Reals/RiemannInt_SF.v b/theories7/Reals/RiemannInt_SF.v
new file mode 100644
index 00000000..3e2cc457
--- /dev/null
+++ b/theories7/Reals/RiemannInt_SF.v
@@ -0,0 +1,1400 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: RiemannInt_SF.v,v 1.2.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis.
+Require Classical_Prop.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Implicit Arguments On.
+
+(**************************************************)
+(* Each bounded subset of N has a maximal element *)
+(**************************************************)
+
+Definition Nbound [I:nat->Prop] : Prop := (EX n:nat | (i:nat)(I i)->(le i n)).
+
+Lemma IZN_var:(z:Z)(`0<=z`)->{ n:nat | z=(INZ n)}.
+Intros; Apply inject_nat_complete_inf; Assumption.
+Qed.
+
+Lemma Nzorn : (I:nat->Prop) (EX n:nat | (I n)) -> (Nbound I) -> (sigTT ?  [n:nat](I n)/\(i:nat)(I i)->(le i n)).
+Intros I H H0; Pose E := [x:R](EX i:nat | (I i)/\(INR i)==x); Assert H1 : (bound E).
+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 : (EXT x:R | (E x)).
+Elim H; Intros; Exists (INR x); Unfold E; Exists x; Split; [Assumption | Reflexivity].
+Assert H3 := (complet 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 O)<=(INR x1)``; Apply le_INR; Apply le_O_n | Apply H4; Assumption].
+Assert H7 := (archimed x); Elim H7; Clear H7; Intros; Assert H9 : ``x<=(IZR (up x))-1``.
+Apply H5; Intros; Assert H10 := (H4 ? H9); Unfold E in H9; Elim H9; Intros; Elim H11; Intros; Rewrite <- H13; Apply Rle_anti_compatibility with R1; Replace ``1+((IZR (up x))-1)`` with (IZR (up x)); [Idtac | Ring]; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
+Assert H14 : `0<=(up x)`.
+Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
+Assert H15 := (IZN ? H14); Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- INR_IZR_INZ; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H13; Apply Rle_lt_trans with x; [Assumption | Rewrite INR_IZR_INZ; Rewrite <- H15; Assumption].
+Assert H10 : ``x==(IZR (up x))-1``.
+Apply Rle_antisym; [Assumption | Apply Rle_anti_compatibility with ``-x+1``; Replace `` -x+1+((IZR (up x))-1)`` with ``(IZR (up x))-x``; [Idtac | Ring]; Replace ``-x+1+x`` with R1; [Assumption | Ring]].
+Assert H11 : `0<=(up x)`.
+Apply le_IZR; Apply Rle_trans with x; [Apply H6 | Left; Assumption].
+Assert H12 := (IZN_var H11); Elim H12; Clear H12; Intros; Assert H13 : (E x).
+Elim (classic (E x)); Intro; Try Assumption.
+Cut ((y:R)(E y)->``y<=x-1``).
+Intro; Assert H14 := (H5 ? H13); Cut ``x-1<x``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H15)).
+Apply Rminus_lt; Replace ``x-1-x`` with ``-1``; [Idtac | Ring]; Rewrite <- Ropp_O; Apply Rlt_Ropp; Apply Rlt_R0_R1.
+Intros; Assert H14 := (H4 ? H13); Elim H14; Intro; Unfold E in H13; Elim H13; Intros; Elim H16; Intros; Apply Rle_anti_compatibility with R1.
+Replace ``1+(x-1)`` with x; [Idtac | Ring]; Rewrite <- H18; Replace ``1+(INR x1)`` with (INR (S x1)); [Idtac | Rewrite S_INR; Ring].
+Cut x==(INR (pred x0)).
+Intro; Rewrite H19; Apply le_INR; Apply lt_le_S; Apply INR_lt; Rewrite H18; Rewrite <- H19; Assumption.
+Rewrite H10; Rewrite p; Rewrite <- INR_IZR_INZ; Replace R1 with (INR (S O)); [Idtac | Reflexivity]; Rewrite <- minus_INR.
+Replace (minus x0 (S O)) with (pred x0); [Reflexivity | Case x0; [Reflexivity | Intro; Simpl; Apply minus_n_O]].
+Induction x0; [Rewrite p in H7; Rewrite <- INR_IZR_INZ in H7; Simpl in H7; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7)) | Apply le_n_S; Apply le_O_n].
+Rewrite H15 in H13; Elim H12; Assumption.
+Split with (pred x0); Unfold E in H13; Elim H13; Intros; Elim H12; Intros; Rewrite H10 in H15; Rewrite p in H15; Rewrite <- INR_IZR_INZ in H15; Assert H16 : ``(INR x0)==(INR x1)+1``.
+Rewrite H15; Ring.
+Rewrite <- S_INR in H16; Assert H17 := (INR_eq ? ? H16); Rewrite H17; Simpl; Split.
+Assumption.
+Intros; Apply INR_le; Rewrite H15; Rewrite <- H15; Elim H12; Intros; Rewrite H20; Apply H4; Unfold E; Exists i; Split; [Assumption | Reflexivity].
+Qed.
+
+(*******************************************)
+(*             Step functions              *)
+(*******************************************)
+
+Definition open_interval [a,b:R] : R->Prop := [x:R]``a<x<b``.
+Definition co_interval [a,b:R] : R->Prop := [x:R]``a<=x<b``. 
+
+Definition adapted_couple [f:R->R;a,b:R;l,lf:Rlist] : Prop := (ordered_Rlist l)/\``(pos_Rl l O)==(Rmin a b)``/\``(pos_Rl l (pred (Rlength l)))==(Rmax a b)``/\(Rlength l)=(S (Rlength lf))/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i))) (pos_Rl lf i)).
+
+Definition adapted_couple_opt [f:R->R;a,b:R;l,lf:Rlist] := (adapted_couple f a b l lf)/\((i:nat)(lt i (pred (Rlength lf)))->(``(pos_Rl lf i)<>(pos_Rl lf (S i))``\/``(f (pos_Rl l (S i)))<>(pos_Rl lf i)``))/\((i:nat)(lt i (pred (Rlength l)))->``(pos_Rl l i)<>(pos_Rl l (S i))``).
+
+Definition is_subdivision [f:R->R;a,b:R;l:Rlist] : Type := (sigTT ? [l0:Rlist](adapted_couple f a b l l0)).
+
+Definition IsStepFun [f:R->R;a,b:R] : Type := (SigT ? [l:Rlist](is_subdivision f a b l)).
+
+(* Class of step functions *)
+Record StepFun [a,b:R] : Type := mkStepFun {
+  fe:> R->R;
+  pre:(IsStepFun fe a b)}.
+
+Definition subdivision [a,b:R;f:(StepFun a b)] : Rlist := (projT1 ? ? (pre f)).
+
+Definition subdivision_val [a,b:R;f:(StepFun a b)] : Rlist := Cases (projT2 ? ? (pre f)) of (existTT a b) => a end.
+
+Fixpoint Int_SF [l:Rlist] : Rlist -> R :=
+[k:Rlist] Cases l of
+| nil => R0
+| (cons a l') => Cases k of
+   | nil => R0
+   | (cons x nil) => R0
+   | (cons x (cons y k')) => ``a*(y-x)+(Int_SF l' (cons y k'))``
+  end
+end.
+
+(* Integral of step functions *)
+Definition RiemannInt_SF [a,b:R;f:(StepFun a b)] : R := 
+Cases (total_order_Rle a b) of
+  (leftT _) => (Int_SF (subdivision_val f) (subdivision f))
+| (rightT _) => ``-(Int_SF (subdivision_val f) (subdivision f))``
+end.
+
+(********************************)
+(* Properties of step functions *)
+(********************************)
+
+Lemma StepFun_P1 : (a,b:R;f:(StepFun a b)) (adapted_couple f a b (subdivision f) (subdivision_val f)).
+Intros a b f; Unfold subdivision_val; Case (projT2 Rlist ([l:Rlist](is_subdivision f a b l)) (pre f)); Intros; Apply a0.
+Qed.
+
+Lemma StepFun_P2 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple f b a l lf).
+Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
+Rewrite H2; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Rewrite H1; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Qed.
+
+Lemma StepFun_P3 : (a,b,c:R) ``a<=b`` -> (adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil)).
+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 (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold constant_D_eq open_interval; Intros; Simpl in H0; Inversion H0; [Reflexivity | Elim (le_Sn_O ? H3)].
+Qed.
+
+Lemma StepFun_P4 : (a,b,c:R) (IsStepFun (fct_cte c) a b).
+Intros; Unfold IsStepFun; Case (total_order_Rle a b); Intro.
+Apply Specif.existT with (cons a (cons b nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply (StepFun_P3 c r).
+Apply Specif.existT with (cons b (cons a nil)); Unfold is_subdivision; Apply existTT with (cons c nil); Apply StepFun_P2; Apply StepFun_P3; Auto with real.
+Qed.
+
+Lemma StepFun_P5 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (is_subdivision f b a l).
+Unfold is_subdivision; Intros; Elim X; Intros; Exists x; Unfold adapted_couple in p; Decompose [and] p; Clear p; Unfold adapted_couple; Repeat Split; Try Assumption.
+Rewrite H1; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Rewrite H0; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Qed.
+
+Lemma StepFun_P6 : (f:R->R;a,b:R) (IsStepFun f a b) -> (IsStepFun f b a).
+Unfold IsStepFun; Intros; Elim X; Intros; Apply Specif.existT with x; Apply StepFun_P5; Assumption.
+Qed.
+
+Lemma StepFun_P7 : (a,b,r1,r2,r3:R;f:R->R;l,lf:Rlist) ``a<=b`` -> (adapted_couple f a b (cons r1 (cons r2 l)) (cons r3 lf)) -> (adapted_couple f r2 b (cons r2 l) lf).
+Unfold adapted_couple; Intros; Decompose [and] H0; Clear H0; Assert H5 : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert H7 : ``r2<=b``.
+Rewrite H5 in H2; Rewrite <- H2; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
+Repeat Split.
+Apply RList_P4 with r1; Assumption.
+Rewrite H5 in H2; Unfold Rmin; Case (total_order_Rle r2 b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmax; Case (total_order_Rle r2 b); Intro; [Rewrite H5 in H2; Rewrite <- H2; Reflexivity | Elim n; Assumption].
+Simpl in H4; Simpl; Apply INR_eq; Apply r_Rplus_plus with R1; Do 2 Rewrite (Rplus_sym R1); Do 2 Rewrite <- S_INR; Rewrite H4; Reflexivity.
+Intros; Unfold constant_D_eq open_interval; Intros; Unfold constant_D_eq open_interval in H6; Assert H9 : (lt (S i) (pred (Rlength (cons r1 (cons r2 l))))).
+Simpl; Simpl in H0; Apply lt_n_S; Assumption.
+Assert H10 := (H6 ? H9); Apply H10; Assumption.
+Qed.
+
+Lemma StepFun_P8 : (f:R->R;l1,lf1:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> a==b -> (Int_SF lf1 l1)==R0.
+Induction l1.
+Intros; Induction lf1; Reflexivity.
+Induction r0.
+Intros; Induction lf1.
+Reflexivity.
+Unfold adapted_couple in H0; Decompose [and] H0; Clear H0; Simpl in H5; Discriminate.
+Intros; Induction lf1.
+Reflexivity.
+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; Case (total_order_Rle a b); Intro; [Assumption | Reflexivity].
+Unfold adapted_couple in H1; Decompose [and] H1; Intros; Apply Rle_antisym.
+Apply (H3 O); 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; Right; Left; Reflexivity] | Unfold Rmin Rmax; Case (total_order_Rle b b); Case (total_order_Rle a b); Intros; Try Assumption Orelse Reflexivity].
+Qed.
+
+Lemma StepFun_P9 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> ``a<>b`` -> (le (2) (Rlength l)).
+Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Induction l; [Simpl in H4; Discriminate | Induction l; [Simpl in H3; Simpl in H2; Generalize H3; Generalize H2; Unfold Rmin Rmax; Case (total_order_Rle a b); Intros; Elim H0; Rewrite <- H5; Rewrite <- H7; Reflexivity | Simpl; Do 2 Apply le_n_S; Apply le_O_n]].
+Qed.
+
+Lemma StepFun_P10 : (f:R->R;l,lf:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))).
+Induction l.
+Intros; Unfold adapted_couple in H0; Decompose [and] H0; Simpl in H4; Discriminate.
+Intros; Case (Req_EM a b); Intro.
+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; Rewrite <- H2; Unfold Rmin; Case (total_order_Rle a a); Intro; Reflexivity.
+Simpl; Rewrite <- H2; Unfold Rmax; Case (total_order_Rle a a); Intro; Reflexivity.
+Elim (RList_P20 ? (StepFun_P9 H1 H2)); Intros t1 [t2 [t3 H3]]; Induction lf.
+Unfold adapted_couple in H1; Decompose [and] H1; Rewrite H3 in H7; Simpl in H7; Discriminate.
+Clear Hreclf; Assert H4 : (adapted_couple f t2 b r0 lf).
+Rewrite H3 in H1; Assert H4 := (RList_P21 ? ? H3); Simpl in H4; Rewrite H4; EApply StepFun_P7; [Apply H0 | Apply H1].
+Cut ``t2<=b``.
+Intro; Assert H6 := (H ? ? ? H5 H4); Case (Req_EM t1 t2); Intro Hyp_eq.
+Replace a with t2.
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Elim H6; Clear H6; Intros l' [lf' H6]; Case (Req_EM t2 b); Intro.
+Exists (cons a (cons b nil)); Exists (cons r1 nil); Unfold adapted_couple_opt; Unfold adapted_couple; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H8; Inversion H8; [Simpl; Assumption | Elim (le_Sn_O ? H10)].
+Simpl; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Simpl; Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Intros; Simpl in H8; Inversion H8.
+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 O).
+Simpl; Apply lt_O_Sn.
+Unfold open_interval; Simpl; Rewrite H7; Simpl in H13; Rewrite H13; Unfold Rmin; Case (total_order_Rle 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; Assumption | Elim (le_Sn_O ? H10)].
+Assert Hyp_min : (Rmin t2 b)==t2.
+Unfold Rmin; Case (total_order_Rle 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]]; Induction lf'.
+Unfold adapted_couple in H6; Decompose [and] H6; Rewrite H9 in H13; Simpl in H13; Discriminate.
+Clear Hreclf'; Case (Req_EM r1 r2); Intro.
+Case (Req_EM (f t2) r1); Intro.
+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; Unfold adapted_couple; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
+Simpl; Apply Rle_trans with s1.
+Replace s1 with t2.
+Apply (H12 O).
+Simpl; Apply lt_O_Sn.
+Simpl in H19; Rewrite H19; Symmetry; Apply Hyp_min.
+Apply (H16 O); 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 (total_order_Rle a b); Case (total_order_Rle t2 b); Intros; Reflexivity Orelse Elim n; Assumption.
+Simpl; Simpl in H20; Apply H20.
+Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Simpl in H6; Case (total_order_T x t2); Intro.
+Elim s; Intro.
+Apply (H17 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Elim H6; Intros; Split; Assumption].
+Rewrite b0; Assumption.
+Rewrite H10; Apply (H22 O); [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; 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)``; Rewrite <- H9; Elim H8; Intros; Apply H6; Simpl; Apply H1.
+Intros; Induction i.
+Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
+Apply (H12 O); Simpl; Apply lt_O_Sn.
+Rewrite <- Hyp_min; Rewrite H6; Simpl in H19; Rewrite <- H19; Apply (H16 O); 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; Unfold adapted_couple; Repeat Split.
+Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
+Simpl; Replace s1 with t2.
+Apply (H16 O); 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))``; Apply (H12 i); Simpl; Apply lt_S_n; Assumption.
+Simpl; Simpl in H19; Apply H19.
+Rewrite H9; Simpl; Simpl in H13; Rewrite H13; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
+Rewrite H9; Simpl; Simpl in H15; Rewrite H15; Reflexivity.
+Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H22 O).
+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); 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.
+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; Apply lt_S_n; Apply H1.
+Intros; Rewrite H9; Induction i.
+Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
+Apply (H16 O); 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; 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; Unfold adapted_couple; Repeat Split.
+Rewrite H9; Unfold ordered_Rlist; Intros; Simpl in H1; Induction i.
+Simpl; Replace s1 with t2.
+Apply (H15 O); 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))``; Apply (H11 i); Simpl; Apply lt_S_n; Assumption.
+Simpl; Simpl in H18; Apply H18.
+Rewrite H9; Simpl; Simpl in H12; Rewrite H12; Unfold Rmax; Case (total_order_Rle t2 b); Case (total_order_Rle a b); Intros; Reflexivity Orelse Elim n; Assumption.
+Rewrite H9; Simpl; Simpl in H14; Rewrite H14; Reflexivity.
+Intros; Simpl in H1; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Rewrite H9 in H6; Simpl in H6; Apply (H21 O).
+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); 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.
+Simpl; Left; Assumption.
+Elim H8; Intros; Apply (H6 i).
+Simpl; Apply lt_S_n; Apply H1.
+Intros; Rewrite H9; Induction i.
+Simpl; Red; Intro; Elim Hyp_eq; Apply Rle_antisym.
+Apply (H15 O); 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; 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; Right; Left; Reflexivity] | Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption]].
+Qed.
+
+Lemma StepFun_P11 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
+Intros; Unfold adapted_couple_opt in H1; Elim H1; Clear H1; Intros; Unfold adapted_couple in H0 H1; Decompose [and] H0; Decompose [and] H1; Clear H0 H1; Assert H12 : r==s1.
+Simpl in H10; Simpl in H5; Rewrite H10; Rewrite H5; Reflexivity.
+Assert H14 := (H3 O (lt_O_Sn ?)); Simpl in H14; Elim H14; Intro.
+Assert H15 := (H7 O (lt_O_Sn ?)); Simpl in H15; Elim H15; Intro.
+Rewrite <- H12 in H1; Case (total_order_Rle r1 s2); Intro; Try Assumption.
+Assert H16 : ``s2<r1``; Auto with real.
+Induction s3.
+Simpl in H9; Rewrite H9 in H16; Cut ``r1<=(Rmax a b)``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H17 H16)).
+Rewrite <- H4; Apply RList_P7; [Assumption | Simpl; Right; Left; Reflexivity].
+Clear Hrecs3; Induction lf2.
+Simpl in H11; Discriminate.
+Clear Hreclf2; Assert H17 : r3==r4.
+Pose x := ``(r+s2)/2``; Assert H17 := (H8 O (lt_O_Sn ?)); Assert H18 := (H13 O (lt_O_Sn ?)); Unfold constant_D_eq open_interval in H17 H18; Simpl in H17; Simpl in H18; Rewrite <- (H17 x).
+Rewrite <- (H18 x).
+Reflexivity.
+Rewrite <- H12; Unfold x; Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Unfold x; Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_trans with s2; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]] | Assumption].
+Assert H18 : (f s2)==r3.
+Apply (H8 O); [Simpl; Apply lt_O_Sn | Unfold open_interval; Simpl; Split; Assumption].
+Assert H19 : r3 == r5.
+Assert H19 := (H7 (S O)); Simpl in H19; Assert H20 := (H19 (lt_n_S ? ? (lt_O_Sn ?))); Elim H20; Intro.
+Pose x := ``(s2+(Rmin r1 r0))/2``; Assert H22 := (H8 O); Assert H23 := (H13 (S O)); Simpl in H22; Simpl in H23; Rewrite <- (H22 (lt_O_Sn ?) x).
+Rewrite <- (H23 (lt_n_S ? ? (lt_O_Sn ?)) x).
+Reflexivity.
+Unfold open_interval; Simpl; Unfold x; Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r0+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_r] | DiscrR]].
+Unfold open_interval; Simpl; Unfold x; Split.
+Apply Rlt_trans with s2; [Assumption | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Unfold Rmin; Case (total_order_Rle r1 r0); Intro; Assumption | DiscrR]]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_le_trans with ``r1+(Rmin r1 r0)``; [Do 2 Rewrite <- (Rplus_sym (Rmin r1 r0)); Apply Rlt_compatibility; Assumption | Apply Rle_compatibility; Apply Rmin_l] | DiscrR]].
+Elim H2; Clear H2; Intros; Assert H23 := (H22 (S O)); Simpl in H23; Assert H24 := (H23 (lt_n_S ? ? (lt_O_Sn ?))); Elim H24; Assumption.
+Elim H2; Intros; Assert H22 := (H20 O); Simpl in H22; Assert H23 := (H22 (lt_O_Sn ?)); Elim H23; Intro; [Elim H24; Rewrite <- H17; Rewrite <- H19; Reflexivity | Elim H24; Rewrite <- H17; Assumption].
+Elim H2; Clear H2; Intros; Assert H17 := (H16 O); Simpl in H17; Elim (H17 (lt_O_Sn ?)); Assumption.
+Rewrite <- H0; Rewrite H12; Apply (H7 O); Simpl; Apply lt_O_Sn.
+Qed.
+
+Lemma StepFun_P12 : (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).
+Unfold adapted_couple_opt; Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
+Rewrite H0; Unfold Rmin; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Rewrite H3; Unfold Rmax; Case (total_order_Rle a b); Intro; Case (total_order_Rle b a); Intro; Try Reflexivity.
+Apply Rle_antisym; Assumption.
+Apply Rle_antisym; Auto with real.
+Qed.
+
+Lemma StepFun_P13 : (a,b,r,r1,r3,s1,s2,r4:R;r2,lf1,s3,lf2:Rlist;f:R->R) ``a<>b`` -> (adapted_couple f a b (cons r (cons r1 r2)) (cons r3 lf1)) -> (adapted_couple_opt f a b (cons s1 (cons s2 s3)) (cons r4 lf2)) -> ``r1<=s2``.
+Intros; Case (total_order_T a b); Intro.
+Elim s; Intro.
+EApply StepFun_P11; [Apply a0 | Apply H0 | Apply H1].
+Elim H; Assumption.
+EApply StepFun_P11; [Apply r0 | Apply StepFun_P2; Apply H0 | Apply StepFun_P12; Apply H1].
+Qed.
+
+Lemma StepFun_P14 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) ``a<=b`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
+Induction l1.
+Intros l2 lf1 lf2 a b Hyp H H0; Unfold adapted_couple in H; Decompose [and] H; Clear H H0 H2 H3 H1 H6; Simpl in H4; Discriminate.
+Induction r0.
+Intros; Case (Req_EM a b); Intro.
+Unfold adapted_couple_opt in H2; Elim H2; Intros; Rewrite (StepFun_P8 H4 H3); Rewrite (StepFun_P8 H1 H3); Reflexivity.
+Assert H4 := (StepFun_P9 H1 H3); Simpl in H4; Elim (le_Sn_O ? (le_S_n ? ? H4)).
+Intros; Clear H; Unfold adapted_couple_opt in H3; Elim H3; Clear H3; Intros; Case (Req_EM a b); Intro.
+Rewrite (StepFun_P8 H2 H4); Rewrite (StepFun_P8 H H4); Reflexivity.
+Assert Hyp_min : (Rmin a b)==a.
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert Hyp_max : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle 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.
+Unfold adapted_couple in H2; Decompose [and] H2; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
+Clear Hreclf1; Induction lf2.
+Unfold adapted_couple in H; Decompose [and] H; Clear H H2 H4 H5 H3 H6 H8 H7 H11; Simpl in H9; Discriminate.
+Clear Hreclf2; Assert H6 : r==s1.
+Unfold adapted_couple in H H2; Decompose [and] H; Decompose [and] H2; Clear H H2; Simpl in H13; Simpl in H8; Rewrite H13; Rewrite H8; Reflexivity.
+Assert H7 : r3==r4\/r==r1.
+Case (Req_EM r r1); Intro.
+Right; Assumption.
+Left; Cut ``r1<=s2``.
+Intro; Unfold adapted_couple in H2 H; Decompose [and] H; Decompose [and] H2; Clear H H2; Pose x := ``(r+r1)/2``; Assert H18 := (H14 O); Assert H20 := (H19 O); Unfold constant_D_eq open_interval in H18 H20; Simpl in H18; Simpl in H20; Rewrite <- (H18 (lt_O_Sn ?) x).
+Rewrite <- (H20 (lt_O_Sn ?) x).
+Reflexivity.
+Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
+Rewrite <- H6; Assert H21 := (H13 O (lt_O_Sn ?)); Simpl in H21; Elim H21; Intro; [Idtac | Elim H7; Assumption]; Unfold x; Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]].
+Apply Rlt_le_trans with r1; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite <- (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Apply H | DiscrR]] | Assumption].
+EApply StepFun_P13.
+Apply H4.
+Apply H2.
+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; Split.
+Apply H.
+Rewrite H5 in H3; Apply H3.
+Elim H7; 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_plus_r; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r3 lf2) (cons r1 (cons s2 s3))); 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; Right; Left; Reflexivity].
+EApply StepFun_P7.
+Apply H1.
+Apply H2.
+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; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
+Simpl; Rewrite <- H20; Apply (H11 O).
+Simpl; Apply lt_O_Sn.
+Induction i.
+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; Rewrite H19; Reflexivity.
+Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Apply (H16 O).
+Simpl; Apply lt_O_Sn.
+Simpl in H2; Rewrite <- H20 in H2; Unfold open_interval; Simpl; Apply H2.
+Clear Hreci; Induction i.
+Simpl; Simpl in H2; Rewrite H9; Apply (H21 O).
+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 O); Simpl; Apply lt_O_Sn.
+Assumption.
+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 (i:nat) (lt i (pred (Rlength (cons r4 lf2)))) ->``(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)``; Rewrite <- H5; Apply H3.
+Rewrite H5 in H11; Intros; Simpl in H12; Induction i.
+Simpl; Red; Intro; Rewrite H13 in H10; Elim (Rlt_antirefl ? H10).
+Clear Hreci; Apply (H11 (S i)); Simpl; Apply H12.
+Rewrite H9; Rewrite H10; Rewrite H6; Apply Rplus_plus_r; 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; Right; Left; Reflexivity].
+EApply StepFun_P7.
+Apply H1.
+Apply H2.
+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; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
+Simpl; Rewrite <- H20; Apply (H11 O); Simpl; Apply lt_O_Sn.
+Rewrite H10; Apply (H15 (S i)); Simpl; Assumption.
+Simpl; Symmetry; Apply Hyp_min.
+Rewrite <- H17; Rewrite H10; Reflexivity.
+Simpl in H19; Simpl; Apply H19.
+Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Apply (H16 O).
+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; Replace (Rlength lf2) with (S (pred (Rlength lf2))).
+Apply lt_n_S; Apply H12.
+Symmetry; Apply S_pred with O; 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; Apply lt_n_S; Apply H12.
+Simpl; Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rmult_Or; Rewrite Rplus_Ol; Change (Int_SF lf1 (cons r1 r2))==(Int_SF (cons r4 lf2) (cons s1 (cons s2 s3))); EApply H0.
+Apply H1.
+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 2 a; Rewrite <- H10; Pattern 2 r; Rewrite H9; Apply H2].
+Qed.
+
+Lemma StepFun_P15 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple_opt f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
+Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P14 r H H0) | Assert H1 : ``b<=a``; [Auto with real | EApply StepFun_P14; [Apply H1 | Apply StepFun_P2; Apply H | Apply StepFun_P12; Apply H0]]].
+Qed.
+
+Lemma StepFun_P16 : (f:R->R;l,lf:Rlist;a,b:R) (adapted_couple f a b l lf) -> (EXT l':Rlist | (EXT lf':Rlist | (adapted_couple_opt f a b l' lf'))). 
+Intros; Case (total_order_Rle a b); Intro; [Apply (StepFun_P10 r H) | Assert H1 : ``b<=a``; [Auto with real | Assert H2 := (StepFun_P10 H1 (StepFun_P2 H)); Elim H2; Intros l' [lf' H3]; Exists l'; Exists lf'; Apply StepFun_P12; Assumption]].
+Qed.
+
+Lemma StepFun_P17 : (f:R->R;l1,l2,lf1,lf2:Rlist;a,b:R) (adapted_couple f a b l1 lf1) -> (adapted_couple f a b l2 lf2) -> (Int_SF lf1 l1)==(Int_SF lf2 l2).
+Intros; Elim (StepFun_P16 H); Intros l' [lf' H1]; Rewrite (StepFun_P15 H H1); Rewrite (StepFun_P15 H0 H1); Reflexivity.
+Qed.
+
+Lemma StepFun_P18 : (a,b,c:R) (RiemannInt_SF (mkStepFun (StepFun_P4 a b c)))==``c*(b-a)``.
+Intros; Unfold RiemannInt_SF; Case (total_order_Rle 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; Ring | Apply StepFun_P17 with (fct_cte c) a b; [Apply StepFun_P3; Assumption | Apply (StepFun_P1 (mkStepFun (StepFun_P4 a b c)))]].
+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 b (cons a nil))); [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)))]].
+Qed.
+
+Lemma StepFun_P19 : (l1:Rlist;f,g:R->R;l:R) (Int_SF (FF l1 [x:R]``(f x)+l*(g x)``) l1)==``(Int_SF (FF l1 f) l1)+l*(Int_SF (FF l1 g) l1)``.
+Intros; Induction l1; [Simpl; Ring | Induction l1; Simpl; [Ring | Simpl in Hrecl1; Rewrite Hrecl1; Ring]].
+Qed.
+
+Lemma StepFun_P20 : (l:Rlist;f:R->R) (lt O (Rlength l)) -> (Rlength l)=(S (Rlength (FF l f))).
+Intros l f H; NewInduction l; [Elim (lt_n_n ? H) | Simpl; Rewrite RList_P18; Rewrite RList_P14; Reflexivity].
+Qed.
+
+Lemma StepFun_P21 : (a,b:R;f:R->R;l:Rlist) (is_subdivision f a b l) -> (adapted_couple f a b l (FF l f)).
+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; Intros; Induction l.
+Discriminate.
+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 Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons r l) i)); Apply Rlt_compatibility; Elim H6; Intros; Apply Rlt_trans with x0; Assumption | DiscrR]].
+Rewrite RList_P14; Simpl in H3; Apply H3.
+Qed.
+
+Lemma StepFun_P22 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert Hyp_max : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Apply existTT 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; Repeat Split.
+Apply RList_P2; Assumption.
+Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
+Induction lf.
+Simpl; Right; Symmetry; Assumption.
+Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
+Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [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))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
+Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
+Induction lf.
+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 O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
+Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
+Rewrite Hyp_max; Apply Rle_antisym.
+Induction lf.
+Simpl; Right; Assumption.
+Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
+Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (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; Apply lt_n_Sn].
+Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _.
+Assert H11 := (H10 H8); Elim H11; Intro.
+Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | 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) (pred (Rlength (cons_ORlist (cons r lf) lg))))); 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 O; 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.
+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; 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; Apply lt_O_Sn.
+Intros; Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq f (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
+Intros; Elim H11; Clear H11; Intros; Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
+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; 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); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
+Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite (H11 ? H15); Reflexivity.
+Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
+Apply H8.
+Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
+Assert H11 : ``a<b``.
+Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
+Rewrite <- H6; Rewrite <- (RList_P15 lf lg).
+Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
+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; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8)].
+Assumption.
+Assumption.
+Rewrite H1; Assumption.
+Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+Elim H10; Intros; Apply Rlt_trans with x; Assumption.
+Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
+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; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
+Rewrite H0; Assumption.
+Pose I := [j:nat]``(pos_Rl lf j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lf)); Assert H12 : (Nbound I).
+Unfold Nbound; Exists (Rlength lf); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
+Assert H13 : (EX n:nat | (I n)).
+Exists O; Unfold I; Split.
+Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
+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; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8).
+Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H5; Rewrite <- H6 in H11; Rewrite <- H5 in H11; Elim (Rlt_antirefl ? H11).
+Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lf0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H9 x0); Assert H17 : (lt x0 (pred (Rlength lf))).
+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).
+Inversion H18.
+2:Apply lt_n_S; Assumption.
+Cut x0=(pred (Rlength lf)).
+Intro; Rewrite H19 in H14; Rewrite H5 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
+Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+Elim H10; Intros; Apply Rlt_trans with x; Assumption.
+Rewrite <- H5; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
+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; 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 O; 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).
+Reflexivity.
+Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
+Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
+Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
+Assert H22 : (lt (S x0) (Rlength lf)).
+Replace (Rlength lf) with (S (pred (Rlength lf))); [Apply lt_n_S; Assumption | Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21)].
+Elim (total_order_Rle (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
+Assert H23 : (le (S x0) x0).
+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.
+Clear b0; Apply RList_P17; Try Assumption.
+Apply RList_P2; Assumption.
+Elim (RList_P9 lf lg (pos_Rl lf (S x0))); Intros; Apply H25; Left; Elim (RList_P3 lf (pos_Rl lf (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22].
+Qed.
+
+Lemma StepFun_P23 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision f a b (cons_ORlist lf lg)).
+Intros; Case (total_order_Rle a b); Intro; [Apply StepFun_P22 with g; Assumption | Apply StepFun_P5; Apply StepFun_P22 with g; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
+Qed.
+
+Lemma StepFun_P24 : (a,b:R;f,g:R->R;lf,lg:Rlist) ``a<=b`` -> (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert Hyp_max : (Rmax a b)==b.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Apply existTT 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; Repeat Split.
+Apply RList_P2; Assumption.
+Rewrite Hyp_min; Symmetry; Apply Rle_antisym.
+Induction lf.
+Simpl; Right; Symmetry; Assumption.
+Assert H10 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (0)) (cons_ORlist (cons r lf) lg)).
+Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros _ H10; Apply H10; Exists O; Split; [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))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H6; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
+Elim (RList_P3 lg (pos_Rl (cons_ORlist (cons r lf) lg) (0))); Intros H11 _; Assert H14 := (H11 H8); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H1; Elim (RList_P6 lg); Intros; Apply H17; [Assumption | Apply le_O_n | Assumption].
+Induction lf.
+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 O; Split; [Symmetry; Assumption | Simpl; Apply lt_O_Sn].
+Apply RList_P5; [Apply RList_P2; Assumption | Assumption].
+Rewrite Hyp_max; Apply Rle_antisym.
+Induction lf.
+Simpl; Right; Assumption.
+Assert H8 : (In (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg)))) (cons_ORlist (cons r lf) lg)).
+Elim (RList_P3 (cons_ORlist (cons r lf) lg) (pos_Rl (cons_ORlist (cons r lf) lg) (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; Apply lt_n_Sn].
+Elim (RList_P9 (cons r lf) lg (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H10 _; Assert H11 := (H10 H8); Elim H11; Intro.
+Elim (RList_P3 (cons r lf) (pos_Rl (cons_ORlist (cons r lf) lg) (pred (Rlength (cons_ORlist (cons r lf) lg))))); Intros H13 _; Assert H14 := (H13 H12); Elim H14; Intros; Elim H15; Clear H15; Intros; Rewrite H15; Rewrite <- H5; Elim (RList_P6 (cons r lf)); Intros; Apply H17; [Assumption | 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) (pred (Rlength (cons_ORlist (cons r lf) lg))))); 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 O; 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.
+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; 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; Apply lt_O_Sn.
+Unfold constant_D_eq open_interval; Intros; Cut (EXT l:R | (constant_D_eq g (open_interval (pos_Rl (cons_ORlist lf lg) i) (pos_Rl (cons_ORlist lf lg) (S i))) l)).
+Intros; Elim H11; Clear H11; Intros;  Assert H12 := H11; Assert Hyp_cons : (EXT r:R | (EXT r0:Rlist | (cons_ORlist lf lg)==(cons r r0))).
+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; 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); Assert H15 : ``(pos_Rl (cons_ORlist lf lg) i)<((pos_Rl (cons_ORlist lf lg) i)+(pos_Rl (cons_ORlist lf lg) (S i)))/2<(pos_Rl (cons_ORlist lf lg) (S i))``.
+Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl (cons_ORlist lf lg) i)); Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite (H11 ? H15); Reflexivity.
+Elim H10; Intros; Rewrite H14 in H15; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H16 H15)).
+Apply H8.
+Rewrite RList_P14; Rewrite Hyp_cons in H8; Simpl in H8; Apply H8.
+Assert H11 : ``a<b``.
+Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i).
+Rewrite <- H6; Rewrite <- (RList_P15 lf lg); Try Assumption.
+Elim (RList_P6 (cons_ORlist lf lg)); Intros; Apply H11.
+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; 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)).
+Elim H10; Intros; Apply Rlt_trans with x; Assumption.
+Rewrite <- H5; Rewrite <- (RList_P16 lf lg); Try Assumption.
+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; Intro; Rewrite <- H13 in H8; Elim (lt_n_O ? H8).
+Rewrite H0; Assumption.
+Pose I := [j:nat]``(pos_Rl lg j)<=(pos_Rl (cons_ORlist lf lg) i)``/\(lt j (Rlength lg)); Assert H12 : (Nbound I).
+Unfold Nbound; Exists (Rlength lg); Intros; Unfold I in H12; Elim H12; Intros; Apply lt_le_weak; Assumption.
+Assert H13 : (EX n:nat | (I n)).
+Exists O; Unfold I; Split.
+Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) O).
+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; Intro; Rewrite <- H15 in H8; Elim (lt_n_O ? H8)]].
+Apply neq_O_lt; Red; Intro; Rewrite <- H13 in H0; Rewrite <- H1 in H11; Rewrite <- H0 in H11; Elim (Rlt_antirefl ? H11).
+Assert H14 := (Nzorn H13 H12); Elim H14; Clear H14; Intros x0 H14; Exists (pos_Rl lg0 x0); Unfold constant_D_eq open_interval; Intros; Assert H16 := (H4 x0); Assert H17 : (lt x0 (pred (Rlength lg))).
+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).
+Inversion H18.
+2:Apply lt_n_S; Assumption.
+Cut x0=(pred (Rlength lg)).
+Intro; Rewrite H19 in H14; Rewrite H0 in H14; Cut ``(pos_Rl (cons_ORlist lf lg) i)<b``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H14 H21)).
+Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)).
+Elim H10; Intros; Apply Rlt_trans with x; Assumption.
+Rewrite <- H0; Apply Rle_trans with (pos_Rl (cons_ORlist lf lg) (pred (Rlength (cons_ORlist lf lg)))).
+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; 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 O; 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).
+Reflexivity.
+Elim H15; Clear H15; Intros; Elim H14; Clear H14; Intros; Unfold I in H14; Elim H14; Clear H14; Intros; Split.
+Apply Rle_lt_trans with (pos_Rl (cons_ORlist lf lg) i); Assumption.
+Apply Rlt_le_trans with (pos_Rl (cons_ORlist lf lg) (S i)); Try Assumption.
+Assert H22 : (lt (S x0) (Rlength lg)).
+Replace (Rlength lg) with (S (pred (Rlength lg))).
+Apply lt_n_S; Assumption.
+Symmetry; Apply S_pred with O; Apply neq_O_lt; Red; Intro; Rewrite <- H22 in H21; Elim (lt_n_O ? H21).
+Elim (total_order_Rle (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); Intro.
+Assert H23 : (le (S x0) x0); [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; [Apply RList_P2; Assumption | Elim (RList_P9 lf lg (pos_Rl lg (S x0))); Intros; Apply H25; Right; Elim (RList_P3 lg (pos_Rl lg (S x0))); Intros; Apply H27; Exists (S x0); Split; [Reflexivity | Apply H22]].
+Qed.
+
+Lemma StepFun_P25 : (a,b:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision g a b (cons_ORlist lf lg)).
+Intros a b f g lf lg H H0; Case (total_order_Rle a b); Intro; [Apply StepFun_P24 with f; Assumption | Apply StepFun_P5; Apply StepFun_P24 with f; [Auto with real | Apply StepFun_P5; Assumption | Apply StepFun_P5; Assumption]].
+Qed.
+
+Lemma StepFun_P26 : (a,b,l:R;f,g:R->R;l1:Rlist) (is_subdivision f a b l1) -> (is_subdivision g a b l1) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b l1).
+Intros a b l f g l1; Unfold is_subdivision; Intros; Elim X; Elim X0; Intros; Clear X X0; Unfold adapted_couple in p p0; Decompose [and] p; Decompose [and] p0; Clear p p0; Apply existTT with (FF l1 [x:R]``(f x)+l*(g x)``); Unfold adapted_couple; Repeat Split; Try Assumption.
+Apply StepFun_P20; Apply neq_O_lt; Red; Intro; Rewrite <- H8 in H7; Discriminate.
+Intros; Unfold constant_D_eq open_interval; Unfold constant_D_eq open_interval in H9 H4; Intros; Rewrite (H9 ? H8 ? H10); Rewrite (H4 ? H8 ? H10); Assert H11 : ~l1==nil.
+Red; Intro; Rewrite H11 in H8; Elim (lt_n_O ? H8).
+Assert H12 := (RList_P19 ? H11); Elim H12; Clear H12; Intros r [r0 H12]; Rewrite H12; Unfold FF; Change ``(pos_Rl x0 i)+l*(pos_Rl x i)`` == (pos_Rl (app_Rlist (mid_Rlist (cons r r0) r) [x2:R]``(f x2)+l*(g x2)``) (S i)); Rewrite RList_P12.
+Rewrite RList_P13.
+Rewrite <- H12; Rewrite (H9 ? H8); Try Rewrite (H4 ? H8); Reflexivity Orelse (Elim H10; Clear H10; Intros; Split; [Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]] | Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Rewrite (Rplus_sym (pos_Rl l1 i)); Apply Rlt_compatibility; Apply Rlt_trans with x1; Assumption | DiscrR]]]).
+Rewrite <- H12; Assumption.
+Rewrite RList_P14; Simpl; Rewrite H12 in H8; Simpl in H8; Apply lt_n_S; Apply H8.
+Qed.
+
+Lemma StepFun_P27 : (a,b,l:R;f,g:R->R;lf,lg:Rlist) (is_subdivision f a b lf) -> (is_subdivision g a b lg) -> (is_subdivision [x:R]``(f x)+l*(g x)`` a b (cons_ORlist lf lg)).
+Intros a b l f g lf lg H H0; Apply StepFun_P26; [Apply StepFun_P23 with g; Assumption | Apply StepFun_P25 with f; Assumption].
+Qed.
+
+(* The set of step functions on [a,b] is a vectorial space *)
+Lemma StepFun_P28 : (a,b,l:R;f,g:(StepFun a b)) (IsStepFun [x:R]``(f x)+l*(g x)`` a b).
+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 Specif.existT with (cons_ORlist x0 x); Apply StepFun_P27; Assumption.
+Qed.
+
+Lemma StepFun_P29 : (a,b:R;f:(StepFun a b)) (is_subdivision f a b (subdivision f)).
+Intros a b f; Unfold is_subdivision; Apply existTT with (subdivision_val f); Apply StepFun_P1.
+Qed.
+
+Lemma StepFun_P30 : (a,b,l:R;f,g:(StepFun a b)) ``(RiemannInt_SF (mkStepFun (StepFun_P28 l f g)))==(RiemannInt_SF f)+l*(RiemannInt_SF g)``.
+Intros a b l f g; Unfold RiemannInt_SF; Case (total_order_Rle a b); (Intro; Replace ``(Int_SF (subdivision_val (mkStepFun (StepFun_P28 l f g))) (subdivision (mkStepFun (StepFun_P28 l f g))))`` with (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) [x:R]``(f x)+l*(g x)``) (cons_ORlist (subdivision f) (subdivision g))); [Rewrite StepFun_P19; Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val f) (subdivision f)); [Replace (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) g) (cons_ORlist (subdivision f) (subdivision g))) with (Int_SF (subdivision_val g) (subdivision g)); [Ring | Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P25 with (fe f); Apply StepFun_P29]] | Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P1 | Apply StepFun_P21; Apply StepFun_P23 with (fe g); Apply StepFun_P29]] | Apply StepFun_P17 with [x:R]``(f x)+l*(g x)`` a b; [Apply StepFun_P21; Apply StepFun_P27; Apply StepFun_P29 | Apply (StepFun_P1 (mkStepFun (StepFun_P28 l f g)))]]).
+Qed.
+
+Lemma StepFun_P31 : (a,b:R;f:R->R;l,lf:Rlist) (adapted_couple f a b l lf) -> (adapted_couple [x:R](Rabsolu (f x)) a b l (app_Rlist lf Rabsolu)).
+Unfold adapted_couple; Intros; Decompose [and] H; Clear H; Repeat Split; Try Assumption.
+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].
+Qed.
+
+Lemma StepFun_P32 : (a,b:R;f:(StepFun a b)) (IsStepFun [x:R](Rabsolu (f x)) a b).
+Intros a b f; Unfold IsStepFun; Apply Specif.existT with (subdivision f); Unfold is_subdivision; Apply existTT with (app_Rlist (subdivision_val f) Rabsolu); Apply StepFun_P31; Apply StepFun_P1.
+Qed.
+
+Lemma StepFun_P33 : (l2,l1:Rlist) (ordered_Rlist l1) -> ``(Rabsolu (Int_SF l2 l1))<=(Int_SF (app_Rlist l2 Rabsolu) l1)``.
+Induction l2; Intros.
+Simpl; Rewrite Rabsolu_R0; Right; Reflexivity.
+Simpl; Induction l1.
+Rewrite Rabsolu_R0; Right; Reflexivity.
+Induction l1.
+Rewrite Rabsolu_R0; Right; Reflexivity.
+Apply Rle_trans with ``(Rabsolu (r*(r2-r1)))+(Rabsolu (Int_SF r0 (cons r2 l1)))``.
+Apply Rabsolu_triang.
+Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``r2-r1``); [Apply Rle_compatibility; Apply H; Apply RList_P4 with r1; Assumption | Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn].
+Qed.
+
+Lemma StepFun_P34 : (a,b:R;f:(StepFun a b)) ``a<=b`` -> ``(Rabsolu (RiemannInt_SF f))<=(RiemannInt_SF (mkStepFun (StepFun_P32 f)))``.
+Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
+Replace (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f))) (subdivision (mkStepFun (StepFun_P32 f)))) with (Int_SF (app_Rlist (subdivision_val f) Rabsolu) (subdivision f)).
+Apply StepFun_P33; Assert H0 := (StepFun_P29 f); Unfold is_subdivision in H0; Elim H0; Intros; Unfold adapted_couple in p; Decompose [and] p; Assumption.
+Apply StepFun_P17 with [x:R](Rabsolu (f x)) a b; [Apply StepFun_P31; Apply StepFun_P1 | Apply (StepFun_P1 (mkStepFun (StepFun_P32 f)))].
+Elim n; Assumption.
+Qed.
+
+Lemma StepFun_P35 : (l:Rlist;a,b:R;f,g:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(Int_SF (FF l f) l)<=(Int_SF (FF l g) l)``.
+Induction l; Intros.
+Right; Reflexivity.
+Simpl; Induction r0.
+Right; Reflexivity.
+Simpl; Apply Rplus_le.
+Case (Req_EM r r0); Intro.
+Rewrite H4; Right; Ring.
+Do 2 Rewrite <- (Rmult_sym ``r0-r``); Apply Rle_monotony.
+Apply Rle_sym2; Apply Rge_minus; Apply Rle_sym1; Apply (H0 O); Simpl; Apply lt_O_Sn.
+Apply H3; Split.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Assert H5 : r==a.
+Apply H1.
+Rewrite H5; Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility.
+Assert H6 := (H0 O (lt_O_Sn ?)).
+Simpl in H6.
+Elim H6; Intro.
+Rewrite H5 in H7; Apply H7.
+Elim H4; Assumption.
+DiscrR.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite double; Assert H5 : ``r0<=b``.
+Replace b with (pos_Rl (cons r (cons r0 r1)) (pred (Rlength (cons r (cons r0 r1))))).
+Replace r0 with (pos_Rl (cons r (cons r0 r1)) (S O)).
+Elim (RList_P6 (cons r (cons r0 r1))); Intros; Apply H5.
+Assumption.
+Simpl; Apply le_n_S.
+Apply le_O_n.
+Simpl; Apply lt_n_Sn.
+Reflexivity.
+Apply Rle_lt_trans with ``r+b``.
+Apply Rle_compatibility; Assumption.
+Rewrite (Rplus_sym r); Apply Rlt_compatibility.
+Apply Rlt_le_trans with r0.
+Assert H6 := (H0 O (lt_O_Sn ?)).
+Simpl in H6.
+Elim H6; Intro.
+Apply H7.
+Elim H4; Assumption.
+Assumption.
+DiscrR.
+Simpl in H; Apply H with r0 b.
+Apply RList_P4 with r; Assumption.
+Reflexivity.
+Rewrite <- H2; Reflexivity.
+Intros; Apply H3; Elim H4; Intros; Split; Try Assumption.
+Apply Rle_lt_trans with r0; Try Assumption.
+Rewrite <- H1.
+Simpl; Apply (H0 O); Simpl; Apply lt_O_Sn.
+Qed.
+
+Lemma StepFun_P36 : (a,b:R;f,g:(StepFun a b);l:Rlist) ``a<=b`` -> (is_subdivision f a b l) -> (is_subdivision g a b l) -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
+Intros; Unfold RiemannInt_SF; Case (total_order_Rle 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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Assert H7 : (Rmax a b)==b; [Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption] | Rewrite H5 in H3; Rewrite H7 in H2; EApply StepFun_P35 with a b; Assumption]].
+Apply StepFun_P17 with (fe g) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
+Apply StepFun_P17 with (fe f) a b; [Apply StepFun_P21; Assumption | Apply StepFun_P1].
+Elim n; Assumption.
+Qed.
+
+Lemma StepFun_P37 : (a,b:R;f,g:(StepFun a b)) ``a<=b`` -> ((x:R)``a<x<b``->``(f x)<=(g x)``) -> ``(RiemannInt_SF f) <= (RiemannInt_SF g)``.
+Intros; EApply StepFun_P36; Try Assumption.
+EApply StepFun_P25; Apply StepFun_P29.
+EApply StepFun_P23; Apply StepFun_P29.
+Qed.
+
+Lemma StepFun_P38 : (l:Rlist;a,b:R;f:R->R) (ordered_Rlist l) -> (pos_Rl l O)==a -> (pos_Rl l (pred (Rlength l)))==b -> (sigTT ? [g:(StepFun a b)](g b)==(f b)/\(i:nat)(lt i (pred (Rlength l)))->(constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i))) (f (pos_Rl l i)))).
+Intros l a b f; Generalize a; Clear a; NewInduction l. 
+Intros a H H0 H1; Simpl in H0; Simpl in H1; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
+Reflexivity.
+Intros; Elim (lt_n_O ? H2).
+Intros; NewDestruct l as [|r1 l].
+Simpl in H1; Simpl in H0; Exists (mkStepFun (StepFun_P4 a b (f b))); Split.
+Reflexivity.
+Intros i H2; Elim (lt_n_O ? H2).
+Intros; Assert H2 : (ordered_Rlist (cons r1 l)).
+Apply RList_P4 with r; Assumption.
+Assert H3 : (pos_Rl (cons r1 l) O)==r1.
+Reflexivity.
+Assert H4 : (pos_Rl (cons r1 l) (pred (Rlength (cons r1 l))))==b.
+Rewrite <- H1; Reflexivity.
+Elim (IHl r1 H2 H3 H4); Intros g [H5 H6].
+Pose g' := [x:R]Cases (total_order_Rle r1 x) of
+                      | (leftT _) => (g x)
+                      | (rightT _) => (f a) end.
+Assert H7 : ``r1<=b``.
+Rewrite <- H4; Apply RList_P7; [Assumption | Left; Reflexivity].
+Assert H8 : (IsStepFun g' a b).
+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; Split with (cons (f a) lg2); Unfold adapted_couple in H9; Decompose [and] H9; Clear H9; Unfold adapted_couple; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H9; Induction i.
+Simpl; Rewrite H12; Replace (Rmin r1 b) with r1.
+Simpl in H0; Rewrite <- H0; Apply (H O); Simpl; Apply lt_O_Sn.
+Unfold Rmin; Case (total_order_Rle 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 O; Apply neq_O_lt; Intro; Rewrite <- H14 in H9; Elim (lt_n_O ? H9).
+Simpl; Assert H14 : ``a<=b``.
+Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
+Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Assert H14 : ``a<=b``.
+Rewrite <- H1; Simpl in H0; Rewrite <- H0; Apply RList_P7; [Assumption | Left; Reflexivity].
+Replace (Rmax a b) with (Rmax r1 b).
+Rewrite <- H11; Induction lg.
+Simpl in H13; Discriminate.
+Reflexivity.
+Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle r1 b); Intros; Reflexivity Orelse Elim n; Assumption.
+Simpl; Rewrite H13; Reflexivity.
+Intros; Simpl in H9; Induction i.
+Unfold constant_D_eq open_interval; Simpl; Intros; Assert H16 : (Rmin r1 b)==r1.
+Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n; Assumption].
+Rewrite H16 in H12; Rewrite H12 in H14; Elim H14; Clear H14; Intros _ H14; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
+Elim (Rlt_antirefl ? (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)); Clear Hreci; Assert H16 := (H15 i); Assert H17 : (lt i (pred (Rlength lg))).
+Apply lt_S_n.
+Replace (S (pred (Rlength lg))) with (Rlength lg).
+Assumption.
+Apply S_pred with O; 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; Intros; Assert H19 := (H18 ? H14); Rewrite <- H19; Unfold g'; Case (total_order_Rle r1 x); Intro.
+Reflexivity.
+Elim n; Replace r1 with (Rmin r1 b).
+Rewrite <- H12; Elim H14; Clear H14; Intros H14 _; Left; Apply Rle_lt_trans with (pos_Rl lg i); Try Assumption.
+Apply RList_P5.
+Assumption.
+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; Intro; Rewrite <- H22 in H17; Elim (lt_n_O ? H17).
+Unfold Rmin; Case (total_order_Rle r1 b); Intro; [Reflexivity | Elim n0; Assumption].
+Exists (mkStepFun H8); Split.
+Simpl; Unfold g'; Case (total_order_Rle r1 b); Intro.
+Assumption.
+Elim n; Assumption.
+Intros; Simpl in H9; Induction i.
+Unfold constant_D_eq co_interval; Simpl; Intros; Simpl in H0; Rewrite H0; Elim H10; Clear H10; Intros; Unfold g'; Case (total_order_Rle r1 x); Intro r3.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r3 H11)).
+Reflexivity.
+Clear Hreci; 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))); Assert H10 := (H6 i); Assert H11 : (lt i (pred (Rlength (cons r1 l)))).
+Simpl; Apply lt_S_n; Assumption.
+Assert H12 := (H10 H11); Unfold constant_D_eq co_interval in H12; Unfold constant_D_eq co_interval; Intros; Rewrite <- (H12 ? H13); Simpl; Unfold g'; Case (total_order_Rle 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) O)<=(pos_Rl (cons r1 l) i)``; Elim (RList_P6 (cons r1 l)); Intros; Apply H15; [Assumption | Apply le_O_n | Simpl; Apply lt_trans with (Rlength l); [Apply lt_S_n; Assumption | Apply lt_n_Sn]].
+Qed.
+
+Lemma StepFun_P39 : (a,b:R;f:(StepFun a b)) (RiemannInt_SF f)==(Ropp (RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))))).
+Intros; Unfold RiemannInt_SF; Case (total_order_Rle a b); Case (total_order_Rle b a); Intros.
+Assert H : (adapted_couple f a b (subdivision f) (subdivision_val f)); [Apply StepFun_P1 | Assert H0 : (adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a (subdivision (mkStepFun (StepFun_P6 (pre f)))) (subdivision_val (mkStepFun (StepFun_P6 (pre f))))); [Apply StepFun_P1 | Assert H1 : a==b; [Apply Rle_antisym; Assumption | Rewrite (StepFun_P8 H H1); Assert H2 : b==a; [Symmetry; Apply H1 | Rewrite (StepFun_P8 H0 H2); Ring]]]].
+Rewrite Ropp_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Pose H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
+Apply eq_Ropp; EApply StepFun_P17; [Apply StepFun_P1 | Apply StepFun_P2; Pose H := (StepFun_P6 (pre f)); Unfold IsStepFun in H; Elim H; Intros; Unfold is_subdivision; Elim p; Intros; Apply p0].
+Assert H : ``a<b``; [Auto with real | Assert H0 : ``b<a``; [Auto with real | Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H0))]].
+Qed.
+
+Lemma StepFun_P40 : (f:R->R;a,b,c:R;l1,l2,lf1,lf2:Rlist) ``a<b`` -> ``b<c`` -> (adapted_couple f a b l1 lf1) -> (adapted_couple f b c l2 lf2) -> (adapted_couple f a c (cons_Rlist l1 l2) (FF (cons_Rlist l1 l2) f)).
+Intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; Unfold adapted_couple in H1 H2; 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; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; (Right; Reflexivity) Orelse (Elim n; Left; Assumption).
+Rewrite RList_P22.
+Rewrite H5; Unfold Rmin Rmax; Case (total_order_Rle a b); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
+Red; Intro; Rewrite H1 in H6; Discriminate.
+Rewrite RList_P24.
+Rewrite H9; Unfold Rmin Rmax; Case (total_order_Rle b c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Apply Rle_trans with b; Left; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
+Red; Intro; Rewrite H1 in H11; Discriminate.
+Apply StepFun_P20.
+Rewrite RList_P23; Apply neq_O_lt; Red; Intro.
+Assert H2 : (plus (Rlength l1) (Rlength l2))=O.
+Symmetry; Apply H1.
+Elim (plus_is_O ? ? H2); Intros; Rewrite H12 in H6; Discriminate.
+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; Apply le_trans with (Rlength l1); [Assumption | Apply le_n_Sn].
+Assert H15 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l1 (S i)).
+Apply RList_P26; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
+Rewrite H14 in H2; Rewrite H15 in H2; Assert H16 : (le (2) (Rlength l1)).
+Apply le_trans with (S (S i)); [Repeat Apply le_n_S; Apply le_O_n | Assumption].
+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); Rewrite RList_P12.
+Induction i.
+Simpl; Assert H18 := (H8 O); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt O (pred (Rlength l1))).
+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 O).
+Simpl; Apply lt_O_Sn.
+Elim H21; Intro.
+Split.
+Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite H17; Simpl; Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym r1); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Elim H2; Intros; Rewrite H17 in H23; Rewrite H17 in H24; Simpl in H24; Simpl in H23; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
+Assumption.
+Clear Hreci; Rewrite RList_P13.
+Rewrite H17 in H14; Rewrite H17 in H15; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)== (pos_Rl (cons r1 (cons r2 r3)) (S i)) in H14; Rewrite H14; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))==(pos_Rl (cons r1 (cons r2 r3)) (S (S i))) in H15; Rewrite H15; Assert H18 := (H8 (S i)); Unfold constant_D_eq open_interval in H18; Assert H19 : (lt (S i) (pred (Rlength l1))).
+Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
+Assert H20 := (H18 H19); Repeat Rewrite H20.
+Reflexivity.
+Rewrite <- H17; Assert H21 : ``(pos_Rl l1 (S i))<=(pos_Rl l1 (S (S i)))``.
+Apply (H3 (S i)); Apply lt_pred; Apply lt_S_n; Apply le_lt_n_Sm; Assumption.
+Elim H21; Intro.
+Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l1 (S i))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Elim H2; Intros; Rewrite H22 in H23; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H23 H24)).
+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; Case (total_order_Rle b c); Intro; [Reflexivity | Elim n; Left; Assumption].
+Rewrite H15; Apply le_n.
+Induction l1.
+Simpl in H15; Discriminate.
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Left; Assumption] | Rewrite H15; Reflexivity].
+Rewrite H15; Apply lt_n_Sn.
+Rewrite H16 in H2; Rewrite H17 in H2; Elim H2; Intros; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H14 H18)).
+Assert H16 : (pos_Rl (cons_Rlist l1 l2) i) == (pos_Rl l2 (minus i (Rlength l1))).
+Apply RList_P29.
+Apply le_S_n; Assumption.
+Apply lt_le_trans with (pred (Rlength (cons_Rlist l1 l2))); [Assumption | Apply le_pred_n].
+Assert H17 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (S (minus i (Rlength l1)))).
+Replace (S (minus i (Rlength l1))) with (minus (S i) (Rlength l1)).
+Apply RList_P29.
+Apply le_S_n; Apply le_trans with (S i); [Assumption | Apply le_n_Sn].
+Induction l1.
+Simpl in H6; Discriminate.
+Clear Hrecl1; Simpl in H1; Simpl; Apply lt_n_S; Assumption.
+Symmetry; Apply minus_Sn_m; Apply le_S_n; Assumption.
+Assert H18 : (le (2) (Rlength l1)).
+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.
+Discriminate.
+Clear Hrecl1; Induction l1.
+Simpl in H5; Simpl in H4; Assert H0 : ``(Rmin a b)<(Rmax a b)``.
+Unfold Rmin Rmax; Case (total_order_Rle a b); Intro; [Assumption | Elim n; Left; Assumption].
+Rewrite <- H5 in H0; Rewrite <- H4 in H0; Elim (Rlt_antirefl ? H0).
+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); Rewrite RList_P12.
+Induction i.
+Assert H20 := (le_S_n ? ? H15); Assert H21 := (le_trans ? ? ? H18 H20); Elim (le_Sn_O ? H21).
+Clear Hreci; Rewrite RList_P13.
+Rewrite H19 in H16; Rewrite H19 in H17; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) i)==  (pos_Rl l2 (minus (S i) (Rlength (cons r1 (cons r2 r3))))) in H16; Rewrite H16; Change (pos_Rl (cons_Rlist (cons r2 r3) l2) (S i))== (pos_Rl l2 (S (minus (S i) (Rlength (cons r1 (cons r2 r3)))))) in H17; Rewrite H17; Assert H20 := (H13 (minus (S i) (Rlength l1))); Unfold constant_D_eq open_interval in H20; Assert H21 : (lt (minus (S i) (Rlength l1)) (pred (Rlength l2))).
+Apply lt_pred; Rewrite minus_Sn_m.
+Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
+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.
+Assert H22 := (H20 H21); Repeat Rewrite H22.
+Reflexivity.
+Rewrite <- H19; Assert H23 : ``(pos_Rl l2 (minus (S i) (Rlength l1)))<=(pos_Rl l2 (S (minus (S i) (Rlength l1))))``.
+Apply H7; Apply lt_pred.
+Rewrite minus_Sn_m.
+Apply simpl_lt_plus_l with (Rlength l1); Rewrite <- le_plus_minus.
+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.
+Elim H23; Intro.
+Split.
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Apply Rlt_monotony_contra with ``2``; [Sup0 | Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym; [Rewrite Rmult_1l; Rewrite (Rplus_sym (pos_Rl l2 (minus (S i) (Rlength l1)))); Rewrite double; Apply Rlt_compatibility; Assumption | DiscrR]].
+Rewrite <- H19 in H16; Rewrite <- H19 in H17; Elim H2; Intros; Rewrite H19 in H25; Rewrite H19 in H26; Simpl in H25; Simpl in H16; Rewrite H16 in H25; Simpl in H26; Simpl in H17; Rewrite H17 in H26; Simpl in H24; Rewrite H24 in H25; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H25 H26)).
+Assert H23 : (pos_Rl (cons_Rlist l1 l2) (S i))==(pos_Rl l2 (minus (S i) (Rlength l1))).
+Rewrite H19; Simpl; Simpl in H16; Apply H16.
+Assert H24 : (pos_Rl (cons_Rlist l1 l2) (S (S i)))==(pos_Rl l2 (S (minus (S i) (Rlength l1)))).
+Rewrite H19; Simpl; Simpl in H17; Apply H17.
+Rewrite <- H23; Rewrite <- H24; Assumption.
+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 : (f:R->R;a,b,c:R) ``a<=b``->``b<=c``->(IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
+Unfold IsStepFun; Unfold is_subdivision; Intros; Elim X; Clear X; Intros l1 [lf1 H1]; Elim X0; Clear X0; Intros l2 [lf2 H2]; Case (total_order_T a b); Intro.
+Elim s; Intro.
+Case (total_order_T b c); Intro.
+Elim s0; Intro.
+Split with (cons_Rlist l1 l2); Split with (FF (cons_Rlist l1 l2) f); Apply StepFun_P40 with b lf1 lf2; Assumption.
+Split with l1; Split with lf1; Rewrite b0 in H1; Assumption.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H0 r)).
+Split with l2; Split with lf2; Rewrite <- b0 in H2; Assumption.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Qed.
+
+Lemma StepFun_P42 : (l1,l2:Rlist;f:R->R) (pos_Rl l1 (pred (Rlength l1)))==(pos_Rl l2 O) -> ``(Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2)) == (Int_SF (FF l1 f) l1) + (Int_SF (FF l2 f) l2)``.
+Intros l1 l2 f; NewInduction l1 as [|r l1 IHl1]; Intros H; [ Simpl; Ring | NewDestruct l1; [Simpl in H; Simpl; NewDestruct l2; [Simpl; Ring | Simpl; Simpl in H; Rewrite H; Ring] | Simpl; Rewrite Rplus_assoc; Apply Rplus_plus_r; Apply IHl1; Rewrite <- H; Reflexivity]].
+Qed.
+
+Lemma StepFun_P43 : (f:R->R;a,b,c:R;pr1:(IsStepFun f a b);pr2:(IsStepFun f b c);pr3:(IsStepFun f a c)) ``(RiemannInt_SF (mkStepFun pr1))+(RiemannInt_SF (mkStepFun pr2))==(RiemannInt_SF (mkStepFun pr3))``.
+Intros f; Intros; Assert H1 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a b l l0))).
+Apply pr1.
+Assert H2 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f b c l l0))).
+Apply pr2.
+Assert H3 : (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
+Apply pr3.
+Elim H1; Clear H1; Intros l1 [lf1 H1]; Elim H2; Clear H2; Intros l2 [lf2 H2]; Elim H3; Clear H3; Intros l3 [lf3 H3].
+Replace (RiemannInt_SF (mkStepFun pr1)) with (Cases (total_order_Rle a b) of (leftT _) => (Int_SF lf1 l1) | (rightT _) => ``-(Int_SF lf1 l1)`` end).
+Replace (RiemannInt_SF (mkStepFun pr2)) with (Cases (total_order_Rle b c) of (leftT _) => (Int_SF lf2 l2) | (rightT _) => ``-(Int_SF lf2 l2)`` end).
+Replace (RiemannInt_SF (mkStepFun pr3)) with (Cases (total_order_Rle a c) of (leftT _) => (Int_SF lf3 l3) | (rightT _) => ``-(Int_SF lf3 l3)`` end).
+Case (total_order_Rle a b); Case (total_order_Rle b c); Case (total_order_Rle a c); Intros.
+Elim r1; Intro.
+Elim r0; Intro.
+Replace (Int_SF lf3 l3) with (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; 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; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; Reflexivity Orelse Elim n; Assumption.
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2; Assumption | Assumption].
+EApply StepFun_P17; [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 R0.
+Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H3; Apply H3].
+Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
+Replace (Int_SF lf1 l1) with R0.
+Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H2 | Rewrite H in H3; Apply H3].
+Symmetry; EApply StepFun_P8; [Apply H1 | Assumption].
+Elim n; Apply Rle_trans with b; Assumption.
+Apply r_Rplus_plus with (Int_SF lf2 l2); Replace ``(Int_SF lf2 l2)+((Int_SF lf1 l1)+ -(Int_SF lf2 l2))`` with (Int_SF lf1 l1); [Idtac | Ring].
+Assert H : ``c<b``.
+Auto with real.
+Elim r; Intro.
+Rewrite Rplus_sym; Replace (Int_SF lf1 l1) with (Int_SF (FF (cons_Rlist l3 l2) f) (cons_Rlist l3 l2)).
+Replace (Int_SF lf3 l3) with (Int_SF (FF l3 f) l3).
+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; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
+EApply StepFun_P17; [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 R0.
+Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Apply StepFun_P2; Rewrite <- H0 in H2; Apply H2].
+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.
+Replace (Int_SF lf2 l2) with (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; 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; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
+EApply StepFun_P17.
+Assert H0 : ``c<a``.
+Auto with real.
+Apply (StepFun_P40 H0 H (StepFun_P2 H3) H1).
+Apply StepFun_P2; Apply H2.
+Replace (Int_SF lf1 l1) with R0.
+Rewrite Rplus_Or; EApply StepFun_P17; [Apply H3 | Rewrite <- H in H2; Apply H2].
+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)``.
+Ring.
+Rewrite Rplus_sym; Elim r; Intro.
+Replace (Int_SF lf2 l2) with (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; 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; Case (total_order_Rle a c); Case (total_order_Rle a b); Intros; [Elim n; Assumption | Reflexivity | Elim n0; Assumption | Elim n1; Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf1; Apply H1 | Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
+EApply StepFun_P17.
+Apply (StepFun_P40 H H0 (StepFun_P2 H1) H3).
+Apply H2.
+Replace (Int_SF lf3 l3) with R0.
+Rewrite Rplus_Or; EApply StepFun_P17; [Apply H1 | Rewrite <- H0 in H2; Apply StepFun_P2; Apply H2].
+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)``.
+Ring.
+Elim r; Intro.
+Replace (Int_SF lf1 l1) with (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; 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; Case (total_order_Rle a c); Case (total_order_Rle b c); Intros; [Elim n; Assumption | Elim n1; Assumption | Reflexivity | Elim n1; Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf3; Apply H3 | Assumption].
+EApply StepFun_P17.
+Apply (StepFun_P40 H0 H H2 (StepFun_P2 H3)).
+Apply StepFun_P2; Apply H1.
+Replace (Int_SF lf2 l2) with R0.
+Rewrite Rplus_Ol; EApply StepFun_P17; [Apply H3 | Rewrite H0 in H1; Apply H1].
+Symmetry; EApply StepFun_P8; [Apply H2 | Assumption].
+Elim n; Apply Rle_trans with a; Try Assumption.
+Auto with real.
+Assert H : ``c<b``.
+Auto with real.
+Assert H0 : ``b<a``.
+Auto with real.
+Replace (Int_SF lf3 l3) with ``(Int_SF lf2 l2)+(Int_SF lf1 l1)``.
+Ring.
+Replace (Int_SF lf3 l3) with (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; 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; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros; [Elim n1; Assumption | Elim n1; Assumption | Elim n0; Assumption | Reflexivity].
+EApply StepFun_P17; [Apply StepFun_P21; Unfold is_subdivision; Split with lf2; Apply H2 | Assumption].
+EApply StepFun_P17; [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; Case (total_order_Rle a c); Intro.
+EApply StepFun_P17.
+Apply H3.
+Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
+Apply eq_Ropp; EApply StepFun_P17.
+Apply H3.
+Change (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun 1!a 2!c 3!f pr3)) (subdivision_val (mkStepFun 1!a 2!c 3!f pr3))); Apply StepFun_P1.
+Unfold RiemannInt_SF; Case (total_order_Rle b c); Intro.
+EApply StepFun_P17.
+Apply H2.
+Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
+Apply eq_Ropp; EApply StepFun_P17.
+Apply H2.
+Change (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun 1!b 2!c 3!f pr2)) (subdivision_val (mkStepFun 1!b 2!c 3!f pr2))); Apply StepFun_P1.
+Unfold RiemannInt_SF; Case (total_order_Rle a b); Intro.
+EApply StepFun_P17.
+Apply H1.
+Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
+Apply eq_Ropp; EApply StepFun_P17.
+Apply H1.
+Change (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun 1!a 2!b 3!f pr1)) (subdivision_val (mkStepFun 1!a 2!b 3!f pr1))); Apply StepFun_P1.
+Qed.
+
+Lemma StepFun_P44 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f a c).
+Intros f; Intros; Assert H0 : ``a<=b``.
+Elim H; Intros; Apply Rle_trans with c; Assumption.
+Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f a c l l0))).
+Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X.
+Apply H2.
+Split; Assumption.
+Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
+Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
+Induction r0.
+Intros; Assert H1 : ``a==b``.
+Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
+Elim H0; Intros; Apply Rle_trans with c; Assumption.
+Replace a with (Rmin a b).
+Pattern 2 b; Replace b with (Rmax a b).
+Rewrite <- H2; Rewrite H3; Reflexivity.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmin; Case (total_order_Rle 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.
+Rewrite H2; Assumption.
+Intros; Clear X; Induction lf1.
+Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
+Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
+Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
+Elim H1; Intro.
+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; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; Assumption].
+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 (total_order_Rle a c); Intro; [Assumption | Elim n; Assumption].
+Simpl; Unfold Rmax; Case (total_order_Rle a c); Intro; [Reflexivity | Elim n; Assumption].
+Unfold constant_D_eq open_interval; Intros; Simpl in H8; Inversion H8.
+Simpl; Assert H10 := (H7 O); Assert H12 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
+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.
+Elim (le_Sn_O ? H11).
+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 (cons r l1'); Split with (cons r3 lf1'); Unfold adapted_couple in H H4; Decompose [and] H; Decompose [and] H4; Clear H H4 X0; Assert H14 : ``a<=b``.
+Elim H0; Intros; Apply Rle_trans with c; Assumption.
+Assert H16 : ``r==a``.
+Simpl in H7; Rewrite H7; Unfold Rmin; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Induction l1'.
+Simpl in H13; Discriminate.
+Clear Hrecl1'; Unfold adapted_couple; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
+Simpl; Replace r4 with r1.
+Apply (H5 O).
+Simpl; Apply lt_O_Sn.
+Simpl in H12; Rewrite H12; Unfold Rmin; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
+Apply (H9 i); Simpl; Apply lt_S_n; Assumption.
+Simpl; Unfold Rmin; Case (total_order_Rle a c); Intro; [Assumption | Elim n; Elim H0; Intros; Assumption].
+Replace (Rmax a c) with (Rmax r1 c).
+Rewrite <- H11; Reflexivity.
+Unfold Rmax; Case (total_order_Rle r1 c); Case (total_order_Rle a c); Intros; [Reflexivity | Elim n; Elim H0; Intros; Assumption | Elim n; Left; Assumption | Elim n0; Left; Assumption].
+Simpl; Simpl in H13; Rewrite H13; Reflexivity.
+Intros; Simpl in H; Unfold constant_D_eq open_interval; Intros; Induction i.
+Simpl; Assert H17 := (H10 O); Assert H18 : (lt (0) (pred (Rlength (cons r (cons r1 r2))))).
+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; Case (total_order_Rle r1 c); Intro; [Reflexivity | Elim n; Left; Assumption].
+Clear Hreci; Simpl; Apply H15.
+Simpl; Apply lt_S_n; Assumption.
+Unfold open_interval; Apply H4.
+Split.
+Left; Assumption.
+Elim H0; Intros; Assumption.
+EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
+Qed.
+
+Lemma StepFun_P45 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> ``a<=c<=b`` -> (IsStepFun f c b).
+Intros f; Intros; Assert H0 : ``a<=b``.
+Elim H; Intros; Apply Rle_trans with c; Assumption.
+Elim H; Clear H; Intros; Unfold IsStepFun in X; Unfold is_subdivision in X; Elim X; Clear X; Intros l1 [lf1 H2]; Cut (l1,lf1:Rlist;a,b,c:R;f:R->R) (adapted_couple f a b l1 lf1) -> ``a<=c<=b`` -> (SigT ? [l:Rlist](sigTT ? [l0:Rlist](adapted_couple f c b l l0))).
+Intros; Unfold IsStepFun; Unfold is_subdivision; EApply X; [Apply H2 | Split; Assumption].
+Clear f a b c H0 H H1 H2 l1 lf1; Induction l1.
+Intros; Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
+Induction r0.
+Intros; Assert H1 : ``a==b``.
+Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H3; Simpl in H2; Assert H7 : ``a<=b``.
+Elim H0; Intros; Apply Rle_trans with c; Assumption.
+Replace a with (Rmin a b).
+Pattern 2 b; Replace b with (Rmax a b).
+Rewrite <- H2; Rewrite H3; Reflexivity.
+Unfold Rmax; Case (total_order_Rle a b); Intro; [Reflexivity | Elim n; Assumption].
+Unfold Rmin; Case (total_order_Rle 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.
+Rewrite <- H2 in H1; Rewrite <- H1; Assumption.
+Intros; Clear X; Induction lf1.
+Unfold adapted_couple in H; Decompose [and] H; Clear H; Simpl in H4; Discriminate.
+Clear Hreclf1; Assert H1 : (sumboolT ``c<=r1`` ``r1<c``).
+Case (total_order_Rle c r1); Intro; [Left; Assumption | Right; Auto with real].
+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; Repeat Split.
+Unfold ordered_Rlist; Intros; Simpl in H; Induction i.
+Simpl; Assumption.
+Clear Hreci; Apply (H2 (S i)); Simpl; Assumption.
+Simpl; Unfold Rmin; Case (total_order_Rle c b); Intro; [Reflexivity | Elim n; Elim H0; Intros; Assumption].
+Replace (Rmax c b) with (Rmax a b).
+Rewrite <- H3; Reflexivity.
+Unfold Rmax; Case (total_order_Rle a b); Case (total_order_Rle 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; Simpl in H5; Apply H5.
+Intros; Simpl in H; Induction i.
+Unfold constant_D_eq open_interval; Intros; Simpl; Apply (H7 O).
+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; Case (total_order_Rle a b); Intros; [Reflexivity | Elim n; Elim H0; Intros; Apply Rle_trans with c; 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'; Split with lf1'; Assumption.
+Split; [Left; Assumption | Elim H0; Intros; Assumption].
+EApply StepFun_P7; [Elim H0; Intros; Apply Rle_trans with c; [Apply H2 | Apply H3] | Apply H].
+Qed.
+
+Lemma StepFun_P46 : (f:R->R;a,b,c:R) (IsStepFun f a b) -> (IsStepFun f b c) -> (IsStepFun f a c).
+Intros f; Intros; Case (total_order_Rle a b); Case (total_order_Rle b c); Intros.
+Apply StepFun_P41 with b; Assumption.
+Case (total_order_Rle a c); Intro.
+Apply StepFun_P44 with b; Try Assumption.
+Split; [Assumption | Auto with real].
+Apply StepFun_P6; Apply StepFun_P44 with b.
+Apply StepFun_P6; Assumption.
+Split; Auto with real.
+Case (total_order_Rle a c); Intro.
+Apply StepFun_P45 with b; Try Assumption.
+Split; Auto with real.
+Apply StepFun_P6; Apply StepFun_P45 with b.
+Apply StepFun_P6; Assumption.
+Split; [Assumption | Auto with real].
+Apply StepFun_P6; Apply StepFun_P41 with b; Auto with real Orelse Apply StepFun_P6; Assumption.
+Qed.
diff --git a/theories7/Reals/Rlimit.v b/theories7/Reals/Rlimit.v
new file mode 100644
index 00000000..3308b2e3
--- /dev/null
+++ b/theories7/Reals/Rlimit.v
@@ -0,0 +1,539 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rlimit.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+(*********************************************************)
+(*           Definition of the limit                     *)
+(*                                                       *)
+(*********************************************************)
+
+Require Rbase.
+Require Rfunctions.
+Require Classical_Prop.
+Require Fourier.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(*******************************)
+(*      Calculus               *)
+(*******************************)
+(*********)
+Lemma eps2_Rgt_R0:(eps:R)(Rgt eps R0)->
+      (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
+Intros;Fourier.
+Qed.
+
+(*********)
+Lemma eps2:(eps:R)(Rplus (Rmult eps (Rinv (Rplus R1 R1)))
+                        (Rmult eps (Rinv (Rplus R1 R1))))==eps.
+Intro esp.
+Assert H := (double_var esp).
+Unfold Rdiv in H.
+Symmetry; Exact H.
+Qed.
+
+(*********)
+Lemma eps4:(eps:R)
+  (Rplus (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) )))
+        (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1) ))))==
+                  (Rmult eps (Rinv (Rplus R1 R1))).
+Intro eps.
+Replace ``2+2`` with ``2*2``.
+Pattern 3 eps; Rewrite double_var.
+Rewrite (Rmult_Rplus_distrl ``eps/2`` ``eps/2`` ``/2``).
+Unfold Rdiv.
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_Rmult.
+Reflexivity.
+DiscrR.
+DiscrR.
+Ring.
+Qed.
+
+(*********)
+Lemma Rlt_eps2_eps:(eps:R)(Rgt eps R0)->
+        (Rlt (Rmult eps (Rinv (Rplus R1 R1))) eps).
+Intros.
+Pattern 2 eps; Rewrite <- Rmult_1r.
+Repeat Rewrite (Rmult_sym eps).
+Apply Rlt_monotony_r.
+Exact H.
+Apply Rlt_monotony_contra with ``2``.
+Fourier.
+Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
+Fourier.
+DiscrR.
+Qed.
+
+(*********)
+Lemma Rlt_eps4_eps:(eps:R)(Rgt eps R0)->
+        (Rlt (Rmult eps (Rinv (Rplus (Rplus R1 R1) (Rplus R1 R1)))) eps).
+Intros.
+Replace ``2+2`` with ``4``.
+Pattern 2 eps; Rewrite <- Rmult_1r.
+Repeat Rewrite (Rmult_sym eps).
+Apply Rlt_monotony_r.
+Exact H.
+Apply Rlt_monotony_contra with ``4``.
+Replace ``4`` with ``2*2``.
+Apply Rmult_lt_pos; Fourier.
+Ring.
+Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
+Fourier.
+DiscrR.
+Ring.
+Qed. 
+
+(*********)
+Lemma prop_eps:(r:R)((eps:R)(Rgt eps R0)->(Rlt r eps))->(Rle r R0).
+Intros;Elim (total_order r R0); Intro.
+Apply Rlt_le; Assumption.
+Elim H0; Intro.
+Apply eq_Rle; Assumption.
+Clear H0;Generalize (H r H1); Intro;Generalize (Rlt_antirefl r);
+ Intro;ElimType False; Auto.
+Qed.
+
+(*********)
+Definition mul_factor := [l,l':R](Rinv (Rplus R1 (Rplus (Rabsolu l) 
+                                                        (Rabsolu l')))).
+
+(*********)
+Lemma mul_factor_wd : (l,l':R)
+  ~(Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))==R0.
+Intros;Rewrite (Rplus_sym R1 (Rplus (Rabsolu l) (Rabsolu l')));
+ Apply tech_Rplus.
+Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
+Cut (Rle R0 (Rabsolu (Rplus l l'))).
+Exact (Rle_trans ? ? ?).
+Exact (Rabsolu_pos (Rplus l l')).
+Exact (Rabsolu_triang ? ?).
+Exact Rlt_R0_R1.
+Qed.
+
+(*********)
+Lemma mul_factor_gt:(eps:R)(l,l':R)(Rgt eps R0)->
+      (Rgt (Rmult eps (mul_factor l l')) R0).
+Intros;Unfold Rgt;Rewrite <- (Rmult_Or eps);Apply Rlt_monotony.
+Assumption.
+Unfold mul_factor;Apply Rlt_Rinv;
+ Cut (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
+Cut (Rlt R0 R1).
+Exact (Rlt_le_trans ? ? ?).
+Exact Rlt_R0_R1.
+Replace (Rle R1 (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))))
+ with (Rle (Rplus R1 R0) (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l')))).
+Apply Rle_compatibility.
+Cut (Rle (Rabsolu (Rplus l l')) (Rplus (Rabsolu l) (Rabsolu l'))).
+Cut (Rle R0 (Rabsolu (Rplus l l'))).
+Exact (Rle_trans ? ? ?).
+Exact (Rabsolu_pos ?).
+Exact (Rabsolu_triang ? ?).
+Rewrite (proj1 ? ? (Rplus_ne R1));Trivial.
+Qed.
+
+(*********)
+Lemma mul_factor_gt_f:(eps:R)(l,l':R)(Rgt eps R0)->
+      (Rgt (Rmin R1 (Rmult eps (mul_factor l l'))) R0).
+Intros;Apply Rmin_Rgt_r;Split.
+Exact Rlt_R0_R1.
+Exact (mul_factor_gt eps l l' H).
+Qed.
+
+
+(*******************************)
+(*      Metric space           *)
+(*******************************)
+
+(*********)
+Record Metric_Space:Type:= {
+   Base:Type;
+   dist:Base->Base->R;
+   dist_pos:(x,y:Base)(Rge (dist x y) R0);
+   dist_sym:(x,y:Base)(dist x y)==(dist y x);
+   dist_refl:(x,y:Base)((dist x y)==R0<->x==y);
+   dist_tri:(x,y,z:Base)(Rle (dist x y) 
+              (Rplus (dist x z) (dist z y))) }.
+
+(*******************************)
+(*     Limit in Metric space   *)
+(*******************************)
+
+(*********)
+Definition limit_in:=
+   [X:Metric_Space; X':Metric_Space; f:(Base X)->(Base X'); 
+    D:(Base X)->Prop; x0:(Base X); l:(Base X')]
+   (eps:R)(Rgt eps R0)->
+   (EXT alp:R | (Rgt alp R0)/\(x:(Base X))(D x)/\
+                (Rlt (dist X x x0) alp)->
+                (Rlt (dist X' (f x) l) eps)). 
+
+(*******************************)
+(*    R is a metric space      *)
+(*******************************)
+
+(*********)
+Definition R_met:Metric_Space:=(Build_Metric_Space R R_dist 
+  R_dist_pos R_dist_sym R_dist_refl R_dist_tri).
+
+(*******************************)
+(*         Limit 1 arg         *)
+(*******************************)
+(*********)
+Definition Dgf:=[Df,Dg:R->Prop][f:R->R][x:R](Df x)/\(Dg (f x)).
+
+(*********)
+Definition limit1_in:(R->R)->(R->Prop)->R->R->Prop:=
+  [f:R->R; D:R->Prop; l:R; x0:R](limit_in R_met R_met f D x0 l).
+
+(*********)
+Lemma tech_limit:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->
+   (limit1_in f D l x0)->l==(f x0).
+Intros f D l x0 H H0.
+Case (Rabsolu_pos (Rminus (f x0) l)); Intros H1.
+Absurd (Rlt (dist R_met (f x0) l) (dist R_met (f x0) l)).
+Apply Rlt_antirefl.
+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_eqT; Auto.
+Qed.
+
+(*********)
+Lemma tech_limit_contr:(f:R->R)(D:R->Prop)(l:R)(x0:R)(D x0)->~l==(f x0)
+   ->~(limit1_in f D l x0).
+Intros;Generalize (tech_limit f D l x0);Tauto.
+Qed.
+
+(*********)
+Lemma lim_x:(D:R->Prop)(x0:R)(limit1_in [x:R]x D x0 x0).
+Unfold limit1_in; Unfold limit_in; Simpl; Intros;Split with eps;
+ Split; Auto;Intros;Elim H0; Intros; Auto.
+Qed.
+
+(*********)
+Lemma limit_plus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
+   (limit1_in f D l x0)->(limit1_in g D l' x0)->
+   (limit1_in [x:R](Rplus (f x) (g x)) D (Rplus l l') x0).
+Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros;
+ Elim (H (Rmult eps (Rinv (Rplus R1 R1))) (eps2_Rgt_R0 eps H1));
+  Elim (H0 (Rmult eps (Rinv (Rplus R1 R1))) (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 R0 (conj ? ? H H2)).
+Intros;Elim H4; Clear H4; Intros;
+ Cut (Rlt (Rplus (R_dist (f x2) l) (R_dist (g x2) l')) eps).
+ Cut (Rle (R_dist (Rplus (f x2) (g x2)) (Rplus l l'))
+      (Rplus (R_dist (f x2) l) (R_dist (g x2) l'))).
+Exact (Rle_lt_trans ? ? ?).
+Exact (R_dist_plus ? ? ? ?).
+Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros.
+Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));
+ Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));
+ Intros;
+ Replace eps
+ with (Rplus (Rmult eps (Rinv (Rplus R1 R1)))
+        (Rmult eps (Rinv (Rplus R1 R1)))).
+Exact (Rplus_lt ? ? ? ? H7 H8).
+Exact (eps2 eps).
+Qed.
+
+(*********)
+Lemma limit_Ropp:(f:R->R)(D:R->Prop)(l:R)(x0:R)
+   (limit1_in f D l x0)->(limit1_in [x:R](Ropp (f x)) D (Ropp l) x0).
+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;Unfold Rminus;
+ Rewrite (Ropp_Ropp l);Rewrite (Rplus_sym (Ropp (f x1)) l);
+ Fold (Rminus l (f x1));Fold (R_dist l (f x1));Rewrite R_dist_sym;
+ Assumption.
+Qed.
+
+(*********)
+Lemma limit_minus:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
+   (limit1_in f D l x0)->(limit1_in g D l' x0)->
+   (limit1_in [x:R](Rminus (f x) (g x)) D (Rminus l l') x0).
+Intros;Unfold Rminus;Generalize (limit_Ropp g D l' x0 H0);Intro;
+ Exact (limit_plus f [x:R](Ropp (g x)) D l (Ropp l') x0 H H1).
+Qed.
+
+(*********)
+Lemma limit_free:(f:R->R)(D:R->Prop)(x:R)(x0:R)
+   (limit1_in [h:R](f x) D (f x) x0).
+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_eqT R (f x)));Unfold Rgt in H;Assumption.
+Qed.
+
+(*********)
+Lemma limit_mul:(f,g:R->R)(D:R->Prop)(l,l':R)(x0:R)
+   (limit1_in f D l x0)->(limit1_in g D l' x0)->
+   (limit1_in [x:R](Rmult (f x) (g x)) D (Rmult l l') x0).
+Intros;Unfold limit1_in; Unfold limit_in; Simpl; Intros; 
+ Elim (H (Rmin R1 (Rmult eps (mul_factor l l'))) 
+                   (mul_factor_gt_f eps l l' H1));
+ Elim (H0 (Rmult eps (mul_factor l l')) (mul_factor_gt eps l l' H1));
+ 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 R0 (conj ? ? H H2)).
+Intros; Elim H4; Clear H4; Intros;Unfold R_dist;
+ Replace (Rminus (Rmult (f x2) (g x2)) (Rmult l l')) with 
+     (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus (f x2) l))).
+Cut (Rlt (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu (Rmult l' 
+ (Rminus (f x2) l)))) eps). 
+Cut (Rle (Rabsolu (Rplus (Rmult (f x2) (Rminus (g x2) l')) (Rmult l' (Rminus 
+  (f x2) l)))) (Rplus (Rabsolu (Rmult (f x2) (Rminus (g x2) l'))) (Rabsolu 
+        (Rmult l' (Rminus (f x2) l))))).
+Exact (Rle_lt_trans ? ? ?).
+Exact (Rabsolu_triang ? ?).
+Rewrite (Rabsolu_mult (f x2) (Rminus (g x2) l'));
+ Rewrite (Rabsolu_mult l' (Rminus (f x2) l));
+ Cut (Rle (Rplus (Rmult (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l'))) 
+   (Rmult (Rabsolu l') (Rmult eps (mul_factor l l')))) eps).
+Cut (Rlt (Rplus (Rmult (Rabsolu (f x2)) (Rabsolu (Rminus (g x2) l'))) (Rmult 
+  (Rabsolu l') (Rabsolu (Rminus (f x2) l)))) (Rplus (Rmult (Rplus R1 (Rabsolu 
+     l)) (Rmult eps (mul_factor l l'))) (Rmult (Rabsolu l') (Rmult eps 
+      (mul_factor l l'))))).
+Exact (Rlt_le_trans ? ? ?).
+Elim (Rmin_Rgt_l x1 x (R_dist x2 x0) H5); Clear H5; Intros;
+ Generalize (H0 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H4 H5));Intro;
+ Generalize (Rmin_Rgt_l ? ? ? H7);Intro;Elim H8;Intros;Clear H0 H8;
+ Apply Rplus_lt_le_lt.
+Apply Rmult_lt_0.
+Apply Rle_sym1.
+Exact (Rabsolu_pos (Rminus (g x2) l')).
+Rewrite (Rplus_sym R1 (Rabsolu l));Unfold Rgt;Apply Rlt_r_plus_R1;
+ Exact (Rabsolu_pos l).
+Unfold R_dist in H9;
+ Apply (Rlt_anti_compatibility (Ropp (Rabsolu l)) (Rabsolu (f x2)) 
+     (Rplus R1 (Rabsolu l))).
+Rewrite <- (Rplus_assoc (Ropp (Rabsolu l)) R1 (Rabsolu l));
+ Rewrite (Rplus_sym (Ropp (Rabsolu l)) R1);
+ Rewrite (Rplus_assoc R1 (Ropp (Rabsolu l)) (Rabsolu l));
+ Rewrite (Rplus_Ropp_l (Rabsolu l));
+ Rewrite (proj1 ? ? (Rplus_ne R1));
+ Rewrite (Rplus_sym (Ropp (Rabsolu l)) (Rabsolu (f x2)));
+ Generalize H9;
+Cut (Rle (Rminus (Rabsolu (f x2)) (Rabsolu l)) (Rabsolu (Rminus (f x2) l))).
+Exact (Rle_lt_trans ? ? ?).
+Exact (Rabsolu_triang_inv ? ?).
+Generalize (H3 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H4 H6));Trivial.
+Apply Rle_monotony.
+Exact (Rabsolu_pos l').
+Unfold Rle;Left;Assumption.
+Rewrite (Rmult_sym (Rplus R1 (Rabsolu l)) (Rmult eps (mul_factor l l')));
+ Rewrite (Rmult_sym (Rabsolu l') (Rmult eps (mul_factor l l')));
+ Rewrite <- (Rmult_Rplus_distr
+           (Rmult eps (mul_factor l l'))
+           (Rplus R1 (Rabsolu l))
+           (Rabsolu l'));
+ Rewrite (Rmult_assoc eps (mul_factor l l') (Rplus (Rplus R1 (Rabsolu l)) 
+      (Rabsolu l')));
+ Rewrite (Rplus_assoc R1 (Rabsolu l) (Rabsolu l'));Unfold mul_factor;
+ Rewrite (Rinv_l (Rplus R1 (Rplus (Rabsolu l) (Rabsolu l'))) 
+  (mul_factor_wd l l'));
+ Rewrite (proj1 ? ? (Rmult_ne eps));Apply eq_Rle;Trivial.
+Ring.
+Qed.
+
+(*********)
+Definition adhDa:(R->Prop)->R->Prop:=[D:R->Prop][a:R]
+  (alp:R)(Rgt alp R0)->(EXT x:R | (D x)/\(Rlt (R_dist x a) alp)).
+
+(*********)
+Lemma single_limit:(f:R->R)(D:R->Prop)(l:R)(l':R)(x0:R)
+  (adhDa D x0)->(limit1_in f D l x0)->(limit1_in f D l' x0)->l==l'.
+Unfold limit1_in; Unfold limit_in; Intros.
+Cut (eps:R)(Rgt eps R0)->(Rlt (dist R_met l l') 
+                              (Rmult (Rplus R1 R1) eps)).
+Clear H0 H1;Unfold dist; Unfold R_met; Unfold R_dist; 
+ Unfold Rabsolu;Case (case_Rabsolu (Rminus l l')); Intros.
+Cut (eps:R)(Rgt eps R0)->(Rlt (Ropp (Rminus l l')) eps).
+Intro;Generalize (prop_eps (Ropp (Rminus l l')) H1);Intro;
+ Generalize (Rlt_RoppO (Rminus l l') r); Intro;Unfold Rgt in H3;
+ Generalize (Rle_not (Ropp (Rminus l l')) R0 H3); Intro;
+ ElimType False; Auto.
+Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
+Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
+ Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
+ Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
+ Rewrite (Rinv_r (Rplus R1 R1)).
+Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
+Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
+ Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
+ Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; 
+ Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
+Unfold Rgt;Unfold Rgt in H1;
+ Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
+ Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
+ Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
+Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
+Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
+Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
+ Intros a b;Rewrite a;Clear a b;Trivial.
+(**)
+Cut (eps:R)(Rgt eps R0)->(Rlt (Rminus l l') eps).
+Intro;Generalize (prop_eps (Rminus l l') H1);Intro;
+ Elim (Rle_le_eq (Rminus l l') R0);Intros a b;Clear b;
+ Apply (Rminus_eq l l');Apply a;Split.
+Assumption.
+Apply (Rle_sym2 R0 (Rminus l l') r).
+Intros;Cut (Rgt (Rmult eps (Rinv (Rplus R1 R1))) R0).
+Intro;Generalize (H0 (Rmult eps (Rinv (Rplus R1 R1))) H2);
+ Rewrite (Rmult_sym eps (Rinv (Rplus R1 R1)));
+ Rewrite <- (Rmult_assoc (Rplus R1 R1) (Rinv (Rplus R1 R1)) eps);
+ Rewrite (Rinv_r (Rplus R1 R1)).
+Elim (Rmult_ne eps);Intros a b;Rewrite b;Clear a b;Trivial.
+Apply (imp_not_Req (Rplus R1 R1) R0);Right;Generalize Rlt_R0_R1;Intro;
+ Unfold Rgt;Generalize (Rlt_compatibility R1 R0 R1 H3);Intro;
+ Elim (Rplus_ne R1);Intros a b;Rewrite a in H4;Clear a b; 
+ Apply (Rlt_trans R0 R1 (Rplus R1 R1) H3 H4).
+Unfold Rgt;Unfold Rgt in H1;
+ Rewrite (Rmult_sym eps(Rinv (Rplus R1 R1)));
+ Rewrite <-(Rmult_Or (Rinv (Rplus R1 R1)));
+ Apply (Rlt_monotony (Rinv (Rplus R1 R1)) R0 eps);Auto.
+Apply (Rlt_Rinv (Rplus R1 R1));Cut (Rlt R1 (Rplus R1 R1)).
+Intro;Apply (Rlt_trans R0 R1 (Rplus R1 R1) Rlt_R0_R1 H2).
+Generalize (Rlt_compatibility R1 R0 R1 Rlt_R0_R1);Elim (Rplus_ne R1);
+ Intros a b;Rewrite a;Clear a b;Trivial.
+(**)
+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;Simpl in H1 H4;Generalize (Rmin_Rgt x x1 R0);Intro;Elim H5;
+ Intros;Clear H5;
+ Elim (H (Rmin x x1) (H7 (conj (Rgt x R0) (Rgt x1 R0) H3 H0)));
+ Intros; Elim H5;Intros;Clear H5 H H6 H7;
+ Generalize (Rmin_Rgt x x1 (R_dist x2 x0));Intro;Elim H;
+ Intros;Clear H H6;Unfold Rgt in H5;Elim (H5 H9);Intros;Clear H5 H9;
+ Generalize (H1 x2 (conj (D x2) (Rlt (R_dist x2 x0) x1) H8 H6));
+ Generalize (H4 x2 (conj (D x2) (Rlt (R_dist x2 x0) x) H8 H));
+ Clear H8 H H6 H1 H4 H0 H3;Intros;
+ Generalize (Rplus_lt (R_dist (f x2) l) eps (R_dist (f x2) l') eps 
+  H H0); Unfold R_dist;Intros;
+ Rewrite (Rabsolu_minus_sym (f x2) l) in H1;
+ Rewrite (Rmult_sym (Rplus R1 R1) eps);Rewrite (Rmult_Rplus_distr eps R1 R1);
+ Elim (Rmult_ne eps);Intros a b;Rewrite a;Clear a b;
+ Generalize (R_dist_tri l l' (f x2));Unfold R_dist;Intros;
+ Apply (Rle_lt_trans (Rabsolu (Rminus l l')) 
+  (Rplus (Rabsolu (Rminus l (f x2))) (Rabsolu (Rminus (f x2) l')))
+  (Rplus eps eps) H3 H1).
+Qed.
+
+(*********)
+Lemma limit_comp:(f,g:R->R)(Df,Dg:R->Prop)(l,l':R)(x0:R)
+   (limit1_in f Df l x0)->(limit1_in g Dg l' l)->
+   (limit1_in [x:R](g (f x)) (Dgf Df Dg f) l' x0).
+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.
+Elim (Hf alpg).
+2: Tauto.
+Intros alpf lf.
+Exists alpf.
+Intuition.
+Qed.
+
+(*********)
+
+Lemma limit_inv : (f:R->R)(D:R->Prop)(l:R)(x0:R) (limit1_in f D l x0)->~(l==R0)->(limit1_in [x:R](Rinv (f x)) D (Rinv l) x0).
+Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H ``(Rabsolu 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; Case (total_order_Rle 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)/\``(Rabsolu (x-x0))<delta1``.
+Cut (D x)/\``(Rabsolu (x-x0))<delta2``.
+Intros; Generalize (H5 H11); Clear H5; Intro H5; Generalize (H7 H12); Clear H7; Intro H7; Generalize (Rabsolu_triang_inv l (f x)); Intro; Rewrite Rabsolu_minus_sym in H7; Generalize (Rle_lt_trans ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu (l-(f x)))`` ``(Rabsolu l)/2`` H13 H7); Intro; Generalize (Rlt_compatibility ``(Rabsolu (f x))-(Rabsolu l)/2`` ``(Rabsolu l)-(Rabsolu (f x))`` ``(Rabsolu l)/2`` H14); Replace ``(Rabsolu (f x))-(Rabsolu l)/2+((Rabsolu l)-(Rabsolu (f x)))`` with ``(Rabsolu l)/2``.
+Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Intro; Cut ~``(f x)==0``.
+Intro; Replace ``/(f x)+ -/l`` with ``(l-(f x))*/(l*(f x))``.
+Rewrite Rabsolu_mult; Rewrite Rabsolu_Rinv.
+Cut ``/(Rabsolu (l*(f x)))<2/(Rsqr l)``.
+Intro; Rewrite Rabsolu_minus_sym in H5; Cut ``0<=/(Rabsolu (l*(f x)))``.
+Intro; Generalize (Rmult_lt2 ``(Rabsolu (l-(f x)))`` ``eps*(Rsqr l)/2`` ``/(Rabsolu (l*(f x)))`` ``2/(Rsqr l)`` (Rabsolu_pos ``l-(f x)``) H18 H5 H17); Replace ``eps*(Rsqr l)/2*2/(Rsqr l)`` with ``eps``.
+Intro; Assumption.
+Unfold Rdiv; Unfold Rsqr; Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym l).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym l).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Reflexivity.
+DiscrR.
+Exact H0.
+Exact H0.
+Exact H0.
+Exact H0.
+Left; Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Apply prod_neq_R0; Assumption.
+Rewrite Rmult_sym; Rewrite Rabsolu_mult; Rewrite Rinv_Rmult.
+Rewrite (Rsqr_abs l); Unfold Rsqr; Unfold Rdiv; Rewrite Rinv_Rmult.
+Repeat Rewrite <- Rmult_assoc; Apply Rlt_monotony_r.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Apply Rlt_monotony_contra with ``(Rabsolu (f x))*(Rabsolu l)*/2``.
+Repeat Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro H18; Assumption | Discriminate].
+Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*/(Rabsolu (f x))`` with ``(Rabsolu l)/2``.
+Replace ``(Rabsolu (f x))*(Rabsolu l)*/2*(2*/(Rabsolu l))`` with ``(Rabsolu (f x))``.
+Assumption.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym (Rabsolu l)).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Reflexivity.
+DiscrR.
+Apply Rabsolu_no_R0.
+Assumption.
+Unfold Rdiv.
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym (Rabsolu (f x))).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Reflexivity.
+Apply Rabsolu_no_R0; Assumption.
+Apply Rabsolu_no_R0; Assumption.
+Apply Rabsolu_no_R0; Assumption.
+Apply Rabsolu_no_R0; Assumption.
+Apply Rabsolu_no_R0; Assumption.
+Apply prod_neq_R0; Assumption.
+Rewrite (Rinv_Rmult ? ? H0 H16).
+Unfold Rminus; Rewrite Rmult_Rplus_distrl.
+Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Rewrite Ropp_mul1.
+Rewrite (Rmult_sym (f x)).
+Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Reflexivity.
+Assumption.
+Assumption.
+Red; Intro; Rewrite H16 in H15; Rewrite Rabsolu_R0 in H15; Cut ``0<(Rabsolu l)/2``.
+Intro; Elim (Rlt_antirefl ``0`` (Rlt_trans ``0`` ``(Rabsolu l)/2`` ``0`` H17 H15)).
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt; Assumption.
+Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H17; Generalize (lt_INR_0 (2) (neq_O_lt (2) H17)); Unfold INR; Intro; Assumption | Discriminate].
+Pattern 3 (Rabsolu l); Rewrite double_var.
+Ring.
+Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_r]].
+Split; [Assumption | Apply Rlt_le_trans with (Rmin delta1 delta2); [Assumption | Apply Rmin_l]].
+Change ``0<eps*(Rsqr l)/2``; Unfold Rdiv; Repeat Rewrite Rmult_assoc; Repeat Apply Rmult_lt_pos.
+Assumption.
+Apply Rsqr_pos_lt; Assumption.
+Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate].
+Change ``0<(Rabsolu l)/2``; Unfold Rdiv; Apply Rmult_lt_pos; [Apply Rabsolu_pos_lt; Assumption | Apply Rlt_Rinv; Cut ~(O=(2)); [Intro H3; Generalize (lt_INR_0 (2) (neq_O_lt (2) H3)); Unfold INR; Intro; Assumption | Discriminate]].
+Qed.
diff --git a/theories7/Reals/Rpower.v b/theories7/Reals/Rpower.v
new file mode 100644
index 00000000..0acfa8d2
--- /dev/null
+++ b/theories7/Reals/Rpower.v
@@ -0,0 +1,560 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rpower.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+(*i Due to L.Thery i*) 
+
+(************************************************************)
+(* Definitions of log and Rpower : R->R->R; main properties *)
+(************************************************************)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require Ranalysis1.
+Require Exp_prop.
+Require Rsqrt_def.
+Require R_sqrt.
+Require MVT.
+Require Ranalysis4.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Lemma P_Rmin: (P : R ->  Prop) (x, y : R) (P x) -> (P y) ->  (P (Rmin x y)).
+Intros P x y H1 H2; Unfold Rmin; Case (total_order_Rle x y); Intro; Assumption.
+Qed.
+
+Lemma exp_le_3 :  ``(exp 1)<=3``.
+Assert exp_1 : ``(exp 1)<>0``.
+Assert H0 := (exp_pos R1); Red; Intro; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
+Apply Rle_monotony_contra with ``/(exp 1)``.
+Apply Rlt_Rinv; Apply exp_pos.
+Rewrite <- Rinv_l_sym.
+Apply Rle_monotony_contra with ``/3``.
+Apply Rlt_Rinv; Sup0.
+Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Replace ``/(exp 1)`` with ``(exp (-1))``.
+Unfold exp; Case (exist_exp ``-1``); Intros; Simpl; Unfold exp_in in e; Assert H := (alternated_series_ineq [i:nat]``/(INR (fact i))`` x (S O)).
+Cut ``(sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (S (mult (S (S O)) (S O)))) <= x <= (sum_f_R0 (tg_alt [([i:nat]``/(INR (fact i))``)]) (mult (S (S O)) (S O)))``.
+Intro; Elim H0; Clear H0; Intros H0 _; Simpl in H0; Unfold tg_alt in H0; Simpl in H0.
+Replace ``/3`` with ``1*/1+ -1*1*/1+ -1*( -1*1)*/2+ -1*( -1*( -1*1))*/(2+1+1+1+1)``.
+Apply H0.
+Repeat Rewrite Rinv_R1; Repeat Rewrite Rmult_1r; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite Ropp_Ropp; Rewrite Rplus_Ropp_r; Rewrite Rmult_1r; Rewrite Rplus_Ol; Rewrite Rmult_1l; Apply r_Rmult_mult with ``6``.
+Rewrite Rmult_Rplus_distr; Replace ``2+1+1+1+1`` with ``6``.
+Rewrite <- (Rmult_sym ``/6``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Replace ``6`` with ``2*3``.
+Do 2 Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Rewrite (Rmult_sym ``3``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Ring.
+DiscrR.
+DiscrR.
+Ring.
+DiscrR.
+Ring.
+DiscrR.
+Apply H.
+Unfold Un_decreasing; Intros; Apply Rle_monotony_contra with ``(INR (fact n))``.
+Apply INR_fact_lt_0.
+Apply Rle_monotony_contra with ``(INR (fact (S n)))``.
+Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Apply le_INR; Apply fact_growing; Apply le_n_Sn.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Assert H0 := (cv_speed_pow_fact R1); Unfold Un_cv; Unfold Un_cv in H0; Intros; Elim (H0 ? H1); Intros; Exists x0; Intros; Unfold R_dist in H2; Unfold R_dist; Replace ``/(INR (fact n))`` with ``(pow 1 n)/(INR (fact n))``.
+Apply (H2 ? H3).
+Unfold Rdiv; Rewrite pow1; Rewrite Rmult_1l; Reflexivity.
+Unfold infinit_sum in e; Unfold Un_cv tg_alt; Intros; Elim (e ? H0); Intros; Exists x0; Intros; Replace (sum_f_R0 ([i:nat]``(pow ( -1) i)*/(INR (fact i))``) n) with (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow ( -1) i)``) n).
+Apply (H1 ? H2).
+Apply sum_eq; Intros; Apply Rmult_sym.
+Apply r_Rmult_mult with ``(exp 1)``.
+Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite <- Rinv_r_sym.
+Reflexivity.
+Assumption.
+Assumption.
+DiscrR.
+Assumption.
+Qed.
+
+(******************************************************************)
+(*                        Properties of  Exp                      *)
+(******************************************************************)
+
+Theorem exp_increasing: (x, y : R) ``x<y`` -> ``(exp x)<(exp y)``.
+Intros x y H.
+Assert H0 : (derivable exp).
+Apply derivable_exp.
+Assert H1 := (positive_derivative ? H0).
+Unfold strict_increasing in H1.
+Apply H1.
+Intro.
+Replace (derive_pt exp x0 (H0 x0)) with (exp x0).
+Apply exp_pos.
+Symmetry; Apply derive_pt_eq_0.
+Apply (derivable_pt_lim_exp x0).
+Apply H.
+Qed.
+ 
+Theorem exp_lt_inv: (x, y : R) ``(exp x)<(exp y)`` -> ``x<y``.
+Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]].
+Assumption.
+Rewrite H1 in H; Elim (Rlt_antirefl ? H).
+Assert H2 := (exp_increasing ? ? H1).
+Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H H2)).
+Qed.
+ 
+Lemma exp_ineq1 : (x:R) ``0<x`` -> ``1+x < (exp x)``.
+Intros; Apply Rlt_anti_compatibility with ``-(exp 0)``; Rewrite <- (Rplus_sym (exp x)); Assert H0 := (MVT_cor1 exp R0 x derivable_exp H); Elim H0; Intros; Elim H1; Intros; Unfold Rminus in H2; Rewrite H2; Rewrite Ropp_O; Rewrite Rplus_Or; Replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
+Rewrite exp_0; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Pattern 1 x; Rewrite <- Rmult_1r; Rewrite (Rmult_sym (exp x0)); Apply Rlt_monotony.
+Apply H.
+Rewrite <- exp_0; Apply exp_increasing; Elim H3; Intros; Assumption.
+Symmetry; Apply derive_pt_eq_0; Apply derivable_pt_lim_exp.
+Qed.
+
+Lemma ln_exists1 : (y:R) ``0<y``->``1<=y``->(sigTT R [z:R]``y==(exp z)``).
+Intros; Pose f := [x:R]``(exp x)-y``; Cut ``(f 0)<=0``.
+Intro; Cut (continuity f).
+Intro; Cut ``0<=(f y)``.
+Intro; Cut ``(f 0)*(f y)<=0``.
+Intro; Assert X := (IVT_cor f R0 y H2 (Rlt_le ? ? H) H4); Elim X; Intros t H5; Apply existTT with t; Elim H5; Intros; Unfold f in H7; Apply Rminus_eq_right; Exact H7.
+Pattern 2 R0; Rewrite <- (Rmult_Or (f y)); Rewrite (Rmult_sym (f R0)); Apply Rle_monotony; Assumption.
+Unfold f; Apply Rle_anti_compatibility with y; Left; Apply Rlt_trans with ``1+y``.
+Rewrite <- (Rplus_sym y); Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Replace ``y+((exp y)-y)`` with (exp y); [Apply (exp_ineq1 y H) | Ring].
+Unfold f; Change (continuity (minus_fct exp (fct_cte y))); Apply continuity_minus; [Apply derivable_continuous; Apply derivable_exp | Apply derivable_continuous; Apply derivable_const].
+Unfold f; Rewrite exp_0; Apply Rle_anti_compatibility with y; Rewrite Rplus_Or; Replace ``y+(1-y)`` with R1; [Apply H0 | Ring].
+Qed.
+
+(**********)
+Lemma ln_exists : (y:R) ``0<y`` -> (sigTT R [z:R]``y==(exp z)``).
+Intros; Case (total_order_Rle R1 y); Intro.
+Apply (ln_exists1 ? H r).
+Assert H0 : ``1<=/y``.
+Apply Rle_monotony_contra with y.
+Apply H.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Left; Apply (not_Rle ? ? n).
+Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
+Assert H1 : ``0</y``.
+Apply Rlt_Rinv; Apply H.
+Assert H2 := (ln_exists1 ? H1 H0); Elim H2; Intros; Apply existTT with ``-x``; Apply r_Rmult_mult with ``(exp x)/y``.
+Unfold Rdiv; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite <- (Rmult_sym ``/y``); Rewrite Rmult_assoc; Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0; Rewrite Rmult_1r; Symmetry; Apply p.
+Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
+Unfold Rdiv; Apply prod_neq_R0.
+Assert H3 := (exp_pos x); Red; Intro; Rewrite H4 in H3; Elim (Rlt_antirefl ? H3).
+Apply Rinv_neq_R0; Red; Intro; Rewrite H3 in H; Elim (Rlt_antirefl ? H).
+Qed.
+
+(* Definition of log R+* -> R *)
+Definition Rln [y:posreal] : R := Cases (ln_exists (pos y) (RIneq.cond_pos y)) of (existTT a b) => a end.
+
+(* Extension on R *)
+Definition ln : R->R := [x:R](Cases (total_order_Rlt R0 x) of
+      (leftT a) => (Rln (mkposreal x a)) 
+    | (rightT a) => R0 end).
+
+Lemma exp_ln :  (x : R) ``0<x`` ->  (exp (ln x)) == x.
+Intros; Unfold ln; Case (total_order_Rlt R0 x); Intro.
+Unfold Rln; Case (ln_exists (mkposreal x r) (RIneq.cond_pos (mkposreal x r))); Intros.
+Simpl in e; Symmetry; Apply e.
+Elim n; Apply H.
+Qed.
+
+Theorem exp_inv: (x, y : R) (exp x) == (exp y) ->  x == y.
+Intros x y H; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto; Assert H2 := (exp_increasing ? ? H1); Rewrite H in H2; Elim (Rlt_antirefl ? H2).
+Qed.
+ 
+Theorem exp_Ropp: (x : R)  ``(exp (-x)) == /(exp x)``.
+Intros x; Assert H : ``(exp x)<>0``.
+Assert H := (exp_pos x); Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
+Apply r_Rmult_mult with r := (exp x).
+Rewrite <- exp_plus; Rewrite Rplus_Ropp_r; Rewrite exp_0.
+Apply Rinv_r_sym.
+Apply H.
+Apply H.
+Qed.
+ 
+(******************************************************************)
+(*                        Properties of  Ln                       *)
+(******************************************************************)
+
+Theorem ln_increasing:
+ (x, y : R) ``0<x`` -> ``x<y`` -> ``(ln x) < (ln y)``.
+Intros x y H H0; Apply exp_lt_inv.
+Repeat  Rewrite exp_ln. 
+Apply H0.
+Apply Rlt_trans with x; Assumption.
+Apply H.
+Qed.
+
+Theorem ln_exp: (x : R)  (ln (exp x)) == x.
+Intros x; Apply exp_inv.
+Apply exp_ln.
+Apply exp_pos.
+Qed.
+ 
+Theorem ln_1: ``(ln 1) == 0``.
+Rewrite <- exp_0; Rewrite ln_exp; Reflexivity.
+Qed.
+ 
+Theorem ln_lt_inv:
+ (x, y : R) ``0<x`` -> ``0<y`` -> ``(ln x)<(ln y)`` ->  ``x<y``.
+Intros x y H H0 H1; Rewrite <- (exp_ln x); Try Rewrite <- (exp_ln y).
+Apply exp_increasing; Apply H1.
+Assumption. 
+Assumption.
+Qed.
+ 
+Theorem ln_inv: (x, y : R) ``0<x`` -> ``0<y`` -> (ln x) == (ln y) ->  x == y.
+Intros x y H H0 H'0; Case (total_order x y); [Intros H1 | Intros [H1|H1]]; Auto.
+Assert H2 := (ln_increasing ? ? H H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
+Assert H2 := (ln_increasing ? ? H0 H1); Rewrite H'0 in H2; Elim (Rlt_antirefl ? H2).
+Qed.
+ 
+Theorem ln_mult: (x, y : R) ``0<x`` -> ``0<y`` ->  ``(ln (x*y)) == (ln x)+(ln y)``.
+Intros x y H H0; Apply exp_inv.
+Rewrite exp_plus.
+Repeat Rewrite exp_ln.
+Reflexivity.
+Assumption.
+Assumption.
+Apply Rmult_lt_pos; Assumption.
+Qed.
+
+Theorem ln_Rinv: (x : R) ``0<x`` ->  ``(ln (/x)) == -(ln x)``.
+Intros x H; Apply exp_inv; Repeat (Rewrite exp_ln Orelse Rewrite exp_Ropp).
+Reflexivity.
+Assumption. 
+Apply Rlt_Rinv; Assumption.
+Qed.
+
+Theorem ln_continue:
+ (y : R) ``0<y`` ->  (continue_in ln [x : R]  (Rlt R0 x) y).
+Intros y H.
+Unfold continue_in limit1_in limit_in; Intros eps Heps.
+Cut (Rlt R1 (exp eps)); [Intros H1 | Idtac].
+Cut (Rlt (exp (Ropp eps)) R1); [Intros H2 | Idtac].
+Exists
+ (Rmin (Rmult y (Rminus (exp eps) R1)) (Rmult y (Rminus R1 (exp (Ropp eps)))));
+ Split.
+Red; Apply P_Rmin.
+Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_anti_compatibility with R1.
+Rewrite Rplus_Or; Replace ``(1+((exp eps)-1))`` with (exp eps); [Apply H1 | Ring].
+Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_anti_compatibility with ``(exp (-eps))``.
+Rewrite Rplus_Or; Replace ``(exp ( -eps))+(1-(exp ( -eps)))`` with R1; [Apply H2 | Ring].
+Unfold dist R_met R_dist; Simpl.
+Intros x ((H3, H4), H5).
+Cut (Rmult y (Rmult x (Rinv y))) == x.
+Intro Hxyy. 
+Replace (Rminus (ln x) (ln y)) with (ln (Rmult x (Rinv y))).
+Case (total_order x y); [Intros Hxy | Intros [Hxy|Hxy]].
+Rewrite Rabsolu_left.
+Apply Ropp_Rlt; Rewrite Ropp_Ropp.
+Apply exp_lt_inv.
+Rewrite exp_ln.
+Apply Rlt_monotony_contra with z := y.
+Apply H.
+Rewrite Hxyy.
+Apply Ropp_Rlt.
+Apply Rlt_anti_compatibility with r := y.
+Replace (Rplus y (Ropp (Rmult y (exp (Ropp eps)))))
+     with (Rmult y (Rminus R1 (exp (Ropp eps)))); [Idtac | Ring].
+Replace (Rplus y (Ropp x)) with (Rabsolu (Rminus x y)); [Idtac | Ring].
+Apply Rlt_le_trans with 1 := H5; Apply Rmin_r.
+Rewrite Rabsolu_left; [Ring | Idtac].
+Apply (Rlt_minus ? ? Hxy).
+Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
+Rewrite <- ln_1.
+Apply ln_increasing.
+Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
+Apply Rlt_monotony_contra with z := y.
+Apply H.
+Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
+Rewrite Hxy; Rewrite Rinv_r.
+Rewrite ln_1; Rewrite Rabsolu_R0; Apply Heps.
+Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
+Rewrite Rabsolu_right.
+Apply exp_lt_inv.
+Rewrite exp_ln.
+Apply Rlt_monotony_contra with z := y.
+Apply H.
+Rewrite Hxyy.
+Apply Rlt_anti_compatibility with r := (Ropp y).
+Replace (Rplus (Ropp y) (Rmult y (exp eps)))
+     with (Rmult y (Rminus (exp eps) R1)); [Idtac | Ring].
+Replace (Rplus (Ropp y) x) with (Rabsolu (Rminus x y)); [Idtac | Ring].
+Apply Rlt_le_trans with 1 := H5; Apply Rmin_l.
+Rewrite Rabsolu_right; [Ring | Idtac].
+Left; Apply (Rgt_minus ? ? Hxy).
+Apply Rmult_lt_pos; [Apply H3  | Apply (Rlt_Rinv ? H)].
+Rewrite <- ln_1.
+Apply Rgt_ge; Red; Apply ln_increasing.
+Apply Rlt_R0_R1.
+Apply Rlt_monotony_contra with z := y.
+Apply H.
+Rewrite Hxyy; Rewrite Rmult_1r; Apply Hxy.
+Rewrite ln_mult.
+Rewrite ln_Rinv.
+Ring.
+Assumption.
+Assumption.
+Apply Rlt_Rinv; Assumption.
+Rewrite (Rmult_sym x); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Ring.
+Red; Intro; Rewrite H0 in H; Elim (Rlt_antirefl ? H).
+Apply Rlt_monotony_contra with (exp eps).
+Apply exp_pos.
+Rewrite <- exp_plus; Rewrite Rmult_1r; Rewrite Rplus_Ropp_r; Rewrite exp_0; Apply H1.
+Rewrite <- exp_0.
+Apply exp_increasing; Apply Heps.
+Qed.
+
+(******************************************************************)
+(*                        Definition of  Rpower                   *)
+(******************************************************************)
+ 
+Definition Rpower := [x : R] [y : R]  ``(exp (y*(ln x)))``.
+
+Infix Local "^R" Rpower (at level 2, left associativity) : R_scope.
+
+(******************************************************************)
+(*                        Properties of  Rpower                   *)
+(******************************************************************)
+ 
+Theorem Rpower_plus:
+ (x, y, z : R)  ``(Rpower z (x+y)) == (Rpower z x)*(Rpower z y)``.
+Intros x y z; Unfold Rpower.
+Rewrite Rmult_Rplus_distrl; Rewrite exp_plus; Auto.
+Qed.
+ 
+Theorem Rpower_mult:
+ (x, y, z : R)  ``(Rpower (Rpower x y) z) == (Rpower x (y*z))``.
+Intros x y z; Unfold Rpower.
+Rewrite ln_exp.
+Replace (Rmult z (Rmult y (ln x))) with (Rmult (Rmult y z) (ln x)).
+Reflexivity.
+Ring.
+Qed.
+ 
+Theorem Rpower_O: (x : R) ``0<x`` ->  ``(Rpower x 0) == 1``.
+Intros x H; Unfold Rpower.
+Rewrite Rmult_Ol; Apply exp_0.
+Qed.
+ 
+Theorem Rpower_1: (x : R) ``0<x`` ->  ``(Rpower x 1) == x``.
+Intros x H; Unfold Rpower.
+Rewrite Rmult_1l; Apply exp_ln; Apply H.
+Qed.
+ 
+Theorem Rpower_pow:
+ (n : nat) (x : R) ``0<x`` ->  (Rpower x (INR n)) == (pow x n).
+Intros n; Elim n; Simpl; Auto; Fold INR.
+Intros x H; Apply Rpower_O; Auto.
+Intros n1; Case n1.
+Intros H x H0; Simpl; Rewrite Rmult_1r; Apply Rpower_1; Auto.
+Intros n0 H x H0; Rewrite Rpower_plus; Rewrite H; Try Rewrite Rpower_1; Try Apply Rmult_sym Orelse Assumption.
+Qed.
+ 
+Theorem Rpower_lt: (x, y, z : R) ``1<x`` -> ``0<=y`` -> ``y<z`` ->  ``(Rpower x y) < (Rpower x z)``.
+Intros x y z H H0 H1.
+Unfold Rpower.
+Apply exp_increasing.
+Apply Rlt_monotony_r.
+Rewrite <- ln_1; Apply ln_increasing.
+Apply Rlt_R0_R1.
+Apply H.
+Apply H1.
+Qed.
+ 
+Theorem Rpower_sqrt: (x : R) ``0<x`` ->  ``(Rpower x (/2)) == (sqrt x)``.
+Intros x H.
+Apply ln_inv.
+Unfold Rpower; Apply exp_pos.
+Apply sqrt_lt_R0; Apply H.
+Apply r_Rmult_mult with (INR (S (S O))).
+Apply exp_inv.
+Fold Rpower.
+Cut (Rpower (Rpower x (Rinv (Rplus R1 R1))) (INR (S (S O)))) == (Rpower (sqrt x) (INR (S (S O)))).
+Unfold Rpower; Auto.
+Rewrite Rpower_mult.
+Rewrite Rinv_l.
+Replace R1 with (INR (S O)); Auto.
+Repeat Rewrite Rpower_pow; Simpl.
+Pattern 1 x; Rewrite <- (sqrt_sqrt x (Rlt_le ? ? H)).
+Ring.
+Apply sqrt_lt_R0; Apply H.
+Apply H.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+Qed.
+ 
+Theorem Rpower_Ropp: (x, y : R) ``(Rpower x (-y)) == /(Rpower x y)``.
+Unfold Rpower.
+Intros x y; Rewrite Ropp_mul1.
+Apply exp_Ropp.
+Qed.
+ 
+Theorem Rle_Rpower: (e,n,m : R) ``1<e`` -> ``0<=n`` -> ``n<=m`` ->  ``(Rpower e n)<=(Rpower e m)``.
+Intros e n m H H0 H1; Case H1.
+Intros H2; Left; Apply Rpower_lt; Assumption.
+Intros H2; Rewrite H2; Right; Reflexivity.
+Qed.
+  
+Theorem ln_lt_2: ``/2<(ln 2)``.
+Apply Rlt_monotony_contra with z := (Rplus R1 R1).
+Sup0.
+Rewrite Rinv_r.
+Apply exp_lt_inv.
+Apply Rle_lt_trans with 1 := exp_le_3.
+Change (Rlt (Rplus R1 (Rplus R1 R1)) (Rpower (Rplus R1 R1) (Rplus R1 R1))).
+Repeat Rewrite Rpower_plus; Repeat Rewrite Rpower_1.
+Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr;
+ Repeat Rewrite Rmult_1l.
+Pattern 1 ``3``; Rewrite <- Rplus_Or; Replace ``2+2`` with ``3+1``; [Apply Rlt_compatibility; Apply Rlt_R0_R1 | Ring].
+Sup0.
+DiscrR.
+Qed.
+
+(**************************************)
+(* Differentiability of Ln and Rpower *)
+(**************************************)
+
+Theorem limit1_ext: (f, g : R ->  R)(D : R ->  Prop)(l, x : R) ((x : R) (D x) ->  (f x) == (g x)) -> (limit1_in f D l x) ->  (limit1_in g D l x).
+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.
+Qed.
+
+Theorem limit1_imp: (f : R ->  R)(D, D1 : R ->  Prop)(l, x : R) ((x : R) (D1 x) ->  (D x)) -> (limit1_in f D l x) ->  (limit1_in f D1 l x).
+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.
+Qed.
+
+Theorem Rinv_Rdiv: (x, y : R) ``x<>0`` -> ``y<>0`` ->  ``/(x/y) == y/x``.
+Intros x y H1 H2; Unfold Rdiv; Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Apply Rmult_sym.
+Assumption.
+Assumption.
+Apply Rinv_neq_R0; Assumption.
+Qed.
+
+Theorem Dln: (y : R) ``0<y`` ->  (D_in ln Rinv [x:R]``0<x`` y).
+Intros y Hy; Unfold D_in.
+Apply limit1_ext with f := [x : R](Rinv (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y)))).
+Intros x (HD1, HD2); Repeat Rewrite exp_ln.
+Unfold Rdiv; Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Apply Rmult_sym.
+Apply Rminus_eq_contra.
+Red; Intros H2; Case HD2.
+Symmetry; Apply (ln_inv ? ? HD1 Hy H2).
+Apply Rminus_eq_contra; Apply (not_sym ? ? HD2).
+Apply Rinv_neq_R0; Apply Rminus_eq_contra; Red; Intros H2; Case HD2; Apply ln_inv; Auto.
+Assumption.
+Assumption.
+Apply limit_inv with f := [x : R]  (Rdiv (Rminus (exp (ln x)) (exp (ln y))) (Rminus (ln x) (ln y))).
+Apply limit1_imp with f := [x : R] ([x : R]  (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus x (ln y))) (ln x)) D := (Dgf (D_x [x : R]  (Rlt R0 x) y) (D_x [x : R]  True (ln y)) ln).
+Intros x (H1, H2); Split.
+Split; Auto.
+Split; Auto.
+Red; Intros H3; Case H2; Apply ln_inv; Auto.
+Apply limit_comp with l := (ln y) g := [x : R]  (Rdiv (Rminus (exp x) (exp (ln y))) (Rminus 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; Unfold limit_in; Simpl; Unfold R_dist; Intros; Elim (H0 ? H); Intros; Exists (pos x); Split.
+Apply (RIneq.cond_pos x).
+Intros; Pattern 3 y; Rewrite <- exp_ln.
+Pattern 1 x0; 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 not_sym; Apply H3.
+Elim H2; Clear H2; Intros _ H2; Apply H2.
+Assumption.
+Red; Intro; Rewrite H in Hy; Elim (Rlt_antirefl ? Hy).
+Qed.
+
+Lemma derivable_pt_lim_ln : (x:R) ``0<x`` -> (derivable_pt_lim ln x ``/x``).
+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; Intros; Elim (H0 ? H1); Intros; Elim H2; Clear H2; Intros; Pose alp := (Rmin x0 ``x/2``); Assert H4 : ``0<alp``.
+Unfold alp; Unfold Rmin; Case (total_order_Rle x0 ``x/2``); Intro.
+Apply H2.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Exists (mkposreal ? H4); Intros; Pattern 2 h; Replace h with ``(x+h)-x``; [Idtac | Ring].
+Apply H3; Split.
+Unfold D_x; Split.
+Case (case_Rabsolu h); Intro.
+Assert H7 : ``(Rabsolu h)<x/2``.
+Apply Rlt_le_trans with alp.
+Apply H6.
+Unfold alp; Apply Rmin_r.
+Apply Rlt_trans with ``x/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Rewrite Rabsolu_left in H7.
+Apply Rlt_anti_compatibility with ``-h-x/2``.
+Replace ``-h-x/2+x/2`` with ``-h``; [Idtac | Ring].
+Pattern 2 x; Rewrite double_var.
+Replace ``-h-x/2+(x/2+x/2+h)`` with ``x/2``; [Apply H7 | Ring].
+Apply r.
+Apply gt0_plus_ge0_is_gt0; [Assumption | Apply Rle_sym2; Apply r].
+Apply not_sym; 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; Apply Rmin_l] | Ring].
+Qed.
+
+Theorem D_in_imp: (f, g : R ->  R)(D, D1 : R ->  Prop)(x : R) ((x : R) (D1 x) ->  (D x)) -> (D_in f g D x) ->  (D_in f g D1 x).
+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.
+
+Theorem D_in_ext: (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).
+Intros f g h D x H; Unfold D_in.
+Rewrite H; Auto.
+Qed.
+
+Theorem Dpower: (y, z : R) ``0<y`` -> (D_in [x:R](Rpower x z) [x:R](Rmult z (Rpower x (Rminus z R1))) [x:R]``0<x`` y).
+Intros y z H; Apply D_in_imp with D := (Dgf [x : R]  (Rlt R0 x) [x : R]  True ln).
+Intros x H0; Repeat Split.
+Assumption.
+Apply D_in_ext with f := [x : R]  (Rmult (Rinv x) (Rmult z (exp (Rmult z (ln x))))).
+Unfold Rminus; Rewrite Rpower_plus; Rewrite Rpower_Ropp; Rewrite (Rpower_1 ? H); Ring.
+Apply Dcomp with f := ln g := [x : R]  (exp (Rmult z x)) df := Rinv dg := [x : R]  (Rmult z (exp (Rmult z x))).
+Apply (Dln ? H).
+Apply D_in_imp with D := (Dgf [x : R]  True [x : R]  True [x : R]  (Rmult z x)).
+Intros x H1; Repeat Split; Auto.
+Apply (Dcomp [_ : R]  True [_ : R]  True [x : ?]  z exp [x : R]  (Rmult z x) exp); Simpl.
+Apply D_in_ext with f := [x : R]  (Rmult z R1).
+Apply Rmult_1r.
+Apply (Dmult_const [x : ?]  True [x : ?]  x [x : ?]  R1); Apply Dx.
+Assert H0 := (derivable_pt_lim_D_in exp exp ``z*(ln y)``); Elim H0; Clear H0; Intros _ H0; Apply H0; Apply derivable_pt_lim_exp.
+Qed.
+
+Theorem derivable_pt_lim_power: (x, y : R) (Rlt R0 x) -> (derivable_pt_lim [x : ?]  (Rpower x y) x (Rmult y (Rpower x (Rminus y R1)))).
+Intros x y H.
+Unfold Rminus; Rewrite Rpower_plus.
+Rewrite Rpower_Ropp.
+Rewrite Rpower_1; Auto.
+Rewrite <- Rmult_assoc.
+Unfold Rpower.
+Apply derivable_pt_lim_comp with f1 := ln f2 := [x : ?]  (exp (Rmult y x)).
+Apply derivable_pt_lim_ln; Assumption.
+Rewrite (Rmult_sym y).
+Apply derivable_pt_lim_comp with f1 := [x : ?]  (Rmult y x) f2 := exp.
+Pattern 2 y; Replace y with (Rplus (Rmult R0 (ln x)) (Rmult y R1)).
+Apply derivable_pt_lim_mult with f1 := [x : R]  y f2 := [x : R]  x.
+Apply derivable_pt_lim_const with a := y.
+Apply derivable_pt_lim_id.
+Ring.
+Apply derivable_pt_lim_exp.
+Qed.
diff --git a/theories7/Reals/Rprod.v b/theories7/Reals/Rprod.v
new file mode 100644
index 00000000..a524a915
--- /dev/null
+++ b/theories7/Reals/Rprod.v
@@ -0,0 +1,164 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rprod.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Compare.
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require PartSum.
+Require Binomial.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(* TT Ak; 1<=k<=N *)
+Fixpoint prod_f_SO [An:nat->R;N:nat] : R := Cases N of
+  O => R1
+| (S p) => ``(prod_f_SO An p)*(An (S p))``
+end.
+
+(**********)
+Lemma prod_SO_split : (An:nat->R;n,k:nat) (le k n) -> (prod_f_SO An n)==(Rmult (prod_f_SO An k) (prod_f_SO [l:nat](An (plus k l)) (minus n k))).
+Intros; Induction n.
+Cut k=O; [Intro; Rewrite H0; Simpl; Ring | Inversion H; Reflexivity].
+Cut k=(S n)\/(le k n).
+Intro; Elim H0; Intro.
+Rewrite H1; Simpl; Rewrite <- minus_n_n; Simpl; Ring.
+Replace (minus (S n) k) with (S (minus n k)).
+Simpl; Replace (plus k (S (minus n k))) with (S n).
+Rewrite Hrecn; [Ring | Assumption].
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite S_INR; Rewrite minus_INR; [Ring | Assumption].
+Apply INR_eq; Rewrite S_INR; Repeat Rewrite minus_INR.
+Rewrite S_INR; Ring.
+Apply le_trans with n; [Assumption | Apply le_n_Sn].
+Assumption.
+Inversion H; [Left; Reflexivity | Right; Assumption].
+Qed.
+
+(**********)
+Lemma prod_SO_pos : (An:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)``) -> ``0<=(prod_f_SO An N)``.
+Intros; Induction N.
+Simpl; Left; Apply Rlt_R0_R1.
+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.
+Qed.
+
+(**********)
+Lemma prod_SO_Rle : (An,Bn:nat->R;N:nat) ((n:nat)(le n N)->``0<=(An n)<=(Bn n)``) -> ``(prod_f_SO An N)<=(prod_f_SO Bn N)``.
+Intros; Induction N.
+Right; Reflexivity.
+Simpl; Apply Rle_trans with ``(prod_f_SO An N)*(Bn (S N))``.
+Apply Rle_monotony.
+Apply prod_SO_pos; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Assumption.
+Elim (H (S N) (le_n (S N))); Intros; Assumption.
+Do 2 Rewrite <- (Rmult_sym (Bn (S N))); Apply Rle_monotony.
+Elim (H (S N) (le_n (S N))); Intros.
+Apply Rle_trans with (An (S N)); Assumption.
+Apply HrecN; Intros; Elim (H n (le_trans ? ? ? H0 (le_n_Sn N))); Intros; Split; Assumption.
+Qed.
+
+(* Application to factorial *)
+Lemma fact_prodSO : (n:nat) (INR (fact n))==(prod_f_SO [k:nat](INR k) n).
+Intro; Induction n.
+Reflexivity.
+Change (INR (mult (S n) (fact n)))==(prod_f_SO ([k:nat](INR k)) (S n)).
+Rewrite mult_INR; Rewrite Rmult_sym; Rewrite Hrecn; Reflexivity.
+Qed.
+
+Lemma le_n_2n : (n:nat) (le n (mult (2) n)).
+Induction n.
+Replace (mult (2) (O)) with O; [Apply le_n | Ring].
+Intros; Replace (mult (2) (S n0)) with (S (S (mult (2) n0))).
+Apply le_n_S; Apply le_S; Assumption.
+Replace (S (S (mult (2) n0))) with (plus (mult (2) n0) (2)); [Idtac | Ring].
+Replace (S n0) with (plus n0 (1)); [Idtac | Ring].
+Ring.
+Qed. 
+
+(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *)
+Lemma RfactN_fact2N_factk : (N,k:nat) (le k (mult (2) N)) -> ``(Rsqr (INR (fact N)))<=(INR (fact (minus (mult (S (S O)) N) k)))*(INR (fact k))``.
+Intros; Unfold Rsqr; Repeat Rewrite fact_prodSO.
+Cut (le k N)\/(le N k).
+Intro; Elim H0; Intro.
+Rewrite (prod_SO_split [l:nat](INR l) (minus (mult (2) N) k) N).
+Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply prod_SO_pos; Intros; Apply pos_INR.
+Replace (minus (minus (mult (2) N) k) N) with (minus N k).
+Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N k).
+Apply Rle_monotony.
+Apply prod_SO_pos; Intros; Apply pos_INR.
+Apply prod_SO_Rle; Intros; Split.
+Apply pos_INR.
+Apply le_INR; Apply le_reg_r; Assumption.
+Assumption.
+Apply INR_eq; Repeat Rewrite minus_INR.
+Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply le_trans with N; [Assumption | Apply le_n_2n].
+Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring].
+Apply le_reg_r; Assumption.
+Assumption.
+Assumption.
+Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring].
+Apply le_reg_r; Assumption.
+Assumption.
+Rewrite <- (Rmult_sym (prod_f_SO [l:nat](INR l) k)); Rewrite (prod_SO_split [l:nat](INR l) k N).
+Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply prod_SO_pos; Intros; Apply pos_INR.
+Rewrite Rmult_sym; Rewrite (prod_SO_split [l:nat](INR l) N (minus (mult (2) N) k)).
+Apply Rle_monotony.
+Apply prod_SO_pos; Intros; Apply pos_INR.
+Replace (minus N (minus (mult (2) N) k)) with (minus k N).
+Apply prod_SO_Rle; Intros; Split.
+Apply pos_INR.
+Apply le_INR; Apply le_reg_r.
+Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
+Assumption.
+Apply INR_eq; Repeat Rewrite minus_INR.
+Rewrite mult_INR; Do 2 Rewrite S_INR; Ring.
+Assumption.
+Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
+Assumption.
+Assumption.
+Apply simpl_le_plus_l with k; Rewrite <- le_plus_minus.
+Replace (mult (2) N) with (plus N N); [Idtac | Ring]; Apply le_reg_r; Assumption.
+Assumption.
+Assumption.
+Elim (le_dec k N); Intro; [Left; Assumption | Right; Assumption].
+Qed.
+
+(**********)
+Lemma INR_fact_lt_0 : (n:nat) ``0<(INR (fact n))``.
+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 : (N,k:nat) (le k (mult (2) N)) -> ``(C (mult (S (S O)) N) k)<=(C (mult (S (S O)) N) N)``.
+Intros; Unfold C; Unfold Rdiv; Apply Rle_monotony.
+Apply pos_INR.
+Replace (minus (mult (2) N) N) with N.
+Apply Rle_monotony_contra with ``((INR (fact N))*(INR (fact N)))``.
+Apply Rmult_lt_pos; Apply INR_fact_lt_0.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_sym; Apply Rle_monotony_contra with ``((INR (fact k))*
+   (INR (fact (minus (mult (S (S O)) N) k))))``.
+Apply Rmult_lt_pos; Apply INR_fact_lt_0.
+Rewrite Rmult_1r; Rewrite <- mult_INR; Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite mult_INR; Rewrite (Rmult_sym (INR (fact k))); Replace ``(INR (fact N))*(INR (fact N))`` with (Rsqr (INR (fact N))).
+Apply RfactN_fact2N_factk.
+Assumption.
+Reflexivity.
+Rewrite mult_INR; Apply prod_neq_R0; Apply INR_fact_neq_0.
+Apply prod_neq_R0; Apply INR_fact_neq_0.
+Apply INR_eq; Rewrite minus_INR; [Rewrite mult_INR; Do 2 Rewrite S_INR; Ring | Apply le_n_2n].
+Qed.
diff --git a/theories7/Reals/Rseries.v b/theories7/Reals/Rseries.v
new file mode 100644
index 00000000..a38099dd
--- /dev/null
+++ b/theories7/Reals/Rseries.v
@@ -0,0 +1,279 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rseries.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Classical.
+Require Compare.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Implicit Variable Type r:R.
+
+(* classical is needed for [Un_cv_crit] *)
+(*********************************************************)
+(*           Definition of sequence and properties       *)
+(*                                                       *)
+(*********************************************************)
+
+Section sequence.
+
+(*********)
+Variable Un:nat->R.
+
+(*********)
+Fixpoint Rmax_N [N:nat]:R:=
+   Cases N of
+     O     => (Un O)
+    |(S n) => (Rmax (Un (S n)) (Rmax_N n))
+   end.
+
+(*********)
+Definition EUn:R->Prop:=[r:R](Ex [i:nat] (r==(Un i))).
+
+(*********)
+Definition Un_cv:R->Prop:=[l:R]
+  (eps:R)(Rgt eps R0)->(Ex[N:nat](n:nat)(ge n N)->
+             (Rlt (R_dist (Un n) l) eps)).
+
+(*********)
+Definition Cauchy_crit:Prop:=(eps:R)(Rgt eps R0)->
+       (Ex[N:nat] (n,m:nat)(ge n N)->(ge m N)->
+                  (Rlt (R_dist (Un n) (Un m)) eps)).
+
+(*********)
+Definition Un_growing:Prop:=(n:nat)(Rle (Un n) (Un (S n))).
+
+(*********)
+Lemma EUn_noempty:(ExT [r:R] (EUn r)).
+Unfold EUn;Split with (Un O);Split with O;Trivial.
+Qed.
+
+(*********)
+Lemma Un_in_EUn:(n:nat)(EUn (Un n)).
+Intro;Unfold EUn;Split with n;Trivial.
+Qed.
+
+(*********)
+Lemma Un_bound_imp:(x:R)((n:nat)(Rle (Un n) x))->(is_upper_bound EUn x).
+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.
+
+(*********)
+Lemma growing_prop:(n,m:nat)Un_growing->(ge n m)->(Rge (Un n) (Un m)).
+Double Induction n m;Intros.
+Unfold Rge;Right;Trivial.
+ElimType False;Unfold ge in H1;Generalize (le_Sn_O n0);Intro;Auto.
+Cut (ge n0 (0)).
+Generalize H0;Intros;Unfold Un_growing in H0;
+ Apply (Rge_trans (Un (S n0)) (Un n0) (Un (0)) 
+                  (Rle_sym1 (Un n0) (Un (S n0)) (H0 n0)) (H O H2 H3)).
+Elim n0;Auto.
+Elim (lt_eq_lt_dec n1 n0);Intro y.
+Elim y;Clear y;Intro y.
+Unfold ge in H2;Generalize (le_not_lt n0 n1 (le_S_n n0 n1 H2));Intro;
+ ElimType False;Auto.
+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 (Rge_trans (Un (S n1)) (Un n1) (Un (S n0)) 
+                  (Rle_sym1 (Un n1) (Un (S n1)) (H1 n1)) H3).
+Qed.
+
+
+(* classical is needed: [not_all_not_ex] *)
+(*********)
+Lemma Un_cv_crit:Un_growing->(bound EUn)->(ExT [l:R] (Un_cv l)).
+Unfold Un_growing Un_cv;Intros;
+ Generalize (complet_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 (n:nat)(Rle (Un n) x);Intro.
+Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
+Intro;Elim H6;Clear H6;Intros;Split with x1.
+Intros;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
+Unfold Rgt in H2;
+ Apply (Rle_lt_trans (Rminus (Un n) x) R0 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 (Rminus x eps) (Un x1) (Un n) H6
+                          (Rle_sym2 (Un x1) (Un n) H8));Intro;
+ Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
+ Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
+ Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
+ Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
+ Trivial.
+Cut ~((N:nat)(Rge (Rminus x eps) (Un N))).
+Intro;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N))));
+ Red;Intro;Red in H6;Elim H6;Clear H6;Intro;
+ Apply (Rlt_not_ge (Rminus x eps) (Un N) (H7 N)).
+Red;Intro;Cut (N:nat)(Rle (Un N) (Rminus x eps)).
+Intro;Generalize (Un_bound_imp (Rminus x eps) H7);Intro;
+ Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);Intro;
+ Generalize (Rle_minus x (Rminus x eps) H9);Unfold Rminus;
+ Rewrite Ropp_distr1;Rewrite <- Rplus_assoc;Rewrite Rplus_Ropp_r;
+ Rewrite (let (H1,H2)=(Rplus_ne (Ropp (Ropp eps))) in H2);
+ Rewrite Ropp_Ropp;Intro;Unfold Rgt in H2;
+ Generalize (Rle_not eps R0 H2);Intro;Auto.
+Intro;Elim (H6 N);Intro;Unfold Rle.
+Left;Unfold Rgt in H7;Assumption.
+Right;Auto.
+Apply (H1 (Un n) (Un_in_EUn n)).
+Qed.
+
+(*********)
+Lemma finite_greater:(N:nat)(ExT [M:R] (n:nat)(le n N)->(Rle (Un n) M)).
+Intro;Induction N.
+Split with (Un O);Intros;Rewrite (le_n_O_eq n H); 
+ Apply (eq_Rle (Un (n)) (Un (n)) (refl_eqT R (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 (Rle (Un n) (Un n)) (Rle (Un n) x) 
+    (eq_Rle (Un n) (Un n) (refl_eqT R (Un n))))).
+Apply (H2 (or_intror (Rle (Un n) (Un (S N))) (Rle (Un n) x) 
+    (H n H3))).
+Qed.
+
+(*********)
+Lemma cauchy_bound:Cauchy_crit->(bound EUn).
+Unfold Cauchy_crit bound;Intros;Unfold is_upper_bound;
+ Unfold Rgt in H;Elim (H R1 Rlt_R0_R1);Clear H;Intros;
+ Generalize (H x);Intro;Generalize (le_dec x);Intro;
+ Elim (finite_greater x);Intros;Split with (Rmax x0 (Rplus (Un x) R1));
+ Clear H;Intros;Unfold EUn in H;Elim H;Clear H;Intros;Elim (H1 x2);
+ Clear H1;Intro y.
+Unfold ge in H0;Generalize (H0 x2 (le_n x) y);Clear H0;Intro;
+ Rewrite <- H in H0;Unfold R_dist in H0;
+ Elim (Rabsolu_def2 (Rminus (Un x) x1) R1 H0);Clear H0;Intros;
+ Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Apply H4;Clear H3 H4;
+ Right;Clear H H0 y;Apply (Rlt_le x1 (Rplus (Un x) R1));
+ Generalize (Rlt_minus (Ropp R1) (Rminus (Un x) x1) H1);Clear H1;
+ Intro;Apply (Rminus_lt x1 (Rplus (Un x) R1));
+ Cut (Rminus (Ropp R1) (Rminus (Un x) x1))==
+  (Rminus x1 (Rplus (Un x) R1));[Intro;Rewrite H0 in H;Assumption|Ring].
+Generalize (H2 x2 y);Clear H2 H0;Intro;Rewrite<-H in H0;
+ Elim (Rmax_Rle x0 (Rplus (Un x) R1) x1);Intros;Clear H1;Apply H2;
+ Left;Assumption.
+Qed.
+
+End sequence.
+
+(*****************************************************************)
+(*           Definition of Power Series and properties           *)
+(*                                                               *)
+(*****************************************************************)
+
+Section Isequence.
+
+(*********)
+Variable An:nat->R.
+
+(*********)
+Definition Pser:R->R->Prop:=[x,l:R]
+   (infinit_sum [n:nat](Rmult (An n) (pow x n)) l).
+
+End Isequence.
+
+Lemma GP_infinite:
+ (x:R) (Rlt (Rabsolu x) R1) 
+       -> (Pser ([n:nat] R1) x (Rinv(Rminus R1 x))).
+Intros;Unfold Pser; Unfold infinit_sum;Intros;Elim (Req_EM x R0).
+Intros;Exists O; Intros;Rewrite H1;Rewrite minus_R0;Rewrite Rinv_R1;
+  Cut (sum_f_R0 [n0:nat](Rmult R1 (pow R0 n0)) n)==R1.
+Intros; Rewrite H3;Rewrite R_dist_eq;Auto.
+Elim n; Simpl.
+Ring.
+Intros;Rewrite H3;Ring.
+Intro;Cut (Rlt R0
+      (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) 
+                        (Rabsolu (Rinv x))))).
+Intro;Elim (pow_lt_1_zero x H
+                    (Rmult eps (Rmult (Rabsolu (Rminus R1 x))
+                                 (Rabsolu (Rinv x))))
+                    H2);Intro N; Intros;Exists N; Intros;
+  Cut (sum_f_R0 [n0:nat](Rmult R1 (pow x n0)) n)==
+    (sum_f_R0 [n0:nat](pow x n0) n).
+Intros; Rewrite H5;Apply (Rlt_monotony_rev
+         (Rabsolu (Rminus R1 x))
+         (R_dist (sum_f_R0 [n0:nat](pow x n0) n) 
+                 (Rinv (Rminus R1 x))) 
+         eps).
+Apply Rabsolu_pos_lt.
+Apply Rminus_eq_contra.
+Apply imp_not_Req.
+Right; Unfold Rgt.
+Apply (Rle_lt_trans x (Rabsolu x) R1).
+Apply Rle_Rabsolu.
+Assumption.
+Unfold R_dist; Rewrite <- Rabsolu_mult.
+Rewrite Rminus_distr.
+Cut (Rmult (Rminus R1 x) (sum_f_R0 [n0:nat](pow x n0) n))==
+    (Ropp (Rmult(sum_f_R0 [n0:nat](pow x n0) n) 
+          (Rminus x R1))).
+Intro; Rewrite H6.
+Rewrite GP_finite.
+Rewrite Rinv_r.
+Cut (Rminus (Ropp (Rminus (pow x (plus n (1))) R1)) R1)==
+    (Ropp (pow x (plus n (1)))).
+Intro; Rewrite H7.
+Rewrite Rabsolu_Ropp;Cut (plus n (S O))=(S n);Auto.
+Intro H8;Rewrite H8;Simpl;Rewrite Rabsolu_mult;
+  Apply (Rlt_le_trans (Rmult (Rabsolu x) (Rabsolu (pow x n)))
+                    (Rmult (Rabsolu x)
+                           (Rmult eps
+                              (Rmult (Rabsolu (Rminus R1 x)) 
+                                      (Rabsolu (Rinv x)))))
+                 (Rmult (Rabsolu (Rminus R1 x)) eps)).
+Apply Rlt_monotony.
+Apply Rabsolu_pos_lt.
+Assumption.
+Auto.
+Cut (Rmult (Rabsolu x)
+           (Rmult eps (Rmult (Rabsolu (Rminus R1 x)) 
+                             (Rabsolu (Rinv x)))))==
+    (Rmult (Rmult (Rabsolu x) (Rabsolu (Rinv x))) 
+           (Rmult eps (Rabsolu (Rminus R1 x)))).
+Clear H8;Intros; Rewrite H8;Rewrite <- Rabsolu_mult;Rewrite Rinv_r.  
+Rewrite Rabsolu_R1;Cut (Rmult R1 (Rmult eps (Rabsolu (Rminus R1 x))))==
+    (Rmult (Rabsolu (Rminus R1 x)) eps).
+Intros; Rewrite H9;Unfold Rle; Right; Reflexivity.
+Ring.
+Assumption.
+Ring.
+Ring.
+Ring.
+Apply Rminus_eq_contra.
+Apply imp_not_Req.
+Right; Unfold Rgt.
+Apply (Rle_lt_trans x (Rabsolu x) R1).
+Apply Rle_Rabsolu.
+Assumption.
+Ring; Ring.
+Elim n; Simpl.
+Ring.
+Intros; Rewrite H5.
+Ring.
+Apply Rmult_lt_pos.
+Auto.
+Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt.
+Apply Rminus_eq_contra.
+Apply imp_not_Req.
+Right; Unfold Rgt.
+Apply (Rle_lt_trans x (Rabsolu x) R1).
+Apply Rle_Rabsolu.
+Assumption.
+Apply Rabsolu_pos_lt.
+Apply Rinv_neq_R0.
+Assumption.
+Qed.
diff --git a/theories7/Reals/Rsigma.v b/theories7/Reals/Rsigma.v
new file mode 100644
index 00000000..f9e8e92b
--- /dev/null
+++ b/theories7/Reals/Rsigma.v
@@ -0,0 +1,117 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rsigma.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require PartSum.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Set Implicit Arguments.
+
+Section Sigma.
+
+Variable f : nat->R.
+
+Definition sigma [low,high:nat] : R := (sum_f_R0 [k:nat](f (plus low k)) (minus high low)).
+
+Theorem sigma_split : (low,high,k:nat) (le low k)->(lt k high)->``(sigma low high)==(sigma low k)+(sigma (S k) high)``.
+Intros; Induction k.
+Cut low = O.
+Intro; Rewrite H1; Unfold sigma; Rewrite <- minus_n_n; Rewrite <- minus_n_O; Simpl; Replace (minus high (S O)) with (pred high).
+Apply (decomp_sum [k:nat](f k)).
+Assumption.
+Apply pred_of_minus.
+Inversion H; Reflexivity.
+Cut (le low k)\/low=(S k).
+Intro; Elim H1; Intro.
+Replace (sigma low (S k)) with ``(sigma low k)+(f (S k))``.
+Rewrite Rplus_assoc; Replace ``(f (S k))+(sigma (S (S k)) high)`` with (sigma (S k) high).
+Apply Hreck.
+Assumption.
+Apply lt_trans with (S k); [Apply lt_n_Sn | Assumption].
+Unfold sigma; Replace (minus high (S (S k))) with (pred (minus high (S k))).
+Pattern 3 (S k); Replace (S k) with (plus (S k) O); [Idtac | Ring].
+Replace (sum_f_R0 [k0:nat](f (plus (S (S k)) k0)) (pred (minus high (S k)))) with (sum_f_R0 [k0:nat](f (plus (S k) (S k0))) (pred (minus high (S k)))).
+Apply (decomp_sum [i:nat](f (plus (S k) i))).
+Apply lt_minus_O_lt; Assumption.
+Apply sum_eq; Intros; Replace (plus (S k) (S i)) with (plus (S (S k)) i).
+Reflexivity.
+Apply INR_eq; Do 2 Rewrite plus_INR; Do 3 Rewrite S_INR; Ring.
+Replace (minus high (S (S k))) with (minus (minus high (S k)) (S O)).
+Apply pred_of_minus.
+Apply INR_eq; Repeat  Rewrite minus_INR.
+Do 4 Rewrite S_INR; Ring.
+Apply lt_le_S; Assumption.
+Apply lt_le_weak; Assumption.
+Apply lt_le_S; Apply lt_minus_O_lt; Assumption.
+Unfold sigma; Replace (minus (S k) low) with (S (minus k low)).
+Pattern 1 (S k); Replace (S k) with (plus low (S (minus k low))).
+Symmetry; Apply (tech5 [i:nat](f (plus low i))).
+Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite minus_INR.
+Ring.
+Assumption.
+Apply minus_Sn_m; Assumption.
+Rewrite <- H2; Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (minus high (S low)) with (pred (minus high low)).
+Replace (sum_f_R0 [k0:nat](f (S (plus low k0))) (pred (minus high low))) with (sum_f_R0 [k0:nat](f (plus low (S k0))) (pred (minus high low))).
+Apply (decomp_sum [k0:nat](f (plus low k0))).
+Apply lt_minus_O_lt.
+Apply le_lt_trans with (S k); [Rewrite H2; Apply le_n | Assumption].
+Apply sum_eq; Intros; Replace (S (plus low i)) with (plus low (S i)).
+Reflexivity.
+Apply INR_eq; Rewrite plus_INR; Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
+Replace (minus high (S low)) with (minus (minus high low) (S O)).
+Apply pred_of_minus.
+Apply INR_eq; Repeat  Rewrite minus_INR.
+Do 2 Rewrite S_INR; Ring.
+Apply lt_le_S; Rewrite H2; Assumption.
+Rewrite H2; Apply lt_le_weak; Assumption.
+Apply lt_le_S; Apply lt_minus_O_lt; Rewrite H2; Assumption.
+Inversion H; [
+  Right; Reflexivity
+| Left; Assumption].
+Qed.
+
+Theorem sigma_diff : (low,high,k:nat) (le low k) -> (lt k high )->``(sigma low high)-(sigma low k)==(sigma (S k) high)``.
+Intros low high k H1 H2; Symmetry; Rewrite -> (sigma_split H1 H2); Ring.
+Qed.
+
+Theorem sigma_diff_neg : (low,high,k:nat) (le low k) -> (lt k high)-> ``(sigma low k)-(sigma low high)==-(sigma (S k) high)``.
+Intros low high k H1 H2; Rewrite -> (sigma_split H1 H2); Ring.
+Qed.
+
+Theorem sigma_first : (low,high:nat) (lt low high) -> ``(sigma low high)==(f low)+(sigma (S low) high)``.
+Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f low)`` with ``(sigma low low)``.
+Apply sigma_split.
+Apply le_n.
+Assumption.
+Unfold sigma; Rewrite <- minus_n_n.
+Simpl.
+Replace (plus low O) with low; [Reflexivity | Ring].
+Qed.
+
+Theorem sigma_last : (low,high:nat) (lt low high) -> ``(sigma low high)==(f high)+(sigma low (pred high))``.
+Intros low high H1; Generalize (lt_le_S low high H1); Intro H2; Generalize (lt_le_weak low high H1); Intro H3; Replace ``(f high)`` with ``(sigma high high)``.
+Rewrite Rplus_sym; Cut high = (S (pred high)).
+Intro; Pattern 3 high; 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 O; Apply le_lt_trans with low; [Apply le_O_n | Assumption].
+Unfold sigma; Rewrite <- minus_n_n; Simpl; Replace (plus high O) with high; [Reflexivity | Ring].
+Qed.
+
+Theorem sigma_eq_arg : (low:nat) (sigma low low)==(f low).
+Intro; Unfold sigma; Rewrite <- minus_n_n.
+Simpl; Replace (plus low O) with low; [Reflexivity | Ring].
+Qed.
+
+End Sigma.
diff --git a/theories7/Reals/Rsqrt_def.v b/theories7/Reals/Rsqrt_def.v
new file mode 100644
index 00000000..17367dce
--- /dev/null
+++ b/theories7/Reals/Rsqrt_def.v
@@ -0,0 +1,688 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rsqrt_def.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Sumbool.
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Ranalysis1.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Fixpoint Dichotomy_lb [x,y:R;P:R->bool;N:nat] : R :=
+Cases N of 
+  O => x
+| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2``  in if (P z) then down else z
+end
+with Dichotomy_ub [x,y:R;P:R->bool;N:nat] : R :=
+Cases N of 
+  O => y
+| (S n) => let down = (Dichotomy_lb x y P n) in let up = (Dichotomy_ub x y P n) in let z = ``(down+up)/2``  in if (P z) then z else up
+end.
+
+Definition dicho_lb [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_lb x y P N).
+Definition dicho_up [x,y:R;P:R->bool] : nat->R := [N:nat](Dichotomy_ub x y P N).
+
+(**********)
+Lemma dicho_comp : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_lb x y P n)<=(dicho_up x y P n)``.
+Intros.
+Induction n.
+Simpl; Assumption.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 1 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
+Rewrite Rmult_1r.
+Rewrite double.
+Apply Rle_compatibility.
+Assumption.
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 3 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
+Rewrite Rmult_1r.
+Rewrite double.
+Rewrite <- (Rplus_sym (Dichotomy_ub x y P n)).
+Apply Rle_compatibility.
+Assumption.
+Qed.
+
+Lemma dicho_lb_growing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_growing (dicho_lb x y P)).
+Intros.
+Unfold Un_growing.
+Intro.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+Right; Reflexivity.
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 1 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
+Rewrite Rmult_1r.
+Rewrite double.
+Apply Rle_compatibility.
+Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Apply dicho_comp; Assumption | Reflexivity].
+Qed.
+
+Lemma dicho_up_decreasing : (x,y:R;P:R->bool) ``x<=y`` -> (Un_decreasing (dicho_up x y P)).
+Intros.
+Unfold Un_decreasing.
+Intro.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 3 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR].
+Rewrite Rmult_1r.
+Rewrite double.
+Replace (Dichotomy_ub x y P n) with (dicho_up x y P n); [Idtac | Reflexivity].
+Replace (Dichotomy_lb x y P n) with (dicho_lb x y P n); [Idtac | Reflexivity].
+Rewrite <- (Rplus_sym ``(dicho_up x y P n)``).
+Apply Rle_compatibility.
+Apply dicho_comp; Assumption.
+Right; Reflexivity.
+Qed.
+
+Lemma dicho_lb_maj_y : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``(dicho_lb x y P n)<=y``.
+Intros.
+Induction n.
+Simpl; Assumption.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+Assumption.
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 3 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
+Rewrite double; Apply Rplus_le.
+Assumption.
+Pattern 2 y; Replace y with (Dichotomy_ub x y P O); [Idtac | Reflexivity].
+Apply decreasing_prop.
+Assert H0 := (dicho_up_decreasing x y P H).
+Assumption.
+Apply le_O_n.
+Qed.
+
+Lemma dicho_lb_maj : (x,y:R;P:R->bool) ``x<=y`` -> (has_ub (dicho_lb x y P)).
+Intros.
+Cut (n:nat)``(dicho_lb x y P n)<=y``.
+Intro.
+Unfold has_ub.
+Unfold bound.
+Exists y.
+Unfold is_upper_bound.
+Intros.
+Elim H1; Intros.
+Rewrite H2; Apply H0.
+Apply dicho_lb_maj_y; Assumption.
+Qed.
+
+Lemma dicho_up_min_x : (x,y:R;P:R->bool) ``x<=y`` -> (n:nat)``x<=(dicho_up x y P n)``.
+Intros.
+Induction n.
+Simpl; Assumption.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Pattern 1 ``2``; Rewrite Rmult_sym.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1r | DiscrR].
+Rewrite double; Apply Rplus_le.
+Pattern 1 x; Replace x with (Dichotomy_lb x y P O); [Idtac | Reflexivity].
+Apply tech9.
+Assert H0 := (dicho_lb_growing x y P H).
+Assumption.
+Apply le_O_n.
+Assumption.
+Assumption.
+Qed.
+
+Lemma dicho_up_min : (x,y:R;P:R->bool) ``x<=y`` -> (has_lb (dicho_up x y P)).
+Intros.
+Cut (n:nat)``x<=(dicho_up x y P n)``.
+Intro.
+Unfold has_lb.
+Unfold bound.
+Exists ``-x``.
+Unfold is_upper_bound.
+Intros.
+Elim H1; Intros.
+Rewrite H2.
+Unfold opp_seq.
+Apply Rle_Ropp1.
+Apply H0.
+Apply dicho_up_min_x; Assumption.
+Qed.
+
+Lemma dicho_lb_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_lb x y P) l)).
+Intros.
+Apply growing_cv.
+Apply dicho_lb_growing; Assumption.
+Apply dicho_lb_maj; Assumption.
+Qed.
+
+Lemma dicho_up_cv : (x,y:R;P:R->bool) ``x<=y`` -> (sigTT R [l:R](Un_cv (dicho_up x y P) l)).
+Intros.
+Apply decreasing_cv.
+Apply dicho_up_decreasing; Assumption.
+Apply dicho_up_min; Assumption.
+Qed.
+
+Lemma dicho_lb_dicho_up : (x,y:R;P:R->bool;n:nat) ``x<=y`` -> ``(dicho_up x y P n)-(dicho_lb x y P n)==(y-x)/(pow 2 n)``.
+Intros.
+Induction n.
+Simpl.
+Unfold Rdiv; Rewrite Rinv_R1; Ring.
+Simpl.
+Case (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``).
+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; Rewrite Hrecn.
+Unfold Rdiv.
+Rewrite Rinv_Rmult.
+Ring.
+DiscrR.
+Apply pow_nonzero; DiscrR.
+Pattern 2 (Dichotomy_lb x y P n); Rewrite (double_var (Dichotomy_lb x y P n)); 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; Rewrite Hrecn.
+Unfold Rdiv.
+Rewrite Rinv_Rmult.
+Ring.
+DiscrR.
+Apply pow_nonzero; DiscrR.
+Pattern 1 (Dichotomy_ub x y P n); Rewrite (double_var (Dichotomy_ub x y P n)); Unfold dicho_up dicho_lb Rminus Rdiv; Ring.
+Qed.
+
+Definition pow_2_n := [n:nat](pow ``2`` n).
+
+Lemma pow_2_n_neq_R0 : (n:nat) ``(pow_2_n n)<>0``.
+Intro.
+Unfold pow_2_n.
+Apply pow_nonzero.
+DiscrR.
+Qed.
+
+Lemma pow_2_n_growing : (Un_growing pow_2_n).
+Unfold Un_growing.
+Intro.
+Replace (S n) with (plus n (1)); [Unfold pow_2_n; Rewrite pow_add | Ring].
+Pattern 1 (pow ``2`` n); Rewrite <- Rmult_1r.
+Apply Rle_monotony.
+Left; Apply pow_lt; Sup0.
+Simpl.
+Rewrite Rmult_1r.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1.
+Qed.
+
+Lemma pow_2_n_infty : (cv_infty pow_2_n).
+Cut (N:nat)``(INR N)<=(pow 2 N)``.
+Intros.
+Unfold cv_infty.
+Intro.
+Case (total_order_T R0 M); Intro.
+Elim s; Intro.
+Pose N := (up M).
+Cut `0<=N`.
+Intro.
+Elim (IZN N H0); Intros N0 H1.
+Exists N0.
+Intros.
+Apply Rlt_le_trans with (INR N0).
+Rewrite INR_IZR_INZ.
+Rewrite <- H1.
+Unfold N.
+Assert H3 := (archimed M).
+Elim H3; Intros; Assumption.
+Apply Rle_trans with (pow_2_n N0).
+Unfold pow_2_n; Apply H.
+Apply Rle_sym2.
+Apply growing_prop.
+Apply pow_2_n_growing.
+Assumption.
+Apply le_IZR.
+Unfold N.
+Simpl.
+Assert H0 := (archimed M); Elim H0; Intros.
+Left; Apply Rlt_trans with M; Assumption.
+Exists O; Intros.
+Rewrite <- b.
+Unfold pow_2_n; Apply pow_lt; Sup0.
+Exists O; Intros.
+Apply Rlt_trans with R0.
+Assumption.
+Unfold pow_2_n; Apply pow_lt; Sup0.
+Induction N.
+Simpl.
+Left; Apply Rlt_R0_R1.
+Intros.
+Pattern 2 (S n); Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite S_INR; Rewrite pow_add.
+Simpl.
+Rewrite Rmult_1r.
+Apply Rle_trans with ``(pow 2 n)``.
+Rewrite <- (Rplus_sym R1).
+Rewrite <- (Rmult_1r (INR n)).
+Apply (poly n R1).
+Apply Rlt_R0_R1.
+Pattern 1 (pow ``2`` n); Rewrite <- Rplus_Or.
+Rewrite <- (Rmult_sym ``2``).
+Rewrite double.
+Apply Rle_compatibility.
+Left; Apply pow_lt; Sup0.
+Qed.
+
+Lemma cv_dicho : (x,y,l1,l2:R;P:R->bool) ``x<=y`` -> (Un_cv (dicho_lb x y P) l1) -> (Un_cv (dicho_up x y P) l2) -> l1==l2.
+Intros.
+Assert H2 := (CV_minus ? ? ? ? H0 H1).
+Cut (Un_cv [i:nat]``(dicho_lb x y P i)-(dicho_up x y P i)`` R0).
+Intro.
+Assert H4 := (UL_sequence ? ? ? H2 H3).
+Symmetry; Apply Rminus_eq_right; 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.
+Elim s; Intro.
+Unfold Un_cv in H4; Unfold R_dist in H4.
+Cut ``0<y-x``.
+Intro Hyp.
+Cut ``0<eps/(y-x)``.
+Intro.
+Elim (H4 ``eps/(y-x)`` H5); Intros N H6.
+Exists N; Intros.
+Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
+Rewrite <- Rabsolu_Ropp.
+Rewrite Ropp_distr3.
+Rewrite dicho_lb_dicho_up.
+Unfold Rdiv; Rewrite Rabsolu_mult.
+Rewrite (Rabsolu_right ``y-x``).
+Apply Rlt_monotony_contra with ``/(y-x)``.
+Apply Rlt_Rinv; Assumption.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace ``/(pow 2 n)`` with ``/(pow 2 n)-0``; [Unfold pow_2_n Rdiv in H6; Rewrite <- (Rmult_sym eps); Apply H6; Assumption | Ring].
+Red; Intro; Rewrite H8 in Hyp; Elim (Rlt_antirefl ? Hyp).
+Apply Rle_sym1.
+Apply Rle_anti_compatibility with x; Rewrite Rplus_Or.
+Replace ``x+(y-x)`` with y; [Assumption | Ring].
+Assumption.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption].
+Apply Rlt_anti_compatibility with x; Rewrite Rplus_Or.
+Replace ``x+(y-x)`` with y; [Assumption | Ring].
+Exists O; Intros.
+Replace ``(dicho_lb x y P n)-(dicho_up x y P n)-0`` with ``(dicho_lb x y P n)-(dicho_up x y P n)``; [Idtac | Ring].
+Rewrite <- Rabsolu_Ropp.
+Rewrite Ropp_distr3.
+Rewrite dicho_lb_dicho_up.
+Rewrite b.
+Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption.
+Assumption.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H r)).
+Qed.
+
+Definition cond_positivity [x:R] : bool := Cases (total_order_Rle R0 x) of 
+  (leftT _) => true 
+| (rightT _) => false end.
+
+(* Sequential caracterisation of continuity *)
+Lemma continuity_seq : (f:R->R;Un:nat->R;l:R) (continuity_pt f l) -> (Un_cv Un l) -> (Un_cv [i:nat](f (Un i)) (f l)).
+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_EM (Un n) l); Intro.
+Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Apply H4.
+Split.
+Unfold D_x no_cond.
+Split.
+Trivial.
+Apply not_sym; Assumption.
+Apply H5; Assumption.
+Qed.
+
+Lemma dicho_lb_car : (x,y:R;P:R->bool;n:nat) (P x)=false -> (P (dicho_lb x y P n))=false.
+Intros.
+Induction n.
+Simpl.
+Assumption.
+Simpl.
+Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
+Elim X; Intro.
+Rewrite a.
+Unfold dicho_lb in Hrecn; Assumption.
+Rewrite b.
+Assumption.
+Qed.
+
+Lemma dicho_up_car : (x,y:R;P:R->bool;n:nat) (P y)=true -> (P (dicho_up x y P n))=true.
+Intros.
+Induction n.
+Simpl.
+Assumption.
+Simpl.
+Assert X := (sumbool_of_bool (P ``((Dichotomy_lb x y P n)+(Dichotomy_ub x y P n))/2``)).
+Elim X; Intro.
+Rewrite a.
+Unfold dicho_lb in Hrecn; Assumption.
+Rewrite b.
+Assumption.
+Qed.
+
+(* Intermediate Value Theorem *)
+Lemma IVT : (f:R->R;x,y:R) (continuity f) -> ``x<y`` -> ``(f x)<0`` -> ``0<(f y)`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
+Intros.
+Cut ``x<=y``.
+Intro.
+Generalize (dicho_lb_cv x y [z:R](cond_positivity (f z)) H3). 
+Generalize (dicho_up_cv x y [z:R](cond_positivity (f z)) H3). 
+Intros.
+Elim X; Intros.
+Elim X0; Intros.
+Assert H4 := (cv_dicho ? ? ? ? ? H3 p0 p).
+Rewrite H4 in p0.
+Apply existTT with x0.
+Split.
+Split.
+Apply Rle_trans with (dicho_lb x y [z:R](cond_positivity (f z)) O).
+Simpl.
+Right; Reflexivity.
+Apply growing_ineq.
+Apply dicho_lb_growing; Assumption.
+Assumption.
+Apply Rle_trans with (dicho_up x y [z:R](cond_positivity (f z)) O).
+Apply decreasing_ineq.
+Apply dicho_up_decreasing; Assumption.
+Assumption.
+Right; Reflexivity.
+2:Left; Assumption.
+Pose Vn := [n:nat](dicho_lb x y [z:R](cond_positivity (f z)) n).
+Pose Wn := [n:nat](dicho_up x y [z:R](cond_positivity (f z)) n).
+Cut ((n:nat)``(f (Vn n))<=0``)->``(f x0)<=0``.
+Cut ((n:nat)``0<=(f (Wn n))``)->``0<=(f x0)``.
+Intros.
+Cut (n:nat)``(f (Vn n))<=0``.
+Cut (n:nat)``0<=(f (Wn n))``.
+Intros.
+Assert H9 := (H6 H8).
+Assert H10 := (H5 H7).
+Apply Rle_antisym; Assumption.
+Intro.
+Unfold Wn.
+Cut (z:R) (cond_positivity z)=true <-> ``0<=z``.
+Intro.
+Assert H8 := (dicho_up_car x y [z:R](cond_positivity (f z)) n).
+Elim (H7 (f (dicho_up x y [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.
+Case (total_order_Rle R0 z); Intro.
+Split.
+Intro; Assumption.
+Intro; Reflexivity.
+Split.
+Intro; Elim diff_false_true; Assumption.
+Intro.
+Elim n0; Assumption.
+Unfold Vn.
+Cut (z:R) (cond_positivity z)=false <-> ``z<0``.
+Intros.
+Assert H8 := (dicho_lb_car x y [z:R](cond_positivity (f z)) n).
+Left.
+Elim (H7 (f (dicho_lb x y [z:R](cond_positivity (f z)) n))); Intros.
+Apply H9.
+Apply H8.
+Elim (H7 (f x)); Intros.
+Apply H12.
+Assumption.
+Intro.
+Unfold cond_positivity.
+Case (total_order_Rle R0 z); Intro.
+Split.
+Intro; Elim diff_true_false; Assumption.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H7)).
+Split.
+Intro; Auto with real.
+Intro; Reflexivity.
+Cut (Un_cv Wn x0).
+Intros.
+Assert H7 := (continuity_seq f Wn x0 (H x0) H5).
+Case (total_order_T R0 (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 (ge x2 x2); [Intro | Unfold ge; Apply le_n].
+Assert H11 := (H9 x2 H10).
+Rewrite Rabsolu_right in H11.
+Pattern 1 ``-(f x0)`` in H11; Rewrite <- Rplus_Or in H11.
+Unfold Rminus in H11; Rewrite (Rplus_sym (f (Wn x2))) in H11.
+Assert H12 := (Rlt_anti_compatibility ? ? ? H11).
+Assert H13 := (H6 x2).
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H13 H12)).
+Apply Rle_sym1; Left; Unfold Rminus; Apply ge0_plus_gt0_is_gt0.
+Apply H6.
+Exact H8.
+Apply Rgt_RO_Ropp; Assumption.
+Unfold Wn; Assumption.
+Cut (Un_cv Vn x0).
+Intros.
+Assert H7 := (continuity_seq f Vn x0 (H x0) H5).
+Case (total_order_T R0 (f x0)); Intro.
+Elim s; Intro.
+Unfold Un_cv in H7; Unfold R_dist in H7.
+Elim (H7 ``(f x0)`` a); Intros.
+Cut (ge x2 x2); [Intro | Unfold ge; Apply le_n].
+Assert H10 := (H8 x2 H9).
+Rewrite Rabsolu_left in H10.
+Pattern 2 ``(f x0)`` in H10; Rewrite <- Rplus_Or in H10.
+Rewrite Ropp_distr3 in H10.
+Unfold Rminus in H10.
+Assert H11 := (Rlt_anti_compatibility ? ? ? H10).
+Assert H12 := (H6 x2).
+Cut ``0<(f (Vn x2))``.
+Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H13 H12)).
+Rewrite <- (Ropp_Ropp (f (Vn x2))).
+Apply Rgt_RO_Ropp; Assumption.
+Apply Rlt_anti_compatibility with ``(f x0)-(f (Vn x2))``.
+Rewrite Rplus_Or; Replace ``(f x0)-(f (Vn x2))+((f (Vn x2))-(f x0))`` with R0; [Unfold Rminus; Apply gt0_plus_ge0_is_gt0 | Ring].
+Assumption.
+Apply Rge_RO_Ropp; Apply Rle_sym1; Apply H6.
+Right; Rewrite <- b; Reflexivity.
+Left; Assumption.
+Unfold Vn; Assumption.
+Qed.
+
+Lemma IVT_cor : (f:R->R;x,y:R) (continuity f) -> ``x<=y`` -> ``(f x)*(f y)<=0`` -> (sigTT R [z:R]``x<=z<=y``/\``(f z)==0``).
+Intros.
+Case (total_order_T R0 (f x)); Intro.
+Case (total_order_T R0 (f y)); Intro.
+Elim s; Intro.
+Elim s0; Intro.
+Cut ``0<(f x)*(f y)``; [Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H1 H2)) | Apply Rmult_lt_pos; Assumption].
+Exists y.
+Split.
+Split; [Assumption | Right; Reflexivity].
+Symmetry; Exact b.
+Exists x.
+Split.
+Split; [Right; Reflexivity | Assumption].
+Symmetry; Exact b.
+Elim s; Intro.
+Cut ``x<y``.
+Intro.
+Assert H3 := (IVT (opp_fct f) x y (continuity_opp f H) H2).
+Cut ``(opp_fct f x)<0``.
+Cut ``0<(opp_fct f y)``.
+Intros.
+Elim (H3 H5 H4); Intros.
+Apply existTT with x0.
+Elim p; Intros.
+Split.
+Assumption.
+Unfold opp_fct in H7.
+Rewrite <- (Ropp_Ropp (f x0)).
+Apply eq_RoppO; Assumption.
+Unfold opp_fct; Apply Rgt_RO_Ropp; Assumption.
+Unfold opp_fct.
+Apply Rlt_anti_compatibility with (f x); Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Assumption.
+Inversion H0.
+Assumption.
+Rewrite H2 in a.
+Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
+Apply existTT with x.
+Split.
+Split; [Right; Reflexivity | Assumption].
+Symmetry; Assumption.
+Case (total_order_T R0 (f y)); Intro.
+Elim s; Intro.
+Cut ``x<y``.
+Intro.
+Apply IVT; Assumption.
+Inversion H0.
+Assumption.
+Rewrite H2 in r.
+Elim (Rlt_antirefl ? (Rlt_trans ? ? ? r a)).
+Apply existTT with y.
+Split.
+Split; [Assumption | Right; Reflexivity].
+Symmetry; Assumption.
+Cut ``0<(f x)*(f y)``.
+Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H2 H1)).
+Rewrite <- Ropp_mul2; Apply Rmult_lt_pos; Apply Rgt_RO_Ropp; Assumption.
+Qed.
+
+(* We can now define the square root function as the reciprocal transformation of the square root function *)
+Lemma Rsqrt_exists : (y:R) ``0<=y`` -> (sigTT R [z:R]``0<=z``/\``y==(Rsqr z)``).
+Intros.
+Pose f := [x:R]``(Rsqr x)-y``.
+Cut ``(f 0)<=0``.
+Intro.
+Cut (continuity f).
+Intro.
+Case (total_order_T y R1); Intro.
+Elim s; Intro.
+Cut ``0<=(f 1)``.
+Intro.
+Cut ``(f 0)*(f 1)<=0``.
+Intro.
+Assert X := (IVT_cor f R0 R1 H1 (Rlt_le ? ? Rlt_R0_R1) H3).
+Elim X; Intros t H4.
+Apply existTT with t.
+Elim H4; Intros.
+Split.
+Elim H5; Intros; Assumption.
+Unfold f in H6.
+Apply Rminus_eq_right; Exact H6.
+Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f R1)).
+Apply Rle_monotony; Assumption.
+Unfold f.
+Rewrite Rsqr_1.
+Apply Rle_anti_compatibility with y.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Left; Assumption.
+Apply existTT with R1.
+Split.
+Left; Apply Rlt_R0_R1.
+Rewrite b; Symmetry; Apply Rsqr_1.
+Cut ``0<=(f y)``.
+Intro.
+Cut ``(f 0)*(f y)<=0``.
+Intro.
+Assert X := (IVT_cor f R0 y H1 H H3).
+Elim X; Intros t H4.
+Apply existTT with t.
+Elim H4; Intros.
+Split.
+Elim H5; Intros; Assumption.
+Unfold f in H6.
+Apply Rminus_eq_right; Exact H6.
+Rewrite Rmult_sym; Pattern 2 R0; Rewrite <- (Rmult_Or (f y)).
+Apply Rle_monotony; Assumption.
+Unfold f.
+Apply Rle_anti_compatibility with y.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Pattern 1 y; Rewrite <- Rmult_1r.
+Unfold Rsqr; Apply Rle_monotony.
+Assumption.
+Left; Exact r.
+Replace f with (minus_fct Rsqr (fct_cte y)).
+Apply continuity_minus.
+Apply derivable_continuous; Apply derivable_Rsqr.
+Apply derivable_continuous; Apply derivable_const.
+Reflexivity.
+Unfold f; Rewrite Rsqr_O.
+Unfold Rminus; Rewrite Rplus_Ol.
+Apply Rle_sym2.
+Apply Rle_RO_Ropp; Assumption.
+Qed.
+
+(* Definition of the square root: R+->R *)
+Definition Rsqrt [y:nonnegreal] : R := Cases (Rsqrt_exists (nonneg y) (cond_nonneg y)) of (existTT a b) => a end.
+
+(**********)
+Lemma Rsqrt_positivity : (x:nonnegreal) ``0<=(Rsqrt x)``.
+Intro.
+Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
+Elim X; Intros.
+Cut x0==(Rsqrt x).
+Intros.
+Elim p; Intros.
+Rewrite H in H0; Assumption.
+Unfold Rsqrt.
+Case (Rsqrt_exists x (cond_nonneg x)).
+Intros.
+Elim p; Elim a; Intros.
+Apply Rsqr_inj.
+Assumption.
+Assumption.
+Rewrite <- H0; Rewrite <- H2; Reflexivity.
+Qed.
+
+(**********)
+Lemma Rsqrt_Rsqrt : (x:nonnegreal) ``(Rsqrt x)*(Rsqrt x)==x``.
+Intros.
+Assert X := (Rsqrt_exists (nonneg x) (cond_nonneg x)).
+Elim X; Intros.
+Cut x0==(Rsqrt x).
+Intros.
+Rewrite <- H.
+Elim p; Intros.
+Rewrite H1; Reflexivity.
+Unfold Rsqrt.
+Case (Rsqrt_exists x (cond_nonneg x)).
+Intros.
+Elim p; Elim a; Intros.
+Apply Rsqr_inj.
+Assumption.
+Assumption.
+Rewrite <- H0; Rewrite <- H2; Reflexivity.
+Qed.
diff --git a/theories7/Reals/Rsyntax.v b/theories7/Reals/Rsyntax.v
new file mode 100644
index 00000000..7b1b6266
--- /dev/null
+++ b/theories7/Reals/Rsyntax.v
@@ -0,0 +1,236 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: Rsyntax.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Export Rdefinitions.
+
+Axiom NRplus : R->R.
+Axiom NRmult : R->R.
+
+V7only[
+Grammar rnatural ident :=
+  nat_id [ prim:var($id) ] -> [$id]
+
+with rnegnumber : constr := 
+  neg_expr [ "-" rnumber ($c) ] -> [ (Ropp $c) ] 
+
+with rnumber :=
+
+with rformula : constr :=
+  form_expr [ rexpr($p) ] -> [ $p ]
+(* | form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT R $p $c) ] *)
+| form_eq [ rexpr($p) "==" rexpr($c) ] -> [ (eqT ? $p $c) ]
+| form_eq2 [ rexpr($p) "=" rexpr($c) ] -> [ (eqT ? $p $c) ]
+| form_le [ rexpr($p) "<=" rexpr($c) ] -> [ (Rle $p $c) ]
+| form_lt [ rexpr($p) "<" rexpr($c) ] -> [ (Rlt $p $c) ]
+| form_ge [ rexpr($p) ">=" rexpr($c) ] -> [ (Rge $p $c) ]
+| form_gt [ rexpr($p) ">" rexpr($c) ] -> [ (Rgt $p $c) ]
+(*
+| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
+              -> [ (eqT R $p $c)/\(eqT R $c $c1) ]
+*)
+| form_eq_eq [ rexpr($p) "==" rexpr($c) "==" rexpr($c1) ]
+              -> [ (eqT ? $p $c)/\(eqT ? $c $c1) ]
+| form_le_le [ rexpr($p) "<=" rexpr($c) "<=" rexpr($c1) ]
+              -> [ (Rle $p $c)/\(Rle $c $c1) ]
+| form_le_lt [ rexpr($p) "<=" rexpr($c) "<" rexpr($c1) ]
+              -> [ (Rle $p $c)/\(Rlt $c $c1) ]
+| form_lt_le [ rexpr($p) "<" rexpr($c) "<=" rexpr($c1) ]
+              -> [ (Rlt $p $c)/\(Rle $c $c1) ]
+| form_lt_lt [ rexpr($p) "<" rexpr($c) "<" rexpr($c1) ]
+              -> [ (Rlt $p $c)/\(Rlt $c $c1) ]
+| form_neq  [ rexpr($p) "<>" rexpr($c) ] -> [ ~(eqT ? $p $c) ]
+
+with rexpr : constr :=
+  expr_plus [ rexpr($p) "+" rexpr($c) ] -> [ (Rplus $p $c) ]
+| expr_minus [ rexpr($p) "-" rexpr($c) ] -> [ (Rminus $p $c) ]
+| rexpr2 [ rexpr2($e) ] -> [ $e ]
+
+with rexpr2 : constr :=
+  expr_mult [ rexpr2($p) "*" rexpr2($c) ] -> [ (Rmult $p $c) ]
+| rexpr0 [ rexpr0($e) ] -> [ $e ]
+
+
+with rexpr0 : constr :=
+  expr_id [ constr:global($c) ] -> [ $c ]
+| expr_com [ "[" constr:constr($c) "]" ] -> [ $c ]
+| expr_appl [ "(" rapplication($a) ")" ] -> [ $a ]
+| expr_num [ rnumber($s) ] -> [ $s ]
+| expr_negnum [ "-" rnegnumber($n) ] -> [ $n ]
+| expr_div [ rexpr0($p) "/" rexpr0($c) ] -> [ (Rdiv $p $c) ]
+| expr_opp [ "-" rexpr0($c) ] -> [ (Ropp $c) ] 
+| expr_inv [ "/" rexpr0($c) ] -> [ (Rinv $c) ]
+| expr_meta [ meta($m) ] -> [ $m ]
+
+with meta :=
+| rimpl [ "?" ] -> [ ? ]
+| rmeta0 [ "?" "0" ] -> [ ?0 ]
+| rmeta1 [ "?" "1" ] -> [ ?1 ]
+| rmeta2 [ "?" "2" ] -> [ ?2 ]
+| rmeta3 [ "?" "3" ] -> [ ?3 ]
+| rmeta4 [ "?" "4" ] -> [ ?4 ]
+| rmeta5 [ "?" "5" ] -> [ ?5 ]
+
+with rapplication : constr :=
+  apply [ rapplication($p) rexpr($c1) ] -> [ ($p $c1) ]
+| pair [ rexpr($p) "," rexpr($c) ] -> [ ($p, $c) ]
+| appl0 [ rexpr($a) ] -> [ $a ].
+
+Grammar constr constr0 :=
+  r_in_com [ "``" rnatural:rformula($c) "``" ] -> [ $c ].
+
+Grammar constr atomic_pattern :=
+  r_in_pattern [ "``" rnatural:rnumber($c) "``" ] -> [ $c ].   
+
+(*i* pp **)
+
+Syntax constr
+  level 0:
+   Rle [ (Rle $n1 $n2) ] -> 
+      [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2) "``"]]
+  | Rlt [ (Rlt $n1 $n2) ] -> 
+      [[<hov 0> "``" (REXPR $n1) [1 0] "< "(REXPR $n2) "``" ]]
+  | Rge [ (Rge $n1 $n2) ] -> 
+      [[<hov 0> "``" (REXPR $n1) [1 0] ">= "(REXPR $n2) "``" ]]
+  | Rgt [ (Rgt $n1 $n2) ] -> 
+      [[<hov 0> "``" (REXPR $n1) [1 0] "> "(REXPR $n2) "``" ]]
+  | Req [ (eqT R $n1 $n2) ] -> 
+      [[<hov 0> "``" (REXPR $n1) [1 0] "= "(REXPR $n2)"``"]]
+  | Rneq [ ~(eqT R $n1 $n2) ] ->
+      [[<hov 0> "``" (REXPR $n1) [1 0] "<> "(REXPR $n2) "``"]]
+  | Rle_Rle [ (Rle $n1 $n2)/\(Rle $n2 $n3) ] ->
+      [[<hov 0> "``" (REXPR $n1) [1 0] "<= " (REXPR $n2)
+                                [1 0] "<= " (REXPR $n3) "``"]]
+  | Rle_Rlt [ (Rle $n1 $n2)/\(Rlt $n2 $n3) ] ->
+      [[<hov 0> "``" (REXPR $n1) [1 0] "<= "(REXPR $n2)
+                                [1 0] "< " (REXPR $n3) "``"]]
+  | Rlt_Rle [ (Rlt $n1 $n2)/\(Rle $n2 $n3) ] ->
+      [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
+                                [1 0] "<= " (REXPR $n3) "``"]]
+  | Rlt_Rlt [ (Rlt $n1 $n2)/\(Rlt $n2 $n3) ] ->
+      [[<hov 0> "``" (REXPR $n1) [1 0] "< " (REXPR $n2)
+                                [1 0] "< " (REXPR $n3) "``"]]
+  | Rzero [ R0 ] -> [ "``0``" ]
+  | Rone [ R1 ] -> [ "``1``" ]
+  ;
+
+  level 7:
+    Rplus [ (Rplus $n1 $n2) ]
+      -> [ [<hov 0> "``"(REXPR $n1):E "+"  [0 0] (REXPR $n2):L "``"] ]
+   | Rodd_outside [(Rplus R1 $r)] -> [ $r:"r_printer_odd_outside"]
+   | Rminus [ (Rminus $n1 $n2) ]
+      -> [ [<hov 0> "``"(REXPR $n1):E "-" [0 0] (REXPR $n2):L "``"] ]
+  ;
+
+  level 6:
+    Rmult [ (Rmult $n1 $n2) ]
+      -> [ [<hov 0> "``"(REXPR $n1):E "*" [0 0] (REXPR $n2):L "``"] ]
+    | Reven_outside [ (Rmult (Rplus R1 R1) $r) ] -> [ $r:"r_printer_even_outside"]
+    | Rdiv [ (Rdiv $n1 $n2) ]
+      -> [ [<hov 0> "``"(REXPR $n1):E "/" [0 0] (REXPR $n2):L "``"] ]
+  ;
+
+  level 8:
+    Ropp [(Ropp $n1)] -> [ [<hov 0> "``" "-"(REXPR $n1):E "``"] ]
+    | Rinv [(Rinv $n1)] -> [ [<hov 0> "``" "/"(REXPR $n1):E "``"] ]
+  ;
+
+  level 0:
+    rescape_inside [<< (REXPR $r) >>] -> [ "[" $r:E "]" ]
+  ;
+
+  level 4:
+    Rappl_inside [<<(REXPR (APPLIST $h ($LIST $t)))>>]
+ -> [ [<hov 0> "("(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E ")"] ]
+  | Rappl_inside_tail [<<(RAPPLINSIDETAIL $h ($LIST $t))>>]
+      -> [(REXPR $h):E [1 0] (RAPPLINSIDETAIL ($LIST $t)):E] 
+  | Rappl_inside_one [<<(RAPPLINSIDETAIL $e)>>] ->[(REXPR $e):E]
+  | rpair_inside [<<(REXPR <<(pair $s1 $s2 $r1 $r2)>>)>>] 
+      -> [ [<hov 0> "("(REXPR $r1):E "," [1 0] (REXPR $r2):E ")"] ]
+  ;
+
+ level 3:
+    rvar_inside [<<(REXPR ($VAR $i))>>] -> [$i]
+  | rsecvar_inside [<<(REXPR (SECVAR $i))>>] -> [(SECVAR $i)]
+  | rconst_inside [<<(REXPR (CONST $c))>>] -> [(CONST $c)]
+  | rmutind_inside [<<(REXPR (MUTIND $i $n))>>] 
+      -> [(MUTIND $i $n)]
+  | rmutconstruct_inside [<<(REXPR (MUTCONSTRUCT $c1 $c2 $c3))>>]
+      -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
+  | rimplicit_head_inside [<<(REXPR (XTRA "!" $c))>>] -> [ $c ]
+  | rimplicit_arg_inside  [<<(REXPR (XTRA "!" $n $c))>>] -> [ ]
+
+  ;
+
+  
+  level 7:
+   Rplus_inside
+      [<<(REXPR <<(Rplus $n1 $n2)>>)>>]
+      	 -> [ (REXPR $n1):E "+" [0 0] (REXPR $n2):L ]
+  | Rminus_inside
+      [<<(REXPR <<(Rminus $n1 $n2)>>)>>]
+      	 -> [ (REXPR $n1):E "-" [0 0] (REXPR $n2):L ]
+  | NRplus_inside
+      [<<(REXPR <<(NRplus $r)>>)>>] -> [ "(" "1" "+" (REXPR $r):L ")"]
+  ;
+
+  level 6:
+    Rmult_inside
+      [<<(REXPR <<(Rmult $n1 $n2)>>)>>]
+      	 -> [ (REXPR $n1):E "*" (REXPR $n2):L ]
+  |  NRmult_inside
+      [<<(REXPR <<(NRmult $r)>>)>>] -> [ "(" "2" "*" (REXPR $r):L ")"]
+  ;
+
+  level 5:
+    Ropp_inside [<<(REXPR <<(Ropp $n1)>>)>>] -> [ " -" (REXPR $n1):E  ]
+  | Rinv_inside [<<(REXPR <<(Rinv $n1)>>)>>] -> [ "/" (REXPR $n1):E  ]
+  | Rdiv_inside
+      [<<(REXPR <<(Rdiv $n1 $n2)>>)>>]
+      	 -> [ (REXPR $n1):E "/" [0 0] (REXPR $n2):L ]
+  ;  
+
+  level 0:
+    Rzero_inside [<<(REXPR <<R0>>)>>] -> ["0"]
+  | Rone_inside [<<(REXPR <<R1>>)>>] -> ["1"]
+  | Rodd_inside [<<(REXPR <<(Rplus R1 $r)>>)>>] -> [ $r:"r_printer_odd" ]
+  | Reven_inside [<<(REXPR <<(Rmult (Rplus R1 R1) $r)>>)>>] -> [ $r:"r_printer_even" ]
+.
+
+(* For parsing/printing based on scopes *)
+Module R_scope.
+
+Infix "<=" Rle (at level 5, no associativity) : R_scope V8only.
+Infix "<"  Rlt (at level 5, no associativity) : R_scope V8only.
+Infix ">=" Rge (at level 5, no associativity) : R_scope V8only.
+Infix ">" Rgt (at level 5, no associativity) : R_scope V8only.
+Infix "+" Rplus (at level 4) : R_scope V8only.
+Infix "-" Rminus (at level 4) : R_scope V8only.
+Infix "*" Rmult (at level 3) : R_scope V8only.
+Infix "/" Rdiv (at level 3) : R_scope V8only.
+Notation "- x" := (Ropp x) (at level 0) : R_scope V8only.
+Notation "x == y == z" := (eqT R x y)/\(eqT R y z)
+  (at level 5, y at level 4, no associtivity): R_scope.
+Notation "x <= y <= z" := (Rle x y)/\(Rle y z)
+  (at level 5, y at level 4) : R_scope
+  V8only.
+Notation "x <= y < z" := (Rle x y)/\(Rlt y z)
+  (at level 5, y at level 4) : R_scope
+  V8only.
+Notation "x < y < z" := (Rlt x y)/\(Rlt y z)
+  (at level 5, y at level 4) : R_scope
+  V8only.
+Notation "x < y <= z" := (Rlt x y)/\(Rle y z)
+  (at level 5, y at level 4) : R_scope
+  V8only.
+Notation "/ x" := (Rinv x) (at level 0): R_scope
+  V8only.
+
+Open Local Scope R_scope.
+End R_scope.
+].
diff --git a/theories7/Reals/Rtopology.v b/theories7/Reals/Rtopology.v
new file mode 100644
index 00000000..f2ae19b9
--- /dev/null
+++ b/theories7/Reals/Rtopology.v
@@ -0,0 +1,1178 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rtopology.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis1.
+Require RList.
+Require Classical_Prop.
+Require Classical_Pred_Type.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+Definition included [D1,D2:R->Prop] : Prop := (x:R)(D1 x)->(D2 x).
+Definition disc [x:R;delta:posreal] : R->Prop := [y:R]``(Rabsolu (y-x))<delta``.
+Definition neighbourhood [V:R->Prop;x:R] : Prop := (EXT delta:posreal | (included (disc x delta) V)).
+Definition open_set [D:R->Prop] : Prop := (x:R) (D x)->(neighbourhood D x).
+Definition complementary [D:R->Prop] : R->Prop := [c:R]~(D c).
+Definition closed_set [D:R->Prop] : Prop := (open_set (complementary D)).
+Definition intersection_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)/\(D2 c).
+Definition union_domain [D1,D2:R->Prop] : R->Prop := [c:R](D1 c)\/(D2 c).
+Definition interior [D:R->Prop] : R->Prop := [x:R](neighbourhood D x).
+
+Lemma interior_P1 : (D:R->Prop) (included (interior D) D).
+Intros; Unfold included; Unfold interior; Intros; Unfold neighbourhood in H; Elim H; Intros; Unfold included in H0; Apply H0; Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
+Qed.
+
+Lemma interior_P2 : (D:R->Prop) (open_set D) -> (included D (interior D)).
+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 := (V:R->Prop) (neighbourhood V x) -> (EXT y:R | (intersection_domain V D y)).
+Definition adherence [D:R->Prop] : R->Prop := [x:R](point_adherent D x).
+
+Lemma adherence_P1 : (D:R->Prop) (included D (adherence D)).
+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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos x0).
+Apply H.
+Qed.
+
+Lemma included_trans : (D1,D2,D3:R->Prop) (included D1 D2) -> (included D2 D3) -> (included D1 D3).
+Unfold included; Intros; Apply H0; Apply H; Apply H1.
+Qed.
+
+Lemma interior_P3 : (D:R->Prop) (open_set (interior D)).
+Intro; Unfold open_set interior; Unfold neighbourhood; Intros; Elim H; Intros.
+Exists x0; Unfold included; Intros.
+Pose del := ``x0-(Rabsolu (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; Unfold disc; Intros.
+Apply Rle_lt_trans with ``(Rabsolu (x3-x1))+(Rabsolu (x1-x))``.
+Replace ``x3-x`` with ``(x3-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
+Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
+Do 2 Rewrite <- (Rplus_sym (Rabsolu ``x1-x``)); Apply Rlt_compatibility; Apply H4.
+Unfold del; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
+Unfold del; Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Idtac | Ring].
+Unfold disc in H1; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1.
+Qed.
+
+Lemma complementary_P1 : (D:R->Prop) ~(EXT y:R | (intersection_domain D (complementary D) y)).
+Intro; Red; Intro; Elim H; Intros; Unfold intersection_domain complementary in H0; Elim H0; Intros; Elim H2; Assumption.
+Qed.
+
+Lemma adherence_P2 : (D:R->Prop) (closed_set D) -> (included (adherence D) D).
+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; Unfold intersection_domain in H5; Elim H5; Intros; Elim H6; Assumption.
+Qed.
+
+Lemma adherence_P3 : (D:R->Prop) (closed_set (adherence D)).
+Intro; Unfold closed_set adherence; Unfold open_set complementary point_adherent; Intros; Pose P := [V:R->Prop](neighbourhood V x)->(EXT 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; Elim H2; Intros; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Intros; Red; Intro.
+Assert H8 := (H7 V0); Cut (EXT delta:posreal | (x:R)(disc x1 delta x)->(V0 x)).
+Intro; Assert H10 := (H8 H9); Elim H4; Assumption.
+Cut ``0<x0-(Rabsolu (x-x1))``.
+Intro; Pose del := (mkposreal ? H9); Exists del; Intros; Unfold included in H5; Apply H5; Unfold disc; Apply Rle_lt_trans with ``(Rabsolu (x2-x1))+(Rabsolu (x1-x))``.
+Replace ``x2-x`` with ``(x2-x1)+(x1-x)``; [Apply Rabsolu_triang | Ring].
+Replace (pos x0) with ``del+(Rabsolu (x1-x))``.
+Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x1-x))``); Apply Rlt_compatibility; Apply H10.
+Unfold del; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x1``); Rewrite Ropp_distr2; Ring.
+Apply Rlt_anti_compatibility with ``(Rabsolu (x-x1))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x1))+(x0-(Rabsolu (x-x1)))`` with (pos x0); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H6 | Ring].
+Qed.
+
+Definition eq_Dom [D1,D2:R->Prop] : Prop := (included D1 D2)/\(included D2 D1).
+
+Infix "=_D" eq_Dom (at level 5, no associativity).
+
+Lemma open_set_P1 : (D:R->Prop) (open_set D) <-> D =_D (interior D).
+Intro; 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; Intros; Unfold included interior in H; Unfold included in H0; Apply (H ? H1).
+Qed.
+
+Lemma closed_set_P1 : (D:R->Prop) (closed_set D) <-> D =_D (adherence D).
+Intro; Split.
+Intro; Unfold eq_Dom; Split.
+Apply adherence_P1.
+Apply adherence_P2; Assumption.
+Unfold eq_Dom; Unfold included; Intros; Assert H0 := (adherence_P3 D); Unfold closed_set in H0; Unfold closed_set; Unfold open_set; Unfold open_set in H0; Intros; Assert H2 : (complementary (adherence D) x).
+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; Unfold neighbourhood in H3; Elim H3; Intros; Exists x0; Unfold included; Unfold included in H4; Intros; Assert H6 := (H4 ? H5); Unfold complementary in H6; Unfold complementary; Red; Intro; Elim H; Clear H; Intros H _; Elim H6; Apply (H ? H7).
+Qed.
+
+Lemma neighbourhood_P1 : (D1,D2:R->Prop;x:R) (included D1 D2) -> (neighbourhood D1 x) -> (neighbourhood D2 x).
+Unfold included neighbourhood; Intros; Elim H0; Intros; Exists x0; Intros; Unfold included; Unfold included in H1; Intros; Apply (H ? (H1 ? H2)).
+Qed.
+
+Lemma open_set_P2 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (union_domain D1 D2)).
+Unfold open_set; Intros; Unfold union_domain in H1; Elim H1; Intro.
+Apply neighbourhood_P1 with D1.
+Unfold included union_domain; Tauto.
+Apply H; Assumption.
+Apply neighbourhood_P1 with D2.
+Unfold included union_domain; Tauto.
+Apply H0; Assumption.
+Qed.
+
+Lemma open_set_P3 : (D1,D2:R->Prop) (open_set D1) -> (open_set D2) -> (open_set (intersection_domain D1 D2)).
+Unfold open_set; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
+Assert H4 := (H ? H2); Assert H5 := (H0 ? H3); 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; Pose del := (mkposreal ? H6).
+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; Simpl; Apply Rmin_l.
+Apply H0; Apply Rlt_le_trans with (pos del).
+Apply H7.
+Unfold del; Simpl; Apply Rmin_r.
+Unfold Rmin; Case (total_order_Rle del1 del2); Intro.
+Apply (cond_pos del1).
+Apply (cond_pos del2).
+Qed.
+
+Lemma open_set_P4 : (open_set [x:R]False).
+Unfold open_set; Intros; Elim H.
+Qed.
+
+Lemma open_set_P5 : (open_set [x:R]True).
+Unfold open_set; Intros; Unfold neighbourhood.
+Exists (mkposreal R1 Rlt_R0_R1); Unfold included; Intros; Trivial.
+Qed.
+
+Lemma disc_P1 : (x:R;del:posreal) (open_set (disc x del)).
+Intros; Assert H := (open_set_P1 (disc x del)).
+Elim H; Intros; Apply H1.
+Unfold eq_Dom; Split.
+Unfold included interior disc; Intros; Cut ``0<del-(Rabsolu (x-x0))``.
+Intro; Pose del2 := (mkposreal ? H3).
+Exists del2; Unfold included; Intros.
+Apply Rle_lt_trans with ``(Rabsolu (x1-x0))+(Rabsolu (x0 -x))``.
+Replace ``x1-x`` with ``(x1-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
+Replace (pos del) with ``del2 + (Rabsolu (x0-x))``.
+Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility.
+Apply H4.
+Unfold del2; Simpl; Rewrite <- (Rabsolu_Ropp ``x-x0``); Rewrite Ropp_distr2; Ring.
+Apply Rlt_anti_compatibility with ``(Rabsolu (x-x0))``; Rewrite Rplus_Or; Replace ``(Rabsolu (x-x0))+(del-(Rabsolu (x-x0)))`` with (pos del); [Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2 | Ring].
+Apply interior_P1.
+Qed.
+
+Lemma continuity_P1 : (f:R->R;x:R) (continuity_pt f x) <-> (W:R->Prop)(neighbourhood W (f x)) -> (EXT V:R->Prop | (neighbourhood V x) /\ ((y:R)(V y)->(W (f y)))).
+Intros; Split.
+Intros; Unfold neighbourhood in H0.
+Elim H0; Intros del1 H1.
+Unfold continuity_pt in H; Unfold continue_in in H; Unfold limit1_in in H; Unfold limit_in in H; Simpl in H; Unfold R_dist in H.
+Assert H2 := (H del1 (cond_pos del1)).
+Elim H2; Intros del2 H3.
+Elim H3; Intros.
+Exists (disc x (mkposreal del2 H4)).
+Intros; Unfold included in H1; Split.
+Unfold neighbourhood disc.
+Exists (mkposreal del2 H4).
+Unfold included; Intros; Assumption.
+Intros; Apply H1; Unfold disc; Case (Req_EM y x); Intro.
+Rewrite H7; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos del1).
+Apply H5; Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Apply not_sym; Apply H7.
+Unfold disc in H6; Apply H6.
+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)).
+Intro; Assert H3 := (H1 H2).
+Elim H3; Intros D H4; Elim H4; Intros; Unfold neighbourhood in H5; Elim H5; Intros del1 H7.
+Exists (pos del1); Split.
+Apply (cond_pos del1).
+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] : R->Prop := [x:R](D (f x)).
+
+(**********)
+Lemma continuity_P2 : (f:R->R;D:R->Prop) (continuity f) -> (open_set D) -> (open_set (image_rec f D)).
+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; 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; Intros; Apply (H8 ? (H9 ? H10)).
+Qed.
+
+(**********)
+Lemma continuity_P3 : (f:R->R) (continuity f) <-> (D:R->Prop) (open_set D)->(open_set (image_rec f D)).
+Intros; Split.
+Intros; Apply continuity_P2; Assumption.
+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)).
+Intro; Assert H4 := (H2 ? H3).
+Unfold neighbourhood in H4; Elim H4; Intros del H5.
+Exists (pos del); Split.
+Apply (cond_pos del).
+Intros; Unfold included in H5; Apply H5; Elim H6; Intros; Apply H8.
+Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H0.
+Apply disc_P1.
+Qed.
+
+(**********)
+Theorem Rsepare : (x,y:R) ``x<>y``->(EXT V:R->Prop | (EXT W:R->Prop | (neighbourhood V x)/\(neighbourhood W y)/\~(EXT y:R | (intersection_domain V W y)))).
+Intros x y Hsep; Pose D := ``(Rabsolu (x-y))``.
+Cut ``0<D/2``.
+Intro; Exists (disc x (mkposreal ? H)).
+Exists (disc y (mkposreal ? H)); Split.
+Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
+Split.
+Unfold neighbourhood; Exists (mkposreal ? H); Unfold included; Tauto.
+Red; Intro; Elim H0; Intros; Unfold intersection_domain in H1; Elim H1; Intros.
+Cut ``D<D``.
+Intro; Elim (Rlt_antirefl ? H4).
+Change ``(Rabsolu (x-y))<D``; Apply Rle_lt_trans with ``(Rabsolu (x-x0))+(Rabsolu (x0-y))``.
+Replace ``x-y`` with ``(x-x0)+(x0-y)``; [Apply Rabsolu_triang | Ring].
+Rewrite (double_var D); Apply Rplus_lt.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H2.
+Apply H3.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Unfold D; Apply Rabsolu_pos_lt; Apply (Rminus_eq_contra ? ? Hsep).
+Apply Rlt_Rinv; Sup0.
+Qed.
+
+Record family : Type := mkfamily {
+  ind : R->Prop;
+  f :> R->R->Prop;
+  cond_fam : (x:R)(EXT y:R|(f x y))->(ind x) }.
+
+Definition family_open_set [f:family] : Prop := (x:R) (open_set (f x)).
+
+Definition domain_finite [D:R->Prop] : Prop := (EXT l:Rlist | (x:R)(D x)<->(In x l)).
+
+Definition family_finite [f:family] : Prop := (domain_finite (ind f)).
+
+Definition covering [D:R->Prop;f:family] : Prop := (x:R) (D x)->(EXT y:R | (f y x)).
+
+Definition covering_open_set [D:R->Prop;f:family] : Prop := (covering D f)/\(family_open_set f).
+
+Definition covering_finite [D:R->Prop;f:family] : Prop := (covering D f)/\(family_finite f).
+
+Lemma restriction_family : (f:family;D:R->Prop) (x:R)(EXT y:R|([z1:R][z2:R](f z1 z2)/\(D z1) x y))->(intersection_domain (ind f) D x).
+Intros; Elim H; Intros; Unfold intersection_domain; Elim H0; Intros; Split.
+Apply (cond_fam f0); Exists x0; Assumption.
+Assumption.
+Qed.
+
+Definition subfamily [f:family;D:R->Prop] : family := (mkfamily (intersection_domain (ind f) D) [x:R][y:R](f x y)/\(D x) (restriction_family f D)).
+
+Definition compact [X:R->Prop] : Prop := (f:family) (covering_open_set X f) -> (EXT D:R->Prop | (covering_finite X (subfamily f D))).
+
+(**********)
+Lemma family_P1 : (f:family;D:R->Prop) (family_open_set f) -> (family_open_set (subfamily f D)).
+Unfold family_open_set; Intros; Unfold subfamily; Simpl; Assert H0 := (classic (D x)).
+Elim H0; Intro.
+Cut (open_set (f0 x))->(open_set [y:R](f0 x y)/\(D x)).
+Intro; Apply H2; Apply H.
+Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Assert H6 := (H2 ? H4); Elim H6; Intros; Exists x1; Unfold included; Intros; Split.
+Apply (H7 ? H8).
+Assumption.
+Cut (open_set [y:R]False) -> (open_set [y:R](f0 x y)/\(D x)).
+Intro; Apply H2; Apply open_set_P4.
+Unfold open_set; Unfold neighbourhood; Intros; Elim H3; Intros; Elim H1; Assumption.
+Qed.
+
+Definition bounded [D:R->Prop] : Prop := (EXT m:R | (EXT M:R | (x:R)(D x)->``m<=x<=M``)).
+
+Lemma open_set_P6 : (D1,D2:R->Prop) (open_set D1) -> D1 =_D D2 -> (open_set D2).
+Unfold open_set; Unfold neighbourhood; Intros.
+Unfold eq_Dom in H0; Elim H0; Intros.
+Assert H4 := (H ? (H3 ? H1)).
+Elim H4; Intros.
+Exists x0; Apply included_trans with D1; Assumption.
+Qed.
+
+(**********)
+Lemma compact_P1 : (X:R->Prop) (compact X) -> (bounded X).
+Intros; Unfold compact in H; Pose D := [x:R]True; Pose g := [x:R][y:R]``(Rabsolu y)<x``; Cut (x:R)(EXT y|(g x y))->True; [Intro | Intro; Trivial].
+Pose f0 := (mkfamily D g H0); Assert H1 := (H f0); Cut (covering_open_set X f0).
+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; Pose 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; Assert H13 := (H7 x0); Simpl in H13; Cut (intersection_domain D D' x0).
+Elim H13; Clear H13; Intros.
+Assert H16 := (H13 H15); Unfold g in H11; Split.
+Cut ``x0<=r``.
+Intro; Cut ``(Rabsolu x)<r``.
+Intro; Assert H19 := (Rabsolu_def2 x r H18); Elim H19; Intros; Left; Assumption.
+Apply Rlt_le_trans with x0; Assumption.
+Apply (MaxRlist_P1 l x0 H16).
+Cut ``x0<=r``.
+Intro; Apply Rle_trans with (Rabsolu x).
+Apply Rle_Rabsolu.
+Apply Rle_trans with x0.
+Left; Apply H11.
+Assumption.
+Apply (MaxRlist_P1 l x0 H16).
+Unfold intersection_domain D; Tauto.
+Unfold covering_open_set; Split.
+Unfold covering; Intros; Simpl; Exists ``(Rabsolu x)+1``; Unfold g; Pattern 1 (Rabsolu x); Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Unfold family_open_set; Intro; Case (total_order R0 x); Intro.
+Apply open_set_P6 with (disc R0 (mkposreal ? H2)).
+Apply disc_P1.
+Unfold eq_Dom; Unfold f0; Simpl; Unfold g disc; Split.
+Unfold included; Intros; Unfold Rminus in H3; Rewrite Ropp_O in H3; Rewrite Rplus_Or in H3; Apply H3.
+Unfold included; Intros; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H3.
+Apply open_set_P6 with [x:R]False.
+Apply open_set_P4.
+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 := (Rabsolu_pos x0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H5 H3)) | Assert H6 := (Rabsolu_pos x0); Assert H7 := (Rlt_trans ? ? ? H3 H4); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 H7))].
+Qed.
+
+(**********)
+Lemma compact_P2 : (X:R->Prop) (compact X) -> (closed_set X).
+Intros; Assert H0 := (closed_set_P1 X); Elim H0; Clear H0; Intros _ H0; Apply H0; Clear H0.
+Unfold eq_Dom; Split.
+Apply adherence_P1.
+Unfold included; Unfold adherence; Unfold point_adherent; Intros; Unfold compact in H; Assert H1 := (classic (X x)); Elim H1; Clear H1; Intro.
+Assumption.
+Cut (y:R)(X y)->``0<(Rabsolu (y-x))/2``.
+Intro; Pose D := X; Pose g := [y:R][z:R]``(Rabsolu (y-z))<(Rabsolu (y-x))/2``/\(D y); Cut (x:R)(EXT y|(g x y))->(D x).
+Intro; Pose f0 := (mkfamily D g H3); Assert H4 := (H f0); Cut (covering_open_set X f0).
+Intro; Assert H6 := (H4 H5); Elim H6; Clear H6; Intros D' H6.
+Unfold covering_finite in H6; Decompose [and] H6; Unfold covering subfamily in H7; Simpl in H7; Unfold family_finite subfamily in H8; Simpl in H8; Unfold domain_finite in H8; Elim H8; Clear H8; Intros l H8; Pose alp := (MinRlist (AbsList l x)); Cut ``0<alp``.
+Intro; Assert H10 := (H0 (disc x (mkposreal ? H9))); Cut (neighbourhood (disc x (mkposreal alp H9)) x).
+Intro; Assert H12 := (H10 H11); Elim H12; Clear H12; Intros y H12; Unfold intersection_domain in H12; Elim H12; Clear H12; Intros; Assert H14 := (H7 ? H13); Elim H14; Clear H14; Intros y0 H14; Elim H14; Clear H14; Intros; Unfold g in H14; Elim H14; Clear H14; Intros; Unfold disc in H12; Simpl in H12; Cut ``alp<=(Rabsolu (y0-x))/2``.
+Intro; Assert H18 := (Rlt_le_trans ? ? ? H12 H17); Cut ``(Rabsolu (y0-x))<(Rabsolu (y0-x))``.
+Intro; Elim (Rlt_antirefl ? H19).
+Apply Rle_lt_trans with ``(Rabsolu (y0-y))+(Rabsolu (y-x))``.
+Replace ``y0-x`` with ``(y0-y)+(y-x)``; [Apply Rabsolu_triang | Ring].
+Rewrite (double_var ``(Rabsolu (y0-x))``); Apply Rplus_lt; Assumption.
+Apply (MinRlist_P1 (AbsList l x) ``(Rabsolu (y0-x))/2``); Apply AbsList_P1; 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; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply H9.
+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; Split.
+Unfold covering; Intros; Exists x0; Simpl; Unfold g; Split.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Unfold Rminus in H2; Apply (H2 ? H5).
+Apply H5.
+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; Split.
+Unfold included disc; Simpl; Intros; Split.
+Rewrite <- (Rabsolu_Ropp ``x0-x1``); Rewrite Ropp_distr2; Apply H6.
+Apply H5.
+Unfold included disc; Simpl; Intros; Elim H6; Intros; Rewrite <- (Rabsolu_Ropp ``x1-x0``); Rewrite Ropp_distr2; Apply H7.
+Apply open_set_P6 with [z:R]False.
+Apply open_set_P4.
+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; Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt; Apply Rminus_eq_contra; Red; Intro; Rewrite H3 in H2; Elim H1; Apply H2.
+Apply Rlt_Rinv; Sup0.
+Qed.
+
+(**********)
+Lemma compact_EMP : (compact [_:R]False).
+Unfold compact; Intros; Exists [x:R]False; Unfold covering_finite; Split.
+Unfold covering; Intros; Elim H0.
+Unfold family_finite; Unfold domain_finite; Exists nil; Intro.
+Split.
+Simpl; Unfold intersection_domain; Intros; Elim H0.
+Elim H0; Clear H0; Intros _ H0; Elim H0.
+Simpl; Intro; Elim H0.
+Qed.
+
+Lemma compact_eqDom : (X1,X2:R->Prop) (compact X1) -> X1 =_D X2 -> (compact X2).
+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; Intros; Apply (H1 ? (H0 ? H4)).
+Apply H3.
+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; Intros; Apply (H5 ? (H2 ? H7)).
+Apply H6.
+Qed.
+
+(* Borel-Lebesgue's lemma *)
+Lemma compact_P3 : (a,b:R) (compact [c:R]``a<=c<=b``).
+Intros; Case (total_order_Rle a b); Intro.
+Unfold compact; Intros; Pose A := [x:R]``a<=x<=b``/\(EXT D:R->Prop | (covering_finite [c:R]``a <= c <= x`` (subfamily f0 D))); Cut (A a).
+Intro; Cut (bound A).
+Intro; Cut (EXT a0:R | (A a0)).
+Intro; Assert H3 := (complet A H1 H2); Elim H3; Clear H3; Intros m H3; Unfold is_lub in H3; Cut ``a<=m<=b``.
+Intro; Unfold covering_open_set in H; Elim H; Clear H; Intros; Unfold covering in H; Assert H6 := (H m H4); Elim H6; Clear H6; Intros y0 H6; Unfold family_open_set in H5; Assert H7 := (H5 y0); Unfold open_set in H7; Assert H8 := (H7 m H6); Unfold neighbourhood in H8; Elim H8; Clear H8; Intros eps H8; Cut (EXT x:R | (A x)/\``m-eps<x<=m``).
+Intro; Elim H9; Clear H9; Intros x H9; Elim H9; Clear H9; Intros; Case (Req_EM m b); Intro.
+Rewrite H11 in H10; Rewrite H11 in H8; Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
+Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
+Cut ``a<=x0<=x``.
+Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; 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; Split.
+Apply H8; Unfold disc; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
+Apply Rlt_trans with ``b-x``.
+Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
+Elim H10; Intros H15 _; Apply Rlt_anti_compatibility 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_sym1; Elim H14; Intros _ H15; Apply H15.
+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_EM x0 y0); Intro.
+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; Unfold intersection_domain.
+Split.
+Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
+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; Left; Elim H17; Intros; Assumption.
+Pose 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_antirefl ? (Rle_lt_trans ? ? ? H15 H16)).
+Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
+Pattern 1 m; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
+Elim H4; Intros.
+Elim H17; Intro.
+Assumption.
+Elim H11; Assumption.
+Unfold A; Split.
+Split.
+Apply Rle_trans with m.
+Elim H4; Intros; Assumption.
+Unfold m'; Unfold Rmin; Case (total_order_Rle ``m+eps/2`` b); Intro.
+Pattern 1 m; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos eps) | Apply Rlt_Rinv; Sup0].
+Elim H4; Intros.
+Elim H13; Intro.
+Assumption.
+Elim H11; Assumption.
+Unfold m'; Apply Rmin_r.
+Unfold A in H9; Elim H9; Clear H9; Intros; Elim H12; Clear H12; Intros Dx H12; Pose Db := [x:R](Dx x)\/x==y0; Exists Db; Unfold covering_finite; Split.
+Unfold covering; Unfold covering_finite in H12; Elim H12; Clear H12; Intros; Unfold covering in H12; Case (total_order_Rle x0 x); Intro.
+Cut ``a<=x0<=x``.
+Intro; Assert H16 := (H12 x0 H15); Elim H16; Clear H16; Intros; Exists x1; 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; Split.
+Apply H8; Unfold disc; Unfold Rabsolu; Case (case_Rabsolu ``x0-m``); Intro.
+Rewrite Ropp_distr2; Apply Rlt_trans with ``m-x``.
+Unfold Rminus; Apply Rlt_compatibility; Apply Rlt_Ropp; Auto with real.
+Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(m-x)`` with ``m-eps``.
+Replace ``x-eps+eps`` with x.
+Elim H10; Intros; Assumption.
+Ring.
+Ring.
+Apply Rle_lt_trans with ``m'-m``.
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-m``); Apply Rle_compatibility; Elim H14; Intros; Assumption.
+Apply Rlt_anti_compatibility with m; Replace ``m+(m'-m)`` with m'.
+Apply Rle_lt_trans with ``m+eps/2``.
+Unfold m'; Apply Rmin_l.
+Apply Rlt_compatibility; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite <- (Rmult_sym ``/2``); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Pattern 1 (pos eps); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply (cond_pos eps).
+DiscrR.
+Ring.
+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_EM x0 y0); Intro.
+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; Unfold intersection_domain.
+Split.
+Apply (cond_fam f0); Rewrite H15; Exists m; Apply H6.
+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; Left; Elim H17; Intros; Assumption.
+Elim (classic (EXT 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_antirefl ? (Rle_lt_trans ? ? ? H13 H14)).
+Pattern 2 m; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_Ropp; Rewrite Ropp_O; Apply (cond_pos eps).
+Pose P := [n:R](A n)/\``m-eps<n<=m``; Assert H12 := (not_ex_all_not ? P H9); Unfold P in H12; Unfold is_upper_bound; Intros; Assert H14 := (not_and_or ? ? (H12 x)); Elim H14; Intro.
+Elim H15; Apply H13.
+Elim (not_and_or ? ? H15); Intro.
+Case (total_order_Rle x ``m-eps``); Intro.
+Assumption.
+Elim H16; Auto with real.
+Unfold is_upper_bound in H10; Assert H17 := (H10 x H13); Elim H16; Apply H17.
+Elim H3; Clear H3; Intros.
+Unfold is_upper_bound in H3.
+Split.
+Apply (H3 ? H0).
+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; 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; 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; Pose D':=[x:R]x==y0; Exists D'; Unfold covering_finite; Split.
+Unfold covering; Simpl; Intros; Cut x==a.
+Intro; Exists y0; Split.
+Rewrite H4; Apply H2.
+Unfold D'; Reflexivity.
+Elim H3; Intros; Apply Rle_antisym; Assumption.
+Unfold family_finite; Unfold domain_finite; Exists (cons y0 nil); Intro; Split.
+Simpl; Unfold intersection_domain; Intro; Elim H3; Clear H3; Intros; Unfold D' in H4; Left; Apply H4.
+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 [c:R]False.
+Apply compact_EMP.
+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 : (X,F:R->Prop) (compact X) -> (closed_set F) -> (included F X) -> (compact F).
+Unfold compact; Intros; Elim (classic (EXT z:R | (F z))); Intro Hyp_F_NE.
+Pose D := (ind f0); Pose g := (f f0); Unfold closed_set in H0.
+Pose g' := [x:R][y:R](f0 x y)\/((complementary F y)/\(D x)).
+Pose D' := D.
+Cut (x:R)(EXT y:R | (g' x y))->(D' x).
+Intro; Pose f' := (mkfamily D' g' H3); Cut (covering_open_set X f').
+Intro; Elim (H ? H4); Intros DX H5; Exists DX.
+Unfold covering_finite; Unfold covering_finite in H5; Elim H5; Clear H5; Intros.
+Split.
+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; 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; 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; Unfold intersection_domain; Unfold D' in H10; Apply H10.
+Unfold covering_open_set; Unfold covering_open_set in H2; Elim H2; Clear H2; Intros.
+Split.
+Unfold covering; Unfold covering in H2; Intros.
+Elim (classic (F x)); Intro.
+Elim (H2 ? H6); Intros y0 H7; Exists y0; Simpl; Unfold g'; Left; Assumption.
+Cut (EXT z:R | (D z)).
+Intro; Elim H7; Clear H7; Intros x0 H7; Exists x0; Simpl; Unfold g'; Right.
+Split.
+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; 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; Split.
+Unfold included union_domain complementary; Intros.
+Elim H6; Intro; [Left; Apply H7 | Right; Split; Assumption].
+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; 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.
+Intros; Elim H3; Intros y0 H4; Unfold g' in H4; Elim H4; Intro.
+Apply (cond_fam f0); Exists y0; Apply H5.
+Elim H5; Clear H5; Intros _ H5; Apply H5.
+(* Cas ou F est l'ensemble vide *)
+Cut (compact F).
+Intro; Apply (H3 f0 H2).
+Apply compact_eqDom with [_:R]False.
+Apply compact_EMP.
+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.
+
+(**********)
+Lemma compact_P5 : (X:R->Prop) (closed_set X)->(bounded X)->(compact X).
+Intros; Unfold bounded in H0.
+Elim H0; Clear H0; Intros m H0.
+Elim H0; Clear H0; Intros M H0.
+Assert H1 := (compact_P3 m M).
+Apply (compact_P4 [c:R]``m<=c<=M`` X H1 H H0).
+Qed.
+
+(**********)
+Lemma compact_carac : (X:R->Prop) (compact X)<->(closed_set X)/\(bounded X).
+Intro; Split.
+Intro; Split; [Apply (compact_P2 ? H) | Apply (compact_P1 ? H)].
+Intro; Elim H; Clear H; Intros; Apply (compact_P5 ? H H0).
+Qed.
+
+Definition image_dir [f:R->R;D:R->Prop] : R->Prop := [x:R](EXT y:R | x==(f y)/\(D y)).
+
+(**********)
+Lemma continuity_compact : (f:R->R;X:R->Prop) ((x:R)(continuity_pt f x)) -> (compact X) -> (compact (image_dir f X)).
+Unfold compact; Intros; Unfold covering_open_set in H1.
+Elim H1; Clear H1; Intros.
+Pose D := (ind f1).
+Pose g := [x:R][y:R](image_rec f0 (f1 x) y).
+Cut (x:R)(EXT y:R | (g x y))->(D x).
+Intro; Pose f' := (mkfamily D g H3).
+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; 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; Unfold domain_finite; Elim H6; Intros l H7; Exists l; Intro; Elim (H7 x); Intros; Split; Intro.
+Apply H8; Simpl in H10; Simpl; Apply H10.
+Apply (H9 H10).
+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; Unfold family_open_set in H2; Intro; Simpl; Unfold g; Cut ([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)).
+Reflexivity.
+Intros; Apply (cond_fam f1); Unfold g in H3; Unfold image_rec in H3; Elim H3; Intros; Exists (f0 x0); Apply H4.
+Qed.
+
+Lemma Rlt_Rminus : (a,b:R) ``a<b`` -> ``0<b-a``.
+Intros; Apply Rlt_anti_compatibility with a; Rewrite Rplus_Or; Replace ``a+(b-a)`` with b; [Assumption | Ring].
+Qed.
+
+Lemma prolongement_C0 : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f c))).
+Intros; Elim H; Intro.
+Pose h := [x:R](Cases (total_order_Rle x a) of
+  (leftT _) => (f0 a)
+| (rightT _) => (Cases (total_order_Rle x b) of
+       (leftT _) => (f0 x)
+     | (rightT _) => (f0 b) end) end).
+Assert H2 : ``0<b-a``.
+Apply Rlt_Rminus; Assumption.
+Exists h; Split.
+Unfold continuity; Intro; Case (total_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``; Apply Rlt_Rminus; Assumption.
+Intros; Elim H5; Clear H5; Intros _ H5; Unfold h.
+Case (total_order_Rle x a); Intro.
+Case (total_order_Rle x0 a); Intro.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Elim n; Left; Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
+Apply Rle_Rabsolu.
+Assumption.
+Elim n; Left; Assumption.
+Elim H3; Intro.
+Assert H5 : ``a<=a<=b``.
+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; 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; Case (total_order_Rle x0 ``b-a``); Intro.
+Elim H8; Intros; Assumption.
+Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
+Intros; Elim H9; Clear H9; Intros _ H9; Cut ``x1<b``.
+Intro; Unfold h; Case (total_order_Rle x a); Intro.
+Case (total_order_Rle x1 a); Intro.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Case (total_order_Rle x1 b); Intro.
+Elim H8; Intros; Apply H12; Split.
+Unfold D_x no_cond; Split.
+Trivial.
+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.
+Elim n0; Left; Assumption.
+Elim n; Right; Assumption.
+Apply Rlt_anti_compatibility with ``-a``; Do 2 Rewrite (Rplus_sym ``-a``); Rewrite H4 in H9; Apply Rle_lt_trans with ``(Rabsolu (x1-a))``.
+Apply Rle_Rabsolu.
+Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
+Assumption.
+Apply Rmin_r.
+Case (total_order x b); Intro.
+Assert H6 : ``a<=x<=b``.
+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; 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``.
+Apply Rlt_Rminus; Assumption.
+Assert H12 : ``0<b-x``.
+Apply Rlt_Rminus; Assumption.
+Exists (Rmin x0 (Rmin ``x-a`` ``b-x``)); Split.
+Unfold Rmin; Case (total_order_Rle ``x-a`` ``b-x``); Intro.
+Case (total_order_Rle x0 ``x-a``); Intro.
+Assumption.
+Assumption.
+Case (total_order_Rle x0 ``b-x``); Intro.
+Assumption.
+Assumption.
+Intros; Elim H13; Clear H13; Intros; Cut ``a<x1<b``.
+Intro; Elim H15; Clear H15; Intros; Unfold h; Case (total_order_Rle x a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
+Case (total_order_Rle x b); Intro.
+Case (total_order_Rle x1 a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r0 H15)).
+Case (total_order_Rle x1 b); Intro.
+Apply H10; Split.
+Assumption.
+Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
+Assumption.
+Apply Rmin_l.
+Elim n1; Left; Assumption.
+Elim n0; Left; Assumption.
+Split.
+Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
+Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
+Assumption.
+Apply Rle_trans with ``(Rmin (x-a) (b-x))``.
+Apply Rmin_r.
+Apply Rmin_l.
+Apply Rlt_anti_compatibility with ``-x``; Do 2 Rewrite (Rplus_sym ``-x``); Apply Rle_lt_trans with ``(Rabsolu (x1-x))``.
+Apply Rle_Rabsolu.
+Apply Rlt_le_trans with ``(Rmin x0 (Rmin (x-a) (b-x)))``.
+Assumption.
+Apply Rle_trans with ``(Rmin (x-a) (b-x))``; Apply Rmin_r.
+Elim H5; Intro.
+Assert H7 : ``a<=b<=b``.
+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; 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; Case (total_order_Rle x0 ``b-a``); Intro.
+Elim H10; Intros; Assumption.
+Change ``0<b-a``; Apply Rlt_Rminus; Assumption.
+Intros; Elim H11; Clear H11; Intros _ H11; Cut ``a<x1``.
+Intro; Unfold h; Case (total_order_Rle x a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
+Case (total_order_Rle x1 a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H12)).
+Case (total_order_Rle x b); Intro.
+Case (total_order_Rle x1 b); Intro.
+Rewrite H6; Elim H10; Intros; Elim r0; Intro.
+Apply H14; Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Red; Intro; Rewrite <- H16 in H15; Elim (Rlt_antirefl ? H15).
+Rewrite H6 in H11; Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
+Apply H11.
+Apply Rmin_l.
+Rewrite H15; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Rewrite H6; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Elim n1; Right; Assumption.
+Rewrite H6 in H11; Apply Ropp_Rlt; Apply Rlt_anti_compatibility with b; Apply Rle_lt_trans with ``(Rabsolu (x1-b))``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
+Apply Rlt_le_trans with ``(Rmin x0 (b-a))``.
+Assumption.
+Apply Rmin_r.
+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``; Apply Rlt_Rminus; Assumption.
+Intros; Elim H8; Clear H8; Intros.
+Assert H10 : ``b<x0``.
+Apply Ropp_Rlt; Apply Rlt_anti_compatibility with x; Apply Rle_lt_trans with ``(Rabsolu (x0-x))``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply Rle_Rabsolu.
+Assumption.
+Unfold h; Case (total_order_Rle x a); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H4)).
+Case (total_order_Rle x b); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H6)).
+Case (total_order_Rle x0 a); Intro.
+Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H1 (Rlt_le_trans ? ? ? H10 r))).
+Case (total_order_Rle x0 b); Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? r H10)).
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Intros; Elim H3; Intros; Unfold h; Case (total_order_Rle c a); Intro.
+Elim r; Intro.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H4 H6)).
+Rewrite H6; Reflexivity.
+Case (total_order_Rle c b); Intro.
+Reflexivity.
+Elim n0; Assumption.
+Exists [_:R](f0 a); Split.
+Apply derivable_continuous; Apply (derivable_const (f0 a)).
+Intros; Elim H2; Intros; Rewrite H1 in H3; Cut b==c.
+Intro; Rewrite <- H5; Rewrite H1; Reflexivity.
+Apply Rle_antisym; Assumption.
+Qed.
+
+(**********)
+Lemma continuity_ab_maj : (f:R->R;a,b:R) ``a<=b`` -> ((c:R)``a<=c<=b``->(continuity_pt f c)) -> (EXT Mx : R |  ((c:R)``a<=c<=b``->``(f c)<=(f Mx)``)/\``a<=Mx<=b``).
+Intros; Cut (EXT g:R->R | (continuity g)/\((c:R)``a<=c<=b``->(g c)==(f0 c))).
+Intro HypProl.
+Elim HypProl; Intros g Hcont_eq.
+Elim Hcont_eq; Clear Hcont_eq; Intros Hcont Heq.
+Assert H1 := (compact_P3 a b).
+Assert H2 := (continuity_compact g [c:R]``a<=c<=b`` Hcont H1).
+Assert H3 := (compact_P2 ? H2).
+Assert H4 := (compact_P1 ? H2).
+Cut (bound (image_dir g [c:R]``a <= c <= b``)).
+Cut (ExT [x:R] ((image_dir g [c:R]``a <= c <= b``) x)).
+Intros; Assert H7 := (complet ? H6 H5).
+Elim H7; Clear H7; Intros M H7; Cut (image_dir g [c:R]``a <= c <= b`` M).
+Intro; Unfold image_dir in H8; Elim H8; Clear H8; Intros Mxx H8; Elim H8; Clear H8; Intros; Exists Mxx; Split.
+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; Exists c; Split; [Reflexivity | Apply H10].
+Apply H9.
+Elim (classic (image_dir g [c:R]``a <= c <= b`` M)); Intro.
+Assumption.
+Cut (EXT eps:posreal | (y:R)~(intersection_domain (disc M eps) (image_dir g [c:R]``a <= c <= b``) y)).
+Intro; Elim H9; Clear H9; Intros eps H9; Unfold is_lub in H7; Elim H7; Clear H7; Intros; Cut (is_upper_bound (image_dir g [c:R]``a <= c <= b``) ``M-eps``).
+Intro; Assert H12 := (H10 ? H11); Cut ``M-eps<M``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H12 H13)).
+Pattern 2 M; Rewrite <- Rplus_Or; Unfold Rminus; Apply Rlt_compatibility; Apply Ropp_Rlt; Rewrite Ropp_O; Rewrite Ropp_Ropp; Apply (cond_pos eps).
+Unfold is_upper_bound image_dir; Intros; Cut ``x<=M``.
+Intro; Case (total_order_Rle x ``M-eps``); Intro.
+Apply r.
+Elim (H9 x); Unfold intersection_domain disc image_dir; Split.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Rewrite Rabsolu_right.
+Apply Rlt_anti_compatibility with ``x-eps``; Replace ``x-eps+(M-x)`` with ``M-eps``.
+Replace ``x-eps+eps`` with x.
+Auto with real.
+Ring.
+Ring.
+Apply Rge_minus; Apply Rle_sym1; Apply H12.
+Apply H11.
+Apply H7; Apply H11.
+Cut (EXT V:R->Prop | (neighbourhood V M)/\((y:R)~(intersection_domain V (image_dir g [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; Intro; Elim (H11 y).
+Unfold intersection_domain; Unfold intersection_domain in H13; Elim H13; Clear H13; Intros; Split.
+Apply (H12 ? H13).
+Apply H14.
+Cut ~(point_adherent (image_dir g [c:R]``a <= c <= b``) M).
+Intro; Unfold point_adherent in H9.
+Assert H10 := (not_all_ex_not ? [V:R->Prop](neighbourhood V M)
+            ->(EXT y:R |
+                   (intersection_domain V
+                     (image_dir g [c:R]``a <= c <= b``) y)) H9).
+Elim H10; Intros V0 H11; Exists V0; Assert H12 := (imply_to_and ? ? H11); Elim H12; Clear H12; Intros.
+Split.
+Apply H12.
+Apply (not_ex_all_not ? ? H13).
+Red; Intro; Cut (adherence (image_dir g [c:R]``a <= c <= b``) M).
+Intro; Elim (closed_set_P1 (image_dir g [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; Exists a; Split.
+Reflexivity.
+Split; [Right; Reflexivity | Apply H].
+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.
+
+(**********)
+Lemma continuity_ab_min : (f:(R->R); a,b:R) ``a <= b``->((c:R)``a<=c<=b``->(continuity_pt f c))->(EXT mx:R | ((c:R)``a <= c <= b``->``(f mx) <= (f c)``)/\``a <= mx <= b``).
+Intros.
+Cut ((c:R)``a<=c<=b``->(continuity_pt (opp_fct f0) c)).
+Intro; Assert H2 := (continuity_ab_maj (opp_fct f0) a b H H1); Elim H2; Intros x0 H3; Exists x0; Intros; Split.
+Intros; Rewrite <- (Ropp_Ropp (f0 x0)); Rewrite <- (Ropp_Ropp (f0 c)); Apply Rle_Ropp1; Elim H3; Intros; Unfold opp_fct in H5; Apply H5; Apply H4.
+Elim H3; Intros; Assumption.
+Intros.
+Assert H2 := (H0 ? H1).
+Apply (continuity_pt_opp ? ? H2).
+Qed.
+
+
+(********************************************************)
+(*         Proof of Bolzano-Weierstrass theorem         *)
+(********************************************************)
+
+Definition ValAdh [un:nat->R;x:R] : Prop := (V:R->Prop;N:nat) (neighbourhood V x) -> (EX p:nat | (le N p)/\(V (un p))).
+
+Definition intersection_family [f:family] : R->Prop := [x:R](y:R)(ind f y)->(f y x).
+
+Lemma ValAdh_un_exists : (un:nat->R) let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in ((x:R)(EXT y:R | (f x y))->(D x)).
+Intros; Elim H; Intros; Unfold f in H0; Unfold adherence in H0; Unfold point_adherent in H0; Assert H1 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
+Unfold neighbourhood disc; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
+Elim (H0 ? H1); Intros; Unfold intersection_domain in H2; Elim H2; Intros; Elim H4; Intros; Apply H6.
+Qed.
+
+Definition ValAdh_un [un:nat->R] : R->Prop := let D=[x:R](EX n:nat | x==(INR n)) in let f=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)) in (intersection_family (mkfamily D f (ValAdh_un_exists un))).
+
+Lemma ValAdh_un_prop : (un:nat->R;x:R) (ValAdh un x) <-> (ValAdh_un un x).
+Intros; Split; Intro.
+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; Intros; Unfold ValAdh_un in H; Unfold intersection_family in H; Simpl in H; Assert H1 : (adherence [y0:R](EX p:nat | ``y0 == (un p)``/\``(INR N) <= (INR p)``)/\(EX n:nat | ``(INR N) == (INR n)``) x).
+Apply H; Exists N; Reflexivity.
+Unfold adherence in H1; Unfold point_adherent in H1; Assert H2 := (H1 ? H0); Elim H2; Intros; Unfold intersection_domain in H3; Elim H3; Clear H3; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Exists x1; Split.
+Apply (INR_le ? ? H6).
+Rewrite H4 in H3; Apply H3.
+Qed.
+
+Lemma adherence_P4 : (F,G:R->Prop) (included F G) -> (included (adherence F) (adherence G)).
+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.
+
+Definition family_closed_set [f:family] : Prop := (x:R) (closed_set (f x)).
+
+Definition intersection_vide_in [D:R->Prop;f:family] : Prop := ((x:R)((ind f x)->(included (f x) D))/\~(EXT y:R | (intersection_family f y))).
+
+Definition intersection_vide_finite_in [D:R->Prop;f:family] : Prop := (intersection_vide_in D f)/\(family_finite f).
+
+(**********)
+Lemma compact_P6 : (X:R->Prop) (compact X) -> (EXT z:R | (X z)) -> ((g:family) (family_closed_set g) -> (intersection_vide_in X g) -> (EXT D:R->Prop | (intersection_vide_finite_in X (subfamily g D)))).
+Intros X H Hyp g H0 H1.
+Pose D' := (ind g).
+Pose f' := [x:R][y:R](complementary (g x) y)/\(D' x).
+Assert H2 : (x:R)(EXT y:R|(f' x y))->(D' x).
+Intros; Elim H2; Intros; Unfold f' in H3; Elim H3; Intros; Assumption.
+Pose f0 := (mkfamily D' f' H2).
+Unfold compact in H; Assert H3 : (covering_open_set X f0).
+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 ? [y:R](y0:R)(ind g y0)->(g y0 y) H5 x); Assert H7 := (not_all_ex_not ? [y0:R](ind g y0)->(g y0 x) H6); Elim H7; Intros; Exists x0; Elim (imply_to_and ? ? H8); Intros; Unfold f0; Simpl; Unfold f'; Split; [Apply H10 | Apply H9].
+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; Simpl; Unfold f'; Unfold eq_Dom; Split.
+Unfold included; Intros; Split; [Apply H4 | Apply H3].
+Unfold included; Intros; Elim H4; Intros; Assumption.
+Apply open_set_P6 with [_:R]False.
+Apply open_set_P4.
+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; 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 (EXT y:R | (intersection_domain (ind g) SF y))); Intro Hyp'.
+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 _; Unfold covering in H4; Elim (H4 x0 H7); Intros; Simpl in H8; Unfold intersection_domain in H6; Cut (ind g x1)/\(SF x1).
+Intro; Assert H10 := (H6 x1 H9); Elim H10; Clear H10; Intros H10 _; Elim H8; Clear H8; Intros H8 _; Unfold f' in H8; Unfold complementary in H8; Elim H8; Clear H8; Intros H8 _; Elim H8; Assumption.
+Split.
+Apply (cond_fam f0).
+Exists x0; Elim H8; Intros; Assumption.
+Elim H8; Intros; Assumption.
+Unfold intersection_vide_in in H1; Elim Hyp'; Intros; Assert H8 := (H6 ? H7); Elim H8; Intros; Cut (ind g x1).
+Intro; Elim (H1 x1); Intros; Apply H12.
+Apply H11.
+Apply H9.
+Apply (cond_fam g); Exists x0; Assumption.
+Unfold covering_finite in H4; Elim H4; Clear H4; Intros H4 _; Cut (EXT 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; 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; Unfold domain_finite; Elim H5; Clear H5; Intros l H5; Exists l; Intro; Elim (H5 x); Intros; Split; Intro; [Apply H6; Simpl; Simpl in H8; Apply H8 | Apply (H7 H8)].
+Qed.
+
+Theorem Bolzano_Weierstrass : (un:nat->R;X:R->Prop) (compact X) -> ((n:nat)(X (un n))) -> (EXT l:R | (ValAdh un l)).
+Intros; Cut (EXT l:R | (ValAdh_un un l)).
+Intro; Elim H1; Intros; Exists x; Elim (ValAdh_un_prop un x); Intros; Apply (H4 H2).
+Assert H1 : (EXT z:R | (X z)).
+Exists (un O); Apply H0.
+Pose D:=[x:R](EX n:nat | x==(INR n)).
+Pose g:=[x:R](adherence [y:R](EX p:nat | y==(un p)/\``x<=(INR p)``)/\(D x)).
+Assert H2 : (x:R)(EXT y:R | (g x y))->(D x).
+Intros; Elim H2; Intros; Unfold g in H3; Unfold adherence in H3; Unfold point_adherent in H3.
+Assert H4 : (neighbourhood (disc x0 (mkposreal ? Rlt_R0_R1)) x0).
+Unfold neighbourhood; Exists (mkposreal ? Rlt_R0_R1); Unfold included; Trivial.
+Elim (H3 ? H4); Intros; Unfold intersection_domain in H5; Decompose [and] H5; Assumption.
+Pose f0 := (mkfamily D g H2).
+Assert H3 := (compact_P6 X H H1 f0).
+Elim (classic (EXT l:R | (ValAdh_un un l))); Intro.
+Assumption.
+Cut (family_closed_set f0).
+Intro; Cut (intersection_vide_in X f0).
+Intro; Assert H7 := (H3 H5 H6).
+Elim H7; Intros SF H8; Unfold intersection_vide_finite_in in H8; Elim H8; Clear H8; Intros; Unfold intersection_vide_in in H8; Elim (H8 R0); Intros _ H10; Elim H10; Unfold family_finite in H9; Unfold domain_finite in H9; Elim H9; Clear H9; Intros l H9; Pose r := (MaxRlist l); Cut (D r).
+Intro; Unfold D in H11; Elim H11; Intros; Exists (un x); Unfold intersection_family; Simpl; Unfold intersection_domain; Intros; Split.
+Unfold g; Apply adherence_P1; Split.
+Exists x; Split; [Reflexivity | 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; Apply MaxRlist_P2; Cut (EXT 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.
+Elim (classic (EXT z:R | (intersection_domain (ind f0) SF z))); Intro.
+Assumption.
+Elim (H8 R0); Intros _ H14; Elim H1; Intros; Assert H16 := (not_ex_all_not ? [y:R](intersection_family (subfamily f0 SF) y) H14); Assert H17 := (not_ex_all_not ? [z:R](intersection_domain (ind f0) SF z) H13); Assert H18 := (H16 x); Unfold intersection_family in H18; Simpl in H18; Assert H19 := (not_all_ex_not ? [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; Intros; Split.
+Intro; Simpl in H6; Unfold f0; Simpl; Unfold g; Apply included_trans with (adherence X).
+Apply adherence_P4.
+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; Unfold f0; Simpl; Unfold g; Intro; Apply adherence_P3.
+Qed.
+
+(********************************************************)
+(*               Proof of Heine's theorem               *)
+(********************************************************)
+
+Definition uniform_continuity [f:R->R;X:R->Prop] : Prop := (eps:posreal)(EXT delta:posreal | (x,y:R) (X x)->(X y)->``(Rabsolu (x-y))<delta`` ->``(Rabsolu ((f x)-(f y)))<eps``).
+
+Lemma is_lub_u : (E:R->Prop;x,y:R) (is_lub E x) -> (is_lub E y) -> x==y.
+Unfold is_lub; Intros; Elim H; Elim H0; Intros; Apply Rle_antisym; [Apply (H4 ? H1) | Apply (H2 ? H3)].
+Qed.
+
+Lemma domain_P1 : (X:R->Prop) ~(EXT y:R | (X y))\/(EXT y:R | (X y)/\((x:R)(X x)->x==y))\/(EXT x:R | (EXT y:R | (X x)/\(X y)/\``x<>y``)).
+Intro; Elim (classic (EXT y:R | (X y))); Intro.
+Right; Elim H; Intros; Elim (classic (EXT y:R | (X y)/\``y<>x``)); Intro.
+Right; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Intros.
+Split; [Assumption | Split; [Assumption | Apply not_sym; Assumption]].
+Left; Exists x; Split.
+Assumption.
+Intros; Case (Req_EM x0 x); Intro.
+Assumption.
+Elim H1; Exists x0; Split; Assumption.
+Left; Assumption.
+Qed.
+
+Theorem Heine : (f:R->R;X:R->Prop) (compact X) -> ((x:R)(X x)->(continuity_pt f x)) -> (uniform_continuity f X).
+Intros f0 X H0 H; Elim (domain_P1 X); Intro Hyp.
+(* X est vide *)
+Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); Intros; Elim Hyp; Exists x; Assumption.
+Elim Hyp; Clear Hyp; Intro Hyp.
+(* X possède un seul élément *)
+Unfold uniform_continuity; Intros; Exists (mkposreal ? Rlt_R0_R1); 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; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (cond_pos eps).
+(* X possède au moins deux éléments distincts *)
+Assert X_enc : (EXT m:R | (EXT M:R | ((x:R)(X x)->``m<=x<=M``)/\``m<M``)).
+Assert H1 := (compact_P1 X H0); Unfold bounded in H1; Elim H1; Intros; Elim H2; Intros; Exists x; Exists x0; Split.
+Apply H3.
+Elim Hyp; Intros; Elim H4; Intros; Decompose [and] H5; Assert H10 := (H3 ? H6); Assert H11 := (H3 ? H8); Elim H10; Intros; Elim H11; Intros; Case (total_order_T x x0); Intro.
+Elim s; Intro.
+Assumption.
+Rewrite b in H13; Rewrite b in H7; Elim H9; Apply Rle_antisym; Apply Rle_trans with x0; Assumption.
+Elim (Rlt_antirefl ? (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; Intro; Assert H1 : (t:posreal)``0<t/2``.
+Intro; Unfold Rdiv; Apply Rmult_lt_pos; [Apply (cond_pos t) | Apply Rlt_Rinv; Sup0].
+Pose g := [x:R][y:R](X x)/\(EXT del:posreal | ((z:R) ``(Rabsolu (z-x))<del``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``)/\(is_lub [zeta:R]``0<zeta<=M-m``/\((z:R) ``(Rabsolu (z-x))<zeta``->``(Rabsolu ((f0 z)-(f0 x)))<eps/2``) del)/\(disc x (mkposreal ``del/2`` (H1 del)) y)).
+Assert H2 : (x:R)(EXT y:R | (g x y))->(X x).
+Intros; Elim H2; Intros; Unfold g in H3; Elim H3; Clear H3; Intros H3 _; Apply H3.
+Pose f' := (mkfamily X g H2); Unfold compact in H0; Assert H3 : (covering_open_set X f').
+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; Unfold limit1_in in H4; Unfold limit_in in H4; Simpl in H4; Unfold R_dist in H4; Elim (H4 ``eps/2`` (H1 eps)); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H6 : (bound E).
+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 : (EXT x:R | (E x)).
+Elim H5; Clear H5; Intros; Exists (Rmin x0 ``M-m``); Unfold E; Intros; Split.
+Split.
+Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro.
+Apply H5.
+Apply Rlt_Rminus; Apply Hyp.
+Apply Rmin_r.
+Intros; Case (Req_EM x z); Intro.
+Rewrite H9; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
+Apply H7; Split.
+Unfold D_x no_cond; Split; [Trivial | Assumption].
+Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H8 | Apply Rmin_l].
+Assert H8 := (complet ? H6 H7); Elim H8; Clear H8; Intros; Cut ``0<x1<=(M-m)``.
+Intro; Elim H8; Clear H8; Intros; Exists (mkposreal ? H8); Split.
+Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x1``/\(E alp)).
+Intros; Elim H11; Intros; Elim H12; Clear H12; Intros; Unfold E in H13; Elim H13; Intros; Apply H15.
+Elim H12; Intros; Assumption.
+Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x1``/\(E alp))); Intro.
+Assumption.
+Assert H12 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x1``/\(E alp) H11); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
+Intro; Assert H16 := (H14 ? H15); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H16)).
+Unfold is_upper_bound; Intros; Unfold is_upper_bound in H13; Assert H16 := (H13 ? H15); Case (total_order_Rle x2 ``(Rabsolu (z-x))``); Intro.
+Assumption.
+Elim (H12 x2); Split; [Split; [Auto with real | Assumption] | Assumption].
+Split.
+Apply p.
+Unfold disc; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Simpl; Unfold Rdiv; Apply Rmult_lt_pos; [Apply H8 | Apply Rlt_Rinv; 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; Unfold is_upper_bound in H11; Split.
+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; Intro; Simpl; Elim (classic (X x)); Intro.
+Unfold g; Unfold open_set; Intros; Elim H4; Clear H4; Intros _ H4; Elim H4; Clear H4; Intros; Elim H4; Clear H4; Intros; Unfold neighbourhood; Case (Req_EM x x0); Intro.
+Exists (mkposreal ? (H1 x1)); Rewrite <- H6; Unfold included; Intros; Split.
+Assumption.
+Exists x1; Split.
+Apply H4.
+Split.
+Elim H5; Intros; Apply H8.
+Apply H7.
+Pose d := ``x1/2-(Rabsolu (x0-x))``; Assert H7 : ``0<d``.
+Unfold d; Apply Rlt_Rminus; Elim H5; Clear H5; Intros; Unfold disc in H7; Apply H7.
+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; Simpl; Unfold disc in H10; Simpl in H10; Apply Rle_lt_trans with ``(Rabsolu (x2-x0))+(Rabsolu (x0-x))``.
+Replace ``x2-x`` with ``(x2-x0)+(x0-x)``; [Apply Rabsolu_triang | Ring].
+Replace ``x1/2`` with ``d+(Rabsolu (x0-x))``; [Idtac | Unfold d; Ring].
+Do 2 Rewrite <- (Rplus_sym ``(Rabsolu (x0-x))``); Apply Rlt_compatibility; Apply H8.
+Apply open_set_P6 with [_:R]False.
+Apply open_set_P4.
+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; Intros; Unfold family_finite in H5; Unfold domain_finite in H5; Unfold covering in H4; Simpl in H4; Simpl in H5; Elim H5; Clear H5; Intros l H5; Unfold intersection_domain in H5; Cut (x:R)(In x l)->(EXT del:R | ``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``)).
+Intros; Assert H7 := (Rlist_P1 l [x:R][del:R]``0<del``/\((z:R)``(Rabsolu (z-x)) < del``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``)/\(included (g x) [z:R]``(Rabsolu (z-x))<del/2``) H6); Elim H7; Clear H7; Intros l' H7; Elim H7; Clear H7; Intros; Pose D := (MinRlist l'); Cut ``0<D/2``.
+Intro; Exists (mkposreal ? H9); Intros; Assert H13 := (H4 ? H10); Elim H13; Clear H13; Intros xi H13; Assert H14 : (In xi l).
+Unfold g in H13; Decompose [and] H13; Elim (H5 xi); Intros; Apply H14; Split; Assumption.
+Elim (pos_Rl_P2 l xi); Intros H15 _; Elim (H15 H14); Intros i H16; Elim H16; Intros; Apply Rle_lt_trans with ``(Rabsolu ((f0 x)-(f0 xi)))+(Rabsolu ((f0 xi)-(f0 y)))``.
+Replace ``(f0 x)-(f0 y)`` with ``((f0 x)-(f0 xi))+((f0 xi)-(f0 y))``; [Apply Rabsolu_triang | Ring].
+Rewrite (double_var eps); Apply Rplus_lt.
+Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Apply H20; Unfold included in H21; Apply Rlt_trans with ``(pos_Rl l' i)/2``.
+Apply H21.
+Elim H13; Clear H13; Intros; Assumption.
+Unfold Rdiv; Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Pattern 1 (pos_Rl l' i); Rewrite <- Rplus_Or; Rewrite double; Apply Rlt_compatibility; Apply H19.
+DiscrR.
+Assert H19 := (H8 i H17); Elim H19; Clear H19; Intros; Rewrite <- H18 in H20; Elim H20; Clear H20; Intros; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H20; Unfold included in H21; Elim H13; Intros; Assert H24 := (H21 x H22); Apply Rle_lt_trans with ``(Rabsolu (y-x))+(Rabsolu (x-xi))``.
+Replace ``y-xi`` with ``(y-x)+(x-xi)``; [Apply Rabsolu_triang | Ring].
+Rewrite (double_var (pos_Rl l' i)); Apply Rplus_lt.
+Apply Rlt_le_trans with ``D/2``.
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H12.
+Unfold Rdiv; Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Sup0.
+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; Apply Rmult_lt_pos; [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 | Apply Rlt_Rinv; Sup0].
+Intros; Elim (H5 x); Intros; Elim (H8 H6); Intros; Pose E:=[zeta:R]``0<zeta <= M-m``/\((z:R)``(Rabsolu (z-x)) < zeta``->``(Rabsolu ((f0 z)-(f0 x))) < eps/2``); Assert H11 : (bound E).
+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 : (EXT 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; Intros; Split.
+Split; [Unfold Rmin; Case (total_order_Rle x0 ``M-m``); Intro; [Apply H12 | Apply Rlt_Rminus; Apply Hyp] | Apply Rmin_r].
+Intros; Case (Req_EM x z); Intro.
+Rewrite H16; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Apply (H1 eps).
+Apply H14; Split; [Unfold D_x no_cond; Split; [Trivial | Assumption] | Apply Rlt_le_trans with (Rmin x0 ``M-m``); [Apply H15 | Apply Rmin_l]].
+Assert H13 := (complet ? H11 H12); Elim H13; Clear H13; Intros; Cut ``0<x0<=M-m``.
+Intro; Elim H13; Clear H13; Intros; Exists x0; Split.
+Assumption.
+Split.
+Intros; Cut (EXT alp:R | ``(Rabsolu (z-x))<alp<=x0``/\(E alp)).
+Intros; Elim H16; Intros; Elim H17; Clear H17; Intros; Unfold E in H18; Elim H18; Intros; Apply H20; Elim H17; Intros; Assumption.
+Elim (classic (EXT alp:R | ``(Rabsolu (z-x)) < alp <= x0``/\(E alp))); Intro.
+Assumption.
+Assert H17 := (not_ex_all_not ? [alp:R]``(Rabsolu (z-x)) < alp <= x0``/\(E alp) H16); Unfold is_lub in p; Elim p; Intros; Cut (is_upper_bound E ``(Rabsolu (z-x))``).
+Intro; Assert H21 := (H19 ? H20); Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H15 H21)).
+Unfold is_upper_bound; Intros; Unfold is_upper_bound in H18; Assert H21 := (H18 ? H20); Case (total_order_Rle x1 ``(Rabsolu (z-x))``); Intro.
+Assumption.
+Elim (H17 x1); Split.
+Split; [Auto with real | Assumption].
+Assumption.
+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.
+Apply p.
+Apply H21.
+Elim H12; Intros; Unfold E in H13; Elim H13; Intros H14 _; Elim H14; Intros H15 _; Unfold is_lub in p; Elim p; Intros; Unfold is_upper_bound in H16; Unfold is_upper_bound in H17; Split.
+Apply Rlt_le_trans with x1; [Assumption | Apply (H16 ? H13)].
+Apply H17; Intros; Unfold E in H18; Elim H18; Intros; Elim H19; Intros; Assumption.
+Qed.
diff --git a/theories7/Reals/Rtrigo.v b/theories7/Reals/Rtrigo.v
new file mode 100644
index 00000000..2b19a00a
--- /dev/null
+++ b/theories7/Reals/Rtrigo.v
@@ -0,0 +1,1111 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rtrigo.v,v 1.1.2.1 2004/07/16 19:31:35 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Export Rtrigo_fun.
+Require Export Rtrigo_def.
+Require Export Rtrigo_alt.
+Require Export Cos_rel.
+Require Export Cos_plus.
+Require ZArith_base.
+Require Zcomplements.
+Require Classical_Prop.
+V7only [Import nat_scope. Import Z_scope. Import R_scope.].
+Open Local Scope nat_scope.
+Open Local Scope R_scope.
+
+(** sin_PI2 is the only remaining axiom **)
+Axiom sin_PI2 : ``(sin (PI/2))==1``.
+
+(**********)
+Lemma PI_neq0 : ~``PI==0``.
+Red; Intro; Assert H0 := PI_RGT_0; Rewrite H in H0; Elim (Rlt_antirefl ? H0).
+Qed.
+
+(**********) 
+Lemma cos_minus : (x,y:R) ``(cos (x-y))==(cos x)*(cos y)+(sin x)*(sin y)``.
+Intros; Unfold Rminus; Rewrite cos_plus.
+Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
+Qed.
+
+(**********)
+Lemma sin2_cos2 : (x:R) ``(Rsqr (sin x)) + (Rsqr (cos x))==1``.
+Intro; Unfold Rsqr; Rewrite Rplus_sym; Rewrite <- (cos_minus x x); Unfold Rminus; Rewrite Rplus_Ropp_r; Apply cos_0.
+Qed.
+
+Lemma cos2 : (x:R) ``(Rsqr (cos x))==1-(Rsqr (sin x))``.
+Intro x; Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Unfold Rminus; Rewrite <- (Rplus_sym (Rsqr (cos x))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Symmetry; Apply Rplus_Or.
+Qed.
+
+(**********)
+Lemma cos_PI2 : ``(cos (PI/2))==0``.
+Apply Rsqr_eq_0; Rewrite cos2; Rewrite sin_PI2; Rewrite Rsqr_1; Unfold Rminus; Apply Rplus_Ropp_r.
+Qed.
+
+(**********)
+Lemma cos_PI : ``(cos PI)==-1``.
+Replace ``PI`` with ``PI/2+PI/2``.
+Rewrite cos_plus.
+Rewrite sin_PI2; Rewrite cos_PI2.
+Ring.
+Symmetry; Apply double_var.
+Qed.
+
+Lemma sin_PI : ``(sin PI)==0``.
+Assert H := (sin2_cos2 PI).
+Rewrite cos_PI in H.
+Rewrite <- Rsqr_neg in H.
+Rewrite Rsqr_1 in H.
+Cut (Rsqr (sin PI))==R0.
+Intro; Apply (Rsqr_eq_0 ? H0).
+Apply r_Rplus_plus with R1.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Exact H.
+Qed.
+
+(**********)
+Lemma neg_cos : (x:R) ``(cos (x+PI))==-(cos x)``.
+Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Qed.
+
+(**********)
+Lemma sin_cos : (x:R) ``(sin x)==-(cos (PI/2+x))``.
+Intro x; Rewrite -> cos_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Qed.
+
+(**********)
+Lemma sin_plus : (x,y:R) ``(sin (x+y))==(sin x)*(cos y)+(cos x)*(sin y)``.
+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_Ropp; Reflexivity.
+Pattern 1 PI; Rewrite (double_var PI); Ring.
+Qed.
+
+Lemma sin_minus : (x,y:R) ``(sin (x-y))==(sin x)*(cos y)-(cos x)*(sin y)``.
+Intros; Unfold Rminus; Rewrite sin_plus.
+Rewrite <- cos_sym; Rewrite sin_antisym; Ring.
+Qed.
+
+(**********)
+Definition tan [x:R] : R := ``(sin x)/(cos x)``.
+
+Lemma tan_plus : (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))``.
+Intros; Unfold tan; Rewrite sin_plus; Rewrite cos_plus; Unfold Rdiv; 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_Rmult.
+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_Rplus_distrl; Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc; Repeat Rewrite (Rmult_sym ``(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; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Apply Rplus_plus_r; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``(sin x)``); Rewrite (Rmult_sym ``(cos y)``); Rewrite <- Ropp_mul3; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite (Rmult_sym (sin x)); Rewrite <- Ropp_mul3; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r; Rewrite (Rmult_sym ``/(cos y)``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Apply Rmult_1r.
+Assumption.
+Assumption.
+Qed.
+
+(*******************************************************)
+(* Some properties of cos, sin and tan                 *)
+(*******************************************************)
+
+Lemma sin2 : (x:R) ``(Rsqr (sin x))==1-(Rsqr (cos x))``.
+Intro x; Generalize (cos2 x); Intro H1; Rewrite -> H1.
+Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Symmetry; Apply Ropp_Ropp.
+Qed.
+
+Lemma sin_2a : (x:R) ``(sin (2*x))==2*(sin x)*(cos x)``.
+Intro x; Rewrite double; Rewrite sin_plus.
+Rewrite <- (Rmult_sym (sin x)); Symmetry; Rewrite Rmult_assoc; Apply double.
+Qed.
+
+Lemma cos_2a : (x:R) ``(cos (2*x))==(cos x)*(cos x)-(sin x)*(sin x)``.
+Intro x; Rewrite double; Apply cos_plus.
+Qed.
+
+Lemma cos_2a_cos : (x:R) ``(cos (2*x))==2*(cos x)*(cos x)-1``.
+Intro x; Rewrite double; Unfold Rminus; Rewrite Rmult_assoc; Rewrite cos_plus; Generalize (sin2_cos2 x); Rewrite double; Intro H1; Rewrite <- H1; SqRing.
+Qed.
+
+Lemma cos_2a_sin : (x:R) ``(cos (2*x))==1-2*(sin x)*(sin x)``.
+Intro x; Rewrite Rmult_assoc; Unfold Rminus; Repeat Rewrite double.
+Generalize (sin2_cos2 x); Intro H1; Rewrite <- H1; Rewrite cos_plus; SqRing.
+Qed.
+
+Lemma tan_2a : (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))``.
+Repeat Rewrite double; Intros; Repeat Rewrite double; Rewrite double in H0; Apply tan_plus; Assumption.
+Qed.
+
+Lemma sin_neg : (x:R) ``(sin (-x))==-(sin x)``.
+Apply sin_antisym.
+Qed.
+
+Lemma cos_neg : (x:R) ``(cos (-x))==(cos x)``.
+Intro; Symmetry; Apply cos_sym.
+Qed.
+
+Lemma tan_0 : ``(tan 0)==0``.
+Unfold tan; Rewrite -> sin_0; Rewrite -> cos_0.
+Unfold Rdiv; Apply Rmult_Ol. 
+Qed.
+
+Lemma tan_neg : (x:R) ``(tan (-x))==-(tan x)``.
+Intros x; Unfold tan; Rewrite sin_neg; Rewrite cos_neg; Unfold Rdiv.
+Apply Ropp_mul1.
+Qed.
+
+Lemma tan_minus : (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))``.
+Intros; Unfold Rminus; Rewrite tan_plus.
+Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Reflexivity.
+Assumption.
+Rewrite cos_neg; Assumption.
+Assumption.
+Rewrite tan_neg; Unfold Rminus; Rewrite <- Ropp_mul1; Rewrite Ropp_mul2; Assumption.
+Qed.
+
+Lemma cos_3PI2 : ``(cos (3*(PI/2)))==0``.
+Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
+Rewrite -> cos_plus; Rewrite -> sin_PI; Rewrite -> cos_PI2; Ring.
+Pattern 1 PI; Rewrite (double_var PI).
+Ring.
+Qed.
+
+Lemma sin_2PI : ``(sin (2*PI))==0``.
+Rewrite -> sin_2a; Rewrite -> sin_PI; Ring.
+Qed.
+
+Lemma cos_2PI : ``(cos (2*PI))==1``.
+Rewrite -> cos_2a; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Qed.
+
+Lemma neg_sin : (x:R) ``(sin (x+PI))==-(sin x)``.
+Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI; Rewrite -> cos_PI; Ring.
+Qed.
+
+Lemma sin_PI_x : (x:R) ``(sin (PI-x))==(sin x)``.
+Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI; Rewrite -> cos_PI; Rewrite Rmult_Ol; Unfold Rminus; Rewrite Rplus_Ol; Rewrite Ropp_mul1; Rewrite Ropp_Ropp; Apply Rmult_1l.
+Qed.
+
+Lemma sin_period : (x:R)(k:nat) ``(sin (x+2*(INR k)*PI))==(sin x)``.
+Intros x k; Induction k.
+Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
+Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> sin_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
+Qed.
+
+Lemma cos_period : (x:R)(k:nat) ``(cos (x+2*(INR k)*PI))==(cos x)``.
+Intros x k; Induction k.
+Cut ``x+2*(INR O)*PI==x``; [Intro; Rewrite H; Reflexivity | Ring].
+Replace ``x+2*(INR (S k))*PI`` with ``(x+2*(INR k)*PI)+(2*PI)``; [Rewrite -> cos_plus; Rewrite -> sin_2PI; Rewrite -> cos_2PI; Ring; Apply Hreck | Rewrite -> S_INR; Ring].
+Qed.
+
+Lemma sin_shift : (x:R) ``(sin (PI/2-x))==(cos x)``.
+Intro x; Rewrite -> sin_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Qed.
+
+Lemma cos_shift : (x:R) ``(cos (PI/2-x))==(sin x)``.
+Intro x; Rewrite -> cos_minus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Qed.
+
+Lemma cos_sin : (x:R) ``(cos x)==(sin (PI/2+x))``.
+Intro x; Rewrite -> sin_plus; Rewrite -> sin_PI2; Rewrite -> cos_PI2; Ring.
+Qed.
+
+Lemma PI2_RGT_0 : ``0<PI/2``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup].
+Qed. 
+
+Lemma SIN_bound : (x:R) ``-1<=(sin x)<=1``.
+Intro; Case (total_order_Rle ``-1`` (sin x)); Intro.
+Case (total_order_Rle (sin x) ``1``); Intro.
+Split; Assumption.
+Cut ``1<(sin x)``.
+Intro; Generalize (Rsqr_incrst_1 ``1`` (sin x) H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` (sin x) (Rlt_trans ``0`` ``1`` (sin x) Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
+Auto with real.
+Cut ``(sin x)< -1``.
+Intro; Generalize (Rlt_Ropp (sin x) ``-1`` H); Rewrite Ropp_Ropp; Clear H; Intro; Generalize (Rsqr_incrst_1 ``1`` ``-(sin x)`` H (Rlt_le ``0`` ``1`` Rlt_R0_R1) (Rlt_le ``0`` ``-(sin x)`` (Rlt_trans ``0`` ``1`` ``-(sin x)`` Rlt_R0_R1 H))); Rewrite Rsqr_1; Intro; Rewrite <- Rsqr_neg in H0; Rewrite sin2 in H0; Unfold Rminus in H0; Generalize (Rlt_compatibility ``-1`` ``1`` ``1+ -(Rsqr (cos x))`` H0); Repeat Rewrite <- Rplus_assoc; Repeat Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Intro; Rewrite <- Ropp_O in H1; Generalize (Rlt_Ropp ``-0`` ``-(Rsqr (cos x))`` H1); Repeat Rewrite Ropp_Ropp; Intro; Generalize (pos_Rsqr (cos x)); Intro; Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` (Rsqr (cos x)) ``0`` H3 H2)).
+Auto with real.
+Qed.
+
+Lemma COS_bound : (x:R) ``-1<=(cos x)<=1``.
+Intro; Rewrite <- sin_shift; Apply SIN_bound.
+Qed.
+
+Lemma cos_sin_0 : (x:R) ~(``(cos x)==0``/\``(sin x)==0``).
+Intro; Red; Intro; Elim H; Intros; Generalize (sin2_cos2 x); Intro; Rewrite H0 in H2; Rewrite H1 in H2; Repeat Rewrite Rsqr_O in H2; Rewrite Rplus_Or in H2; Generalize Rlt_R0_R1; Intro; Rewrite <- H2 in H3; Elim (Rlt_antirefl ``0`` H3).
+Qed.
+  
+Lemma cos_sin_0_var : (x:R) ~``(cos x)==0``\/~``(sin x)==0``.
+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 : (a:R) ``0<a``->``a<=PI/2``->``0<(sin_lb a)``.
+Intros.
+Unfold sin_lb; Unfold sin_approx; Unfold sin_term.
+Pose Un := [i:nat]``(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
+Replace (sum_f_R0 [i:nat] ``(pow ( -1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))`` (S (S (S O)))) with (sum_f_R0 [i:nat]``(pow (-1) i)*(Un i)`` (3)); [Idtac | Apply sum_eq; Intros; Unfold Un; Reflexivity].
+Cut (n:nat)``(Un (S n))<(Un n)``.
+Intro; Simpl.
+Repeat Rewrite Rmult_1l; Repeat Rewrite Rmult_1r; Replace ``-1*(Un (S O))`` with ``-(Un (S O))``; [Idtac | Ring]; Replace ``-1* -1*(Un (S (S O)))`` with ``(Un (S (S O)))``; [Idtac | Ring]; Replace ``-1*( -1* -1)*(Un (S (S (S O))))`` with ``-(Un (S (S (S O))))``; [Idtac | Ring]; Replace ``(Un O)+ -(Un (S O))+(Un (S (S O)))+ -(Un (S (S (S O))))`` with ``((Un O)-(Un (S O)))+((Un (S (S O)))-(Un (S (S (S O)))))``; [Idtac | Ring].
+Apply gt0_plus_gt0_is_gt0.
+Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S O)); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S O))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
+Unfold Rminus; Apply Rlt_anti_compatibility with (Un (S (S (S O)))); Rewrite Rplus_Or; Rewrite (Rplus_sym (Un (S (S (S O))))); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H1.
+Intro; Unfold Un.
+Cut (plus (mult (2) (S n)) (S O)) = (plus (plus (mult (2) n) (S O)) (2)).
+Intro; Rewrite H1.
+Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rlt_monotony.
+Apply pow_lt; Assumption.
+Rewrite <- H1; Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) n) (S O)))).
+Apply lt_INR_0; Apply neq_O_lt.
+Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
+Red; Intro; Elim H2; Symmetry; Assumption.
+Rewrite <- Rinv_r_sym.
+Apply Rlt_monotony_contra with (INR (fact (plus (mult (S (S O)) (S n)) (S O)))).
+Apply lt_INR_0; Apply neq_O_lt.
+Assert H2 := (fact_neq_0 (plus (mult (2) (S n)) (1))).
+Red; Intro; Elim H2; Symmetry; Assumption.
+Rewrite (Rmult_sym (INR (fact (plus (mult (S (S O)) (S n)) (S O))))); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Do 2 Rewrite Rmult_1r; Apply Rle_lt_trans with ``(INR (fact (plus (mult (S (S O)) n) (S O))))*4``.
+Apply Rle_monotony.
+Replace R0 with (INR O); [Idtac | Reflexivity]; Apply le_INR; Apply le_O_n.
+Simpl; Rewrite Rmult_1r; Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing]; Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity]; Apply Rsqr_incr_1.
+Apply Rle_trans with ``PI/2``; [Assumption | Unfold Rdiv; Apply Rle_monotony_contra with ``2``; [ Sup0 | Rewrite <- Rmult_assoc;  Rewrite Rinv_r_simpl_m; [Replace ``2*2`` with ``4``; [Apply PI_4 | Ring] | DiscrR]]].
+Left; Assumption.
+Left; Sup0.
+Rewrite H1; Replace (plus (plus (mult (S (S O)) n) (S O)) (S (S O))) with (S (S (plus (mult (S (S O)) n) (S O)))).
+Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR.
+Repeat Rewrite <- Rmult_assoc.
+Rewrite <- (Rmult_sym (INR (fact (plus (mult (S (S O)) n) (S O))))).
+Rewrite Rmult_assoc.
+Apply Rlt_monotony.
+Apply lt_INR_0; Apply neq_O_lt.
+Assert H2 := (fact_neq_0 (plus (mult (2) n) (1))).
+Red; Intro; Elim H2; Symmetry; Assumption.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Pose x := (INR n); Unfold INR.
+Replace ``(2*x+1+1+1)*(2*x+1+1)`` with ``4*x*x+10*x+6``; [Idtac | Ring].
+Apply Rlt_anti_compatibility with ``-4``; Rewrite Rplus_Ropp_l; Replace ``-4+(4*x*x+10*x+6)`` with ``(4*x*x+10*x)+2``; [Idtac | Ring].
+Apply ge0_plus_gt0_is_gt0.
+Cut ``0<=x``.
+Intro; Apply ge0_plus_ge0_is_ge0; Repeat Apply Rmult_le_pos; Assumption Orelse Left; Sup.
+Unfold x; Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Sup0.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 3 Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Qed.
+
+Lemma SIN : (a:R) ``0<=a`` -> ``a<=PI`` -> ``(sin_lb a)<=(sin a)<=(sin_ub a)``.
+Intros; Unfold sin_lb sin_ub; Apply (sin_bound a (S O) H H0).
+Qed.
+
+Lemma COS : (a:R) ``-PI/2<=a`` -> ``a<=PI/2`` -> ``(cos_lb a)<=(cos a)<=(cos_ub a)``.
+Intros; Unfold cos_lb cos_ub; Apply (cos_bound a (S O) H H0).
+Qed.
+
+(**********)
+Lemma _PI2_RLT_0 : ``-(PI/2)<0``.
+Rewrite <- Ropp_O; Apply Rlt_Ropp1; Apply PI2_RGT_0.
+Qed.
+
+Lemma PI4_RLT_PI2 : ``PI/4<PI/2``.
+Unfold Rdiv; Apply Rlt_monotony.
+Apply PI_RGT_0.
+Apply Rinv_lt.
+Apply Rmult_lt_pos; Sup0.
+Pattern 1 ``2``; Rewrite <- Rplus_Or.
+Replace ``4`` with ``2+2``; [Apply Rlt_compatibility; Sup0 | Ring].
+Qed.
+
+Lemma PI2_Rlt_PI : ``PI/2<PI``.
+Unfold Rdiv; Pattern 2 PI; Rewrite <- Rmult_1r.
+Apply Rlt_monotony.
+Apply PI_RGT_0.
+Pattern 3 R1; Rewrite <- Rinv_R1; Apply Rinv_lt.
+Rewrite Rmult_1l; Sup0.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Apply Rlt_R0_R1.
+Qed.
+
+(********************************************)
+(* Increasing and decreasing of COS and SIN *)
+(********************************************)
+Theorem sin_gt_0 : (x:R) ``0<x`` -> ``x<PI`` -> ``0<(sin x)``.
+Intros; Elim (SIN x (Rlt_le R0 x H) (Rlt_le x PI H0)); Intros H1 _; Case (total_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_R0_R1.
+Rewrite <- sin_PI_x; Generalize (Rgt_Ropp x ``PI/2`` H3); Intro H4; Generalize (Rlt_compatibility PI (Ropp x) (Ropp ``PI/2``) H4).
+Replace ``PI+(-x)`` with ``PI-x``.
+Replace ``PI+ -(PI/2)`` with ``PI/2``.
+Intro H5; Generalize (Rlt_Ropp x PI H0); Intro H6; Change ``-PI < -x`` in H6; Generalize (Rlt_compatibility PI (Ropp PI) (Ropp x) H6).
+Rewrite Rplus_Ropp_r.
+Replace ``PI+ -x`` with ``PI-x``.
+Intro H7; Elim (SIN ``PI-x`` (Rlt_le R0 ``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 2 PI; Rewrite double_var; Ring.
+Reflexivity.
+Qed.
+
+Theorem cos_gt_0 : (x:R) ``-(PI/2)<x`` -> ``x<PI/2`` -> ``0<(cos x)``.
+Intros; Rewrite cos_sin; Generalize (Rlt_compatibility ``PI/2`` ``-(PI/2)`` x H).
+Rewrite Rplus_Ropp_r; Intro H1; Generalize (Rlt_compatibility ``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 : (x:R) ``0<=x`` -> ``x<=PI`` -> ``0<=(sin x)``.
+Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (sin_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply sin_PI ] | Rewrite <- H3; Right; Symmetry; Apply sin_0].
+Qed.
+
+Lemma cos_ge_0 : (x:R) ``-(PI/2)<=x`` -> ``x<=PI/2`` -> ``0<=(cos x)``.
+Intros x H1 H2; Elim H1; Intro H3; [ Elim H2; Intro H4; [ Left ; Apply (cos_gt_0 x H3 H4) | Rewrite H4; Right; Symmetry; Apply cos_PI2 ] | Rewrite <- H3; Rewrite cos_neg; Right; Symmetry; Apply cos_PI2 ].
+Qed.
+
+Lemma sin_le_0 : (x:R) ``PI<=x`` -> ``x<=2*PI`` -> ``(sin x)<=0``.
+Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rle_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_ge_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rle_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
+Qed.
+
+Lemma cos_le_0 : (x:R) ``PI/2<=x``->``x<=3*(PI/2)``->``(cos x)<=0``.
+Intros x H1 H2; Apply Rle_sym2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rle_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
+Rewrite cos_period; Apply cos_ge_0.
+Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
+Unfold Rminus; Rewrite (Rplus_sym x); Apply Rle_compatibility; Assumption.
+Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring.
+Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
+Apply Rle_compatibility; Assumption.
+Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
+Unfold INR; Ring.
+Qed.
+
+Lemma sin_lt_0 : (x:R) ``PI<x`` -> ``x<2*PI`` -> ``(sin x)<0``.
+Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (sin x)); Apply Rlt_Ropp; Rewrite <- neg_sin; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``; [Rewrite -> (sin_period (Rminus x PI) (S O)); Apply sin_gt_0; [Replace ``x-PI`` with ``x+(-PI)``; [Rewrite Rplus_sym; Replace ``0`` with ``(-PI)+PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring] | Replace ``x-PI`` with ``x+(-PI)``; Rewrite Rplus_sym; [Pattern 2 PI; Replace ``PI`` with ``(-PI)+2*PI``; [Apply Rlt_compatibility; Assumption | Ring] | Ring]] |Unfold INR; Ring].
+Qed.
+
+Lemma sin_lt_0_var : (x:R) ``-PI<x`` -> ``x<0`` -> ``(sin x)<0``.
+Intros; Generalize (Rlt_compatibility ``2*PI`` ``-PI`` x H); Replace ``2*PI+(-PI)`` with ``PI``; [Intro H1; Rewrite Rplus_sym in H1; Generalize (Rlt_compatibility ``2*PI`` x ``0`` H0); Intro H2; Rewrite (Rplus_sym ``2*PI``) in H2; Rewrite <- (Rplus_sym R0) in H2; Rewrite Rplus_Ol in H2; Rewrite <- (sin_period x (1)); Unfold INR; Replace ``2*1*PI`` with ``2*PI``; [Apply (sin_lt_0 ``x+2*PI`` H1 H2) | Ring] | Ring].
+Qed.
+
+Lemma cos_lt_0 : (x:R) ``PI/2<x`` -> ``x<3*(PI/2)``-> ``(cos x)<0``.
+Intros x H1 H2; Rewrite <- Ropp_O; Rewrite <- (Ropp_Ropp (cos x)); Apply Rlt_Ropp; Rewrite <- neg_cos; Replace ``x+PI`` with ``(x-PI)+2*(INR (S O))*PI``.
+Rewrite cos_period; Apply cos_gt_0.
+Replace ``-(PI/2)`` with ``-PI+(PI/2)``.
+Unfold Rminus; Rewrite (Rplus_sym x); Apply Rlt_compatibility; Assumption.
+Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
+Unfold Rminus; Rewrite Rplus_sym; Replace ``PI/2`` with ``(-PI)+3*(PI/2)``.
+Apply Rlt_compatibility; Assumption.
+Pattern 1 PI; Rewrite (double_var PI); Rewrite Ropp_distr1; Ring. 
+Unfold INR; Ring.
+Qed.
+
+Lemma tan_gt_0 : (x:R) ``0<x`` -> ``x<PI/2`` -> ``0<(tan x)``.
+Intros x H1 H2; Unfold tan; Generalize _PI2_RLT_0; Generalize (Rlt_trans R0 x ``PI/2`` H1 H2); Intros; Generalize (Rlt_trans ``-(PI/2)`` R0 x H0 H1); Intro H5; Generalize (Rlt_trans x ``PI/2`` PI H2 PI2_Rlt_PI); Intro H7; Unfold Rdiv;  Apply Rmult_lt_pos.
+Apply sin_gt_0; Assumption.
+Apply Rlt_Rinv; Apply cos_gt_0; Assumption.
+Qed.
+
+Lemma tan_lt_0 : (x:R) ``-(PI/2)<x``->``x<0``->``(tan x)<0``.
+Intros x H1 H2; Unfold tan; Generalize (cos_gt_0 x H1 (Rlt_trans x ``0`` ``PI/2`` H2 PI2_RGT_0)); Intro H3; Rewrite <- Ropp_O; Replace ``(sin x)/(cos x)`` with ``- ((-(sin x))/(cos x))``.
+Rewrite <- sin_neg; Apply Rgt_Ropp; Change ``0<(sin (-x))/(cos x)``; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply sin_gt_0.
+Rewrite <- Ropp_O; Apply Rgt_Ropp; Assumption.
+Apply Rlt_trans with ``PI/2``.
+Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rgt_Ropp; Assumption.
+Apply PI2_Rlt_PI.
+Apply Rlt_Rinv; Assumption.
+Unfold Rdiv; Ring.
+Qed.
+
+Lemma cos_ge_0_3PI2 : (x:R) ``3*(PI/2)<=x``->``x<=2*PI``->``0<=(cos x)``.
+Intros; Rewrite <- cos_neg; Rewrite <- (cos_period ``-x`` (1)); Unfold INR; Replace ``-x+2*1*PI`` with ``2*PI-x``.
+Generalize (Rle_Ropp x ``2*PI`` H0); Intro H1; Generalize (Rle_sym2 ``-(2*PI)`` ``-x`` H1); Clear H1; Intro H1; Generalize (Rle_compatibility ``2*PI`` ``-(2*PI)`` ``-x`` H1).
+Rewrite Rplus_Ropp_r. 
+Intro H2; Generalize (Rle_Ropp ``3*(PI/2)`` x H); Intro H3; Generalize (Rle_sym2 ``-x`` ``-(3*(PI/2))`` H3); Clear H3; Intro H3;  Generalize (Rle_compatibility ``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 2 3 PI; Rewrite double_var; Ring.
+Ring.
+Qed.
+
+Lemma form1 : (p,q:R) ``(cos p)+(cos q)==2*(cos ((p-q)/2))*(cos ((p+q)/2))``.
+Intros p q; Pattern 1 p; 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 3 q; Rewrite double_var; Unfold Rdiv; Ring.
+Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
+Qed.
+
+Lemma form2 : (p,q:R) ``(cos p)-(cos q)==-2*(sin ((p-q)/2))*(sin ((p+q)/2))``.
+Intros p q; Pattern 1 p; 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 3 q; Rewrite double_var; Unfold Rdiv; Ring.
+Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
+Qed.
+
+Lemma form3 : (p,q:R) ``(sin p)+(sin q)==2*(cos ((p-q)/2))*(sin ((p+q)/2))``.
+Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
+Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
+Rewrite sin_plus; Rewrite sin_minus; Ring.
+Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
+Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
+Qed.
+
+Lemma form4 : (p,q:R) ``(sin p)-(sin q)==2*(cos ((p+q)/2))*(sin ((p-q)/2))``.
+Intros p q; Pattern 1 p; Replace ``p`` with ``(p-q)/2+(p+q)/2``.
+Pattern 3 q; Replace ``q`` with ``(p+q)/2-(p-q)/2``.
+Rewrite sin_plus; Rewrite sin_minus; Ring.
+Pattern 3 q; Rewrite double_var; Unfold Rdiv; Ring.
+Pattern 3 p; Rewrite double_var; Unfold Rdiv; Ring.
+
+Qed.
+
+Lemma sin_increasing_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<(sin y)``->``x<y``.
+Intros; Cut ``(sin ((x-y)/2))<0``.
+Intro H4; Case (total_order ``(x-y)/2`` ``0``); Intro H5.
+Assert Hyp : ``0<2``.
+Sup0.
+Generalize (Rlt_monotony ``2`` ``(x-y)/2`` ``0`` Hyp H5).
+Unfold Rdiv.
+Rewrite <- Rmult_assoc.
+Rewrite Rinv_r_simpl_m.
+Rewrite Rmult_Or.
+Clear H5; Intro H5; Apply Rminus_lt; Assumption.
+DiscrR.
+Elim H5; Intro H6.
+Rewrite H6 in H4; Rewrite sin_0 in H4; Elim (Rlt_antirefl ``0`` H4).
+Change ``0<(x-y)/2`` in H6; Generalize (Rle_Ropp ``-(PI/2)`` y H1).
+Rewrite Ropp_Ropp.
+Intro H7; Generalize (Rle_sym2 ``-y`` ``PI/2`` H7); Clear H7; Intro H7; Generalize (Rplus_le x ``PI/2`` ``-y`` ``PI/2`` H0 H7).
+Rewrite <- double_var.
+Intro H8.
+Assert Hyp : ``0<2``.
+Sup0.
+Generalize (Rle_monotony ``(Rinv 2)`` ``x-y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H8).
+Repeat Rewrite (Rmult_sym ``/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_antirefl ``(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 x ``PI/2`` y ``PI/2`` H0 H2).
+Rewrite <- double_var.
+Assert Hyp : ``0<2``.
+Sup0.
+Intro H4; Generalize (Rle_monotony ``(Rinv 2)`` ``x+y`` PI (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``2`` Hyp)) H4).
+Repeat Rewrite (Rmult_sym ``/2``). 
+Clear H4; Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` y H H1); Replace ``-(PI/2)+(-(PI/2))`` with ``-PI``.
+Intro H5; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``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 (Rlt_monotony ``2`` ``0`` ``(cos ((x+y)/2))`` Hyp H6).
+Rewrite Rmult_Or. 
+Clear H6; Intro H6; Case (case_Rabsolu ``(sin ((x-y)/2))``); Intro H7.
+Assumption.
+Generalize (Rle_sym2 ``0`` ``(sin ((x-y)/2))`` 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_antirefl ``0`` H9).
+Rewrite <- H50 in H3; Rewrite cos_neg in H3; Rewrite cos_PI2 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
+Unfold Rdiv in H3.
+Rewrite H40 in H3; Assert H50 := cos_PI2; Unfold Rdiv in H50; Rewrite H50 in H3; Rewrite Rmult_Or in H3; Rewrite Rmult_Ol in H3; Elim (Rlt_antirefl ``0`` H3).
+Unfold Rdiv.
+Rewrite <- Ropp_mul1.
+Apply Rmult_sym.
+Unfold Rdiv; Apply Rmult_sym.
+Pattern 1 PI; Rewrite double_var.
+Rewrite Ropp_distr1.
+Reflexivity.
+Qed.
+
+Lemma sin_increasing_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<y``->``(sin x)<(sin y)``.
+Intros; Generalize (Rlt_compatibility ``x`` ``x`` ``y`` H3); Intro H4; Generalize (Rplus_le ``-(PI/2)`` x ``-(PI/2)`` x H H); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
+Assert Hyp : ``0<2``.
+Sup0.
+Intro H5; Generalize (Rle_lt_trans ``-PI`` ``x+x`` ``x+y`` H5 H4); Intro H6; Generalize (Rlt_monotony ``(Rinv 2)`` ``-PI`` ``x+y`` (Rlt_Rinv ``2`` Hyp) H6); Replace ``/2*(-PI)`` with ``-(PI/2)``.
+Replace ``/2*(x+y)`` with ``(x+y)/2``.
+Clear H4 H5 H6; Intro H4; Generalize (Rlt_compatibility ``y`` ``x`` ``y`` H3); Intro H5; Rewrite Rplus_sym in H5; Generalize (Rplus_le 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 (Rlt_monotony ``(Rinv 2)``  ``x+y`` PI (Rlt_Rinv ``2`` Hyp) H7); Replace ``/2*PI`` with ``PI/2``.
+Replace ``/2*(x+y)`` with ``(x+y)/2``.
+Clear H5 H6 H7; Intro H5; Generalize (Rle_Ropp ``-(PI/2)`` y H1); Rewrite Ropp_Ropp; Clear H1; Intro H1; Generalize (Rle_sym2 ``-y`` ``PI/2`` H1); Clear H1; Intro H1; Generalize (Rle_Ropp y ``PI/2`` H2); Clear H2; Intro H2; Generalize (Rle_sym2 ``-(PI/2)`` ``-y`` H2); Clear H2; Intro H2; Generalize (Rlt_compatibility ``-y`` x y H3); Replace ``-y+x`` with ``x-y``.
+Rewrite Rplus_Ropp_l.
+Intro H6; Generalize (Rlt_monotony ``(Rinv 2)``  ``x-y`` ``0`` (Rlt_Rinv ``2`` Hyp) H6); Rewrite Rmult_Or; Replace ``/2*(x-y)`` with ``(x-y)/2``.
+Clear H6; Intro H6; Generalize (Rplus_le  ``-(PI/2)`` x ``-(PI/2)`` ``-y`` H H2); Replace ``-(PI/2)+ (-(PI/2))`` with ``-PI``.
+Replace `` x+ -y`` with ``x-y``.
+Intro H7; Generalize (Rle_monotony ``(Rinv 2)`` ``-PI`` ``x-y`` (Rlt_le ``0`` ``/2`` (Rlt_Rinv ``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_pos ``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 (Rlt_anti_monotony ``(sin ((x-y)/2))`` ``0`` ``2*(cos ((x+y)/2))`` H10 H8); Intro H11; Rewrite Rmult_Or in H11; Rewrite Rmult_sym; Assumption.
+Apply Rlt_Ropp; Apply PI2_Rlt_PI.
+Unfold Rdiv; Apply Rmult_sym.
+Unfold Rdiv; Rewrite <- Ropp_mul1; Apply Rmult_sym.
+Reflexivity.
+Pattern 1 PI; Rewrite double_var.
+Rewrite Ropp_distr1.
+Reflexivity.
+Unfold Rdiv; Apply Rmult_sym.
+Unfold Rminus; Apply Rplus_sym.
+Unfold Rdiv; Apply Rmult_sym.
+Unfold Rdiv; Apply Rmult_sym.
+Unfold Rdiv; Apply Rmult_sym.
+Unfold Rdiv.
+Rewrite <- Ropp_mul1.
+Apply Rmult_sym.
+Pattern 1 PI; Rewrite double_var.
+Rewrite Ropp_distr1.
+Reflexivity.
+Qed.
+
+Lemma sin_decreasing_0 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``(sin x)<(sin y)`` -> ``y<x``.
+Intros; Rewrite <- (sin_PI_x x) in H3; Rewrite <- (sin_PI_x y) in H3; Generalize (Rlt_Ropp ``(sin (PI-x))`` ``(sin (PI-y))`` H3); Repeat Rewrite <- sin_neg; Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-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 Rlt_anti_compatibility with ``-PI``; Rewrite Rplus_sym; Replace ``y+ (-PI)`` with ``y-PI``.
+Rewrite Rplus_sym; Replace ``x+ (-PI)`` with ``x-PI``.
+Apply (sin_increasing_0 ``y-PI`` ``x-PI`` H4 H5 H6 H7 H8).
+Reflexivity.
+Reflexivity.
+Unfold Rminus; Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Apply Rplus_sym.
+Unfold Rminus; Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Apply Rplus_sym.
+Pattern 2 PI; Rewrite double_var.
+Rewrite Ropp_distr1.
+Ring.
+Unfold Rminus; Apply Rplus_sym.
+Pattern 2 PI; Rewrite double_var.
+Rewrite Ropp_distr1.
+Ring.
+Unfold Rminus; Apply Rplus_sym.
+Qed.
+
+Lemma sin_decreasing_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<y``  -> ``(sin y)<(sin x)``.
+Intros; Rewrite <- (sin_PI_x x); Rewrite <- (sin_PI_x y); Generalize (Rle_compatibility ``-PI`` x ``3*(PI/2)`` H); Generalize (Rle_compatibility ``-PI`` ``PI/2`` x H0); Generalize (Rle_compatibility ``-PI`` y ``3*(PI/2)`` H1); Generalize (Rle_compatibility ``-PI`` ``PI/2`` y H2); Generalize (Rlt_compatibility ``-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_Rlt; 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; Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Apply Rplus_sym.
+Unfold Rminus; Rewrite Ropp_distr1.
+Rewrite Ropp_Ropp.
+Apply Rplus_sym.
+Unfold Rminus; Apply Rplus_sym.
+Pattern 2 PI; Rewrite double_var; Ring.
+Unfold Rminus; Apply Rplus_sym.
+Pattern 2 PI; Rewrite double_var; Ring.
+Qed.
+
+Lemma cos_increasing_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<(cos y)`` -> ``x<y``.
+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; 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 (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-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 Rlt_anti_compatibility 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.
+Rewrite Ropp_mul1. 
+Apply Rplus_sym. 
+Unfold Rminus.
+Rewrite Ropp_mul1. 
+Apply Rplus_sym. 
+Pattern 3 PI; Rewrite double_var.
+Ring.
+Rewrite double; Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Unfold Rminus.
+Rewrite Ropp_mul1. 
+Apply Rplus_sym. 
+Unfold Rminus.
+Rewrite Ropp_mul1. 
+Apply Rplus_sym. 
+Rewrite Rmult_1r.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Rewrite Rmult_1r.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Qed.
+
+Lemma cos_increasing_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<y`` -> ``(cos x)<(cos y)``.
+Intros x y H1 H2 H3 H4 H5; Generalize (Rle_compatibility ``-3*(PI/2)`` PI x H1); Generalize (Rle_compatibility ``-3*(PI/2)`` x ``2*PI`` H2); Generalize (Rle_compatibility ``-3*(PI/2)`` PI y H3); Generalize (Rle_compatibility ``-3*(PI/2)`` y ``2*PI`` H4); Generalize (Rlt_compatibility ``-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; 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_1r.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Rewrite Rmult_1r.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite double_var.
+Ring.
+Pattern 3 PI; Rewrite double_var; Ring.
+Unfold Rminus.
+Rewrite <- Ropp_mul1.
+Apply Rplus_sym.
+Unfold Rminus.
+Rewrite <- Ropp_mul1.
+Apply Rplus_sym.
+Qed.
+
+Lemma cos_decreasing_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<(cos y)``->``y<x``.
+Intros; Generalize (Rlt_Ropp (cos x) (cos y) H3); Repeat Rewrite <- neg_cos; Intro H4; Change ``(cos (y+PI))<(cos (x+PI))`` in H4; Rewrite (Rplus_sym x) in H4; Rewrite (Rplus_sym y) in H4; Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
+Rewrite <- double.
+Clear H H0 H1 H2 H3; Intros; Apply Rlt_anti_compatibility with ``PI``; Apply (cos_increasing_0 ``PI+y`` ``PI+x`` H0 H H2 H1 H4).
+Qed.
+
+Lemma cos_decreasing_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<y``->``(cos y)<(cos x)``.
+Intros; Apply Ropp_Rlt; Repeat Rewrite <- neg_cos; Rewrite (Rplus_sym x); Rewrite (Rplus_sym y); Generalize (Rle_compatibility PI ``0`` x H); Generalize (Rle_compatibility PI x PI H0); Generalize (Rle_compatibility PI ``0`` y H1); Generalize (Rle_compatibility PI y PI H2); Rewrite Rplus_Or.
+Rewrite <- double.
+Generalize (Rlt_compatibility 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 : (x,y:R) ~``(cos x)==0``->~``(cos y)==0``->``(tan x)-(tan y)==(sin (x-y))/((cos x)*(cos y))``.
+Intros; Unfold tan;Rewrite sin_minus.
+Unfold Rdiv. 
+Unfold Rminus.
+Rewrite Rmult_Rplus_distrl.
+Rewrite Rinv_Rmult.
+Repeat Rewrite (Rmult_sym (sin x)).
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym (cos y)).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Rewrite (Rmult_sym (sin x)).
+Apply Rplus_plus_r.
+Rewrite <- Ropp_mul1.
+Rewrite <- Ropp_mul3.
+Rewrite (Rmult_sym ``/(cos x)``).
+Repeat Rewrite Rmult_assoc.
+Rewrite (Rmult_sym (cos x)).
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Reflexivity.
+Assumption.
+Assumption.
+Assumption.
+Assumption.
+Qed.
+
+Lemma tan_increasing_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<(tan y)``->``x<y``.
+Intros; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``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_sym ``0`` (cos x) (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_sym ``0`` (cos y) (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 (Rle_Ropp ``-(PI/4)`` y H1); Rewrite Ropp_Ropp; Intro H10; Generalize (Rle_sym2 ``-y`` ``PI/4`` H10); Clear H10; Intro H10; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(PI/4)`` x ``-(PI/4)`` ``-y`` H H11); Generalize (Rplus_le 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 (total_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_antirefl ``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_antirefl ``0`` H9). 
+Apply Rminus_lt; Assumption.
+Pattern 1 PI; Rewrite double_var.
+Unfold Rdiv.
+Rewrite Rmult_Rplus_distrl.
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_Rmult.
+Rewrite Ropp_distr1.
+Replace ``2*2`` with ``4``.
+Reflexivity.
+Ring.
+DiscrR.
+DiscrR.
+Pattern 1 PI; Rewrite double_var.
+Unfold Rdiv.
+Rewrite Rmult_Rplus_distrl.
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_Rmult.
+Replace ``2*2`` with ``4``.
+Reflexivity.
+Ring.
+DiscrR.
+DiscrR.
+Reflexivity.
+Case (case_Rabsolu ``(sin (x-y))``); Intro H9.
+Assumption.
+Generalize (Rle_sym2 ``0`` ``(sin (x-y))`` H9); Clear H9; Intro H9; Generalize (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (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_antirefl ``0`` (Rle_lt_trans ``0`` ``(sin (x-y))*/((cos x)*(cos y))`` ``0`` H13 H3)).
+Rewrite Rinv_Rmult.
+Reflexivity. 
+Assumption.
+Assumption.
+Qed.
+
+Lemma tan_increasing_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<y``->``(tan x)<(tan y)``.
+Intros; Apply Rminus_lt; Generalize PI4_RLT_PI2; Intro H4; Generalize (Rlt_Ropp ``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_sym ``0`` (cos x) (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_sym ``0`` (cos y) (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 (Rlt_Rinv (cos x) HP1); Intro H10; Generalize (Rlt_Rinv (cos y) HP2); Intro H11; Generalize (Rmult_lt_pos (Rinv (cos x)) (Rinv (cos y)) H10 H11); Replace ``/(cos x)*/(cos y)`` with ``/((cos x)*(cos y))``.
+Clear H10 H11; Intro H8; Generalize (Rle_Ropp y ``PI/4`` H2); Intro H11; Generalize (Rle_sym2 ``-(PI/4)`` ``-y`` H11); Clear H11; Intro H11; Generalize (Rplus_le ``-(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 (Rlt_Ropp ``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 (Rlt_anti_monotony ``(sin (x-y))`` ``0`` ``/((cos x)*(cos y))`` H2 H8); Rewrite Rmult_Or; Intro H4; Assumption.
+Pattern 1 PI; Rewrite double_var.
+Unfold Rdiv.
+Rewrite Rmult_Rplus_distrl.
+Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_Rmult.
+Replace ``2*2`` with ``4``.
+Rewrite Ropp_distr1.
+Reflexivity.
+Ring.
+DiscrR.
+DiscrR.
+Reflexivity.
+Apply Rinv_Rmult; Assumption.
+Qed.
+
+Lemma sin_incr_0 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``(sin x)<=(sin y)``->``x<=y``.
+Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (sin y) H8)]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
+Qed.
+
+Lemma sin_incr_1 : (x,y:R) ``-(PI/2)<=x``->``x<=PI/2``->``-(PI/2)<=y``->``y<=PI/2``->``x<=y``->``(sin x)<=(sin y)``.
+Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Qed.
+
+Lemma sin_decr_0 : (x,y:R) ``x<=3*(PI/2)``->``PI/2<=x``->``y<=3*(PI/2)``->``PI/2<=y``-> ``(sin x)<=(sin y)`` -> ``y<=x``.
+Intros; Case (total_order (sin x) (sin y)); Intro H4; [Left; Apply (sin_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (sin_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (sin y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5))]].
+Qed.
+
+Lemma sin_decr_1 : (x,y:R) ``x<=3*(PI/2)``-> ``PI/2<=x`` -> ``y<=3*(PI/2)``-> ``PI/2<=y`` -> ``x<=y``  -> ``(sin y)<=(sin x)``.
+Intros; Case (total_order x y); Intro H4; [Left; Apply (sin_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Qed.
+
+Lemma cos_incr_0 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``(cos x)<=(cos y)`` -> ``x<=y``.
+Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (cos y) H8)]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
+Qed.
+
+Lemma cos_incr_1 : (x,y:R) ``PI<=x`` -> ``x<=2*PI`` ->``PI<=y`` -> ``y<=2*PI`` -> ``x<=y`` -> ``(cos x)<=(cos y)``.
+Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Qed.
+
+Lemma cos_decr_0 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``(cos x)<=(cos y)`` -> ``y<=x``.
+Intros; Case (total_order (cos x) (cos y)); Intro H4; [Left; Apply (cos_decreasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_order x y); Intro H6; [Generalize (cos_decreasing_1 x y H H0 H1 H2 H6); Intro H8; Rewrite H5 in H8; Elim (Rlt_antirefl (cos y) H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5))]].
+Qed.
+
+Lemma cos_decr_1 : (x,y:R) ``0<=x``->``x<=PI``->``0<=y``->``y<=PI``->``x<=y``->``(cos y)<=(cos x)``.
+Intros; Case (total_order x y); Intro H4; [Left; Apply (cos_decreasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8) | Elim H6; Intro H7; [Right; Symmetry; Assumption | Left; Assumption]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Qed.
+
+Lemma tan_incr_0 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``(tan x)<=(tan y)``->``x<=y``.
+Intros; Case (total_order (tan x) (tan y)); Intro H4; [Left; Apply (tan_increasing_0 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl (tan y) H8)]] | Elim (Rlt_antirefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5))]].
+Qed.
+
+Lemma tan_incr_1 : (x,y:R) ``-(PI/4)<=x``->``x<=PI/4`` ->``-(PI/4)<=y``->``y<=PI/4``->``x<=y``->``(tan x)<=(tan y)``.
+Intros; Case (total_order x y); Intro H4; [Left; Apply (tan_increasing_1 x y H H0 H1 H2 H4) | Elim H4; Intro H5; [Case (total_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_antirefl y H8)]] | Elim (Rlt_antirefl x (Rle_lt_trans x y x H3 H5))]].
+Qed.
+
+(**********)
+Lemma sin_eq_0_1 : (x:R) (EXT k:Z | x==(Rmult (IZR k) PI)) -> (sin x)==R0.
+Intros.
+Elim H; Intros.
+Apply (Zcase_sign x0).
+Intro.
+Rewrite H1 in H0.
+Simpl in H0.
+Rewrite H0; Rewrite Rmult_Ol; Apply sin_0.
+Intro.
+Cut `0<=x0`.
+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.
+Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
+Rewrite sin_period.
+Apply sin_0.
+Rewrite H5.
+Rewrite S_INR; Rewrite mult_INR.
+Simpl.
+Rewrite Rmult_Rplus_distrl.
+Rewrite Rmult_1l; Rewrite sin_plus.
+Rewrite sin_PI.
+Rewrite Rmult_Or.
+Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
+Rewrite sin_period.
+Rewrite sin_0; Ring.
+Apply le_IZR.
+Left; Apply IZR_lt.
+Assert H2 := Zgt_iff_lt.
+Elim (H2 x0 `0`); Intros.
+Apply H3; Assumption.
+Intro.
+Rewrite H0.
+Replace ``(sin ((IZR x0)*PI))`` with ``-(sin (-(IZR x0)*PI))``.
+Cut `0<=-x0`.
+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.
+Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
+Rewrite sin_period.
+Rewrite sin_0; Ring.
+Rewrite H5.
+Rewrite S_INR; Rewrite mult_INR.
+Simpl.
+Rewrite Rmult_Rplus_distrl.
+Rewrite Rmult_1l; Rewrite sin_plus.
+Rewrite sin_PI.
+Rewrite Rmult_Or.
+Rewrite <- (Rplus_Ol ``2*(INR x2)*PI``).
+Rewrite sin_period.
+Rewrite sin_0; Ring.
+Apply le_IZR.
+Apply Rle_anti_compatibility with ``(IZR x0)``.
+Rewrite Rplus_Or.
+Rewrite Ropp_Ropp_IZR.
+Rewrite Rplus_Ropp_r.
+Left; Replace R0 with (IZR `0`); [Apply IZR_lt | Reflexivity].
+Assumption.
+Rewrite <- sin_neg.
+Rewrite Ropp_mul1.
+Rewrite Ropp_Ropp.
+Reflexivity.
+Qed.
+
+Lemma sin_eq_0_0 : (x:R) (sin x)==R0 -> (EXT k:Z | x==(Rmult (IZR k) PI)).
+Intros.
+Assert H0 := (euclidian_division x PI PI_neq0).
+Elim H0; Intros q H1.
+Elim H1; Intros r H2.
+Exists q.
+Cut r==R0.
+Intro.
+Elim H2; Intros H4 _; Rewrite H4; Rewrite H3.
+Apply Rplus_Or.
+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_Ol in H.
+Rewrite Rplus_Ol in H.
+Assert H6 := (without_div_Od ? ? H).
+Elim H6; Intro.
+Assert H8 := (sin2_cos2 ``(IZR q)*PI``).
+Rewrite H5 in H8; Rewrite H7 in H8.
+Rewrite Rsqr_O in H8.
+Rewrite Rplus_Or in H8.
+Elim R1_neq_R0; Symmetry; Assumption.
+Cut r==R0\/``0<r<PI``.
+Intro; Elim H8; Intro.
+Assumption.
+Elim H9; Intros.
+Assert H12 := (sin_gt_0 ? H10 H11).
+Rewrite H7 in H12; Elim (Rlt_antirefl ? H12).
+Rewrite Rabsolu_right in H4.
+Elim H4; Intros.
+Case (total_order R0 r); Intro.
+Right; Split; Assumption.
+Elim H10; Intro.
+Left; Symmetry; Assumption.
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 H11)).
+Apply Rle_sym1.
+Left; Apply PI_RGT_0.
+Apply sin_eq_0_1.
+Exists q; Reflexivity.
+Qed.
+
+Lemma cos_eq_0_0 : (x:R) (cos x)==R0 -> (EXT k : Z | ``x==(IZR k)*PI+PI/2``). 
+Intros x H; Rewrite -> cos_sin in H; Generalize (sin_eq_0_0 (Rplus (Rdiv PI (INR (2))) x) H); Intro H2; Elim H2; Intros x0 H3; Exists (Zminus x0 (inject_nat (S O))); Rewrite <- Z_R_minus; Ring; Rewrite Rmult_sym; Rewrite <- H3; Unfold INR.
+Rewrite (double_var ``-PI``); Unfold Rdiv; Ring.
+Qed.
+
+Lemma  cos_eq_0_1 : (x:R) (EXT k : Z | ``x==(IZR k)*PI+PI/2``) -> ``(cos x)==0``.
+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_O.
+Apply eq_Ropp; Apply sin_eq_0_1; Exists x0; Reflexivity.
+Pattern 2 PI; Rewrite (double_var PI); Ring.
+Qed.
+
+Lemma sin_eq_O_2PI_0 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``(sin x)==0`` -> ``x==0``\/``x==PI``\/``x==2*PI``.
+Intros; Generalize (sin_eq_0_0 x H1); Intro.
+Elim H2; Intros k0 H3.
+Case (total_order PI x); Intro.
+Rewrite H3 in H4; Rewrite H3 in H0.
+Right; Right.
+Generalize (Rlt_monotony_r ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv ``PI`` PI_RGT_0) H4); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``(IZR k0)*PI`` ``2*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H0); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
+Repeat Rewrite Rmult_1r; Intro; Generalize (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H5); Rewrite <- plus_IZR.
+Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
+Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``2`` H6); Rewrite <- plus_IZR.
+Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
+Intro; Cut ``-1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
+Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H9); Intro.
+Cut k0=`2`.
+Intro; Rewrite H11 in H3; Rewrite H3; Simpl.
+Reflexivity.
+Rewrite <- (Zplus_inverse_l `2`) in H10; Generalize (Zsimpl_plus_l `-2` k0 `2` H10); Intro; Assumption.
+Split.
+Assumption.
+Apply Rle_lt_trans with ``0``.
+Assumption.
+Apply Rlt_R0_R1.
+Simpl; Ring.
+Simpl; Ring.
+Apply PI_neq0.
+Apply PI_neq0.
+Elim H4; Intro.
+Right; Left.
+Symmetry; Assumption.
+Left.
+Rewrite H3 in H5; Rewrite H3 in H; Generalize (Rlt_monotony_r ``/PI``  ``(IZR k0)*PI`` PI (Rlt_Rinv ``PI`` PI_RGT_0) H5); Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Intro; Generalize (Rle_monotony_r ``/PI`` ``0`` ``(IZR k0)*PI`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv ``PI`` PI_RGT_0)) H); Repeat Rewrite Rmult_assoc; Repeat Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Rewrite Rmult_Ol; Intro.
+Cut ``-1 < (IZR (k0)) < 1``.
+Intro; Generalize (one_IZR_lt1 k0 H8); Intro; Rewrite H9 in H3; Rewrite H3; Simpl; Apply Rmult_Ol.
+Split.
+Apply Rlt_le_trans with ``0``.
+Rewrite <- Ropp_O; Apply Rgt_Ropp; Apply Rlt_R0_R1.
+Assumption.
+Assumption.
+Apply PI_neq0.
+Apply PI_neq0.
+Qed.
+
+Lemma sin_eq_O_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==0``\/``x==PI``\/``x==2*PI`` -> ``(sin x)==0``.
+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 : (x:R) ``R0<=x`` -> ``x<=2*PI`` -> ``(cos x)==0`` -> ``x==(PI/2)``\/``x==3*(PI/2)``.
+Intros; Case (total_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 (Rle_compatibility ``PI/2`` ``0`` x H); Rewrite Rplus_Or; Rewrite H6; Intro.
+Elim (Rlt_antirefl ``0`` (Rlt_le_trans ``0`` ``PI/2`` ``0`` PI2_RGT_0 H7)).
+Left.
+Generalize (Rplus_plus_r ``-(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 3 PI; Rewrite (double_var PI); Ring.
+Ring.
+Right.
+Generalize (Rplus_plus_r ``-(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 3 4 PI; Rewrite (double_var PI); Ring.
+Ring.
+Left; Replace ``2*PI`` with ``PI/2+3*(PI/2)``.
+Apply Rlt_compatibility; Assumption.
+Rewrite (double PI); Pattern 3 4 PI; Rewrite (double_var PI); Ring.
+Apply ge0_plus_ge0_is_ge0.
+Left; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply PI_RGT_0.
+Apply Rlt_Rinv; 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 (Rlt_compatibility ``-(PI/2)`` ``3*PI/2`` ``(IZR k0)*PI+PI/2`` H3); Generalize (Rle_compatibility ``-(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 (Rlt_monotony ``/PI`` ``PI`` ``(IZR k0)*PI`` (Rlt_Rinv PI PI_RGT_0) H7); Generalize (Rle_monotony ``/PI`` ``(IZR k0)*PI`` ``3*(PI/2)`` (Rlt_le ``0`` ``/PI`` (Rlt_Rinv 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 (Rlt_compatibility (IZR `-2`) ``1`` (IZR k0) H9); Rewrite <- plus_IZR.
+Replace ``(IZR (NEG (xO xH)))+1`` with ``-1``.
+Intro; Generalize (Rle_compatibility (IZR `-2`) (IZR k0) ``3*/2`` H8); Rewrite <- plus_IZR.
+Replace ``(IZR (NEG (xO xH)))+2`` with ``0``.
+Intro; Cut `` -1 < (IZR (Zplus (NEG (xO xH)) k0)) < 1``.
+Intro; Generalize (one_IZR_lt1 (Zplus (NEG (xO xH)) k0) H12); Intro.
+Cut k0=`2`.
+Intro; Rewrite H14 in H8.
+Assert Hyp : ``0<2``.
+Sup0.
+Generalize (Rle_monotony ``2`` ``(IZR (POS (xO xH)))`` ``3*/2`` (Rlt_le ``0`` ``2`` Hyp) H8); Simpl.
+Replace ``2*2`` with ``4``.
+Replace ``2*(3*/2)`` with ``3``.
+Intro; Cut ``3<4``.
+Intro; Elim (Rlt_antirefl ``3`` (Rlt_le_trans ``3`` ``4`` ``3`` H16 H15)).
+Generalize (Rlt_compatibility ``3`` ``0`` ``1`` Rlt_R0_R1); Rewrite Rplus_Or.
+Replace ``3+1`` with ``4``.
+Intro; Assumption.
+Ring.
+Symmetry; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
+DiscrR.
+Ring.
+Rewrite <- (Zplus_inverse_l `2`) in H13; Generalize (Zsimpl_plus_l `-2` k0 `2` H13); Intro; Assumption.
+Split.
+Assumption.
+Apply Rle_lt_trans with ``(IZR (NEG (xO xH)))+3*/2``.
+Assumption.
+Simpl; Replace ``-2+3*/2`` with ``-(1*/2)``.
+Apply Rlt_trans with ``0``.
+Rewrite <- Ropp_O; Apply Rlt_Ropp.
+Apply Rmult_lt_pos; [Apply Rlt_R0_R1 | Apply Rlt_Rinv; Sup0].
+Apply Rlt_R0_R1.
+Rewrite Rmult_1l; Apply r_Rmult_mult with ``2``.
+Rewrite Ropp_mul3; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
+Ring.
+DiscrR.
+DiscrR.
+DiscrR.
+Simpl; Ring.
+Simpl; Ring.
+Apply PI_neq0.
+Unfold Rdiv; Pattern 1 ``3``; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Apply Rmult_sym.
+Apply PI_neq0.
+Symmetry; Rewrite (Rmult_sym ``/PI``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Apply Rmult_1r.
+Apply PI_neq0.
+Rewrite double; Pattern 3 4 PI; Rewrite double_var; Ring.
+Ring.
+Pattern 1 PI; Rewrite double_var; Ring.
+Qed.
+
+Lemma  cos_eq_0_2PI_1 : (x:R) ``0<=x`` -> ``x<=2*PI`` -> ``x==PI/2``\/``x==3*(PI/2)`` -> ``(cos x)==0``.
+Intros x H1 H2 H3; Elim H3; Intro H4; [ Rewrite H4; Rewrite -> cos_PI2; Reflexivity | Rewrite H4; Rewrite -> cos_3PI2; Reflexivity ].
+Qed.
diff --git a/theories7/Reals/Rtrigo_alt.v b/theories7/Reals/Rtrigo_alt.v
new file mode 100644
index 00000000..db0e2fea
--- /dev/null
+++ b/theories7/Reals/Rtrigo_alt.v
@@ -0,0 +1,294 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rtrigo_alt.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo_def.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(*****************************************************************)
+(* Using series definitions of cos and sin                       *)
+(*****************************************************************)
+
+Definition sin_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (plus (mult (S (S O)) i) (S O)))/(INR (fact (plus (mult (S (S O)) i) (S O))))``.
+
+Definition cos_term [a:R] : nat->R := [i:nat] ``(pow (-1) i)*(pow a (mult (S (S O)) i))/(INR (fact (mult (S (S O)) i)))``.
+
+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``.
+Assert H0 := (PI_ineq O).
+Elim H0; Clear H0; Intros _ H0.
+Unfold tg_alt PI_tg in H0; Simpl in H0.
+Rewrite Rinv_R1 in H0; Rewrite Rmult_1r in H0; Unfold Rdiv in H0.
+Apply Rle_monotony_contra with ``/4``.
+Apply Rlt_Rinv; Sup0.
+Rewrite <- Rinv_l_sym; [Rewrite Rmult_sym; Assumption | DiscrR].
+Qed.
+
+(**********)
+Theorem sin_bound : (a:R; n:nat) ``0 <= a``->``a <= PI``->``(sin_approx a (plus (mult (S (S O)) n) (S O))) <= (sin a)<= (sin_approx a (mult (S (S O)) (plus n (S O))))``.
+Intros; Case (Req_EM a R0); Intro Hyp_a.
+Rewrite Hyp_a; Rewrite sin_0; Split; Right; Unfold sin_approx; Apply sum_eq_R0 Orelse (Symmetry; Apply sum_eq_R0); Intros; Unfold sin_term; Rewrite pow_add; Simpl; Unfold Rdiv; Rewrite Rmult_Ol; Ring.
+Unfold sin_approx; Cut ``0<a``.
+Intro Hyp_a_pos.
+Rewrite (decomp_sum (sin_term a) (plus (mult (S (S O)) n) (S O))).
+Rewrite (decomp_sum (sin_term a) (mult (S (S O)) (plus n (S O)))).
+Replace (sin_term a O) with a.
+Cut (Rle (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O)))) ``(sin a)-a``)/\(Rle ``(sin a)-a`` (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O)))))) -> (Rle (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (plus (mult (S (S O)) n) (S O))))) (sin a))/\(Rle (sin a) (Rplus a (sum_f_R0 [i:nat](sin_term a (S i)) (pred (mult (S (S O)) (plus n (S O))))))).
+Intro; Apply H1.
+Pose Un := [n:nat]``(pow a (plus (mult (S (S O)) (S n)) (S O)))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))``.
+Replace (pred (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) n).
+Replace (pred (mult (S (S O)) (plus n (S O)))) with (S (mult (S (S O)) n)).
+Replace (sum_f_R0 [i:nat](sin_term a (S i)) (mult (S (S O)) n)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``.
+Replace (sum_f_R0 [i:nat](sin_term a (S i)) (S (mult (S (S O)) n))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
+Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))<=a-(sin a)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n)) <= (sin a)-a <=  -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``.
+Intro; Apply H2.
+Apply alternated_series_ineq.
+Unfold Un_decreasing Un; Intro; Cut (plus (mult (S (S O)) (S (S n0))) (S O))=(S (S (plus (mult (S (S O)) (S n0)) (S O)))).
+Intro; Rewrite H3.
+Replace ``(pow a (S (S (plus (mult (S (S O)) (S n0)) (S O)))))`` with ``(pow a (plus (mult (S (S O)) (S n0)) (S O)))*(a*a)``.
+Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply pow_lt; Assumption.
+Apply Rle_monotony_contra with ``(INR (fact (S (S (plus (mult (S (S O)) (S n0)) (S O))))))``.
+Rewrite <- H3; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H5 := (sym_eq ? ? ? H4); Elim (fact_neq_0 ? H5).
+Rewrite <- H3; Rewrite (Rmult_sym ``(INR (fact (plus (mult (S (S O)) (S (S n0))) (S O))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite H3; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Simpl; Replace ``((0+1+1)*((INR n0)+1)+(0+1)+1+1)*((0+1+1)*((INR n0)+1)+(0+1)+1)`` with ``4*(INR n0)*(INR n0)+18*(INR n0)+20``; [Idtac | Ring].
+Apply Rle_trans with ``20``.
+Apply Rle_trans with ``16``.
+Replace ``16`` with ``(Rsqr 4)``; [Idtac | SqRing].
+Replace ``a*a`` with (Rsqr a); [Idtac | Reflexivity].
+Apply Rsqr_incr_1.
+Apply Rle_trans with PI; [Assumption | Apply PI_4].
+Assumption.
+Left; Sup0.
+Rewrite <- (Rplus_Or ``16``); Replace ``20`` with ``16+4``; [Apply Rle_compatibility; Left; Sup0 | Ring].
+Rewrite <- (Rplus_sym ``20``); Pattern 1 ``20``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
+Apply ge0_plus_ge0_is_ge0.
+Repeat Apply Rmult_le_pos.
+Left; Sup0.
+Left; Sup0.
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Apply Rmult_le_pos.
+Left; Sup0.
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Simpl; Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite plus_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+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 (plus (mult (2) (S n0)) (1)) with (S (mult (2) (S n0))).
+Unfold ge; Apply le_trans with (mult (2) (S n0)).
+Apply le_trans with (mult (2) (S N)).
+Apply le_trans with (mult (2) N).
+Apply le_n_2n.
+Apply mult_le; Apply le_n_Sn.
+Apply mult_le; Apply le_n_S; Assumption.
+Apply le_n_Sn.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Reflexivity.
+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 infinit_sum in p; Unfold R_dist in p; Unfold Un_cv; Unfold R_dist; Intros.
+Cut ``0<eps/(Rabsolu a)``.
+Intro; Elim (p ? H5); Intros N H6.
+Exists N; Intros.
+Replace (sum_f_R0 (tg_alt Un) n0) with (Rmult a (Rminus R1 (sum_f_R0 [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)))).
+Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym a); Rewrite (Rplus_sym ``-a``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply Rlt_monotony_contra with ``/(Rabsolu a)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Pattern 1 ``/(Rabsolu a)``; Rewrite <- (Rabsolu_Rinv a  Hyp_a).
+Rewrite <- Rabsolu_mult; Rewrite Rmult_Rplus_distr; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym; [Rewrite Rmult_1l | Assumption]; Rewrite (Rmult_sym ``/a``); Rewrite (Rmult_sym ``/(Rabsolu a)``); Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus Rdiv in H6; Apply H6; Unfold ge; Apply le_trans with n0; [Exact H7 | Apply le_n_Sn].
+Rewrite (decomp_sum [i:nat]``(sin_n i)*(pow (Rsqr a) i)`` (S n0)).
+Replace (sin_n O) with R1.
+Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Rewrite scal_sum; Apply sum_eq.
+Intros; Unfold sin_n Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
+Replace ``(pow a (plus (mult (S (S O)) (S i)) (S O)))`` with ``(Rsqr a)*(pow (Rsqr a) i)*a``.
+Unfold Rdiv; Ring.
+Rewrite pow_add; Rewrite pow_Rsqr; Simpl; Ring.
+Simpl; Ring.
+Unfold sin_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
+Apply lt_O_Sn.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption.
+Unfold sin; Case (exist_sin (Rsqr a)).
+Intros; Cut x==x0.
+Intro; Rewrite H3; Unfold Rdiv.
+Symmetry; Apply Rinv_r_simpl_m; Assumption.
+Unfold sin_in in p; Unfold sin_in in s; EApply unicity_sum.
+Apply p.
+Apply s.
+Intros; Elim H2; Intros.
+Replace ``(sin a)-a`` with ``-(a-(sin a))``; [Idtac | Ring].
+Split; Apply Rle_Ropp1; Assumption.
+Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n)))``; [Rewrite scal_sum | Ring].
+Apply sum_eq; Intros; Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
+Unfold Rdiv; Ring.
+Reflexivity.
+Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n))``; [Rewrite scal_sum | Ring].
+Apply sum_eq; Intros.
+Unfold sin_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
+Unfold Rdiv; Ring.
+Reflexivity.
+Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
+Reflexivity.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
+Reflexivity.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Intro; Elim H1; Intros.
+Split.
+Apply Rle_anti_compatibility with ``-a``.
+Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H2.
+Apply Rle_anti_compatibility with ``-a``.
+Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-a``); Apply H3.
+Unfold sin_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
+Replace (mult (2) (plus n (1))) with (S (S (mult (2) n))).
+Apply lt_O_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)).
+Apply lt_O_Sn.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Inversion H; [Assumption | Elim Hyp_a; Symmetry; Assumption].
+Qed.
+
+(**********)
+Lemma cos_bound : (a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``. 
+Cut ((a:R; n:nat) ``0 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``) -> ((a:R; n:nat) `` -PI/2 <= a``->``a <= PI/2``->``(cos_approx a (plus (mult (S (S O)) n) (S O))) <= (cos a) <= (cos_approx a (mult (S (S O)) (plus n (S O))))``).
+Intros H a n; Apply H.
+Intros; Unfold cos_approx.
+Rewrite (decomp_sum (cos_term a0) (plus (mult (S (S O)) n0) (S O))).
+Rewrite (decomp_sum (cos_term a0) (mult (S (S O)) (plus n0 (S O)))).
+Replace (cos_term a0 O) with R1.
+Cut (Rle (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O)))) ``(cos a0)-1``)/\(Rle ``(cos a0)-1`` (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O)))))) -> (Rle (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (plus (mult (S (S O)) n0) (S O))))) (cos a0))/\(Rle (cos a0) (Rplus R1 (sum_f_R0 [i:nat](cos_term a0 (S i)) (pred (mult (S (S O)) (plus n0 (S O))))))).
+Intro; Apply H2.
+Pose Un := [n:nat]``(pow a0 (mult (S (S O)) (S n)))/(INR (fact (mult (S (S O)) (S n))))``.
+Replace (pred (plus (mult (S (S O)) n0) (S O))) with (mult (S (S O)) n0).
+Replace (pred (mult (S (S O)) (plus n0 (S O)))) with (S (mult (S (S O)) n0)).
+Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (mult (S (S O)) n0)) with ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``.
+Replace (sum_f_R0 [i:nat](cos_term a0 (S i)) (S (mult (S (S O)) n0))) with ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
+Cut ``(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))<=1-(cos a0)<=(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``->`` -(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0)) <= (cos a0)-1 <=  -(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``.
+Intro; Apply H3.
+Apply alternated_series_ineq.
+Unfold Un_decreasing; Intro; Unfold Un.
+Cut (mult (S (S O)) (S (S n1)))=(S (S (mult (S (S O)) (S n1)))).
+Intro; Rewrite H4; Replace ``(pow a0 (S (S (mult (S (S O)) (S n1)))))`` with ``(pow a0 (mult (S (S O)) (S n1)))*(a0*a0)``.
+Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
+Apply pow_le; Assumption.
+Apply Rle_monotony_contra with ``(INR (fact (S (S (mult (S (S O)) (S n1))))))``.
+Rewrite <- H4; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H6 := (sym_eq ? ? ? H5); Elim (fact_neq_0 ? H6).
+Rewrite <- H4; Rewrite (Rmult_sym ``(INR (fact (mult (S (S O)) (S (S n1)))))``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite H4; Do 2 Rewrite fact_simpl; Do 2 Rewrite mult_INR; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Do 2 Rewrite S_INR; Rewrite mult_INR; Repeat Rewrite S_INR; 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].
+Apply Rle_trans with ``12``.
+Apply Rle_trans with ``4``.
+Replace ``4`` with ``(Rsqr 2)``; [Idtac | SqRing].
+Replace ``a0*a0`` with (Rsqr a0); [Idtac | Reflexivity].
+Apply Rsqr_incr_1.
+Apply Rle_trans with ``PI/2``.
+Assumption.
+Unfold Rdiv; Apply Rle_monotony_contra with ``2``.
+Sup0.
+Rewrite <- Rmult_assoc; Rewrite Rinv_r_simpl_m.
+Replace ``2*2`` with ``4``; [Apply PI_4 | Ring].
+DiscrR.
+Assumption.
+Left; Sup0.
+Pattern 1 ``4``; Rewrite <- Rplus_Or; Replace ``12`` with ``4+8``; [Apply Rle_compatibility; Left; Sup0 | Ring].
+Rewrite <- (Rplus_sym ``12``); Pattern 1 ``12``; Rewrite <- Rplus_Or; Apply Rle_compatibility.
+Apply ge0_plus_ge0_is_ge0.
+Repeat Apply Rmult_le_pos.
+Left; Sup0.
+Left; Sup0.
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Apply Rmult_le_pos.
+Left; Sup0.
+Replace R0 with (INR O); [Apply le_INR; Apply le_O_n | Reflexivity].
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Simpl; Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+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; Apply le_trans with (mult (2) (S N)).
+Apply le_trans with (mult (2) N).
+Apply le_n_2n.
+Apply mult_le; Apply le_n_Sn.
+Apply mult_le; Apply le_n_S; Assumption.
+Assert X := (exist_cos (Rsqr a0)); Elim X; Intros.
+Cut ``x==(cos a0)``.
+Intro; Rewrite H4 in p; Unfold cos_in in p; Unfold infinit_sum in p; 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 (Rminus R1 (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1))).
+Unfold Rminus; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Repeat Rewrite Rplus_assoc; Rewrite (Rplus_sym R1); Rewrite (Rplus_sym ``-1``); Repeat Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr1; Rewrite Ropp_Ropp; Unfold Rminus in H6; Apply H6.
+Unfold ge; Apply le_trans with n1.
+Exact H7.
+Apply le_n_Sn.
+Rewrite (decomp_sum [i:nat]``(cos_n i)*(pow (Rsqr a0) i)`` (S n1)).
+Replace (cos_n O) with R1.
+Simpl; Rewrite Rmult_1r; Unfold Rminus; Rewrite Ropp_distr1; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Ol; Replace (Ropp (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)) with (Rmult ``-1`` (sum_f_R0 [i:nat]``(cos_n (S i))*((Rsqr a0)*(pow (Rsqr a0) i))`` n1)); [Idtac | Ring]; Rewrite scal_sum; Apply sum_eq; Intros; Unfold cos_n Un tg_alt.
+Replace ``(pow (-1) (S i))`` with ``-(pow (-1) i)``.
+Replace ``(pow a0 (mult (S (S O)) (S i)))`` with ``(Rsqr a0)*(pow (Rsqr a0) i)``.
+Unfold Rdiv; Ring.
+Rewrite pow_Rsqr; Reflexivity.
+Simpl; Ring.
+Unfold cos_n; Unfold Rdiv; Simpl; Rewrite Rinv_R1; Rewrite Rmult_1r; Reflexivity.
+Apply lt_O_Sn.
+Unfold cos; Case (exist_cos (Rsqr a0)); Intros; Unfold cos_in in p; Unfold cos_in in c; EApply unicity_sum.
+Apply p.
+Apply c.
+Intros; Elim H3; Intros; Replace ``(cos a0)-1`` with ``-(1-(cos a0))``; [Idtac | Ring].
+Split; Apply Rle_Ropp1; Assumption.
+Replace ``-(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))`` with ``-1*(sum_f_R0 (tg_alt Un) (S (mult (S (S O)) n0)))``; [Rewrite scal_sum | Ring].
+Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
+Unfold Rdiv; Ring.
+Reflexivity.
+Replace ``-(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))`` with ``-1*(sum_f_R0 (tg_alt Un) (mult (S (S O)) n0))``; [Rewrite scal_sum | Ring]; Apply sum_eq; Intros; Unfold cos_term Un tg_alt; Replace ``(pow (-1) (S i))`` with ``-1*(pow (-1) i)``.
+Unfold Rdiv; Ring.
+Reflexivity.
+Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
+Reflexivity.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
+Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
+Reflexivity.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Intro; Elim H2; Intros; Split.
+Apply Rle_anti_compatibility with ``-1``.
+Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H3.
+Apply Rle_anti_compatibility with ``-1``.
+Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Rewrite (Rplus_sym ``-1``); Apply H4.
+Unfold cos_term; Simpl; Unfold Rdiv; Rewrite Rinv_R1; Ring.
+Replace (mult (2) (plus n0 (1))) with (S (S (mult (2) n0))).
+Apply lt_O_Sn.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Rewrite plus_INR; Repeat Rewrite S_INR; Ring.
+Replace (plus (mult (2) n0) (1)) with (S (mult (2) n0)).
+Apply lt_O_Sn.
+Apply INR_eq; Rewrite S_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Intros; Case (total_order_T R0 a); Intro.
+Elim s; Intro.
+Apply H; [Left; Assumption | Assumption].
+Apply H; [Right; Assumption | Assumption].
+Cut ``0< -a``.
+Intro; Cut (x:R;n:nat) (cos_approx x n)==(cos_approx ``-x`` n).
+Intro; Rewrite H3; Rewrite (H3 a (mult (S (S O)) (plus n (S O)))); Rewrite cos_sym; Apply H.
+Left; Assumption.
+Rewrite <- (Ropp_Ropp ``PI/2``); Apply Rle_Ropp1; Unfold Rdiv; Unfold Rdiv in H0; Rewrite <- Ropp_mul1; 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 Rgt_RO_Ropp; Assumption.
+Qed.
diff --git a/theories7/Reals/Rtrigo_calc.v b/theories7/Reals/Rtrigo_calc.v
new file mode 100644
index 00000000..ab181106
--- /dev/null
+++ b/theories7/Reals/Rtrigo_calc.v
@@ -0,0 +1,350 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rtrigo_calc.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require R_sqrt.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Lemma tan_PI : ``(tan PI)==0``.
+Unfold tan; Rewrite sin_PI; Rewrite cos_PI; Unfold Rdiv; Apply Rmult_Ol. 
+Qed.
+
+Lemma sin_3PI2 : ``(sin (3*(PI/2)))==(-1)``.
+Replace ``3*(PI/2)`` with ``PI+(PI/2)``.
+Rewrite sin_plus; Rewrite sin_PI; Rewrite cos_PI; Rewrite sin_PI2; Ring.
+Pattern 1 PI; Rewrite (double_var PI); Ring.
+Qed.
+
+Lemma tan_2PI : ``(tan (2*PI))==0``.
+Unfold tan; Rewrite sin_2PI; Unfold Rdiv; Apply Rmult_Ol.
+Qed.
+
+Lemma sin_cos_PI4 : ``(sin (PI/4)) == (cos (PI/4))``.
+Proof with Trivial.
+Rewrite cos_sin.
+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 2 3 PI; Rewrite H; Pattern 2 3 PI; Rewrite H.
+Assert H0 : ``2<>0``; [DiscrR | Unfold Rdiv; Rewrite Rinv_Rmult; Try Ring].
+Qed.
+
+Lemma sin_PI3_cos_PI6 : ``(sin (PI/3))==(cos (PI/6))``.
+Proof with Trivial.
+Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
+Rewrite cos_shift.
+Assert H0 : ``6<>0``; [DiscrR | Idtac].
+Assert H1 : ``3<>0``; [DiscrR | Idtac].
+Assert H2 : ``2<>0``; [DiscrR | Idtac].
+Apply r_Rmult_mult with ``6``.
+Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
+Unfold Rdiv; Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Ring.
+Qed.
+
+Lemma sin_PI6_cos_PI3 : ``(cos (PI/3))==(sin (PI/6))``.
+Proof with Trivial.
+Replace ``PI/6`` with ``(PI/2)-(PI/3)``.
+Rewrite sin_shift.
+Assert H0 : ``6<>0``; [DiscrR | Idtac].
+Assert H1 : ``3<>0``; [DiscrR | Idtac].
+Assert H2 : ``2<>0``; [DiscrR | Idtac].
+Apply r_Rmult_mult with ``6``.
+Rewrite Rminus_distr; Repeat Rewrite (Rmult_sym ``6``).
+Unfold Rdiv; Repeat Rewrite Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite (Rmult_sym ``/3``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Pattern 2 PI; Rewrite (Rmult_sym PI); Repeat Rewrite Rmult_1r; Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Ring.
+Qed.
+
+Lemma PI6_RGT_0 : ``0<PI/6``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
+Qed.
+
+Lemma PI6_RLT_PI2 : ``PI/6<PI/2``.
+Unfold Rdiv; Apply Rlt_monotony.
+Apply PI_RGT_0.
+Apply Rinv_lt; Sup.
+Qed.
+
+Lemma sin_PI6 : ``(sin (PI/6))==1/2``.
+Proof with Trivial.
+Assert H : ``2<>0``; [DiscrR | Idtac].
+Apply r_Rmult_mult with ``2*(cos (PI/6))``.
+Replace ``2*(cos (PI/6))*(sin (PI/6))`` with ``2*(sin (PI/6))*(cos (PI/6))``.
+Rewrite <- sin_2a; Replace ``2*(PI/6)`` with ``PI/3``.
+Rewrite sin_PI3_cos_PI6.
+Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rmult_assoc; Pattern 2 ``2``; Rewrite (Rmult_sym ``2``); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Unfold Rdiv; Rewrite Rinv_Rmult.
+Rewrite (Rmult_sym ``/2``); Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+DiscrR.
+Ring.
+Apply prod_neq_R0.
+Cut ``0<(cos (PI/6))``; [Intro H1; Auto with real | Apply cos_gt_0; [Apply (Rlt_trans ``-(PI/2)`` ``0`` ``PI/6`` _PI2_RLT_0 PI6_RGT_0) | Apply PI6_RLT_PI2]].
+Qed.
+
+Lemma sqrt2_neq_0 : ~``(sqrt 2)==0``.
+Assert Hyp:``0<2``; [Sup0 | 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.
+
+Lemma R1_sqrt2_neq_0 : ~``1/(sqrt 2)==0``.
+Generalize (Rinv_neq_R0 ``(sqrt 2)`` sqrt2_neq_0); Intro H; Generalize (prod_neq_R0 ``1`` ``(Rinv (sqrt 2))`` R1_neq_R0 H); Intro H0; Assumption.
+Qed.
+
+Lemma sqrt3_2_neq_0 : ~``2*(sqrt 3)==0``.
+Apply prod_neq_R0; [DiscrR | Assert Hyp:``0<3``; [Sup0 | 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.
+
+Lemma Rlt_sqrt2_0 : ``0<(sqrt 2)``.
+Assert Hyp:``0<2``; [Sup0 | Generalize (sqrt_positivity ``2`` (Rlt_le ``0`` ``2`` Hyp)); Intro H1; Elim H1; Intro H2; [Assumption | Absurd ``0 == (sqrt 2)``; [Apply not_sym; Apply sqrt2_neq_0 | Assumption]]].
+Qed.
+
+Lemma Rlt_sqrt3_0 : ``0<(sqrt 3)``.
+Cut ~(O=(1)); [Intro H0; Assert Hyp:``0<2``; [Sup0 | Generalize (Rlt_le ``0`` ``2`` Hyp); Intro H1; Assert Hyp2:``0<3``; [Sup0 | Generalize (Rlt_le ``0`` ``3`` Hyp2); Intro H2; Generalize (lt_INR_0 (1) (neq_O_lt (1) H0)); Unfold INR; Intro H3; Generalize (Rlt_compatibility ``2`` ``0`` ``1`` H3); Rewrite Rplus_sym; Rewrite Rplus_Ol; Replace ``2+1`` with ``3``; [Intro H4; Generalize (sqrt_lt_1 ``2`` ``3`` H1 H2 H4); Clear H3; Intro H3; Apply (Rlt_trans ``0`` ``(sqrt 2)`` ``(sqrt 3)`` Rlt_sqrt2_0 H3) | Ring]]] | Discriminate].
+Qed.
+
+Lemma PI4_RGT_0 : ``0<PI/4``.
+Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0].
+Qed.
+
+Lemma cos_PI4 : ``(cos (PI/4))==1/(sqrt 2)``.
+Proof with Trivial.
+Apply Rsqr_inj.
+Apply cos_ge_0.
+Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/4`` _PI2_RLT_0 PI4_RGT_0).
+Left; Apply PI4_RLT_PI2.
+Left; Apply (Rmult_lt_pos R1 ``(Rinv (sqrt 2))``).
+Sup.
+Apply Rlt_Rinv; Apply Rlt_sqrt2_0.
+Rewrite Rsqr_div.
+Rewrite Rsqr_1; Rewrite Rsqr_sqrt.
+Assert H : ``2<>0``; [DiscrR | Idtac].
+Unfold Rsqr; Pattern 1 ``(cos (PI/4))``; 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_1r.
+Unfold Rdiv; Rewrite (Rmult_sym ``2``); Rewrite Rinv_Rmult.
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Unfold Rdiv; Rewrite Rmult_1l; Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Left; Sup.
+Apply sqrt2_neq_0.
+Qed.
+
+Lemma sin_PI4 : ``(sin (PI/4))==1/(sqrt 2)``.
+Rewrite sin_cos_PI4; Apply cos_PI4.
+Qed.
+
+Lemma tan_PI4 : ``(tan (PI/4))==1``.
+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; Rewrite Ropp_mul1.
+Unfold Rminus; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
+Qed.
+
+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; Rewrite Ropp_Ropp; Pattern 1 PI; Rewrite double_var; Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_Rmult; [Ring | DiscrR | DiscrR].
+Qed.
+
+Lemma cos_PI6 : ``(cos (PI/6))==(sqrt 3)/2``.
+Proof with Trivial.
+Apply Rsqr_inj.
+Apply cos_ge_0.
+Left; Apply (Rlt_trans ``-(PI/2)`` R0 ``PI/6`` _PI2_RLT_0 PI6_RGT_0).
+Left; Apply PI6_RLT_PI2.
+Left; Apply (Rmult_lt_pos ``(sqrt 3)`` ``(Rinv 2)``).
+Apply Rlt_sqrt3_0.
+Apply Rlt_Rinv; Sup0.
+Assert H : ``2<>0``; [DiscrR | Idtac].
+Assert H1 : ``4<>0``; [Apply prod_neq_R0 | Idtac].
+Rewrite Rsqr_div.
+Rewrite cos2; Unfold Rsqr; Rewrite sin_PI6; Rewrite sqrt_def.
+Unfold Rdiv; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
+Rewrite Rminus_distr; Rewrite (Rmult_sym ``3``); Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite Rmult_1r.
+Rewrite <- (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- Rinv_r_sym.
+Ring.
+Left; Sup0.
+Qed.
+
+Lemma tan_PI6 : ``(tan (PI/6))==1/(sqrt 3)``.
+Unfold tan; Rewrite sin_PI6; Rewrite cos_PI6; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Rewrite (Rmult_sym ``/2``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Apply Rmult_1r.
+DiscrR.
+DiscrR.
+Red; Intro; Assert H1 := Rlt_sqrt3_0; Rewrite H in H1; Elim (Rlt_antirefl ``0`` H1).
+Apply Rinv_neq_R0; DiscrR.
+Qed.
+
+Lemma sin_PI3 : ``(sin (PI/3))==(sqrt 3)/2``.
+Rewrite sin_PI3_cos_PI6; Apply cos_PI6.
+Qed.
+
+Lemma cos_PI3 : ``(cos (PI/3))==1/2``.
+Rewrite sin_PI6_cos_PI3; Apply sin_PI6.
+Qed.
+
+Lemma tan_PI3 : ``(tan (PI/3))==(sqrt 3)``.
+Unfold tan; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Rewrite Rmult_1l; Rewrite Rinv_Rinv.
+Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Apply Rmult_1r.
+DiscrR.
+DiscrR.
+Qed.
+
+Lemma sin_2PI3 : ``(sin (2*(PI/3)))==(sqrt 3)/2``.
+Rewrite double; Rewrite sin_plus; Rewrite sin_PI3; Rewrite cos_PI3; Unfold Rdiv; Repeat Rewrite Rmult_1l; Rewrite (Rmult_sym ``/2``); Repeat Rewrite <- Rmult_assoc; Rewrite double_var; Reflexivity.
+Qed.
+
+Lemma cos_2PI3 : ``(cos (2*(PI/3)))==-1/2``.
+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; Rewrite Rmult_1l; Apply r_Rmult_mult with ``4``.
+Rewrite Rminus_distr; Repeat Rewrite Rmult_assoc; Rewrite (Rmult_sym ``2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- (Rinv_l_sym).
+Rewrite Rmult_1r; Rewrite <- Rinv_r_sym.
+Pattern 4 ``2``; Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite Ropp_mul3; Rewrite Rmult_1r.
+Rewrite (Rmult_sym ``2``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite (Rmult_sym ``2``); Rewrite (Rmult_sym ``/2``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Rewrite sqrt_def.
+Ring.
+Left; Sup.
+Qed.
+
+Lemma tan_2PI3 : ``(tan (2*(PI/3)))==-(sqrt 3)``.
+Proof with Trivial.
+Assert H : ``2<>0``; [DiscrR | Idtac].
+Unfold tan; Rewrite sin_2PI3; Rewrite cos_2PI3; Unfold Rdiv; Rewrite Ropp_mul1; Rewrite Rmult_1l; Rewrite <- Ropp_Rinv.
+Rewrite Rinv_Rinv.
+Rewrite Rmult_assoc; Rewrite Ropp_mul3; Rewrite <- Rinv_l_sym.
+Ring.
+Apply Rinv_neq_R0.
+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; Rewrite Ropp_mul1.
+Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; 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; Rewrite Ropp_mul1.
+Pattern 2 PI; Rewrite double_var; Pattern 2 3 PI; Rewrite double_var; Assert H : ``2<>0``; [DiscrR | Unfold Rdiv; Repeat Rewrite Rinv_Rmult; Try Ring].
+Qed.
+
+Lemma sin_cos5PI4 : ``(cos (5*(PI/4)))==(sin (5*(PI/4)))``.
+Rewrite cos_5PI4; Rewrite sin_5PI4; Reflexivity.
+Qed.
+
+Lemma Rgt_3PI2_0 : ``0<3*(PI/2)``.
+Apply Rmult_lt_pos; [Sup0 | Unfold Rdiv; Apply Rmult_lt_pos; [Apply PI_RGT_0 | Apply Rlt_Rinv; Sup0]].
+Qed.
+
+Lemma Rgt_2PI_0 : ``0<2*PI``.
+Apply Rmult_lt_pos; [Sup0 | Apply PI_RGT_0].
+Qed.
+
+Lemma Rlt_PI_3PI2 : ``PI<3*(PI/2)``.
+Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility PI ``0`` ``PI/2`` H1); Replace ``PI+(PI/2)`` with ``3*(PI/2)``.
+Rewrite Rplus_Or; Intro H2; Assumption.
+Pattern 2 PI; Rewrite double_var; Ring.
+Qed. 
+ 
+Lemma Rlt_3PI2_2PI : ``3*(PI/2)<2*PI``.
+Generalize PI2_RGT_0; Intro H1; Generalize (Rlt_compatibility ``3*(PI/2)`` ``0`` ``PI/2`` H1); Replace ``3*(PI/2)+(PI/2)`` with ``2*PI``.
+Rewrite Rplus_Or; Intro H2; Assumption.
+Rewrite double; Pattern 1 2 PI; Rewrite double_var; Ring.
+Qed.
+
+(***************************************************************)
+(* Radian -> Degree | Degree -> Radian                         *)
+(***************************************************************)
+
+Definition plat : R := ``180``.
+Definition toRad [x:R] : R := ``x*PI*/plat``.
+Definition toDeg [x:R] : R := ``x*plat*/PI``.
+
+Lemma rad_deg : (x:R) (toRad (toDeg x))==x.
+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; DiscrR.
+Qed.
+
+Lemma toRad_inj : (x,y:R) (toRad x)==(toRad y) -> x==y.
+Intros; Unfold toRad in H; Apply r_Rmult_mult with PI.
+Rewrite <- (Rmult_sym x); Rewrite <- (Rmult_sym y).
+Apply r_Rmult_mult with ``/plat``.
+Rewrite <- (Rmult_sym ``x*PI``); Rewrite <- (Rmult_sym ``y*PI``); Assumption.
+Apply Rinv_neq_R0; Unfold plat; DiscrR.
+Apply PI_neq0.
+Qed.
+
+Lemma deg_rad : (x:R) (toDeg (toRad x))==x.
+Intro x; Apply toRad_inj; Rewrite -> (rad_deg (toRad x)); Reflexivity.
+Qed.
+
+Definition sind [x:R] : R := (sin (toRad x)).
+Definition cosd [x:R] : R := (cos (toRad x)).
+Definition tand [x:R] : R := (tan (toRad x)).
+
+Lemma Rsqr_sin_cos_d_one : (x:R) ``(Rsqr (sind x))+(Rsqr (cosd x))==1``.
+Intro x; Unfold sind; Unfold cosd; Apply sin2_cos2.
+Qed.
+
+(***************************************************)
+(*                Other properties                 *)
+(***************************************************)
+
+Lemma sin_lb_ge_0 : (a:R) ``0<=a``->``a<=PI/2``->``0<=(sin_lb a)``.
+Intros; Case (total_order R0 a); Intro.
+Left; Apply sin_lb_gt_0; Assumption.
+Elim H1; Intro.
+Rewrite <- H2; Unfold sin_lb; Unfold sin_approx; Unfold sum_f_R0; Unfold sin_term; Repeat Rewrite pow_ne_zero.
+Unfold Rdiv; Repeat Rewrite Rmult_Ol; Repeat Rewrite Rmult_Or; Repeat Rewrite Rplus_Or; Right; Reflexivity.
+Discriminate.
+Discriminate.
+Discriminate.
+Discriminate.
+Elim (Rlt_antirefl ``0`` (Rle_lt_trans ``0`` a ``0`` H H2)).
+Qed.
diff --git a/theories7/Reals/Rtrigo_def.v b/theories7/Reals/Rtrigo_def.v
new file mode 100644
index 00000000..0897416b
--- /dev/null
+++ b/theories7/Reals/Rtrigo_def.v
@@ -0,0 +1,357 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rtrigo_def.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo_fun.
+Require Max.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(*****************************)
+(* Definition of exponential *)
+(*****************************)
+Definition exp_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``/(INR (fact i))*(pow x i)`` l).
+
+Lemma exp_cof_no_R0 : (n:nat) ``/(INR (fact n))<>0``.
+Intro.
+Apply Rinv_neq_R0.
+Apply INR_fact_neq_0.
+Qed.
+
+Lemma exist_exp : (x:R)(SigT R [l:R](exp_in x l)).
+Intro; Generalize (Alembert_C3 [n:nat](Rinv (INR (fact n))) x exp_cof_no_R0 Alembert_exp).
+Unfold Pser exp_in.
+Trivial.
+Defined.
+
+Definition exp : R -> R := [x:R](projT1 ? ? (exist_exp x)).
+
+Lemma pow_i : (i:nat) (lt O i) -> (pow R0 i)==R0.
+Intros; Apply pow_ne_zero.
+Red; Intro; Rewrite H0 in H; Elim (lt_n_n ? H).
+Qed.
+
+(*i Calculus of $e^0$ *)
+Lemma exist_exp0 : (SigT R [l:R](exp_in R0 l)).
+Apply Specif.existT with R1.
+Unfold exp_in; Unfold infinit_sum; Intros.
+Exists O.
+Intros; Replace (sum_f_R0 ([i:nat]``/(INR (fact i))*(pow R0 i)``) n) with R1.
+Unfold R_dist; Replace ``1-1`` with R0; [Rewrite Rabsolu_R0; Assumption | Ring].
+Induction n.
+Simpl; Rewrite Rinv_R1; Ring.
+Rewrite tech5.
+Rewrite <- Hrecn.
+Simpl.
+Ring.
+Unfold ge; Apply le_O_n.
+Defined.
+
+Lemma exp_0 : ``(exp 0)==1``. 
+Cut (exp_in R0 (exp R0)).
+Cut (exp_in R0 R1).
+Unfold exp_in; Intros; EApply unicity_sum.
+Apply H0.
+Apply H.
+Exact (projT2 ? ? exist_exp0).
+Exact (projT2 ? ? (exist_exp R0)).
+Qed.
+
+(**************************************)
+(* Definition of hyperbolic functions *)
+(**************************************)
+Definition cosh : R->R := [x:R]``((exp x)+(exp (-x)))/2``.
+Definition sinh : R->R := [x:R]``((exp x)-(exp (-x)))/2``.
+Definition tanh : R->R := [x:R]``(sinh x)/(cosh x)``.
+
+Lemma cosh_0 : ``(cosh 0)==1``.
+Unfold cosh; Rewrite Ropp_O; Rewrite exp_0.
+Unfold Rdiv; Rewrite <- Rinv_r_sym; [Reflexivity | DiscrR].
+Qed.
+
+Lemma sinh_0 : ``(sinh 0)==0``.
+Unfold sinh; Rewrite Ropp_O; Rewrite exp_0.
+Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Apply Rmult_Ol.
+Qed.
+
+Definition cos_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (mult (S (S O)) n)))``.
+
+Lemma simpl_cos_n : (n:nat) (Rdiv (cos_n (S n)) (cos_n n))==(Ropp (Rinv (INR (mult (mult (2) (S n)) (plus (mult (2) n) (1)))))). 
+Intro; Unfold cos_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(/(pow ( -1) n)*(INR (fact (mult (S (S O)) n))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (mult (S (S O)) (plus n (S O)))))*(INR (fact (mult (S (S O)) n)))*(pow (-1) (S O))``; [Idtac | Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r.
+Replace (mult (S (S O)) (plus n (S O))) with (S (S (mult (S (S O)) n))); [Idtac | Ring].
+Do 2 Rewrite fact_simpl; Do 2  Rewrite mult_INR; Repeat Rewrite Rinv_Rmult; Try (Apply not_O_INR; Discriminate).
+Rewrite <- (Rmult_sym ``-1``).
+Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r.
+Replace (S (mult (S (S O)) n)) with (plus (mult (S (S O)) n) (S O)); [Idtac | Ring].
+Rewrite mult_INR; Rewrite Rinv_Rmult.
+Ring.
+Apply not_O_INR; Discriminate.
+Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (S (S O)) n)); [Apply not_O_INR; Discriminate | Ring].
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
+Apply pow_nonzero; DiscrR.
+Apply INR_fact_neq_0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Qed.
+
+Lemma archimed_cor1 : (eps:R) ``0<eps`` -> (EX N : nat | ``/(INR N) < eps``/\(lt O N)).
+Intros; Cut ``/eps < (IZR (up (/eps)))``.
+Intro; Cut `0<=(up (Rinv eps))`.
+Intro; Assert H2 := (IZN ? H1); Elim H2; Intros; Exists (max x (1)).
+Split.
+Cut ``0<(IZR (INZ x))``.
+Intro; Rewrite INR_IZR_INZ; Apply Rle_lt_trans with ``/(IZR (INZ x))``.
+Apply Rle_monotony_contra with (IZR (INZ x)).
+Assumption.
+Rewrite <- Rinv_r_sym; [Idtac | Red; Intro; Rewrite H5 in H4; Elim (Rlt_antirefl ? H4)].
+Apply Rle_monotony_contra with (IZR (INZ (max x (1)))).
+Apply Rlt_le_trans with (IZR (INZ x)).
+Assumption.
+Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
+Rewrite Rmult_1r; Rewrite (Rmult_sym (IZR (INZ (max x (S O))))); Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Repeat Rewrite <- INR_IZR_INZ; Apply le_INR; Apply le_max_l.
+Rewrite <- INR_IZR_INZ; Apply not_O_INR.
+Red; Intro;Assert H6 := (le_max_r x (1)); Cut (lt O (1)); [Intro | Apply lt_O_Sn]; Assert H8 := (lt_le_trans ? ? ? H7 H6); Rewrite H5 in H8; Elim (lt_n_n ? H8).
+Pattern 1 eps; Rewrite <- Rinv_Rinv.
+Apply Rinv_lt.
+Apply Rmult_lt_pos; [Apply Rlt_Rinv; Assumption | Assumption].
+Rewrite H3 in H0; Assumption.
+Red; Intro; Rewrite H5 in H; Elim (Rlt_antirefl ? H).
+Apply Rlt_trans with ``/eps``.
+Apply Rlt_Rinv; Assumption.
+Rewrite H3 in H0; Assumption.
+Apply lt_le_trans with (1); [Apply lt_O_Sn | Apply le_max_r].
+Apply le_IZR; Replace (IZR `0`) with R0; [Idtac | Reflexivity]; Left; Apply Rlt_trans with ``/eps``; [Apply Rlt_Rinv; Assumption | Assumption].
+Assert H0 := (archimed ``/eps``).
+Elim H0; Intros; Assumption.
+Qed.
+
+Lemma Alembert_cos : (Un_cv [n:nat]``(Rabsolu (cos_n (S n))/(cos_n n))`` R0).
+Unfold Un_cv; Intros.
+Assert H0 := (archimed_cor1 eps H).
+Elim H0; Intros; Exists x.
+Intros; Rewrite simpl_cos_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
+Rewrite mult_INR; Rewrite Rinv_Rmult.
+Cut ``/(INR (mult (S (S O)) (S n)))<1``.
+Intro; Cut ``/(INR (plus (mult (S (S O)) n) (S O)))<eps``.
+Intro; Rewrite <- (Rmult_1l eps).
+Apply Rmult_lt; Try Assumption.
+Change ``0</(INR (plus (mult (S (S O)) n) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Apply Rlt_R0_R1.
+Cut (lt x (plus (mult (2) n) (1))).
+Intro; Assert H5 := (lt_INR ? ? H4).
+Apply Rlt_trans with ``/(INR x)``.
+Apply Rinv_lt.
+Apply Rmult_lt_pos.
+Apply lt_INR_0.
+Elim H1; Intros; Assumption.
+Apply lt_INR_0; Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Apply lt_O_Sn | Ring].
+Assumption.
+Elim H1; Intros; Assumption.
+Apply lt_le_trans with (S n).
+Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
+Replace (plus (mult (2) n) (1)) with (S (mult (2) n)); [Idtac | Ring].
+Apply le_n_S; Apply le_n_2n.
+Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
+Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Apply lt_O_Sn.
+Replace (S n) with (plus n (1)); [Idtac | Ring].
+Ring.
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
+Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Apply lt_n_S; Apply lt_O_Sn.
+Replace (S n) with (plus n (1)); [Ring | Ring].
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+Replace (plus (mult (S (S O)) n) (S O)) with (S (mult (2) n)); [Apply not_O_INR; Discriminate | Ring].
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Apply lt_INR_0.
+Replace (mult (mult (2) (S n)) (plus (mult (2) n) (1))) with (S (S (plus (mult (4) (mult n n)) (mult (6) n)))).
+Apply lt_O_Sn.
+Apply INR_eq.
+Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
+Qed.
+
+Lemma cosn_no_R0 : (n:nat)``(cos_n n)<>0``.
+Intro; Unfold cos_n; Unfold Rdiv; Apply prod_neq_R0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0.
+Apply INR_fact_neq_0.
+Qed.
+
+(**********)
+Definition cos_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(cos_n i)*(pow x i)`` l).
+
+(**********)
+Lemma exist_cos : (x:R)(SigT R [l:R](cos_in x l)).
+Intro; Generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
+Unfold Pser cos_in; Trivial.
+Qed.
+
+(* Definition of cosinus *)
+(*************************)
+Definition cos : R -> R := [x:R](Cases (exist_cos (Rsqr x)) of (Specif.existT a b) => a end).
+
+
+Definition sin_n [n:nat] : R := ``(pow (-1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``.
+
+Lemma simpl_sin_n : (n:nat) (Rdiv (sin_n (S n)) (sin_n n))==(Ropp (Rinv (INR (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n)))))). 
+Intro; Unfold sin_n; Replace (S n) with (plus n (1)); [Idtac | Ring].
+Rewrite pow_add; Unfold Rdiv; Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Replace ``(pow ( -1) n)*(pow ( -1) (S O))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(/(pow ( -1) n)*(INR (fact (plus (mult (S (S O)) n) (S O)))))`` with ``((pow ( -1) n)*/(pow ( -1) n))*/(INR (fact (plus (mult (S (S O)) (plus n (S O))) (S O))))*(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow (-1) (S O))``; [Idtac | Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Unfold pow; Rewrite Rmult_1r; Replace (plus (mult (S (S O)) (plus n (S O))) (S O)) with (S (S (plus (mult (S (S O)) n) (S O)))).
+Do 2 Rewrite fact_simpl; Do 2  Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
+Rewrite <- (Rmult_sym ``-1``); Repeat Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Replace (S (plus (mult (S (S O)) n) (S O))) with (mult (S (S O)) (plus n (S O))).
+Repeat Rewrite mult_INR; Repeat Rewrite Rinv_Rmult.
+Ring.
+Apply not_O_INR; Discriminate.
+Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
+Apply not_O_INR; Discriminate.
+Apply prod_neq_R0.
+Apply not_O_INR; Discriminate.
+Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
+Apply not_O_INR; Discriminate.
+Replace (plus n (S O)) with (S n); [Apply not_O_INR; Discriminate | Ring].
+Rewrite mult_plus_distr_r; Cut (n:nat) (S n)=(plus n (1)).
+Intros; Rewrite (H (plus (mult (2) n) (1))).
+Ring.
+Intros; Ring.
+Apply INR_fact_neq_0.
+Apply not_O_INR; Discriminate.
+Apply INR_fact_neq_0.
+Apply not_O_INR; Discriminate.
+Apply prod_neq_R0; [Apply not_O_INR; Discriminate | Apply INR_fact_neq_0].
+Cut (n:nat) (S (S n))=(plus n (2)); [Intros; Rewrite (H (plus (mult (2) n) (1))); Ring | Intros; Ring].
+Apply pow_nonzero; DiscrR.
+Apply INR_fact_neq_0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Qed.
+
+Lemma Alembert_sin : (Un_cv [n:nat]``(Rabsolu (sin_n (S n))/(sin_n n))`` R0).
+Unfold Un_cv; Intros; Assert H0 := (archimed_cor1 eps H).
+Elim H0; Intros; Exists x.
+Intros; Rewrite simpl_sin_n; Unfold R_dist; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_Rabsolu; Rewrite Rabsolu_Ropp; Rewrite Rabsolu_right.
+Rewrite mult_INR; Rewrite Rinv_Rmult.
+Cut ``/(INR (mult (S (S O)) (S n)))<1``.
+Intro; Cut ``/(INR (plus (mult (S (S O)) (S n)) (S O)))<eps``.
+Intro; Rewrite <- (Rmult_1l eps); Rewrite (Rmult_sym ``/(INR (plus (mult (S (S O)) (S n)) (S O)))``); Apply Rmult_lt; Try Assumption.
+Change ``0</(INR (plus (mult (S (S O)) (S n)) (S O)))``; Apply Rlt_Rinv; Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
+Apply Rlt_R0_R1.
+Cut (lt x (plus (mult (2) (S n)) (1))).
+Intro; Assert H5 := (lt_INR ? ? H4); Apply Rlt_trans with ``/(INR x)``.
+Apply Rinv_lt.
+Apply Rmult_lt_pos.
+Apply lt_INR_0; Elim H1; Intros; Assumption.
+Apply lt_INR_0; Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Apply lt_O_Sn | Ring].
+Assumption.
+Elim H1; Intros; Assumption.
+Apply lt_le_trans with (S n).
+Unfold ge in H2; Apply le_lt_n_Sm; Assumption.
+Replace (plus (mult (2) (S n)) (1)) with (S (mult (2) (S n))); [Idtac | Ring].
+Apply le_S; Apply le_n_2n.
+Apply Rlt_monotony_contra with (INR (mult (S (S O)) (S n))).
+Apply lt_INR_0; Replace (mult (2) (S n)) with (S (S (mult (2) n))); [Apply lt_O_Sn | Replace (S n) with (plus n (1)); [Idtac | Ring]; Ring].
+Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Replace R1 with (INR (1)); [Apply lt_INR | Reflexivity].
+Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Apply lt_n_S; Apply lt_O_Sn.
+Replace (S n) with (plus n (1)); [Ring | Ring].
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+Apply not_O_INR; Discriminate.
+Left; Change ``0</(INR (mult (plus (mult (S (S O)) (S n)) (S O)) (mult (S (S O)) (S n))))``; Apply Rlt_Rinv.
+Apply lt_INR_0.
+Replace (mult (plus (mult (2) (S n)) (1)) (mult (2) (S n))) with (S (S (S (S (S (S (plus (mult (4) (mult n n)) (mult (10) n)))))))).
+Apply lt_O_Sn.
+Apply INR_eq; Repeat Rewrite S_INR; Rewrite plus_INR; Repeat Rewrite mult_INR; Rewrite plus_INR; Rewrite mult_INR; Repeat Rewrite S_INR; Replace (INR O) with R0; [Ring | Reflexivity].
+Qed.
+
+Lemma sin_no_R0 : (n:nat)``(sin_n n)<>0``.
+Intro; Unfold sin_n; Unfold Rdiv; Apply prod_neq_R0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Qed.
+
+(**********)
+Definition sin_in:R->R->Prop := [x,l:R](infinit_sum [i:nat]``(sin_n i)*(pow x i)`` l).
+
+(**********)
+Lemma exist_sin : (x:R)(SigT R [l:R](sin_in x l)).
+Intro; Generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
+Unfold Pser sin_n; Trivial.
+Qed.
+
+(***********************)
+(* Definition of sinus *)
+Definition sin : R -> R := [x:R](Cases (exist_sin (Rsqr x)) of (Specif.existT a b) => ``x*a`` end).
+
+(*********************************************)
+(*                 PROPERTIES                *)
+(*********************************************)
+
+Lemma cos_sym : (x:R) ``(cos x)==(cos (-x))``.
+Intros; Unfold cos; Replace ``(Rsqr (-x))`` with (Rsqr x).
+Reflexivity.
+Apply Rsqr_neg.
+Qed.
+
+Lemma sin_antisym : (x:R)``(sin (-x))==-(sin 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``.
+Unfold sin; Case (exist_sin (Rsqr R0)).
+Intros; Ring.
+Qed.
+
+Lemma exist_cos0 : (SigT R [l:R](cos_in R0 l)).
+Apply Specif.existT with R1.
+Unfold cos_in; Unfold infinit_sum; Intros; Exists O.
+Intros.
+Unfold R_dist.
+Induction n.
+Unfold cos_n; Simpl.
+Unfold Rdiv; Rewrite Rinv_R1.
+Do 2 Rewrite Rmult_1r.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Rewrite tech5.
+Replace ``(cos_n (S n))*(pow 0 (S n))`` with R0.
+Rewrite Rplus_Or.
+Apply Hrecn; Unfold ge; Apply le_O_n.
+Simpl; Ring.
+Defined.
+
+(* Calculus of (cos 0) *)
+Lemma cos_0 : ``(cos 0)==1``.
+Cut (cos_in R0 (cos R0)).
+Cut (cos_in R0 R1).
+Unfold cos_in; Intros; EApply unicity_sum.
+Apply H0.
+Apply H.
+Exact (projT2 ? ? exist_cos0).
+Assert H := (projT2 ? ? (exist_cos (Rsqr R0))); Unfold cos; Pattern 1 R0; Replace R0 with (Rsqr R0); [Exact H | Apply Rsqr_O].
+Qed.
diff --git a/theories7/Reals/Rtrigo_fun.v b/theories7/Reals/Rtrigo_fun.v
new file mode 100644
index 00000000..bc72c0e1
--- /dev/null
+++ b/theories7/Reals/Rtrigo_fun.v
@@ -0,0 +1,118 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rtrigo_fun.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(*****************************************************************)
+(*           To define transcendental functions                  *)
+(*                                                               *)
+(*****************************************************************)
+(*****************************************************************)
+(*           For exponential function                            *)
+(*                                                               *)
+(*****************************************************************)
+
+(*********)
+Lemma Alembert_exp:(Un_cv
+   [n:nat](Rabsolu (Rmult (Rinv (INR (fact (S n)))) 
+         (Rinv (Rinv (INR (fact n)))))) R0).
+Unfold Un_cv;Intros;Elim (total_order_Rgt eps R1);Intro.
+Split with O;Intros;Rewrite (simpl_fact n);Unfold R_dist;
+ Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
+ Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
+ Cut (Rgt (Rinv (INR (S n))) R0).
+Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
+Cut (Rlt (Rminus (Rinv eps) R1) R0).
+Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) R0 (INR n) H2 
+   (pos_INR n));Clear H2;Intro;
+ Unfold Rminus in H2;Generalize (Rlt_compatibility R1 
+       (Rplus (Rinv eps) (Ropp R1)) (INR n) H2);
+ Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
+ [Clear H2;Intro|Ring].
+Rewrite (Rplus_sym R1 (INR n)) in H2;Rewrite <-(S_INR n) in H2;
+ Generalize (Rmult_gt (Rinv (INR (S n))) eps H1 H);Intro;
+ Unfold Rgt in H3;
+ Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
+     (INR (S n)) H3 H2);Intro;
+ Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H4;
+ Rewrite (Rinv_r eps (imp_not_Req eps R0 
+      (or_intror (Rlt eps R0) (Rgt eps R0) H))) 
+  in H4;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) 
+  in H4;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H4;
+ Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H4;
+ Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) 
+      (sym_not_equal nat O (S n) (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_R1;
+ Apply (Rinv_lt R1 eps);Auto;
+ Rewrite (let (H1,H2)=(Rmult_ne eps) in H2);Unfold Rgt in H;Assumption.
+Unfold Rgt in H1;Apply Rlt_le;Assumption.
+Unfold Rgt;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
+(**)
+Cut `0<=(up (Rminus (Rinv eps) R1))`.
+Intro;Elim (IZN (up (Rminus (Rinv eps) R1)) H0);Intros;
+ Split with x;Intros;Rewrite (simpl_fact n);Unfold R_dist;
+ Rewrite (minus_R0 (Rabsolu (Rinv (INR (S n)))));
+ Rewrite (Rabsolu_Rabsolu (Rinv (INR (S n))));
+ Cut (Rgt (Rinv (INR (S n))) R0).
+Intro; Rewrite (Rabsolu_pos_eq (Rinv (INR (S n)))).
+Cut (Rlt (Rminus (Rinv eps) R1) (INR x)).
+Intro;Generalize (Rlt_le_trans (Rminus (Rinv eps) R1) (INR x) (INR n) 
+      H4 (le_INR x n ([n,m:nat; H:(ge m n)]H x n H2)));  
+ Clear H4;Intro;Unfold Rminus in H4;Generalize (Rlt_compatibility R1 
+       (Rplus (Rinv eps) (Ropp R1)) (INR n) H4);
+ Replace (Rplus R1 (Rplus (Rinv eps) (Ropp R1))) with (Rinv eps);
+ [Clear H4;Intro|Ring].
+Rewrite (Rplus_sym R1 (INR n)) in H4;Rewrite <-(S_INR n) in H4;
+ Generalize (Rmult_gt (Rinv (INR (S n))) eps H3 H);Intro;
+ Unfold Rgt in H5;
+ Generalize (Rlt_monotony (Rmult (Rinv (INR (S n))) eps) (Rinv eps)
+     (INR (S n)) H5 H4);Intro;
+ Rewrite (Rmult_assoc (Rinv (INR (S n))) eps (Rinv eps)) in H6;
+ Rewrite (Rinv_r eps (imp_not_Req eps R0 
+      (or_intror (Rlt eps R0) (Rgt eps R0) H))) 
+  in H6;Rewrite (let (H1,H2)=(Rmult_ne (Rinv (INR (S n)))) in H1) 
+  in H6;Rewrite (Rmult_sym (Rinv (INR (S n)))) in H6;
+ Rewrite (Rmult_assoc eps (Rinv (INR (S n))) (INR (S n))) in H6;
+ Rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) 
+      (sym_not_equal nat O (S n) (O_S n)))) in H6;
+ Rewrite (let (H1,H2)=(Rmult_ne eps) in H1) in H6;Assumption.
+Cut (IZR (up (Rminus (Rinv eps) R1)))==(IZR (INZ x));
+ [Intro|Rewrite H1;Trivial].
+Elim (archimed (Rminus (Rinv eps) R1));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;Apply Rlt_Rinv; Apply lt_INR_0;Apply lt_O_Sn.
+Apply (le_O_IZR (up (Rminus (Rinv eps) R1))); 
+ Apply (Rle_trans R0 (Rminus (Rinv eps) R1) 
+  (IZR (up (Rminus (Rinv eps) R1)))).
+Generalize (Rgt_not_le eps R1 b);Clear b;Unfold Rle;Intro;Elim H0;
+ Clear H0;Intro.
+Left;Unfold Rgt in H;
+ Generalize (Rlt_monotony (Rinv eps) eps R1 (Rlt_Rinv eps H) H0);
+ Rewrite (Rinv_l eps (sym_not_eqT R R0 eps
+    (imp_not_Req R0 eps (or_introl (Rlt R0 eps) (Rgt R0 eps) H))));
+ Rewrite (let (H1,H2)=(Rmult_ne (Rinv eps)) in H1);Intro;
+ Fold (Rgt (Rminus (Rinv eps) R1) R0);Apply Rgt_minus;Unfold Rgt;
+ Assumption.
+Right;Rewrite H0;Rewrite Rinv_R1;Apply sym_eqT;Apply eq_Rminus;Auto.
+Elim (archimed (Rminus (Rinv eps) R1));Intros;Clear H1;
+ Unfold Rgt in H0;Apply Rlt_le;Assumption.
+Qed.
+
+
+
+
+
+
diff --git a/theories7/Reals/Rtrigo_reg.v b/theories7/Reals/Rtrigo_reg.v
new file mode 100644
index 00000000..02e40caf
--- /dev/null
+++ b/theories7/Reals/Rtrigo_reg.v
@@ -0,0 +1,497 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Rtrigo_reg.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require SeqSeries.
+Require Rtrigo.
+Require Ranalysis1.
+Require PSeries_reg.
+V7only [Import nat_scope. Import Z_scope. Import R_scope.].
+Open Local Scope nat_scope.
+Open Local Scope R_scope.
+
+Lemma CVN_R_cos : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
+Unfold CVN_R; Intros.
+Cut (r::R)<>``0``.
+Intro hyp_r; Unfold CVN_r.
+Apply Specif.existT with [n:nat]``/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))``.
+Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (mult (S (S O)) k)))*(pow r (mult (S (S O)) k))``) n) l)).
+Intro; Elim X; Intros.
+Apply existTT with x.
+Split.
+Apply p.
+Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult.
+Rewrite pow_1_abs; Rewrite Rmult_1l.
+Cut ``0</(INR (fact (mult (S (S O)) n)))``.
+Intro; Rewrite (Rabsolu_right  ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
+Apply Rle_monotony.
+Left; Apply H1.
+Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
+Rewrite Rabsolu_Rabsolu.
+Unfold Boule in H0; Rewrite minus_R0 in H0.
+Left; Apply H0.
+Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Apply Alembert_C2.
+Intro; Apply Rabsolu_no_R0.
+Apply prod_neq_R0.
+Apply Rinv_neq_R0.
+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; Intros.
+Cut ``0<eps/(Rsqr r)``.
+Intro; Elim (H0 ? H2); Intros N0 H3.
+Exists N0; Intros.
+Unfold R_dist; Assert H5 := (H3 ? H4).
+Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (mult (S (S O)) (S n))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (mult (S (S O)) n)))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (mult (S (S O)) (S n))))/((pow ( -1) n)/(INR (fact (mult (S (S O)) n))))))``.
+Apply Rlt_monotony_contra with ``/(Rsqr r)``.
+Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
+Pattern 1 ``/(Rsqr r)``; Replace ``/(Rsqr r)`` with ``(Rabsolu (/(Rsqr r)))``.
+Rewrite <- Rabsolu_mult; Rewrite Rminus_distr; Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps); Apply H5.
+Unfold Rsqr; Apply prod_neq_R0; Assumption.
+Rewrite Rabsolu_Rinv.
+Rewrite Rabsolu_right.
+Reflexivity.
+Apply Rle_sym1; Apply pos_Rsqr.
+Unfold Rsqr; Apply prod_neq_R0; Assumption.
+Rewrite (Rmult_sym (Rsqr r)); Unfold Rdiv; Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs; Rewrite Rmult_1l; Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
+Rewrite Rabsolu_Rinv.
+Rewrite Rabsolu_mult; Rewrite (pow_1_abs n); Rewrite Rmult_1l; Rewrite <- Rabsolu_Rinv.
+Rewrite Rinv_Rinv.
+Rewrite Rinv_Rmult.
+Rewrite Rabsolu_Rinv.
+Rewrite Rinv_Rinv.
+Rewrite (Rmult_sym ``(Rabsolu (Rabsolu (pow r (mult (S (S O)) (S n)))))``); Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite Rmult_assoc; Apply Rmult_mult_r.
+Rewrite Rabsolu_Rinv.
+Do 2 Rewrite Rabsolu_Rabsolu; Repeat Rewrite Rabsolu_right.
+Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
+Repeat Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Unfold Rsqr; Ring.
+Apply pow_nonzero; Assumption.
+Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Simpl; Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
+Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
+Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
+Apply Rabsolu_no_R0; Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
+Apply INR_fact_neq_0.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Apply prod_neq_R0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply H1.
+Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
+Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
+Qed.
+
+(**********)
+Lemma continuity_cos : (continuity cos).
+Pose fn := [N:nat][x:R]``(pow (-1) N)/(INR (fact (mult (S (S O)) N)))*(pow x (mult (S (S O)) N))``.
+Cut (CVN_R fn).
+Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
+Intro cv; Cut ((n:nat)(continuity (fn n))).
+Intro; Cut (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; Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; 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.
+Case (cv x); Case (exist_cos (Rsqr x)); Intros.
+Symmetry; EApply UL_sequence.
+Apply u.
+Unfold cos_in in c; Unfold infinit_sum in c; Unfold Un_cv; Intros.
+Elim (c ? H0); Intros N0 H1.
+Exists N0; Intros.
+Unfold R_dist in H1; Unfold R_dist SP.
+Replace (sum_f_R0 [k:nat](fn k x) n) with (sum_f_R0 [i:nat]``(cos_n i)*(pow (Rsqr x) i)`` n).
+Apply H1; Assumption.
+Apply sum_eq; Intros.
+Unfold cos_n fn; Apply Rmult_mult_r.
+Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
+Intro; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (mult (S (S O)) n)))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
+Apply continuity_mult.
+Apply derivable_continuous; Apply derivable_const.
+Apply derivable_continuous; Apply (derivable_pow (mult (2) n)).
+Apply CVN_R_CVS; Apply X.
+Apply CVN_R_cos; Unfold fn; Reflexivity.
+Qed.
+
+(**********)
+Lemma continuity_sin : (continuity sin).
+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; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Simpl; Unfold R_dist; Intros.
+Elim (H0 ? H); Intros.
+Exists x0; Intros.
+Elim H1; Intros.
+Split.
+Assumption.
+Intros; Rewrite <- (cos_shift x); Rewrite <- (cos_shift x1); Apply H3.
+Elim H4; Intros.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Red; Intro; Unfold D_x no_cond in H5; Elim H5; Intros _ H8; Elim H8; Rewrite <- (Ropp_Ropp x); Rewrite <- (Ropp_Ropp x1); Apply eq_Ropp; Apply r_Rplus_plus with ``PI/2``; Apply H7.
+Replace ``PI/2-x1-(PI/2-x)`` with ``x-x1``; [Idtac | Ring]; Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr3; Apply H6.
+Qed.
+
+Lemma CVN_R_sin : (fn:nat->R->R) (fn == [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``) -> (CVN_R fn).
+Unfold CVN_R; Unfold CVN_r; Intros fn H r.
+Apply Specif.existT with [n:nat]``/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))``.
+Cut (SigT ? [l:R](Un_cv [n:nat](sum_f_R0 [k:nat](Rabsolu ``/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow r (mult (S (S O)) k))``) n) l)).
+Intro; Elim X; Intros.
+Apply existTT with x.
+Split.
+Apply p.
+Intros; Rewrite H; Unfold Rdiv; Do 2 Rewrite Rabsolu_mult; Rewrite pow_1_abs; Rewrite Rmult_1l.
+Cut ``0</(INR (fact (plus (mult (S (S O)) n) (S O))))``.
+Intro; Rewrite (Rabsolu_right  ? (Rle_sym1 ? ? (Rlt_le ? ? H1))).
+Apply Rle_monotony.
+Left; Apply H1.
+Rewrite <- Pow_Rabsolu; Apply pow_maj_Rabs.
+Rewrite Rabsolu_Rabsolu; Unfold Boule in H0; Rewrite minus_R0 in H0; Left; Apply H0.
+Apply Rlt_Rinv; Apply INR_fact_lt_0.
+Cut (r::R)<>``0``.
+Intro; Apply Alembert_C2.
+Intro; Apply Rabsolu_no_R0.
+Apply prod_neq_R0.
+Apply Rinv_neq_R0; 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; Intros.
+Cut ``0<eps/(Rsqr r)``.
+Intro; Elim (H1 ? H3); Intros N0 H4.
+Exists N0; Intros.
+Unfold R_dist; Assert H6 := (H4 ? H5).
+Unfold R_dist in H5; Replace ``(Rabsolu ((Rabsolu (/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))*(pow r (mult (S (S O)) (S n)))))/(Rabsolu (/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow r (mult (S (S O)) n))))))`` with ``(Rsqr r)*(Rabsolu ((pow ( -1) (S n))/(INR (fact (plus (mult (S (S O)) (S n)) (S O))))/((pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O)))))))``.
+Apply Rlt_monotony_contra with ``/(Rsqr r)``.
+Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
+Pattern 1 ``/(Rsqr r)``; Rewrite <- (Rabsolu_right ``/(Rsqr r)``).
+Rewrite <- Rabsolu_mult.
+Rewrite Rminus_distr.
+Rewrite Rmult_Or; Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite <- (Rmult_sym eps).
+Apply H6.
+Unfold Rsqr; Apply prod_neq_R0; Assumption.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption.
+Unfold Rdiv; Rewrite (Rmult_sym (Rsqr r)); Repeat Rewrite Rabsolu_mult; Rewrite Rabsolu_Rabsolu; Rewrite pow_1_abs.
+Rewrite Rmult_1l.
+Repeat Rewrite Rmult_assoc; Apply Rmult_mult_r.
+Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Rewrite Rabsolu_mult.
+Rewrite Rabsolu_Rinv.
+Rewrite pow_1_abs; Rewrite Rinv_R1; Rewrite Rmult_1l.
+Rewrite Rinv_Rmult.
+Rewrite <- Rabsolu_Rinv.
+Rewrite Rinv_Rinv.
+Rewrite Rabsolu_mult.
+Do 2 Rewrite Rabsolu_Rabsolu.
+Rewrite (Rmult_sym ``(Rabsolu (pow r (mult (S (S O)) (S n))))``).
+Rewrite Rmult_assoc; Apply Rmult_mult_r.
+Rewrite Rabsolu_Rinv.
+Rewrite Rabsolu_Rabsolu.
+Repeat Rewrite Rabsolu_right.
+Replace ``(pow r (mult (S (S O)) (S n)))`` with ``(pow r (mult (S (S O)) n))*r*r``.
+Do 2 Rewrite <- Rmult_assoc.
+Rewrite <- Rinv_l_sym.
+Unfold Rsqr; Ring.
+Apply pow_nonzero; Assumption.
+Replace (mult (2) (S n)) with (S (S (mult (2) n))).
+Simpl; Ring.
+Apply INR_eq; Do 2 Rewrite S_INR; Do 2 Rewrite mult_INR; Repeat Rewrite S_INR; Ring.
+Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
+Apply Rle_sym1; Apply pow_le; Left; Apply (cond_pos r).
+Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
+Apply INR_fact_neq_0.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Apply Rabsolu_no_R0; Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Apply Rabsolu_no_R0; Apply pow_nonzero; Assumption.
+Apply pow_nonzero; DiscrR.
+Apply INR_fact_neq_0.
+Apply pow_nonzero; DiscrR.
+Apply Rinv_neq_R0; Apply INR_fact_neq_0.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rsqr_pos_lt; Assumption].
+Assert H0 := (cond_pos r); Red; Intro; Rewrite H1 in H0; Elim (Rlt_antirefl ? H0).
+Qed.
+
+(* (sin h)/h -> 1 when h -> 0 *)
+Lemma derivable_pt_lim_sin_0 : (derivable_pt_lim sin R0 R1).
+Unfold derivable_pt_lim; Intros.
+Pose fn := [N:nat][x:R]``(pow ( -1) N)/(INR (fact (plus (mult (S (S O)) N) (S O))))*(pow x (mult (S (S O)) N))``.
+Cut (CVN_R fn).
+Intro; Cut (x:R)(sigTT ? [l:R](Un_cv [N:nat](SP fn N x) l)).
+Intro cv.
+Pose r := (mkposreal ? Rlt_R0_R1).
+Cut (CVN_r fn r).
+Intro; Cut ((n:nat; y:R)(Boule ``0`` r y)->(continuity_pt (fn n) y)).
+Intro; Cut (Boule R0 r R0).
+Intro; Assert H2 := (SFL_continuity_pt ? cv ? X0 H0 ? H1).
+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 ? H); Intros alp H3.
+Elim H3; Intros.
+Exists (mkposreal ? H4).
+Simpl; Intros.
+Rewrite sin_0; Rewrite Rplus_Ol; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
+Cut ``(Rabsolu ((SFL fn cv h)-(SFL fn cv 0))) < eps``.
+Intro; Cut (SFL fn cv R0)==R1.
+Intro; Cut (SFL fn cv h)==``(sin h)/h``.
+Intro; Rewrite H9 in H8; Rewrite H10 in H8.
+Apply H8.
+Unfold SFL sin.
+Case (cv h); Intros.
+Case (exist_sin (Rsqr h)); Intros.
+Unfold Rdiv; Rewrite (Rinv_r_simpl_m h x0 H6).
+EApply UL_sequence.
+Apply u.
+Unfold sin_in in s; Unfold sin_n infinit_sum in s; Unfold SP fn Un_cv; Intros.
+Elim (s ? H10); Intros N0 H11.
+Exists N0; Intros.
+Unfold R_dist; Unfold R_dist in H11.
+Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow h (mult (S (S O)) k))`` n) with (sum_f_R0 [i:nat]``(pow ( -1) i)/(INR (fact (plus (mult (S (S O)) i) (S O))))*(pow (Rsqr h) i)`` n).
+Apply H11; Assumption.
+Apply sum_eq; Intros; Apply Rmult_mult_r; Unfold Rsqr; Rewrite pow_sqr; Reflexivity.
+Unfold SFL sin.
+Case (cv R0); Intros.
+EApply UL_sequence.
+Apply u.
+Unfold SP fn; Unfold Un_cv; Intros; Exists (S O); Intros.
+Unfold R_dist; Replace (sum_f_R0 [k:nat]``(pow ( -1) k)/(INR (fact (plus (mult (S (S O)) k) (S O))))*(pow 0 (mult (S (S O)) k))`` n) with R1.
+Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Assumption.
+Rewrite decomp_sum.
+Simpl; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rinv_R1; Rewrite Rmult_1r; Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rplus_plus_r.
+Symmetry; Apply sum_eq_R0; Intros.
+Rewrite Rmult_Ol; Rewrite Rmult_Or; Reflexivity.
+Unfold ge in H10; Apply lt_le_trans with (1); [Apply lt_n_Sn | Apply H10].
+Apply H5.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Apply not_sym; Apply H6.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply H7.
+Unfold Boule; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Apply (cond_pos r).
+Intros; Unfold fn; Replace [x:R]``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))*(pow x (mult (S (S O)) n))`` with (mult_fct (fct_cte ``(pow ( -1) n)/(INR (fact (plus (mult (S (S O)) n) (S O))))``) (pow_fct (mult (S (S O)) n))); [Idtac | Reflexivity].
+Apply continuity_pt_mult.
+Apply derivable_continuous_pt.
+Apply derivable_pt_const.
+Apply derivable_continuous_pt.
+Apply (derivable_pt_pow (mult (2) n) y).
+Apply (X r).
+Apply (CVN_R_CVS ? X).
+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``).
+Unfold derivable_pt_lim; Intros.
+Assert H0 := derivable_pt_lim_sin_0.
+Unfold derivable_pt_lim in H0.
+Cut ``0<eps/2``.
+Intro; Elim (H0 ? H1); Intros del H2.
+Cut (continuity_pt sin ``0``).
+Intro; Unfold continuity_pt in H3; Unfold continue_in in H3; Unfold limit1_in in H3; Unfold limit_in in H3; Simpl in H3; Unfold R_dist in H3.
+Cut ``0<eps/2``; [Intro | Assumption].
+Elim (H3 ? H4); Intros del_c H5.
+Cut ``0<(Rmin del del_c)``.
+Intro; Pose delta := (mkposreal ? H6).
+Exists delta; Intros.
+Rewrite Rplus_Ol; Replace ``((cos h)-(cos 0))`` with ``-2*(Rsqr (sin (h/2)))``.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or.
+Unfold Rdiv; Do 2 Rewrite Ropp_mul1.
+Rewrite Rabsolu_Ropp.
+Replace ``2*(Rsqr (sin (h*/2)))*/h`` with ``(sin (h/2))*((sin (h/2))/(h/2)-1)+(sin (h/2))``.
+Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))*((sin (h/2))/(h/2)-1)))+(Rabsolu ((sin (h/2))))``.
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Apply Rplus_lt.
+Apply Rle_lt_trans with ``(Rabsolu ((sin (h/2))/(h/2)-1))``.
+Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin (h/2))/(h/2)-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
+Apply Rabsolu_pos.
+Assert H9 := (SIN_bound ``h/2``).
+Unfold Rabsolu; Case (case_Rabsolu ``(sin (h/2))``); Intro.
+Pattern 3 R1; Rewrite <- (Ropp_Ropp ``1``).
+Apply Rle_Ropp1.
+Elim H9; Intros; Assumption.
+Elim H9; Intros; Assumption.
+Cut ``(Rabsolu (h/2))<del``.
+Intro; Cut ``h/2<>0``.
+Intro; Assert H11 := (H2 ? H10 H9). 
+Rewrite Rplus_Ol in H11; Rewrite sin_0 in H11.
+Rewrite minus_R0 in H11; Apply H11.
+Unfold Rdiv; Apply prod_neq_R0.
+Apply H7.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rlt_trans with ``del/2``.
+Unfold Rdiv; Rewrite Rabsolu_mult.
+Rewrite (Rabsolu_right ``/2``).
+Do 2 Rewrite <- (Rmult_sym ``/2``); Apply Rlt_monotony.
+Apply Rlt_Rinv; Sup0.
+Apply Rlt_le_trans with (pos delta).
+Apply H8.
+Unfold delta; Simpl; Apply Rmin_l.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
+Rewrite <- (Rplus_Or ``del/2``); Pattern 1 del; Rewrite (double_var del); Apply Rlt_compatibility; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply (cond_pos del).
+Apply Rlt_Rinv; Sup0.
+Elim H5; Intros; Assert H11 := (H10 ``h/2``).
+Rewrite sin_0 in H11; Do 2 Rewrite minus_R0 in H11.
+Apply H11.
+Split.
+Unfold D_x no_cond; Split.
+Trivial.
+Apply not_sym; Unfold Rdiv; Apply prod_neq_R0.
+Apply H7.
+Apply Rinv_neq_R0; DiscrR.
+Apply Rlt_trans with ``del_c/2``.
+Unfold Rdiv; Rewrite Rabsolu_mult.
+Rewrite (Rabsolu_right ``/2``).
+Do 2 Rewrite <- (Rmult_sym ``/2``).
+Apply Rlt_monotony.
+Apply Rlt_Rinv; Sup0.
+Apply Rlt_le_trans with (pos delta).
+Apply H8.
+Unfold delta; Simpl; Apply Rmin_r.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Sup0.
+Rewrite <- (Rplus_Or ``del_c/2``); Pattern 2 del_c; Rewrite (double_var del_c); Apply Rlt_compatibility.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply H9.
+Apply Rlt_Rinv; Sup0.
+Rewrite Rminus_distr; Rewrite Rmult_1r; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Rewrite (Rmult_sym ``2``); Unfold Rdiv Rsqr.
+Repeat Rewrite Rmult_assoc.
+Repeat Apply Rmult_mult_r.
+Rewrite Rinv_Rmult.
+Rewrite Rinv_Rinv.
+Apply Rmult_sym.
+DiscrR.
+Apply H7.
+Apply Rinv_neq_R0; DiscrR.
+Pattern 2 h; Replace h with ``2*(h/2)``.
+Rewrite (cos_2a_sin ``h/2``).
+Rewrite cos_0; Unfold Rsqr; Ring.
+Unfold Rdiv; Rewrite <- Rmult_assoc; Apply Rinv_r_simpl_m.
+DiscrR.
+Unfold Rmin; Case (total_order_Rle del del_c); Intro.
+Apply (cond_pos del).
+Elim H5; Intros; Assumption.
+Apply continuity_sin.
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0].
+Qed.
+
+(**********)
+Theorem derivable_pt_lim_sin : (x:R)(derivable_pt_lim sin x (cos x)).
+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; Intros.
+Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Apply H1 | Apply Rlt_Rinv; Sup0]].
+Elim (H0 ? H2); Intros alp1 H3.
+Elim (H ? H2); Intros alp2 H4.
+Pose alp := (Rmin alp1 alp2).
+Cut ``0<alp``.
+Intro; Exists (mkposreal ? H5); Intros.
+Replace ``((sin (x+h))-(sin x))/h-(cos x)`` with ``(sin x)*((cos h)-1)/h+(cos x)*((sin h)/h-1)``.
+Apply Rle_lt_trans with ``(Rabsolu ((sin x)*((cos h)-1)/h))+(Rabsolu ((cos x)*((sin h)/h-1)))``.
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Apply Rplus_lt.
+Apply Rle_lt_trans with ``(Rabsolu ((cos h)-1)/h)``.
+Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu (((cos h)-1)/h))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
+Apply Rabsolu_pos.
+Assert H8 := (SIN_bound x); Elim H8; Intros.
+Unfold Rabsolu; Case (case_Rabsolu (sin x)); Intro.
+Rewrite <- (Ropp_Ropp R1).
+Apply Rle_Ropp1; Assumption.
+Assumption.
+Cut ``(Rabsolu h)<alp2``.
+Intro; Assert H9 := (H4 ? H6 H8).
+Rewrite cos_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
+Apply Rlt_le_trans with alp.
+Apply H7.
+Unfold alp; Apply Rmin_r.
+Apply Rle_lt_trans with ``(Rabsolu ((sin h)/h-1))``.
+Rewrite Rabsolu_mult; Rewrite Rmult_sym; Pattern 2 ``(Rabsolu ((sin h)/h-1))``; Rewrite <- Rmult_1r; Apply Rle_monotony.
+Apply Rabsolu_pos.
+Assert H8 := (COS_bound x); Elim H8; Intros.
+Unfold Rabsolu; Case (case_Rabsolu (cos x)); Intro.
+Rewrite <- (Ropp_Ropp R1); Apply Rle_Ropp1; Assumption.
+Assumption.
+Cut ``(Rabsolu h)<alp1``.
+Intro; Assert H9 := (H3 ? H6 H8).
+Rewrite sin_0 in H9; Rewrite Rplus_Ol in H9; Rewrite minus_R0 in H9; Apply H9.
+Apply Rlt_le_trans with alp.
+Apply H7.
+Unfold alp; Apply Rmin_l.
+Rewrite sin_plus; Unfold Rminus Rdiv; Repeat Rewrite Rmult_Rplus_distrl; Repeat Rewrite Rmult_Rplus_distr; Repeat Rewrite Rmult_assoc; Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Rewrite (Rplus_sym ``(sin x)*( -1*/h)``); Repeat Rewrite Rplus_assoc; Apply Rplus_plus_r.
+Rewrite Ropp_mul3; Rewrite Ropp_mul1; Rewrite Rmult_1r; Rewrite Rmult_1l; Rewrite Ropp_mul3; Rewrite <- Ropp_mul1; Apply Rplus_sym.
+Unfold alp; Unfold Rmin; Case (total_order_Rle alp1 alp2); Intro.
+Apply (cond_pos alp1).
+Apply (cond_pos alp2).
+Qed.
+
+Lemma derivable_pt_lim_cos : (x:R) (derivable_pt_lim cos x ``-(sin x)``).
+Intro; Cut (h:R)``(sin (h+PI/2))``==(cos h).
+Intro; Replace ``-(sin x)`` with (Rmult (cos ``x+PI/2``) (Rplus R1 R0)).
+Generalize (derivable_pt_lim_comp (plus_fct id (fct_cte ``PI/2``)) sin); Intros.
+Cut (derivable_pt_lim (plus_fct id (fct_cte ``PI/2``)) x ``1+0``).
+Cut (derivable_pt_lim sin (plus_fct id (fct_cte ``PI/2``) x) ``(cos (x+PI/2))``).
+Intros; Generalize (H0 ? ? ? H2 H1); Replace (comp sin (plus_fct id (fct_cte ``PI/2``))) with [x:R]``(sin (x+PI/2))``; [Idtac | Reflexivity].
+Unfold derivable_pt_lim; Intros.
+Elim (H3 eps H4); Intros.
+Exists x0.
+Intros; Rewrite <- (H ``x+h``); Rewrite <- (H x); Apply H5; Assumption.
+Apply derivable_pt_lim_sin.
+Apply derivable_pt_lim_plus.
+Apply derivable_pt_lim_id.
+Apply derivable_pt_lim_const.
+Rewrite sin_cos; Rewrite <- (Rplus_sym x); Ring.
+Intro; Rewrite cos_sin; Rewrite Rplus_sym; Reflexivity.
+Qed.
+
+Lemma derivable_pt_sin : (x:R) (derivable_pt sin x).
+Unfold derivable_pt; Intro.
+Apply Specif.existT with (cos x).
+Apply derivable_pt_lim_sin.
+Qed.
+
+Lemma derivable_pt_cos : (x:R) (derivable_pt cos x).
+Unfold derivable_pt; Intro.
+Apply Specif.existT with ``-(sin x)``.
+Apply derivable_pt_lim_cos.
+Qed.
+
+Lemma derivable_sin : (derivable sin).
+Unfold derivable; Intro; Apply derivable_pt_sin.
+Qed.
+
+Lemma derivable_cos : (derivable cos).
+Unfold derivable; Intro; Apply derivable_pt_cos.
+Qed.
+
+Lemma derive_pt_sin : (x:R) ``(derive_pt sin x (derivable_pt_sin ?))==(cos x)``.
+Intros; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_sin.
+Qed.
+
+Lemma derive_pt_cos : (x:R) ``(derive_pt cos x (derivable_pt_cos ?))==-(sin x)``.
+Intros; Apply derive_pt_eq_0.
+Apply derivable_pt_lim_cos.
+Qed.
diff --git a/theories7/Reals/SeqProp.v b/theories7/Reals/SeqProp.v
new file mode 100644
index 00000000..b34fa339
--- /dev/null
+++ b/theories7/Reals/SeqProp.v
@@ -0,0 +1,1089 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: SeqProp.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Rseries.
+Require Classical.
+Require Max.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+Definition Un_decreasing [Un:nat->R] : Prop := (n:nat) (Rle (Un (S n)) (Un n)).
+Definition opp_seq [Un:nat->R] : nat->R := [n:nat]``-(Un n)``.
+Definition has_ub [Un:nat->R] : Prop := (bound (EUn Un)).
+Definition has_lb [Un:nat->R] : Prop := (bound (EUn (opp_seq Un))).
+
+(**********)
+Lemma growing_cv : (Un:nat->R) (Un_growing Un) -> (has_ub Un) -> (sigTT R [l:R](Un_cv Un l)).
+Unfold Un_growing Un_cv;Intros; 
+ NewDestruct (complet (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
+ Exists x;Intros eps H1.
+ Unfold is_upper_bound in H2 H3.
+Assert H5:(n:nat)(Rle (Un n) x).
+  Intro n; Apply (H2 (Un n) (Un_in_EUn Un n)).
+Cut (Ex [N:nat] (Rlt (Rminus x eps) (Un N))).
+Intro H6;NewDestruct H6 as [N H6];Exists N.
+Intros n H7;Unfold R_dist;Apply (Rabsolu_def1 (Rminus (Un n) x) eps).
+Unfold Rgt in H1.
+ Apply (Rle_lt_trans (Rminus (Un n) x) R0 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 (Rminus x eps) (Un N) (Un n) H6
+                          (Rle_sym2 (Un N) (Un n) H8));Intro H9;
+ Generalize (Rlt_compatibility (Ropp x) (Rminus x eps) (Un n) H9);
+ Unfold Rminus;Rewrite <-(Rplus_assoc (Ropp x) x (Ropp eps));
+ Rewrite (Rplus_sym (Ropp x) (Un n));Fold (Rminus (Un n) x);
+ Rewrite Rplus_Ropp_l;Rewrite (let (H1,H2)=(Rplus_ne (Ropp eps)) in H2);
+ Trivial.
+Cut ~((N:nat)(Rle (Un N) (Rminus x eps))).
+Intro H6;Apply (not_all_not_ex nat ([N:nat](Rlt (Rminus x eps) (Un N)))).
+ Intro H7; Apply H6; Intro N; Apply Rnot_lt_le; Apply H7.
+Intro H7;Generalize (Un_bound_imp Un (Rminus x eps) H7);Intro H8;
+ Unfold is_upper_bound in H8;Generalize (H3 (Rminus x eps) H8);
+ Apply Rlt_le_not; Apply tech_Rgt_minus; Exact H1.
+Qed.
+
+Lemma decreasing_growing : (Un:nat->R) (Un_decreasing Un) -> (Un_growing (opp_seq Un)).
+Intro.
+Unfold Un_growing opp_seq Un_decreasing.
+Intros.
+Apply Rle_Ropp1.
+Apply H.
+Qed.
+
+Lemma decreasing_cv : (Un:nat->R) (Un_decreasing Un) -> (has_lb Un) -> (sigTT R [l:R](Un_cv Un l)).
+Intros.
+Cut (sigTT R [l:R](Un_cv (opp_seq Un) l)) -> (sigTT R [l:R](Un_cv Un l)).
+Intro.
+Apply X.
+Apply growing_cv.
+Apply decreasing_growing; Assumption.
+Exact H0.
+Intro.
+Elim X; Intros.
+Apply existTT with ``-x``.
+Unfold Un_cv in p.
+Unfold R_dist in p.
+Unfold opp_seq in p.
+Unfold Un_cv.
+Unfold R_dist.
+Intros.
+Elim (p eps H1); Intros.
+Exists x0; Intros.
+Assert H4 := (H2 n H3).
+Rewrite <- Rabsolu_Ropp.
+Replace ``-((Un n)- -x)`` with ``-(Un n)-x``; [Assumption | Ring].
+Qed.
+
+(***********)
+Lemma maj_sup : (Un:nat->R) (has_ub Un) -> (sigTT R [l:R](is_lub (EUn Un) l)).
+Intros.
+Unfold has_ub in H.
+Apply complet.
+Assumption.
+Exists (Un O).
+Unfold EUn.
+Exists O; Reflexivity.
+Qed.
+
+(**********)
+Lemma min_inf : (Un:nat->R) (has_lb Un) -> (sigTT R [l:R](is_lub (EUn (opp_seq Un)) l)).
+Intros; Unfold has_lb in H.
+Apply complet.
+Assumption.
+Exists ``-(Un O)``.
+Exists O.
+Reflexivity.
+Qed.
+
+Definition majorant [Un:nat->R;pr:(has_ub Un)] : R := Cases (maj_sup Un pr) of (existTT a b) => a end.
+
+Definition minorant [Un:nat->R;pr:(has_lb Un)] : R := Cases (min_inf Un pr) of (existTT a b) => ``-a`` end.
+
+Lemma maj_ss : (Un:nat->R;k:nat) (has_ub Un) -> (has_ub [i:nat](Un (plus k i))).
+Intros.
+Unfold has_ub in H.
+Unfold bound in H.
+Elim H; Intros.
+Unfold is_upper_bound in H0.
+Unfold has_ub.
+Exists x.
+Unfold is_upper_bound.
+Intros.
+Apply H0.
+Elim H1; Intros.
+Exists (plus k x1); Assumption.
+Qed.
+
+Lemma min_ss : (Un:nat->R;k:nat) (has_lb Un) -> (has_lb [i:nat](Un (plus k i))).
+Intros.
+Unfold has_lb in H.
+Unfold bound in H.
+Elim H; Intros.
+Unfold is_upper_bound in H0.
+Unfold has_lb.
+Exists x.
+Unfold is_upper_bound.
+Intros.
+Apply H0.
+Elim H1; Intros.
+Exists (plus k x1); Assumption.
+Qed.
+
+Definition sequence_majorant [Un:nat->R;pr:(has_ub Un)] : nat -> R := [i:nat](majorant [k:nat](Un (plus i k)) (maj_ss Un i pr)).
+
+Definition sequence_minorant [Un:nat->R;pr:(has_lb Un)] : nat -> R := [i:nat](minorant [k:nat](Un (plus i k)) (min_ss Un i pr)).
+
+Lemma Wn_decreasing : (Un:nat->R;pr:(has_ub Un)) (Un_decreasing (sequence_majorant Un pr)). 
+Intros.
+Unfold Un_decreasing.
+Intro.
+Unfold sequence_majorant.
+Assert H := (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
+Assert H0 := (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
+Elim H; Intros.
+Elim H0; Intros.
+Cut (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) == x; [Intro Maj1; Rewrite Maj1 | Idtac].
+Cut (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) == x0; [Intro Maj2; Rewrite Maj2 | Idtac].
+Unfold is_lub in p.
+Unfold is_lub in p0.
+Elim p; Intros.
+Apply H2.
+Elim p0; Intros.
+Unfold is_upper_bound.
+Intros.
+Unfold is_upper_bound in H3.
+Apply H3.
+Elim H5; Intros.
+Exists (plus (1) x2).
+Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
+Assumption.
+Replace (S n) with (plus (1) n); [Ring | Ring].
+Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr))).
+Intro.
+Unfold is_lub in p0; Unfold is_lub in H1.
+Elim p0; Intros; Elim H1; Intros.
+Assert H6 := (H5 x0 H2).
+Assert H7 := (H3 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr)) H4).
+Apply Rle_antisym; Assumption.
+Unfold majorant.
+Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr)).
+Trivial.
+Cut (is_lub (EUn [k:nat](Un (plus (S n) k))) (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr))).
+Intro.
+Unfold is_lub in p; Unfold is_lub in H1.
+Elim p; Intros; Elim H1; Intros.
+Assert H6 := (H5 x H2).
+Assert H7 := (H3 (majorant ([k:nat](Un (plus (S n) k))) (maj_ss Un (S n) pr)) H4).
+Apply Rle_antisym; Assumption.
+Unfold majorant.
+Case (maj_sup [k:nat](Un (plus (S n) k)) (maj_ss Un (S n) pr)).
+Trivial.
+Qed.
+
+Lemma Vn_growing : (Un:nat->R;pr:(has_lb Un)) (Un_growing (sequence_minorant Un pr)).
+Intros.
+Unfold Un_growing.
+Intro.
+Unfold sequence_minorant.
+Assert H := (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
+Assert H0 := (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
+Elim H; Intros.
+Elim H0; Intros.
+Cut (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)) == ``-x``; [Intro Maj1; Rewrite Maj1 | Idtac].
+Cut (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)) == ``-x0``; [Intro Maj2; Rewrite Maj2 | Idtac].
+Unfold is_lub in p.
+Unfold is_lub in p0.
+Elim p; Intros.
+Apply Rle_Ropp1.
+Apply H2.
+Elim p0; Intros.
+Unfold is_upper_bound.
+Intros.
+Unfold is_upper_bound in H3.
+Apply H3.
+Elim H5; Intros.
+Exists (plus (1) x2).
+Unfold opp_seq in H6.
+Unfold opp_seq.
+Replace (plus n (plus (S O) x2)) with (plus (S n) x2).
+Assumption.
+Replace (S n) with (plus (1) n); [Ring | Ring].
+Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr)))).
+Intro.
+Unfold is_lub in p0; Unfold is_lub in H1.
+Elim p0; Intros; Elim H1; Intros.
+Assert H6 := (H5 x0 H2).
+Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))) H4).
+Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr))).
+Apply eq_Ropp; Apply Rle_antisym; Assumption.
+Unfold minorant.
+Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr)).
+Intro; Rewrite Ropp_Ropp.
+Trivial.
+Cut (is_lub (EUn (opp_seq [k:nat](Un (plus (S n) k)))) (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr)))).
+Intro.
+Unfold is_lub in p; Unfold is_lub in H1.
+Elim p; Intros; Elim H1; Intros.
+Assert H6 := (H5 x H2).
+Assert H7 := (H3 (Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))) H4).
+Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus (S n) k))) (min_ss Un (S n) pr))).
+Apply eq_Ropp; Apply Rle_antisym; Assumption.
+Unfold minorant.
+Case (min_inf [k:nat](Un (plus (S n) k)) (min_ss Un (S n) pr)).
+Intro; Rewrite Ropp_Ropp.
+Trivial.
+Qed.
+
+(**********)
+Lemma Vn_Un_Wn_order : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (n:nat) ``((sequence_minorant Un pr2) n)<=(Un n)<=((sequence_majorant Un pr1) n)``. 
+Intros.
+Split.
+Unfold sequence_minorant.
+Cut (sigTT R [l:R](is_lub (EUn (opp_seq [i:nat](Un (plus n i)))) l)).
+Intro.
+Elim X; Intros.
+Replace (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)) with ``-x``.
+Unfold is_lub in p.
+Elim p; Intros.
+Unfold is_upper_bound in H.
+Rewrite <- (Ropp_Ropp (Un n)).
+Apply Rle_Ropp1.
+Apply H.
+Exists O.
+Unfold opp_seq.
+Replace (plus n O) with n; [Reflexivity | Ring].
+Cut (is_lub (EUn (opp_seq [k:nat](Un (plus n k)))) (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2)))).
+Intro.
+Unfold is_lub in p; Unfold is_lub in H.
+Elim p; Intros; Elim H; Intros.
+Assert H4 := (H3 x H0).
+Assert H5 := (H1 (Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))) H2).
+Rewrite <- (Ropp_Ropp (minorant ([k:nat](Un (plus n k))) (min_ss Un n pr2))).
+Apply eq_Ropp; Apply Rle_antisym; Assumption.
+Unfold minorant.
+Case (min_inf [k:nat](Un (plus n k)) (min_ss Un n pr2)).
+Intro; Rewrite Ropp_Ropp.
+Trivial.
+Apply min_inf.
+Apply min_ss; Assumption.
+Unfold sequence_majorant.
+Cut (sigTT R [l:R](is_lub (EUn [i:nat](Un (plus n i))) l)).
+Intro.
+Elim X; Intros.
+Replace (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) with ``x``.
+Unfold is_lub in p.
+Elim p; Intros.
+Unfold is_upper_bound in H.
+Apply H.
+Exists O.
+Replace (plus n O) with n; [Reflexivity | Ring].
+Cut (is_lub (EUn [k:nat](Un (plus n k))) (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1))).
+Intro.
+Unfold is_lub in p; Unfold is_lub in H.
+Elim p; Intros; Elim H; Intros.
+Assert H4 := (H3 x H0).
+Assert H5 := (H1 (majorant ([k:nat](Un (plus n k))) (maj_ss Un n pr1)) H2).
+Apply Rle_antisym; Assumption.
+Unfold majorant.
+Case (maj_sup [k:nat](Un (plus n k)) (maj_ss Un n pr1)).
+Intro; Trivial.
+Apply maj_sup.
+Apply maj_ss; Assumption.
+Qed.
+
+Lemma min_maj : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_ub (sequence_minorant Un pr2)).
+Intros.
+Assert H := (Vn_Un_Wn_order Un pr1 pr2).
+Unfold has_ub.
+Unfold bound.
+Unfold has_ub in pr1.
+Unfold bound in pr1.
+Elim pr1; Intros.
+Exists x.
+Unfold is_upper_bound.
+Intros.
+Unfold is_upper_bound in H0.
+Elim H1; Intros.
+Rewrite H2.
+Apply Rle_trans with (Un x1).
+Assert H3 := (H x1); Elim H3; Intros; Assumption.
+Apply H0.
+Exists x1; Reflexivity.
+Qed.
+
+Lemma maj_min : (Un:nat->R;pr1:(has_ub Un);pr2:(has_lb Un)) (has_lb (sequence_majorant Un pr1)). 
+Intros.
+Assert H := (Vn_Un_Wn_order Un pr1 pr2).
+Unfold has_lb.
+Unfold bound.
+Unfold has_lb in pr2.
+Unfold bound in pr2.
+Elim pr2; Intros.
+Exists x.
+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; Apply Rle_Ropp1.
+Assumption.
+Apply H0.
+Exists x1; Reflexivity.
+Qed.
+
+(**********)
+Lemma cauchy_maj : (Un:nat->R) (Cauchy_crit Un) -> (has_ub Un).
+Intros.
+Unfold has_ub.
+Apply cauchy_bound.
+Assumption.
+Qed.
+
+(**********)
+Lemma cauchy_opp : (Un:nat->R) (Cauchy_crit Un) -> (Cauchy_crit (opp_seq Un)).
+Intro.
+Unfold Cauchy_crit.
+Unfold R_dist.
+Intros.
+Elim (H eps H0); Intros.
+Exists x; Intros.
+Unfold opp_seq.
+Rewrite <- Rabsolu_Ropp.
+Replace ``-( -(Un n)- -(Un m))`` with ``(Un n)-(Un m)``; [Apply H1; Assumption | Ring].
+Qed.
+
+(**********)
+Lemma cauchy_min : (Un:nat->R) (Cauchy_crit Un) -> (has_lb Un).
+Intros.
+Unfold has_lb.
+Assert H0 := (cauchy_opp ? H).
+Apply cauchy_bound.
+Assumption.
+Qed.
+
+(**********)
+Lemma maj_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l)).
+Intros.
+Apply decreasing_cv.
+Apply Wn_decreasing.
+Apply maj_min.
+Apply cauchy_min.
+Assumption.
+Qed.
+
+(**********)
+Lemma min_cv : (Un:nat->R;pr:(Cauchy_crit Un)) (sigTT R [l:R](Un_cv (sequence_minorant Un (cauchy_min Un pr)) l)).
+Intros.
+Apply growing_cv.
+Apply Vn_growing.
+Apply min_maj.
+Apply cauchy_maj.
+Assumption.
+Qed.
+
+Lemma cond_eq : (x,y:R) ((eps:R)``0<eps``->``(Rabsolu (x-y))<eps``) -> x==y.
+Intros.
+Case (total_order_T x y); Intro.
+Elim s; Intro.
+Cut ``0<y-x``.
+Intro.
+Assert H1 := (H ``y-x`` H0).
+Rewrite <- Rabsolu_Ropp in H1.
+Cut ``-(x-y)==y-x``; [Intro; Rewrite H2 in H1 | Ring].
+Rewrite Rabsolu_right in H1.
+Elim (Rlt_antirefl ? H1).
+Left; Assumption.
+Apply Rlt_anti_compatibility with x.
+Rewrite Rplus_Or; Replace ``x+(y-x)`` with y; [Assumption | Ring].
+Assumption.
+Cut ``0<x-y``.
+Intro.
+Assert H1 := (H ``x-y`` H0).
+Rewrite Rabsolu_right in H1.
+Elim (Rlt_antirefl ? H1).
+Left; Assumption.
+Apply Rlt_anti_compatibility with y.
+Rewrite Rplus_Or; Replace ``y+(x-y)`` with x; [Assumption | Ring].
+Qed.
+
+Lemma not_Rlt : (r1,r2:R)~(``r1<r2``)->``r1>=r2``.
+Intros r1 r2 ; Generalize (total_order r1 r2) ; Unfold Rge.
+Tauto.
+Qed. 
+
+(**********)
+Lemma approx_maj : (Un:nat->R;pr:(has_ub Un)) (eps:R) ``0<eps`` -> (EX k : nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
+Intros.
+Pose P := [k:nat]``(Rabsolu ((majorant Un pr)-(Un k))) < eps``.
+Unfold P.
+Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((majorant Un pr)-(Un k))) < eps``).
+Intros.
+Apply H0.
+Apply not_all_not_ex.
+Red; Intro.
+2:Unfold P; Trivial.
+Unfold P in H1.
+Cut (n:nat)``(Rabsolu ((majorant Un pr)-(Un n))) >= eps``.
+Intro.
+Cut (is_lub (EUn Un) (majorant Un pr)).
+Intro.
+Unfold is_lub in H3.
+Unfold is_upper_bound in H3.
+Elim H3; Intros.
+Cut (n:nat)``eps<=(majorant Un pr)-(Un n)``.
+Intro.
+Cut (n:nat)``(Un n)<=(majorant Un pr)-eps``.
+Intro.
+Cut ((x:R)(EUn Un x)->``x <= (majorant Un pr)-eps``).
+Intro.
+Assert H9 := (H5 ``(majorant Un pr)-eps`` H8).
+Cut ``eps<=0``.
+Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
+Apply Rle_anti_compatibility with ``(majorant Un pr)-eps``.
+Rewrite Rplus_Or.
+Replace ``(majorant Un pr)-eps+eps`` with (majorant Un pr); [Assumption | Ring].
+Intros.
+Unfold EUn in H8.
+Elim H8; Intros.
+Rewrite H9; Apply H7.
+Intro.
+Assert H7 := (H6 n).
+Apply Rle_anti_compatibility with ``eps-(Un n)``.
+Replace ``eps-(Un n)+(Un n)`` with ``eps``.
+Replace ``eps-(Un n)+((majorant Un pr)-eps)`` with ``(majorant Un pr)-(Un n)``.
+Assumption.
+Ring.
+Ring.
+Intro.
+Assert H6 := (H2 n).
+Rewrite Rabsolu_right in H6.
+Apply Rle_sym2.
+Assumption.
+Apply Rle_sym1.
+Apply Rle_anti_compatibility with (Un n).
+Rewrite Rplus_Or; Replace ``(Un n)+((majorant Un pr)-(Un n))`` with (majorant Un pr); [Apply H4 | Ring].
+Exists n; Reflexivity.
+Unfold majorant.
+Case (maj_sup Un pr).
+Trivial.
+Intro.
+Assert H2 := (H1 n).
+Apply not_Rlt; Assumption.
+Qed.
+
+(**********)
+Lemma approx_min : (Un:nat->R;pr:(has_lb Un)) (eps:R) ``0<eps`` -> (EX k :nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
+Intros.
+Pose P := [k:nat]``(Rabsolu ((minorant Un pr)-(Un k))) < eps``.
+Unfold P.
+Cut (EX k:nat | (P k)) -> (EX k:nat | ``(Rabsolu ((minorant Un pr)-(Un k))) < eps``).
+Intros.
+Apply H0.
+Apply not_all_not_ex.
+Red; Intro.
+2:Unfold P; Trivial.
+Unfold P in H1.
+Cut (n:nat)``(Rabsolu ((minorant Un pr)-(Un n))) >= eps``.
+Intro.
+Cut (is_lub (EUn (opp_seq Un)) ``-(minorant Un pr)``).
+Intro.
+Unfold is_lub in H3.
+Unfold is_upper_bound in H3.
+Elim H3; Intros.
+Cut (n:nat)``eps<=(Un n)-(minorant Un pr)``.
+Intro.
+Cut (n:nat)``((opp_seq Un) n)<=-(minorant Un pr)-eps``.
+Intro.
+Cut ((x:R)(EUn (opp_seq Un) x)->``x <= -(minorant Un pr)-eps``).
+Intro.
+Assert H9 := (H5 ``-(minorant Un pr)-eps`` H8).
+Cut ``eps<=0``.
+Intro.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H H10)).
+Apply Rle_anti_compatibility with ``-(minorant Un pr)-eps``.
+Rewrite Rplus_Or.
+Replace ``-(minorant Un pr)-eps+eps`` with ``-(minorant Un pr)``; [Assumption | Ring].
+Intros.
+Unfold EUn in H8.
+Elim H8; Intros.
+Rewrite H9; Apply H7.
+Intro.
+Assert H7 := (H6 n).
+Unfold opp_seq.
+Apply Rle_anti_compatibility with ``eps+(Un n)``.
+Replace ``eps+(Un n)+ -(Un n)`` with ``eps``.
+Replace ``eps+(Un n)+(-(minorant Un pr)-eps)`` with ``(Un n)-(minorant Un pr)``.
+Assumption.
+Ring.
+Ring.
+Intro.
+Assert H6 := (H2 n).
+Rewrite Rabsolu_left1 in H6.
+Apply Rle_sym2.
+Replace ``(Un n)-(minorant Un pr)`` with `` -((minorant Un pr)-(Un n))``; [Assumption | Ring].
+Apply Rle_anti_compatibility with ``-(minorant Un pr)``.
+Rewrite Rplus_Or; Replace ``-(minorant Un pr)+((minorant Un pr)-(Un n))`` with ``-(Un n)``.
+Apply H4.
+Exists n; Reflexivity.
+Ring.
+Unfold minorant.
+Case (min_inf Un pr).
+Intro.
+Rewrite Ropp_Ropp.
+Trivial.
+Intro.
+Assert H2 := (H1 n).
+Apply not_Rlt; Assumption.
+Qed.
+
+(* Unicity of limit for convergent sequences *) 
+Lemma UL_sequence : (Un:nat->R;l1,l2:R) (Un_cv Un l1) -> (Un_cv Un l2) -> l1==l2. 
+Intros Un l1 l2; Unfold Un_cv; Unfold R_dist; Intros. 
+Apply cond_eq. 
+Intros; Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
+Elim (H ``eps/2`` H2); Intros. 
+Elim (H0 ``eps/2`` H2); Intros. 
+Pose N := (max x x0). 
+Apply Rle_lt_trans with ``(Rabsolu (l1 -(Un N)))+(Rabsolu ((Un N)-l2))``. 
+Replace ``l1-l2`` with ``(l1-(Un N))+((Un N)-l2)``; [Apply Rabsolu_triang | Ring]. 
+Rewrite (double_var eps); Apply Rplus_lt. 
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H3; Unfold ge N; Apply le_max_l. 
+Apply H4; Unfold ge N; Apply le_max_r. 
+Qed.
+
+(**********) 
+Lemma CV_plus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)+(Bn i)`` ``l1+l2``). 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
+Elim (H ``eps/2`` H2); Intros. 
+Elim (H0 ``eps/2`` H2); Intros. 
+Pose N := (max x x0). 
+Exists N; Intros. 
+Replace ``(An n)+(Bn n)-(l1+l2)`` with ``((An n)-l1)+((Bn n)-l2)``; [Idtac | Ring]. 
+Apply Rle_lt_trans with ``(Rabsolu ((An n)-l1))+(Rabsolu ((Bn n)-l2))``. 
+Apply Rabsolu_triang. 
+Rewrite (double_var eps); Apply Rplus_lt. 
+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.
+
+(**********) 
+Lemma cv_cvabs : (Un:nat->R;l:R) (Un_cv Un l) -> (Un_cv [i:nat](Rabsolu (Un i)) (Rabsolu l)). 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Elim (H eps H0); Intros. 
+Exists x; Intros. 
+Apply Rle_lt_trans with ``(Rabsolu ((Un n)-l))``. 
+Apply Rabsolu_triang_inv2. 
+Apply H1; Assumption. 
+Qed. 
+
+(**********) 
+Lemma CV_Cauchy : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (Cauchy_crit Un). 
+Intros; Elim X; Intros. 
+Unfold Cauchy_crit; Intros. 
+Unfold Un_cv in p; Unfold R_dist in p. 
+Cut ``0<eps/2``; [Intro | Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Sup0]]. 
+Elim (p ``eps/2`` H0); Intros. 
+Exists x0; Intros. 
+Unfold R_dist; Apply Rle_lt_trans with ``(Rabsolu ((Un n)-x))+(Rabsolu (x-(Un m)))``. 
+Replace ``(Un n)-(Un m)`` with ``((Un n)-x)+(x-(Un m))``; [Apply Rabsolu_triang | Ring]. 
+Rewrite (double_var eps); Apply Rplus_lt. 
+Apply H1; Assumption. 
+Rewrite <- Rabsolu_Ropp; Rewrite Ropp_distr2; Apply H1; Assumption. 
+Qed. 
+
+(**********)
+Lemma maj_by_pos : (Un:nat->R) (sigTT R [l:R](Un_cv Un l)) -> (EXT l:R | ``0<l``/\((n:nat)``(Rabsolu (Un n))<=l``)). 
+Intros; Elim X; Intros. 
+Cut (sigTT R [l:R](Un_cv [k:nat](Rabsolu (Un k)) l)). 
+Intro. 
+Assert H := (CV_Cauchy [k:nat](Rabsolu (Un k)) X0). 
+Assert H0 := (cauchy_bound [k:nat](Rabsolu (Un k)) H). 
+Elim H0; Intros. 
+Exists ``x0+1``. 
+Cut ``0<=x0``. 
+Intro. 
+Split. 
+Apply ge0_plus_gt0_is_gt0; [Assumption | Apply Rlt_R0_R1]. 
+Intros. 
+Apply Rle_trans with x0. 
+Unfold is_upper_bound in H1. 
+Apply H1. 
+Exists n; Reflexivity. 
+Pattern 1 x0; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Apply Rlt_R0_R1. 
+Apply Rle_trans with (Rabsolu (Un O)). 
+Apply Rabsolu_pos. 
+Unfold is_upper_bound in H1. 
+Apply H1. 
+Exists O; Reflexivity. 
+Apply existTT with (Rabsolu x). 
+Apply cv_cvabs; Assumption. 
+Qed. 
+ 
+(**********) 
+Lemma CV_mult : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)*(Bn i)`` ``l1*l2``). 
+Intros. 
+Cut (sigTT R [l:R](Un_cv An l)). 
+Intro. 
+Assert H1 := (maj_by_pos An X). 
+Elim H1; Intros M H2. 
+Elim H2; Intros. 
+Unfold Un_cv; Unfold R_dist; Intros. 
+Cut ``0<eps/(2*M)``. 
+Intro. 
+Case (Req_EM l2 R0); Intro. 
+Unfold Un_cv in H0; Unfold R_dist in H0. 
+Elim (H0 ``eps/(2*M)`` H6); Intros. 
+Exists x; Intros. 
+Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. 
+Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. 
+Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. 
+Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with R0. 
+Rewrite Rplus_Or. 
+Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. 
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). 
+Apply Rle_monotony. 
+Apply Rabsolu_pos. 
+Apply H4. 
+Apply Rlt_monotony_contra with ``/M``. 
+Apply Rlt_Rinv; Apply H3. 
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
+Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). 
+Apply Rlt_trans with  ``eps/(2*M)``. 
+Apply H8; Assumption. 
+Unfold Rdiv; Rewrite Rinv_Rmult. 
+Apply Rlt_monotony_contra with ``2``. 
+Sup0.
+Replace ``2*(eps*(/2*/M))`` with ``(2*/2)*(eps*/M)``; [Idtac | Ring]. 
+Rewrite <- Rinv_r_sym. 
+Rewrite Rmult_1l; Rewrite double. 
+Pattern 1 ``eps*/M``; Rewrite <- Rplus_Or. 
+Apply Rlt_compatibility; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Assumption]. 
+DiscrR. 
+DiscrR. 
+Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). 
+Red; Intro; Rewrite H10 in H3; Elim (Rlt_antirefl ? H3). 
+Rewrite H7; Do 2 Rewrite Rmult_Or; Unfold Rminus; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Reflexivity. 
+Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Idtac | Ring]. 
+Symmetry; Apply Rabsolu_mult. 
+Cut ``0<eps/(2*(Rabsolu l2))``. 
+Intro. 
+Unfold Un_cv in H; Unfold R_dist in H; Unfold Un_cv in H0; Unfold R_dist in H0. 
+Elim (H ``eps/(2*(Rabsolu l2))`` H8); Intros N1 H9. 
+Elim (H0 ``eps/(2*M)`` H6); Intros N2 H10. 
+Pose N := (max N1 N2). 
+Exists N; Intros. 
+Apply Rle_lt_trans with ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))+(Rabsolu ((An n)*l2-l1*l2))``. 
+Replace ``(An n)*(Bn n)-l1*l2`` with ``((An n)*(Bn n)-(An n)*l2)+((An n)*l2-l1*l2)``; [Apply Rabsolu_triang | Ring]. 
+Replace ``(Rabsolu ((An n)*(Bn n)-(An n)*l2))`` with ``(Rabsolu (An n))*(Rabsolu ((Bn n)-l2))``. 
+Replace ``(Rabsolu ((An n)*l2-l1*l2))`` with ``(Rabsolu l2)*(Rabsolu ((An n)-l1))``. 
+Rewrite (double_var eps); Apply Rplus_lt. 
+Apply Rle_lt_trans with ``M*(Rabsolu ((Bn n)-l2))``. 
+Do 2 Rewrite <- (Rmult_sym ``(Rabsolu ((Bn n)-l2))``). 
+Apply Rle_monotony. 
+Apply Rabsolu_pos. 
+Apply H4. 
+Apply Rlt_monotony_contra with ``/M``. 
+Apply Rlt_Rinv; Apply H3. 
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
+Rewrite Rmult_1l; Rewrite (Rmult_sym ``/M``). 
+Apply Rlt_le_trans with  ``eps/(2*M)``. 
+Apply H10. 
+Unfold ge; Apply le_trans with N. 
+Unfold N; Apply le_max_r. 
+Assumption. 
+Unfold Rdiv; Rewrite Rinv_Rmult. 
+Right; Ring. 
+DiscrR. 
+Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). 
+Red; Intro; Rewrite H12 in H3; Elim (Rlt_antirefl ? H3). 
+Apply Rlt_monotony_contra with ``/(Rabsolu l2)``. 
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt; Assumption. 
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym. 
+Rewrite Rmult_1l; Apply Rlt_le_trans with ``eps/(2*(Rabsolu l2))``. 
+Apply H9. 
+Unfold ge; Apply le_trans with N. 
+Unfold N; Apply le_max_l. 
+Assumption. 
+Unfold Rdiv; Right; Rewrite Rinv_Rmult. 
+Ring. 
+DiscrR. 
+Apply Rabsolu_no_R0; Assumption. 
+Apply Rabsolu_no_R0; Assumption. 
+Replace ``(An n)*l2-l1*l2`` with ``l2*((An n)-l1)``; [Symmetry; Apply Rabsolu_mult | Ring]. 
+Replace ``(An n)*(Bn n)-(An n)*l2`` with ``(An n)*((Bn n)-l2)``; [Symmetry; Apply Rabsolu_mult | Ring]. 
+Unfold Rdiv; Apply Rmult_lt_pos. 
+Assumption. 
+Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Apply Rabsolu_pos_lt; Assumption]. 
+Unfold Rdiv; Apply Rmult_lt_pos; [Assumption | Apply Rlt_Rinv; Apply Rmult_lt_pos; [Sup0 | Assumption]]. 
+Apply existTT with l1; Assumption. 
+Qed. 
+
+Lemma tech9 : (Un:nat->R) (Un_growing Un) -> ((m,n:nat)(le m n)->``(Un m)<=(Un n)``).
+Intros; Unfold Un_growing in H.
+Induction n.
+Induction m.
+Right; Reflexivity.
+Elim (le_Sn_O ? H0).
+Cut (le m n)\/m=(S n).
+Intro; Elim H1; Intro.
+Apply Rle_trans with (Un n).
+Apply Hrecn; Assumption.
+Apply H.
+Rewrite H2; Right; Reflexivity.
+Inversion H0.
+Right; Reflexivity.
+Left; Assumption.
+Qed.
+
+Lemma tech10 : (Un:nat->R;x:R) (Un_growing Un) -> (is_lub (EUn Un) x) -> (Un_cv Un x).
+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 (n:nat)``(Un n)<=x``.
+Intro; Unfold Un_cv in H3; Cut ``0<x0-x``.
+Intro; Elim (H3 ``x0-x`` H5); Intros.
+Cut (ge x1 x1).
+Intro; Assert H8 := (H6 x1 H7).
+Unfold R_dist in H8; Rewrite Rabsolu_left1 in H8.
+Rewrite Ropp_distr2 in H8; Unfold Rminus in H8.
+Assert H9 := (Rlt_anti_compatibility ``x0`` ? ? H8).
+Assert H10 := (Ropp_Rlt ? ? H9).
+Assert H11 := (H4 x1).
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H10 H11)).
+Apply Rle_minus; Apply Rle_trans with x.
+Apply H4.
+Left; Assumption.
+Unfold ge; 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; Exists n; Reflexivity.
+Rewrite b; Assumption.
+Cut ((n:nat)``(Un n)<=x0``).
+Intro; Unfold is_lub in H0; Unfold is_upper_bound in H0; Elim H0; Intros.
+Cut (y:R)(EUn Un y)->``y<=x0``.
+Intro; Assert H8 := (H6 ? H7). 
+Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H8 r)).
+Unfold EUn; Intros; Elim H7; Intros.
+Rewrite H8; Apply H4.
+Intro; Case (total_order_Rle (Un n) x0); Intro.
+Assumption.
+Cut (n0:nat)(le n n0) -> ``x0<(Un n0)``. 
+Intro; Unfold Un_cv in H3; Cut ``0<(Un n)-x0``.
+Intro; Elim (H3 ``(Un n)-x0`` H5); Intros.
+Cut (ge (max n x1) x1).
+Intro; Assert H8 := (H6 (max n x1) H7).
+Unfold R_dist in H8.
+Rewrite Rabsolu_right in H8.
+Unfold Rminus in H8; Do 2 Rewrite <- (Rplus_sym ``-x0``) in H8.
+Assert H9 := (Rlt_anti_compatibility ? ? ? H8).
+Cut ``(Un n)<=(Un (max n x1))``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H10 H9)).
+Apply tech9; [Assumption | Apply le_max_l].
+Apply Rge_trans with ``(Un n)-x0``.
+Unfold Rminus; Apply Rle_sym1; Do 2 Rewrite <- (Rplus_sym ``-x0``); Apply Rle_compatibility.
+Apply tech9; [Assumption | Apply le_max_l].
+Left; Assumption.
+Unfold ge; Apply le_max_r.
+Apply Rlt_anti_compatibility with x0.
+Rewrite Rplus_Or; Unfold Rminus; Rewrite (Rplus_sym x0); Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or; Apply H4; Apply le_n.
+Intros; Apply Rlt_le_trans with (Un n).
+Case (total_order_Rlt_Rle x0 (Un n)); Intro.
+Assumption.
+Elim n0; Assumption.
+Apply tech9; Assumption.
+Unfold bound; Exists x; Unfold is_lub in H0; Elim H0; Intros; Assumption.
+Qed.
+
+Lemma tech13 : (An:nat->R;k:R) ``0<=k<1`` -> (Un_cv [n:nat](Rabsolu ``(An (S n))/(An n)``) k) -> (EXT k0 : R | ``k<k0<1`` /\ (EX N:nat | (n:nat) (le N n)->``(Rabsolu ((An (S n))/(An n)))<k0``)).
+Intros; Exists ``k+(1-k)/2``.
+Split.
+Split.
+Pattern 1 k; Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Replace ``k+(1-k)`` with R1; [Elim H; Intros; Assumption | Ring].
+Apply Rlt_Rinv; Sup0.
+Apply Rlt_monotony_contra with ``2``.
+Sup0.
+Unfold Rdiv; Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Pattern 1 ``2``; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym; [Idtac | DiscrR]; Rewrite Rmult_1r; Replace ``2*k+(1-k)`` with ``1+k``; [Idtac | Ring].
+Elim H; Intros.
+Apply Rlt_compatibility; Assumption.
+Unfold Un_cv in H0; Cut ``0<(1-k)/2``.
+Intro; Elim (H0 ``(1-k)/2`` H1); Intros.
+Exists x; Intros.
+Assert H4 := (H2 n H3).
+Unfold R_dist in H4; Rewrite <- Rabsolu_Rabsolu; Replace ``(Rabsolu ((An (S n))/(An n)))`` with ``((Rabsolu ((An (S n))/(An n)))-k)+k``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu ((Rabsolu ((An (S n))/(An n)))-k))+(Rabsolu k)``.
+Apply Rabsolu_triang.
+Rewrite (Rabsolu_right k).
+Apply Rlt_anti_compatibility with ``-k``; Rewrite <- (Rplus_sym k); Repeat Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Repeat Rewrite Rplus_Ol; Apply H4.
+Apply Rle_sym1; Elim H; Intros; Assumption.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_anti_compatibility with k; Rewrite Rplus_Or; Elim H; Intros; Replace ``k+(1-k)`` with R1; [Assumption | Ring].
+Apply Rlt_Rinv; Sup0.
+Qed.
+
+(**********)
+Lemma growing_ineq : (Un:nat->R;l:R) (Un_growing Un) -> (Un_cv Un l) -> ((n:nat)``(Un n)<=l``). 
+Intros; Case (total_order_T (Un n) l); Intro.
+Elim s; Intro.
+Left; Assumption.
+Right; Assumption.
+Cut ``0<(Un n)-l``.
+Intro; Unfold Un_cv in H0; Unfold R_dist in H0.
+Elim (H0 ``(Un n)-l`` H1); Intros N1 H2.
+Pose N := (max n N1).
+Cut ``(Un n)-l<=(Un N)-l``.
+Intro; Cut ``(Un N)-l<(Un n)-l``.
+Intro; Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H3 H4)).
+Apply Rle_lt_trans with ``(Rabsolu ((Un N)-l))``.
+Apply Rle_Rabsolu.
+Apply H2.
+Unfold ge N; Apply le_max_r.
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rle_compatibility.
+Apply tech9.
+Assumption.
+Unfold N; Apply le_max_l.
+Apply Rlt_anti_compatibility with l.
+Rewrite Rplus_Or.
+Replace ``l+((Un n)-l)`` with (Un n); [Assumption | Ring].
+Qed.
+
+(* Un->l => (-Un) -> (-l) *)
+Lemma CV_opp : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv (opp_seq An) ``-l``).
+Intros An l.
+Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H eps H0); Intros.
+Exists x; Intros.
+Unfold opp_seq; Replace ``-(An n)- (-l)`` with ``-((An n)-l)``; [Rewrite Rabsolu_Ropp | Ring].
+Apply H1; Assumption.
+Qed.
+
+(**********)
+Lemma decreasing_ineq : (Un:nat->R;l:R) (Un_decreasing Un) -> (Un_cv Un l) -> ((n:nat)``l<=(Un n)``).
+Intros.
+Assert H1 := (decreasing_growing ? H).
+Assert H2 := (CV_opp ? ? H0).
+Assert H3 := (growing_ineq ? ? H1 H2).
+Apply Ropp_Rle.
+Unfold opp_seq in H3; Apply H3.
+Qed.
+
+(**********)
+Lemma CV_minus : (An,Bn:nat->R;l1,l2:R) (Un_cv An l1) -> (Un_cv Bn l2) -> (Un_cv [i:nat]``(An i)-(Bn i)`` ``l1-l2``). 
+Intros. 
+Replace [i:nat]``(An i)-(Bn i)`` with [i:nat]``(An i)+((opp_seq Bn) i)``. 
+Unfold Rminus; Apply CV_plus. 
+Assumption. 
+Apply CV_opp; Assumption. 
+Unfold Rminus opp_seq; Reflexivity. 
+Qed. 
+
+(* Un -> +oo *)
+Definition cv_infty [Un:nat->R] : Prop := (M:R)(EXT N:nat | (n:nat) (le N n) -> ``M<(Un n)``).
+
+(* Un -> +oo => /Un -> O *)
+Lemma cv_infty_cv_R0 : (Un:nat->R) ((n:nat)``(Un n)<>0``) -> (cv_infty Un) -> (Un_cv [n:nat]``/(Un n)`` R0).
+Unfold cv_infty Un_cv; Unfold R_dist; Intros.
+Elim (H0 ``/eps``); Intros N0 H2.
+Exists N0; Intros.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite (Rabsolu_Rinv ? (H n)).
+Apply Rlt_monotony_contra with (Rabsolu (Un n)).
+Apply Rabsolu_pos_lt; Apply H.
+Rewrite <- Rinv_r_sym.
+Apply Rlt_monotony_contra with ``/eps``.
+Apply Rlt_Rinv; Assumption.
+Rewrite Rmult_1r; Rewrite (Rmult_sym ``/eps``); Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Apply Rlt_le_trans with (Un n).
+Apply H2; Assumption.
+Apply Rle_Rabsolu.
+Red; Intro; Rewrite H4 in H1; Elim (Rlt_antirefl ? H1).
+Apply Rabsolu_no_R0; Apply H.
+Qed.
+
+(**********)
+Lemma decreasing_prop : (Un:nat->R;m,n:nat) (Un_decreasing Un) -> (le m n) -> ``(Un n)<=(Un m)``.
+Unfold Un_decreasing; Intros.
+Induction n.
+Induction m.
+Right; Reflexivity.
+Elim (le_Sn_O ? H0).
+Cut (le m n)\/m=(S n).
+Intro; Elim H1; Intro.
+Apply Rle_trans with (Un n).
+Apply H.
+Apply Hrecn; Assumption.
+Rewrite H2; Right; Reflexivity.
+Inversion H0; [Right; Reflexivity | Left; Assumption].
+Qed.
+
+(* |x|^n/n! -> 0 *)
+Lemma cv_speed_pow_fact : (x:R) (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` R0).
+Intro; Cut (Un_cv [n:nat]``(pow (Rabsolu x) n)/(INR (fact n))`` R0) -> (Un_cv [n:nat]``(pow x n)/(INR (fact n))`` ``0``).
+Intro; Apply H.
+Unfold Un_cv; Unfold R_dist; Intros; Case (Req_EM x R0); Intro.
+Exists (S O); Intros.
+Rewrite H1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite Rabsolu_R0; Rewrite pow_ne_zero; [Unfold Rdiv; Rewrite Rmult_Ol; Rewrite Rabsolu_R0; Assumption | Red; Intro; Rewrite H3 in H2; Elim (le_Sn_n ? H2)].
+Assert H2 := (Rabsolu_pos_lt x H1); Pose M := (up (Rabsolu x)); Cut `0<=M`.
+Intro; Elim (IZN M H3); Intros M_nat H4.
+Pose Un := [n:nat]``(pow (Rabsolu x) (plus M_nat n))/(INR (fact (plus M_nat n)))``.
+Cut (Un_cv Un R0); Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H5 eps H0); Intros N H6.
+Exists (plus M_nat N); Intros; Cut (EX p:nat | (ge p N)/\n=(plus M_nat p)).
+Intro; Elim H8; Intros p H9.
+Elim H9; Intros; Rewrite H11; Unfold Un in H6; Apply H6; Assumption.
+Exists (minus n M_nat).
+Split.
+Unfold ge; Apply simpl_le_plus_l with M_nat; Rewrite <- le_plus_minus.
+Assumption.
+Apply le_trans with (plus M_nat N).
+Apply le_plus_l.
+Assumption.
+Apply le_plus_minus; Apply le_trans with (plus M_nat N); [Apply le_plus_l | Assumption].
+Pose Vn := [n:nat]``(Rabsolu x)*(Un O)/(INR (S n))``.
+Cut (le (1) M_nat).
+Intro; Cut (n:nat)``0<(Un n)``.
+Intro; Cut (Un_decreasing Un).
+Intro; Cut (n:nat)``(Un (S n))<=(Vn n)``.
+Intro; Cut (Un_cv Vn R0).
+Unfold Un_cv; Unfold R_dist; Intros.
+Elim (H10 eps0 H5); Intros N1 H11.
+Exists (S N1); Intros.
+Cut (n:nat)``0<(Vn n)``.
+Intro; Apply Rle_lt_trans with ``(Rabsolu ((Vn (pred n))-0))``.
+Repeat Rewrite Rabsolu_right.
+Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Replace n with (S (pred n)).
+Apply H9.
+Inversion H12; Simpl; Reflexivity.
+Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H13.
+Apply Rle_sym1; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Left; Apply H7.
+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 [n:nat](INR (S n))).
+Intro; Cut (Un_cv [n:nat]``/(INR (S n))`` R0).
+Unfold Un_cv R_dist; Intros; Unfold Vn.
+Cut ``0<eps1/((Rabsolu x)*(Un O))``.
+Intro; Elim (H11 ? H13); Intros N H14.
+Exists N; Intros; Replace ``(Rabsolu x)*(Un O)/(INR (S n))-0`` with ``((Rabsolu x)*(Un O))*(/(INR (S n))-0)``; [Idtac | Unfold Rdiv; Ring].
+Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu ((Rabsolu x)*(Un O)))``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Apply prod_neq_R0.
+Apply Rabsolu_no_R0; Assumption.
+Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16).
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l.
+Replace ``/(Rabsolu ((Rabsolu x)*(Un O)))*eps1`` with ``eps1/((Rabsolu x)*(Un O))``.
+Apply H14; Assumption.
+Unfold Rdiv; Rewrite (Rabsolu_right ``(Rabsolu x)*(Un O)``).
+Apply Rmult_sym.
+Apply Rle_sym1; Apply Rmult_le_pos.
+Apply Rabsolu_pos.
+Left; Apply H7.
+Apply Rabsolu_no_R0.
+Apply prod_neq_R0; [Apply Rabsolu_no_R0; Assumption | Assert H16 := (H7 O); Red; Intro; Rewrite H17 in H16; Elim (Rlt_antirefl ? H16)].
+Unfold Rdiv; Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv; Apply Rmult_lt_pos.
+Apply Rabsolu_pos_lt; Assumption.
+Apply H7.
+Apply (cv_infty_cv_R0 [n:nat]``(INR (S n))``).
+Intro; Apply not_O_INR; Discriminate.
+Assumption.
+Unfold cv_infty; Intro; Case (total_order_T M0 R0); Intro.
+Elim s; Intro.
+Exists O; Intros.
+Apply Rlt_trans with R0; [Assumption | Apply lt_INR_0; Apply lt_O_Sn].
+Exists O; Intros; Rewrite b; Apply lt_INR_0; Apply lt_O_Sn.
+Pose M0_z := (up M0).
+Assert H10 := (archimed M0).
+Cut `0<=M0_z`.
+Intro; Elim (IZN ? H11); Intros M0_nat H12.
+Exists M0_nat; Intros.
+Apply Rlt_le_trans with (IZR M0_z).
+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; Unfold M0_z; Apply Rlt_trans with M0; [Assumption | Elim H10; Intros; Assumption].
+Intro; Apply Rle_trans with ``(Rabsolu x)*(Un n)*/(INR (S n))``.
+Unfold Un; Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
+Rewrite pow_add; Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
+Unfold Rdiv; Rewrite <- (Rmult_sym (Rabsolu x)); Repeat Rewrite Rmult_assoc; Repeat Apply Rle_monotony.
+Apply Rabsolu_pos.
+Left; Apply pow_lt; Assumption.
+Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
+Rewrite fact_simpl; Rewrite mult_sym; Rewrite mult_INR; Rewrite Rinv_Rmult.
+Apply Rle_monotony.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H10 := (sym_eq ? ? ? H9); Elim (fact_neq_0 ? H10).
+Left; Apply Rinv_lt.
+Apply Rmult_lt_pos; Apply lt_INR_0; Apply lt_O_Sn.
+Apply lt_INR; Apply lt_n_S.
+Pattern 1 n; Replace n with (plus O n); [Idtac | Reflexivity].
+Apply lt_reg_r.
+Apply lt_le_trans with (S O); [Apply lt_O_Sn | Assumption].
+Apply INR_fact_neq_0.
+Apply not_O_INR; Discriminate.
+Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
+Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
+Unfold Vn; Rewrite Rmult_assoc; Unfold Rdiv; Rewrite (Rmult_sym (Un O)); Rewrite (Rmult_sym (Un n)).
+Repeat Apply Rle_monotony.
+Apply Rabsolu_pos.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply lt_O_Sn.
+Apply decreasing_prop; [Assumption | Apply le_O_n].
+Unfold Un_decreasing; Intro; Unfold Un.
+Replace (plus M_nat (S n)) with (plus (plus M_nat n) (1)).
+Rewrite pow_add; Unfold Rdiv; Rewrite Rmult_assoc; Apply Rle_monotony.
+Left; Apply pow_lt; Assumption.
+Replace (pow (Rabsolu x) (S O)) with (Rabsolu x); [Idtac | Simpl; Ring].
+Replace (plus (plus M_nat n) (S O)) with (S (plus M_nat n)).
+Apply Rle_monotony_contra with (INR (fact (S (plus M_nat n)))).
+Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H9 := (sym_eq ? ? ? H8); Elim (fact_neq_0 ? H9).
+Rewrite (Rmult_sym (Rabsolu x)); Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l.
+Rewrite fact_simpl; Rewrite mult_INR; Rewrite Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1r; Apply Rle_trans with (INR M_nat).
+Left; Rewrite INR_IZR_INZ.
+Rewrite <- H4; Assert H8 := (archimed (Rabsolu x)); Elim H8; Intros; Assumption.
+Apply le_INR; Apply le_trans with (S M_nat); [Apply le_n_Sn | Apply le_n_S; Apply le_plus_l].
+Apply INR_fact_neq_0.
+Apply INR_fact_neq_0.
+Apply INR_eq; Rewrite S_INR; Do 3 Rewrite plus_INR; Reflexivity.
+Apply INR_eq; Do 3 Rewrite plus_INR; Do 2 Rewrite S_INR; Ring.
+Intro; Unfold Un; Unfold Rdiv; Apply Rmult_lt_pos.
+Apply pow_lt; Assumption.
+Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H8 := (sym_eq ? ? ? H7); Elim (fact_neq_0 ? H8).
+Clear Un Vn; Apply INR_le; Simpl.
+Induction M_nat.
+Assert H6 := (archimed (Rabsolu x)); Fold M in H6; Elim H6; Intros. 
+Rewrite H4 in H7; Rewrite <- INR_IZR_INZ in H7.
+Simpl in H7; Elim (Rlt_antirefl ? (Rlt_trans ? ? ? H2 H7)).
+Replace R1 with (INR (S O)); [Apply le_INR | Reflexivity]; Apply le_n_S; Apply le_O_n.
+Apply le_IZR; Simpl; Left; Apply Rlt_trans with (Rabsolu x).
+Assumption.
+Elim (archimed (Rabsolu x)); Intros; Assumption.
+Unfold Un_cv; Unfold R_dist; Intros; Elim (H eps H0); Intros.
+Exists x0; Intros; Apply Rle_lt_trans with ``(Rabsolu ((pow (Rabsolu x) n)/(INR (fact n))-0))``.
+Unfold Rminus; Rewrite Ropp_O; Do 2 Rewrite Rplus_Or; Rewrite (Rabsolu_right ``(pow (Rabsolu x) n)/(INR (fact n))``).
+Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(INR (fact n))``).
+Rewrite Pow_Rabsolu; Right; Reflexivity.
+Apply Rle_sym1; Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
+Apply Rle_sym1; Unfold Rdiv; Apply Rmult_le_pos.
+Case (Req_EM x R0); Intro.
+Rewrite H3; Rewrite Rabsolu_R0.
+Induction n; [Simpl; Left; Apply Rlt_R0_R1 | Simpl; Rewrite Rmult_Ol; Right; Reflexivity].
+Left; Apply pow_lt; Apply Rabsolu_pos_lt; Assumption.
+Left; Apply Rlt_Rinv; Apply lt_INR_0; Apply neq_O_lt; Red; Intro; Assert H4 := (sym_eq ? ? ? H3); Elim (fact_neq_0 ? H4).
+Apply H1; Assumption.
+Qed.
diff --git a/theories7/Reals/SeqSeries.v b/theories7/Reals/SeqSeries.v
new file mode 100644
index 00000000..dd93c304
--- /dev/null
+++ b/theories7/Reals/SeqSeries.v
@@ -0,0 +1,307 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: SeqSeries.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Max.
+Require Export Rseries.
+Require Export SeqProp.
+Require Export Rcomplete.
+Require Export PartSum.
+Require Export AltSeries.
+Require Export Binomial.
+Require Export Rsigma.
+Require Export Rprod.
+Require Export Cauchy_prod.
+Require Export Alembert.
+V7only [ Import nat_scope. Import Z_scope. Import R_scope. ].
+Open Local Scope R_scope.
+
+(**********)
+Lemma sum_maj1 : (fn:nat->R->R;An:nat->R;x,l1,l2:R;N:nat) (Un_cv [n:nat](SP fn n x) l1) -> (Un_cv [n:nat](sum_f_R0 An n) l2) -> ((n:nat)``(Rabsolu (fn n x))<=(An n)``) -> ``(Rabsolu (l1-(SP fn N x)))<=l2-(sum_f_R0 An N)``.
+Intros; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](fn (plus (S N) l) x) n) l)).
+Intro; Cut (sigTT R [l:R](Un_cv [n:nat](sum_f_R0 [l:nat](An (plus (S N) l)) n) l)).
+Intro; Elim X; Intros l1N H2.
+Elim X0; Intros l2N H3.
+Cut ``l1-(SP fn N x)==l1N``.
+Intro; Cut ``l2-(sum_f_R0 An N)==l2N``.
+Intro; Rewrite H4; Rewrite H5.
+Apply sum_cv_maj with [l:nat](An (plus (S N) l)) [l:nat][x:R](fn (plus (S N) l) x) x.
+Unfold SP; Apply H2.
+Apply H3.
+Intros; Apply H1.
+Symmetry; EApply UL_sequence.
+Apply H3.
+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; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
+Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
+Apply H6; Unfold ge; Apply le_trans with n.
+Apply H7.
+Apply le_trans with (plus N n).
+Apply le_plus_r.
+Apply le_n_Sn.
+Cut (le O N).
+Cut (lt N (S (plus N n))).
+Intros; Assert H10 := (sigma_split An H9 H8).
+Unfold sigma in H10.
+Do 2 Rewrite <- minus_n_O in H10.
+Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
+Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
+Cut (minus (S (plus N n)) (S N))=n.
+Intro; Rewrite H11 in H10.
+Apply H10.
+Apply INR_eq; Rewrite minus_INR.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_S; Apply le_plus_l.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply le_lt_n_Sm; Apply le_plus_l.
+Apply le_O_n.
+Symmetry; EApply UL_sequence.
+Apply H2.
+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; Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
+Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
+Unfold SP in H5; Apply H5; Unfold ge; Apply le_trans with n.
+Apply H6.
+Apply le_trans with (plus N n).
+Apply le_plus_r.
+Apply le_n_Sn.
+Cut (le O N).
+Cut (lt N (S (plus N n))).
+Intros; Assert H9 := (sigma_split [k:nat](fn k x) H8 H7).
+Unfold sigma in H9.
+Do 2 Rewrite <- minus_n_O in H9.
+Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
+Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
+Cut (minus (S (plus N n)) (S N))=n.
+Intro; Rewrite H10 in H9.
+Apply H9.
+Apply INR_eq; Rewrite minus_INR.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_S; Apply le_plus_l.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply le_lt_n_Sm.
+Apply le_plus_l.
+Apply le_O_n.
+Apply existTT with ``l2-(sum_f_R0 An N)``.
+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; Replace (Rminus (sum_f_R0 [l:nat](An (plus (S N) l)) n) (Rminus l2 (sum_f_R0 An N))) with (Rminus (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) l2); [Idtac | Ring].
+Replace (Rplus (sum_f_R0 An N) (sum_f_R0 [l:nat](An (plus (S N) l)) n)) with (sum_f_R0 An (S (plus N n))).
+Apply H3; Unfold ge; Apply le_trans with n.
+Apply H4.
+Apply le_trans with (plus N n).
+Apply le_plus_r.
+Apply le_n_Sn.
+Cut (le O N).
+Cut (lt N (S (plus N n))).
+Intros; Assert H7 := (sigma_split An H6 H5).
+Unfold sigma in H7.
+Do 2 Rewrite <- minus_n_O in H7.
+Replace (sum_f_R0 An (S (plus N n))) with (sum_f_R0 [k:nat](An (plus (0) k)) (S (plus N n))).
+Replace (sum_f_R0 An N) with (sum_f_R0 [k:nat](An (plus (0) k)) N).
+Cut (minus (S (plus N n)) (S N))=n.
+Intro; Rewrite H8 in H7.
+Apply H7.
+Apply INR_eq; Rewrite minus_INR.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_S; Apply le_plus_l.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply le_lt_n_Sm.
+Apply le_plus_l.
+Apply le_O_n.
+Apply existTT with ``l1-(SP fn N x)``.
+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.
+Replace (Rminus (sum_f_R0 [l:nat](fn (plus (S N) l) x) n) (Rminus l1 (sum_f_R0 [k:nat](fn k x) N))) with (Rminus (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) l1); [Idtac | Ring].
+Replace (Rplus (sum_f_R0 [k:nat](fn k x) N) (sum_f_R0 [l:nat](fn (plus (S N) l) x) n)) with (sum_f_R0 [k:nat](fn k x) (S (plus N n))).
+Unfold SP in H3; Apply H3.
+Unfold ge; Apply le_trans with n.
+Apply H4.
+Apply le_trans with (plus N n).
+Apply le_plus_r.
+Apply le_n_Sn.
+Cut (le O N).
+Cut (lt N (S (plus N n))).
+Intros; Assert H7 := (sigma_split [k:nat](fn k x) H6 H5).
+Unfold sigma in H7.
+Do 2 Rewrite <- minus_n_O in H7.
+Replace (sum_f_R0 [k:nat](fn k x) (S (plus N n))) with (sum_f_R0 [k:nat](fn (plus (0) k) x) (S (plus N n))).
+Replace (sum_f_R0 [k:nat](fn k x) N) with (sum_f_R0 [k:nat](fn (plus (0) k) x) N).
+Cut (minus (S (plus N n)) (S N))=n.
+Intro; Rewrite H8 in H7.
+Apply H7.
+Apply INR_eq; Rewrite minus_INR.
+Do 2 Rewrite S_INR; Rewrite plus_INR; Ring.
+Apply le_n_S; Apply le_plus_l.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply sum_eq; Intros.
+Reflexivity.
+Apply le_lt_n_Sm.
+Apply le_plus_l.
+Apply le_O_n.
+Qed.
+
+(* Comparaison of convergence for series *)
+Lemma Rseries_CV_comp : (An,Bn:nat->R) ((n:nat)``0<=(An n)<=(Bn n)``) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 Bn N) l)) -> (sigTT ? [l:R](Un_cv [N:nat](sum_f_R0 An N) l)).
+Intros; Apply cv_cauchy_2.
+Assert H0 := (cv_cauchy_1 ? X).
+Unfold Cauchy_crit_series; Unfold Cauchy_crit.
+Intros; Elim (H0 eps H1); Intros.
+Exists x; Intros.
+Cut (Rle (R_dist (sum_f_R0 An n) (sum_f_R0 An m)) (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m))).
+Intro; Apply Rle_lt_trans with (R_dist (sum_f_R0 Bn n) (sum_f_R0 Bn m)).
+Assumption.
+Apply H2; Assumption.
+Assert H5 := (lt_eq_lt_dec n m).
+Elim H5; Intro.
+Elim a; Intro.
+Rewrite (tech2 An n m); [Idtac | Assumption].
+Rewrite (tech2 Bn n m); [Idtac | Assumption].
+Unfold R_dist; Unfold Rminus; Do 2 Rewrite Ropp_distr1; Do 2 Rewrite <- Rplus_assoc; Do 2 Rewrite Rplus_Ropp_r; Do 2 Rewrite Rplus_Ol; Do 2 Rewrite Rabsolu_Ropp; Repeat Rewrite Rabsolu_right.
+Apply sum_Rle; Intros.
+Elim (H (plus (S n) n0)); Intros.
+Apply H8.
+Apply Rle_sym1; Apply cond_pos_sum; Intro.
+Elim (H (plus (S n) n0)); Intros.
+Apply Rle_trans with (An (plus (S n) n0)); Assumption.
+Apply Rle_sym1; Apply cond_pos_sum; Intro.
+Elim (H (plus (S n) n0)); Intros; Assumption.
+Rewrite b; Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0; Right; Reflexivity.
+Rewrite (tech2 An m n); [Idtac | Assumption].
+Rewrite (tech2 Bn m n); [Idtac | Assumption].
+Unfold R_dist; Unfold Rminus; Do 2 Rewrite Rplus_assoc; Rewrite (Rplus_sym (sum_f_R0 An m)); Rewrite (Rplus_sym (sum_f_R0 Bn m)); Do 2 Rewrite Rplus_assoc; Do 2 Rewrite Rplus_Ropp_l; Do 2 Rewrite Rplus_Or; Repeat Rewrite Rabsolu_right.
+Apply sum_Rle; Intros.
+Elim (H (plus (S m) n0)); Intros; Apply H8.
+Apply Rle_sym1; Apply cond_pos_sum; Intro.
+Elim (H (plus (S m) n0)); Intros.
+Apply Rle_trans with (An (plus (S m) n0)); Assumption.
+Apply Rle_sym1.
+Apply cond_pos_sum; Intro.
+Elim (H (plus (S m) n0)); Intros; Assumption.
+Qed.
+
+(* Cesaro's theorem *)
+Lemma Cesaro : (An,Bn:nat->R;l:R) (Un_cv Bn l) -> ((n:nat)``0<(An n)``) -> (cv_infty [n:nat](sum_f_R0 An n)) -> (Un_cv [n:nat](Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l).
+Proof with Trivial.
+Unfold Un_cv; Intros; Assert H3 : (n:nat)``0<(sum_f_R0 An n)``.
+Intro; Apply tech1.
+Assert H4 : (n:nat) ``(sum_f_R0 An n)<>0``.
+Intro; Red; Intro; Assert H5 := (H3 n); Rewrite H4 in H5; Elim (Rlt_antirefl ? H5).
+Assert H5 := (cv_infty_cv_R0 ? H4 H1); Assert H6 : ``0<eps/2``.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Sup.
+Elim (H ? H6); Clear H; Intros N1 H; Pose C := (Rabsolu (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1)); Assert H7 : (EX N:nat | (n:nat) (le N n) -> ``C/(sum_f_R0 An n)<eps/2``).
+Case (Req_EM C R0); Intro.
+Exists O; Intros.
+Rewrite H7; Unfold Rdiv; Rewrite Rmult_Ol; Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Sup.
+Assert H8 : ``0<eps/(2*(Rabsolu C))``.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply Rlt_Rinv; Apply Rmult_lt_pos.
+Sup.
+Apply Rabsolu_pos_lt.
+Elim (H5 ? H8); Intros; Exists x; Intros; Assert H11 := (H9 ? H10); Unfold R_dist in H11; Unfold Rminus in H11; Rewrite Ropp_O in H11; Rewrite Rplus_Or in H11.
+Apply Rle_lt_trans with (Rabsolu ``C/(sum_f_R0 An n)``).
+Apply Rle_Rabsolu.
+Unfold Rdiv; Rewrite Rabsolu_mult; Apply Rlt_monotony_contra with ``/(Rabsolu C)``.
+Apply Rlt_Rinv; Apply Rabsolu_pos_lt.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Replace ``/(Rabsolu C)*(eps*/2)`` with ``eps/(2*(Rabsolu C))``.
+Unfold Rdiv; Rewrite Rinv_Rmult.
+Ring.
+DiscrR.
+Apply Rabsolu_no_R0.
+Apply Rabsolu_no_R0.
+Elim H7; Clear H7; Intros N2 H7; Pose N := (max N1 N2); Exists (S N); Intros; Unfold R_dist; Replace (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 An n)) l) with (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) (sum_f_R0 An n)).
+Assert H9 : (lt N1 n).
+Apply lt_le_trans with (S N).
+Apply le_lt_n_Sm; Unfold N; Apply le_max_l.
+Rewrite (tech2 [k:nat]``(An k)*((Bn k)-l)`` ? ? H9); Unfold Rdiv; Rewrite Rmult_Rplus_distrl; Apply Rle_lt_trans with (Rplus (Rabsolu (Rdiv (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` N1) (sum_f_R0 An n))) (Rabsolu (Rdiv (sum_f_R0 [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))) (sum_f_R0 An n)))).
+Apply Rabsolu_triang.
+Rewrite (double_var eps); Apply Rplus_lt.
+Unfold Rdiv; Rewrite Rabsolu_mult; Fold C; Rewrite Rabsolu_right.
+Apply (H7 n); Apply le_trans with (S N).
+Apply le_trans with N; [Unfold N; Apply le_max_r | Apply le_n_Sn].
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+
+Unfold R_dist in H; Unfold Rdiv; Rewrite Rabsolu_mult; Rewrite (Rabsolu_right ``/(sum_f_R0 An n)``).
+Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat](Rabsolu ``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)``) (minus n (S N1))) ``/(sum_f_R0 An n)``).
+Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
+Left; Apply Rlt_Rinv.
+Apply (sum_Rabsolu [i:nat]``(An (plus (S N1) i))*((Bn (plus (S N1) i))-l)`` (minus n (S N1))).
+Apply Rle_lt_trans with (Rmult (sum_f_R0 [i:nat]``(An (plus (S N1) i))*eps/2`` (minus n (S N1))) ``/(sum_f_R0 An n)``).
+Do 2 Rewrite <- (Rmult_sym ``/(sum_f_R0 An n)``); Apply Rle_monotony.
+Left; Apply Rlt_Rinv.
+Apply sum_Rle; Intros; Rewrite Rabsolu_mult; Pattern 2 (An (plus (S N1) n0)); Rewrite <- (Rabsolu_right (An (plus (S N1) n0))).
+Apply Rle_monotony.
+Apply Rabsolu_pos.
+Left; Apply H; Unfold ge; Apply le_trans with (S N1); [Apply le_n_Sn | Apply le_plus_l].
+Apply Rle_sym1; Left.
+Rewrite <- (scal_sum [i:nat](An (plus (S N1) i)) (minus n (S N1)) ``eps/2``); Unfold Rdiv; Repeat Rewrite Rmult_assoc; Apply Rlt_monotony.
+Pattern 2 ``/2``; Rewrite <- Rmult_1r; Apply Rlt_monotony.
+Apply Rlt_Rinv; Sup.
+Rewrite Rmult_sym; Apply Rlt_monotony_contra with (sum_f_R0 An n).
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite Rmult_1r; Rewrite (tech2 An N1 n).
+Rewrite Rplus_sym; Pattern 1 (sum_f_R0 [i:nat](An (plus (S N1) i)) (minus n (S N1))); Rewrite <- Rplus_Or; Apply Rlt_compatibility.
+Apply Rle_sym1; Left; Apply Rlt_Rinv.
+Replace (sum_f_R0 [k:nat]``(An k)*((Bn k)-l)`` n) with (Rplus (sum_f_R0 [k:nat]``(An k)*(Bn k)`` n) (sum_f_R0 [k:nat]``(An k)*-l`` n)).
+Rewrite <- (scal_sum An n ``-l``); Field.
+Rewrite <- plus_sum; Apply sum_eq; Intros; Ring.
+Qed.
+
+Lemma Cesaro_1 : (An:nat->R;l:R) (Un_cv An l) -> (Un_cv [n:nat]``(sum_f_R0 An (pred n))/(INR n)`` l).
+Proof with Trivial.
+Intros Bn l H; Pose An := [_:nat]R1.
+Assert H0 : (n:nat) ``0<(An n)``.
+Intro; Unfold An; Apply Rlt_R0_R1.
+Assert H1 : (n:nat)``0<(sum_f_R0 An n)``.
+Intro; Apply tech1.
+Assert H2 : (cv_infty [n:nat](sum_f_R0 An n)).
+Unfold cv_infty; Intro; Case (total_order_Rle M R0); Intro.
+Exists O; Intros; Apply Rle_lt_trans with R0.
+Assert H2 : ``0<M``.
+Auto with real.
+Clear n; Pose m := (up M); Elim (archimed M); Intros; Assert H5 : `0<=m`.
+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_1l; Apply Rlt_trans with (IZR (up M)).
+Apply Rle_lt_trans with (INR x).
+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; 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 (Rabsolu (Rminus (Rdiv (sum_f_R0 [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 (Rminus (Rdiv (sum_f_R0 [k:nat]``(An k)*(Bn k)`` (pred n)) (sum_f_R0 An (pred n))) l).
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-l``); Apply Rplus_plus_r.
+Unfold An; Replace (sum_f_R0 [k:nat]``1*(Bn k)`` (pred n)) with (sum_f_R0 Bn (pred n)).
+Rewrite sum_cte; Rewrite Rmult_1l; Replace (S (pred n)) with n.
+Apply S_pred with O; Apply lt_le_trans with (S x).
+Apply lt_O_Sn.
+Apply sum_eq; Intros; Ring.
+Apply H5; Unfold ge; Apply le_S_n; Replace (S (pred n)) with n.
+Apply S_pred with O; Apply lt_le_trans with (S x).
+Apply lt_O_Sn.
+Qed.
diff --git a/theories7/Reals/SplitAbsolu.v b/theories7/Reals/SplitAbsolu.v
new file mode 100644
index 00000000..30580a0c
--- /dev/null
+++ b/theories7/Reals/SplitAbsolu.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        *)
+(************************************************************************)
+
+(*i      $Id: SplitAbsolu.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $       i*)
+
+Require Rbasic_fun.
+
+Recursive Tactic Definition SplitAbs :=
+  Match Context With
+    | [ |- [(case_Rabsolu ?1)] ] -> 
+         Case (case_Rabsolu ?1); Try SplitAbs.
+
+
+Recursive Tactic Definition SplitAbsolu :=
+  Match Context With
+    | [ id:[(Rabsolu ?)] |- ? ] -> Generalize id; Clear id;Try SplitAbsolu
+    | [ |- [(Rabsolu ?1)] ] ->  Unfold Rabsolu; Try SplitAbs;Intros.
diff --git a/theories7/Reals/SplitRmult.v b/theories7/Reals/SplitRmult.v
new file mode 100644
index 00000000..392675c3
--- /dev/null
+++ b/theories7/Reals/SplitRmult.v
@@ -0,0 +1,19 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: SplitRmult.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+(*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
+
+
+Require Rbase.
+
+Recursive Tactic Definition SplitRmult :=
+  Match Context With
+  | [ |- ~(Rmult ?1 ?2)==R0 ] -> Apply mult_non_zero; Split;Try SplitRmult.
+
diff --git a/theories7/Reals/Sqrt_reg.v b/theories7/Reals/Sqrt_reg.v
new file mode 100644
index 00000000..d2068e5d
--- /dev/null
+++ b/theories7/Reals/Sqrt_reg.v
@@ -0,0 +1,297 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+ 
+(*i $Id: Sqrt_reg.v,v 1.1.2.1 2004/07/16 19:31:36 herbelin Exp $ i*)
+
+Require Rbase.
+Require Rfunctions.
+Require Ranalysis1.
+Require R_sqrt.
+V7only [Import R_scope.]. Open Local Scope R_scope.
+
+(**********)
+Lemma sqrt_var_maj : (h:R) ``(Rabsolu h) <= 1`` -> ``(Rabsolu ((sqrt (1+h))-1))<=(Rabsolu h)``.
+Intros; Cut ``0<=1+h``.
+Intro; Apply Rle_trans with ``(Rabsolu ((sqrt (Rsqr (1+h)))-1))``.
+Case (total_order_T h R0); Intro.
+Elim s; Intro.
+Repeat Rewrite Rabsolu_left.
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``).
+Do 2 Rewrite Ropp_distr1;Rewrite Ropp_Ropp; Apply Rle_compatibility.
+Apply Rle_Ropp1; Apply sqrt_le_1.
+Apply pos_Rsqr.
+Apply H0.
+Pattern 2 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
+Apply H0.
+Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
+Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
+Apply pos_Rsqr.
+Left; Apply Rlt_R0_R1.
+Pattern 2 R1; Rewrite <- Rsqr_1; Apply Rsqr_incrst_1.
+Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Apply H0.
+Left; Apply Rlt_R0_R1.
+Apply Rlt_anti_compatibility with R1; Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Pattern 2 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
+Apply H0.
+Left; Apply Rlt_R0_R1.
+Pattern 2 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Rewrite b; Rewrite Rplus_Or; Rewrite Rsqr_1; Rewrite sqrt_1; Right; Reflexivity.
+Repeat Rewrite Rabsolu_right.
+Unfold Rminus; Do 2 Rewrite <- (Rplus_sym ``-1``); Apply Rle_compatibility.
+Apply sqrt_le_1.
+Apply H0.
+Apply pos_Rsqr.
+Pattern 1 ``1+h``; Rewrite <- Rmult_1r; Unfold Rsqr; Apply Rle_monotony.
+Apply H0.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
+Apply Rle_sym1; Apply Rle_anti_compatibility with R1.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_le_1.
+Left; Apply Rlt_R0_R1.
+Apply pos_Rsqr.
+Pattern 1 R1; Rewrite <- Rsqr_1; Apply Rsqr_incr_1.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rle_compatibility; Left; Assumption.
+Left; Apply Rlt_R0_R1.
+Apply H0.
+Apply Rle_sym1; Left; Apply Rlt_anti_compatibility with R1.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Or.
+Pattern 1 R1; Rewrite <- sqrt_1; Apply sqrt_lt_1.
+Left; Apply Rlt_R0_R1.
+Apply H0.
+Pattern 1 R1; Rewrite <- Rplus_Or; Apply Rlt_compatibility; Assumption.
+Rewrite sqrt_Rsqr.
+Replace ``(1+h)-1`` with h; [Right; Reflexivity | Ring].
+Apply H0.
+Case (total_order_T h R0); Intro.
+Elim s; Intro.
+Rewrite (Rabsolu_left h a) in H.
+Apply Rle_anti_compatibility with ``-h``.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Exact H.
+Left; Rewrite b; Rewrite Rplus_Or; Apply Rlt_R0_R1.
+Left; Apply gt0_plus_gt0_is_gt0.
+Apply Rlt_R0_R1.
+Apply r.
+Qed.
+
+(* sqrt is continuous in 1 *)
+Lemma sqrt_continuity_pt_R1 : (continuity_pt sqrt R1).
+Unfold continuity_pt; Unfold continue_in; Unfold limit1_in; Unfold limit_in; Unfold dist; Simpl; Unfold R_dist; Intros.
+Pose alpha := (Rmin eps R1).
+Exists alpha; Intros.
+Split.
+Unfold alpha; Unfold Rmin; Case (total_order_Rle eps R1); Intro.
+Assumption.
+Apply Rlt_R0_R1.
+Intros; Elim H0; Intros.
+Rewrite sqrt_1; Replace x with ``1+(x-1)``; [Idtac | Ring]; Apply Rle_lt_trans with ``(Rabsolu (x-1))``.
+Apply sqrt_var_maj.
+Apply Rle_trans with alpha.
+Left; Apply H2.
+Unfold alpha; Apply Rmin_r.
+Apply Rlt_le_trans with alpha; [Apply H2 | Unfold alpha; Apply Rmin_l].
+Qed.
+
+(* sqrt is continuous forall x>0 *)
+Lemma sqrt_continuity_pt : (x:R) ``0<x`` -> (continuity_pt sqrt x).
+Intros; Generalize sqrt_continuity_pt_R1.
+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.
+Elim H3; Intros.
+Pose alpha := ``alp_1*x``.
+Exists (Rmin alpha x); Intros.
+Split.
+Change ``0<(Rmin alpha x)``; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
+Unfold alpha; Apply Rmult_lt_pos; Assumption.
+Apply H.
+Intros; Replace x0 with ``x+(x0-x)``; [Idtac | Ring]; Replace ``(sqrt (x+(x0-x)))-(sqrt x)`` with ``(sqrt x)*((sqrt (1+(x0-x)/x))-(sqrt 1))``.
+Rewrite Rabsolu_mult; Rewrite (Rabsolu_right (sqrt x)).
+Apply Rlt_monotony_contra with ``/(sqrt x)``.
+Apply Rlt_Rinv; Apply sqrt_lt_R0; Assumption.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1l; Rewrite Rmult_sym.
+Unfold Rdiv in H5.
+Case (Req_EM x x0); Intro.
+Rewrite H7; Unfold Rminus Rdiv; Rewrite Rplus_Ropp_r; Rewrite Rmult_Ol; Rewrite Rplus_Or; Rewrite Rplus_Ropp_r; Rewrite Rabsolu_R0.
+Apply Rmult_lt_pos.
+Assumption.
+Apply Rlt_Rinv; Rewrite <- H7; Apply sqrt_lt_R0; Assumption.
+Apply H5.
+Split.
+Unfold D_x no_cond.
+Split.
+Trivial.
+Red; Intro.
+Cut ``(x0-x)*/x==0``.
+Intro.
+Elim (without_div_Od ? ? H9); Intro.
+Elim H7.
+Apply (Rminus_eq_right ? ? H10).
+Assert H11 := (without_div_Oi1 ? x H10).
+Rewrite <- Rinv_l_sym in H11.
+Elim R1_neq_R0; Exact H11.
+Red; Intro; Rewrite H12 in H; Elim (Rlt_antirefl ? H).
+Symmetry; Apply r_Rplus_plus with R1; Rewrite Rplus_Or; Unfold Rdiv in H8; Exact H8.
+Unfold Rminus; Rewrite Rplus_sym; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Elim H6; Intros.
+Unfold Rdiv; Rewrite Rabsolu_mult.
+Rewrite Rabsolu_Rinv.
+Rewrite (Rabsolu_right x).
+Rewrite Rmult_sym; Apply Rlt_monotony_contra with x.
+Apply H.
+Rewrite <- Rmult_assoc; Rewrite <- Rinv_r_sym.
+Rewrite Rmult_1l; Rewrite Rmult_sym; Fold alpha.
+Apply Rlt_le_trans with (Rmin alpha x).
+Apply H9.
+Apply Rmin_l.
+Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
+Apply Rle_sym1; Left; Apply H.
+Red; Intro; Rewrite H10 in H; Elim (Rlt_antirefl ? H).
+Assert H7 := (sqrt_lt_R0 x H).
+Red; Intro; Rewrite H8 in H7; Elim (Rlt_antirefl ? H7).
+Apply Rle_sym1; Apply sqrt_positivity.
+Left; Apply H.
+Unfold Rminus; Rewrite Rmult_Rplus_distr; Rewrite Ropp_mul3; Repeat Rewrite <- sqrt_times.
+Rewrite Rmult_1r; Rewrite Rmult_Rplus_distr; Rewrite Rmult_1r; Unfold Rdiv; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Reflexivity.
+Red; Intro; Rewrite H7 in H; Elim (Rlt_antirefl ? H).
+Left; Apply H.
+Left; Apply Rlt_R0_R1.
+Left; Apply H.
+Elim H6; Intros.
+Case (case_Rabsolu ``x0-x``); Intro.
+Rewrite (Rabsolu_left ``x0-x`` r) in H8.
+Rewrite Rplus_sym.
+Apply Rle_anti_compatibility with ``-((x0-x)/x)``.
+Rewrite Rplus_Or; Rewrite <- Rplus_assoc; Rewrite Rplus_Ropp_l; Rewrite Rplus_Ol; Unfold Rdiv; Rewrite <- Ropp_mul1.
+Apply Rle_monotony_contra with x.
+Apply H.
+Rewrite Rmult_1r; Rewrite Rmult_sym; Rewrite Rmult_assoc; Rewrite <- Rinv_l_sym.
+Rewrite Rmult_1r; Left; Apply Rlt_le_trans with (Rmin alpha x).
+Apply H8.
+Apply Rmin_r.
+Red; Intro; Rewrite H9 in H; Elim (Rlt_antirefl ? H).
+Apply ge0_plus_ge0_is_ge0.
+Left; Apply Rlt_R0_R1.
+Unfold Rdiv; Apply Rmult_le_pos.
+Apply Rle_sym2; Exact r.
+Left; Apply Rlt_Rinv; Apply H.
+Unfold Rdiv; Apply Rmult_lt_pos.
+Apply H1.
+Apply Rlt_Rinv; Apply sqrt_lt_R0; Apply H.
+Qed.
+
+(* sqrt is derivable for all x>0 *)
+Lemma derivable_pt_lim_sqrt : (x:R) ``0<x`` -> (derivable_pt_lim sqrt x ``/(2*(sqrt x))``).
+Intros; Pose g := [h:R]``(sqrt x)+(sqrt (x+h))``.
+Cut (continuity_pt g R0).
+Intro; Cut ``(g 0)<>0``.
+Intro; Assert H2 := (continuity_pt_inv g R0 H0 H1).
+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.
+Elim H4; Intros.
+Pose alpha1 := (Rmin alpha x).
+Cut ``0<alpha1``.
+Intro; Exists (mkposreal alpha1 H7); Intros.
+Replace ``((sqrt (x+h))-(sqrt x))/h`` with ``/((sqrt x)+(sqrt (x+h)))``.
+Unfold inv_fct g in H6; Replace ``2*(sqrt x)`` with ``(sqrt x)+(sqrt (x+0))``.
+Apply H6.
+Split.
+Unfold D_x no_cond.
+Split.
+Trivial.
+Apply not_sym; Exact H8.
+Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Apply Rlt_le_trans with alpha1.
+Exact H9.
+Unfold alpha1; Apply Rmin_l.
+Rewrite Rplus_Or; Ring.
+Cut ``0<=x+h``.
+Intro; Cut ``0<(sqrt x)+(sqrt (x+h))``.
+Intro; Apply r_Rmult_mult with ``((sqrt x)+(sqrt (x+h)))``.
+Rewrite <- Rinv_r_sym.
+Rewrite Rplus_sym; Unfold Rdiv; Rewrite <- Rmult_assoc; Rewrite Rsqr_plus_minus; Repeat Rewrite Rsqr_sqrt.
+Rewrite Rplus_sym; Unfold Rminus; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Rewrite <- Rinv_r_sym.
+Reflexivity.
+Apply H8.
+Left; Apply H.
+Assumption.
+Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
+Red; Intro; Rewrite H12 in H11; Elim (Rlt_antirefl ? H11).
+Apply gt0_plus_ge0_is_gt0.
+Apply sqrt_lt_R0; Apply H.
+Apply sqrt_positivity; Apply H10.
+Case (case_Rabsolu h); Intro.
+Rewrite (Rabsolu_left h r) in H9.
+Apply Rle_anti_compatibility with ``-h``.
+Rewrite Rplus_Or; Rewrite Rplus_sym; Rewrite Rplus_assoc; Rewrite Rplus_Ropp_r; Rewrite Rplus_Or; Left; Apply Rlt_le_trans with alpha1.
+Apply H9.
+Unfold alpha1; Apply Rmin_r.
+Apply ge0_plus_ge0_is_ge0.
+Left; Assumption.
+Apply Rle_sym2; Apply r.
+Unfold alpha1; Unfold Rmin; Case (total_order_Rle alpha x); Intro.
+Apply H5.
+Apply H.
+Unfold g; Rewrite Rplus_Or.
+Cut ``0<(sqrt x)+(sqrt x)``.
+Intro; Red; Intro; Rewrite H2 in H1; Elim (Rlt_antirefl ? H1).
+Apply gt0_plus_gt0_is_gt0; Apply sqrt_lt_R0; Apply H.
+Replace g with (plus_fct (fct_cte (sqrt x)) (comp sqrt (plus_fct (fct_cte x) id))); [Idtac | Reflexivity].
+Apply continuity_pt_plus.
+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; Intro; Reflexivity.
+Apply derivable_continuous_pt; Apply derivable_pt_id.
+Apply sqrt_continuity_pt.
+Unfold plus_fct fct_cte id; Rewrite Rplus_Or; Apply H.
+Qed.
+
+(**********)
+Lemma derivable_pt_sqrt : (x:R) ``0<x`` -> (derivable_pt sqrt x).
+Unfold derivable_pt; Intros.
+Apply Specif.existT with ``/(2*(sqrt x))``.
+Apply derivable_pt_lim_sqrt; Assumption.
+Qed.
+
+(**********)
+Lemma derive_pt_sqrt : (x:R;pr:``0<x``) ``(derive_pt sqrt x (derivable_pt_sqrt ? pr)) == /(2*(sqrt x))``.
+Intros.
+Apply derive_pt_eq_0.
+Apply derivable_pt_lim_sqrt; Assumption.
+Qed.
+
+(* We show that sqrt is continuous for all x>=0 *)
+(* Remark : by definition of sqrt (as extension of Rsqrt on |R), *)
+(*          we could also show that sqrt is continuous for all x *)
+Lemma continuity_pt_sqrt : (x:R) ``0<=x`` -> (continuity_pt sqrt x).
+Intros; Case (total_order R0 x); Intro.
+Apply (sqrt_continuity_pt x H0).
+Elim H0; Intro.
+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)``; Apply Rsqr_pos_lt.
+Red; Intro; Rewrite H3 in H2; Elim (Rlt_antirefl ? H2).
+Intros; Elim H3; Intros.
+Rewrite <- H1; Rewrite sqrt_0; Unfold Rminus; Rewrite Ropp_O; Rewrite Rplus_Or; Rewrite <- H1 in H5; Unfold Rminus in H5; Rewrite Ropp_O in H5; Rewrite Rplus_Or in H5.
+Case (case_Rabsolu x0); Intro.
+Unfold sqrt; Case (case_Rabsolu x0); Intro.
+Rewrite Rabsolu_R0; Apply H2.
+Assert H6 := (Rle_sym2 ? ? r0); Elim (Rlt_antirefl ? (Rle_lt_trans ? ? ? H6 r)).
+Rewrite Rabsolu_right.
+Apply Rsqr_incrst_0.
+Rewrite Rsqr_sqrt.
+Rewrite (Rabsolu_right x0 r) in H5; Apply H5.
+Apply Rle_sym2; Exact r.
+Apply sqrt_positivity; Apply Rle_sym2; Exact r.
+Left; Exact H2.
+Apply Rle_sym1; Apply sqrt_positivity; Apply Rle_sym2; Exact r.
+Elim (Rlt_antirefl ? (Rlt_le_trans ? ? ? H1 H)).
+Qed.
diff --git a/theories7/Relations/Newman.v b/theories7/Relations/Newman.v
new file mode 100755
index 00000000..c53db971
--- /dev/null
+++ b/theories7/Relations/Newman.v
@@ -0,0 +1,115 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Newman.v,v 1.1.2.1 2004/07/16 19:31:37 herbelin Exp $ i*)
+
+Require Rstar.
+
+Section Newman.
+
+Variable A: Type. 
+Variable R: A->A->Prop.
+
+Local Rstar := (Rstar A R). 
+Local Rstar_reflexive := (Rstar_reflexive A R).
+Local Rstar_transitive := (Rstar_transitive A R).
+Local Rstar_Rstar' := (Rstar_Rstar' A R).
+
+Definition coherence := [x:A][y:A] (exT2 ? (Rstar x) (Rstar y)).
+
+Theorem coherence_intro :  (x:A)(y:A)(z:A)(Rstar x z)->(Rstar y z)->(coherence x y).
+Proof [x:A][y:A][z:A][h1:(Rstar x z)][h2:(Rstar y z)]
+      (exT_intro2 A (Rstar x) (Rstar y) z h1 h2).
+  
+(** A very simple case of coherence : *)
+
+Lemma Rstar_coherence : (x:A)(y:A)(Rstar x y)->(coherence x y).
+ Proof  [x:A][y:A][h:(Rstar x y)](coherence_intro x y y h (Rstar_reflexive y)).  
+  
+(** coherence is symmetric *)
+Lemma coherence_sym: (x:A)(y:A)(coherence x y)->(coherence y x).
+ Proof [x:A][y:A][h:(coherence x y)]
+        (exT2_ind A (Rstar x) (Rstar y) (coherence y x)
+                 [w:A][h1:(Rstar x w)][h2:(Rstar y w)]
+                      (coherence_intro y x w h2 h1) h).
+
+Definition confluence :=
+     [x:A](y:A)(z:A)(Rstar x y)->(Rstar x z)->(coherence y z).  
+  
+Definition local_confluence :=
+     [x:A](y:A)(z:A)(R x y)->(R x z)->(coherence y z).  
+  
+Definition noetherian :=
+     (x:A)(P:A->Prop)((y:A)((z:A)(R y z)->(P z))->(P y))->(P x).  
+  
+Section Newman_section.
+
+(** The general hypotheses of the theorem *)
+
+Hypothesis Hyp1:noetherian.
+Hypothesis Hyp2:(x:A)(local_confluence x).  
+  
+(** The induction hypothesis *)
+
+Section Induct.
+  Variable    x:A.
+  Hypothesis  hyp_ind:(u:A)(R x u)->(confluence u).  
+  
+(** Confluence in [x] *)
+
+  Variables   y,z:A.  
+  Hypothesis  h1:(Rstar x y).  
+  Hypothesis  h2:(Rstar x z).  
+  
+(** particular case [x->u] and [u->*y]   *)
+Section Newman_.
+  Variable    u:A.  
+  Hypothesis  t1:(R x u).  
+  Hypothesis  t2:(Rstar u y).  
+  
+(** In the usual diagram, we assume also [x->v] and [v->*z] *)
+
+Theorem Diagram : (v:A)(u1:(R x v))(u2:(Rstar v z))(coherence y z).
+
+Proof     (* We draw the diagram ! *)
+   [v:A][u1:(R x v)][u2:(Rstar v z)]
+   (exT2_ind A (Rstar u) (Rstar v)    (* local confluence in x for u,v *)
+      (coherence y z)                (* gives w, u->*w and v->*w *)
+      ([w:A][s1:(Rstar u w)][s2:(Rstar v w)]
+   (exT2_ind A (Rstar y) (Rstar w)    (* confluence in u => coherence(y,w) *)
+      (coherence y z)                (* gives a, y->*a and z->*a *)
+      ([a:A][v1:(Rstar y a)][v2:(Rstar w a)]
+   (exT2_ind A (Rstar a) (Rstar z)    (* confluence in v => coherence(a,z) *)
+      (coherence y z)                (* gives b, a->*b and z->*b *)
+      ([b:A][w1:(Rstar a b)][w2:(Rstar z b)]
+        (coherence_intro y z b (Rstar_transitive y a b v1 w1) w2))
+      (hyp_ind v u1 a z (Rstar_transitive v w a s2 v2) u2)))
+     (hyp_ind u t1 y w t2 s1)))
+    (Hyp2 x u v t1 u1)).
+  
+Theorem caseRxy : (coherence y z).
+Proof (Rstar_Rstar' x z h2 
+      ([v:A][w:A](coherence y w))
+      (coherence_sym x y (Rstar_coherence x y h1))  (*i case x=z i*)
+      Diagram).                                     (*i case x->v->*z i*)
+End Newman_.
+
+Theorem Ind_proof : (coherence y z).
+Proof (Rstar_Rstar' x y h1 ([u:A][v:A](coherence v z))
+        (Rstar_coherence x z h2)                    (*i case x=y i*)
+        caseRxy).                                   (*i case x->u->*z i*)
+End Induct.
+
+Theorem Newman : (x:A)(confluence x).
+Proof [x:A](Hyp1 x confluence Ind_proof).  
+
+End Newman_section.
+
+
+End Newman.
+
diff --git a/theories7/Relations/Operators_Properties.v b/theories7/Relations/Operators_Properties.v
new file mode 100755
index 00000000..4f1818bc
--- /dev/null
+++ b/theories7/Relations/Operators_Properties.v
@@ -0,0 +1,98 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Operators_Properties.v,v 1.1.2.1 2004/07/16 19:31:37 herbelin Exp $ i*)
+
+(****************************************************************************)
+(*                            Bruno Barras                                  *)
+(****************************************************************************)
+
+Require Relation_Definitions.
+Require Relation_Operators.
+
+
+Section Properties.
+
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Local incl : (relation A)->(relation A)->Prop :=
+      [R1,R2: (relation A)] (x,y:A) (R1 x y) -> (R2 x y).
+
+Section Clos_Refl_Trans.
+
+  Lemma clos_rt_is_preorder: (preorder A (clos_refl_trans A R)).
+Apply Build_preorder.
+Exact (rt_refl A R).
+
+Exact (rt_trans A R).
+Qed.
+
+
+
+Lemma clos_rt_idempotent:
+       (incl (clos_refl_trans A (clos_refl_trans A R))
+                     (clos_refl_trans A R)).
+Red.
+NewInduction 1; Auto with sets.
+Intros.
+Apply rt_trans with y; Auto with sets.
+Qed.
+
+  Lemma  clos_refl_trans_ind_left: (A:Set)(R:A->A->Prop)(M:A)(P:A->Prop)
+           (P M)
+            ->((P0,N:A)
+                (clos_refl_trans A R M P0)->(P P0)->(R P0 N)->(P N))
+               ->(a:A)(clos_refl_trans A R M a)->(P a).
+Intros.
+Generalize H H0 .
+Clear  H H0.
+Elim H1; Intros; Auto with sets.
+Apply H2 with x; Auto with sets.
+
+Apply H3.
+Apply H0; Auto with sets.
+
+Intros.
+Apply H5 with P0; Auto with sets.
+Apply rt_trans with y; Auto with sets.
+Qed.
+
+
+End Clos_Refl_Trans.
+
+
+Section Clos_Refl_Sym_Trans.
+
+  Lemma clos_rt_clos_rst: (inclusion A (clos_refl_trans A R)
+				        (clos_refl_sym_trans A R)).
+Red.
+NewInduction 1; Auto with sets.
+Apply rst_trans with y; Auto with sets.
+Qed.
+
+  Lemma clos_rst_is_equiv: (equivalence A (clos_refl_sym_trans A R)).
+Apply Build_equivalence.
+Exact (rst_refl A R).
+
+Exact (rst_trans A R).
+
+Exact (rst_sym A R).
+Qed.
+
+  Lemma clos_rst_idempotent:
+       (incl (clos_refl_sym_trans A (clos_refl_sym_trans A R))
+                     (clos_refl_sym_trans A R)).
+Red.
+NewInduction 1; Auto with sets.
+Apply rst_trans with y; Auto with sets.
+Qed.
+
+End Clos_Refl_Sym_Trans.
+
+End Properties.
diff --git a/theories7/Relations/Relation_Definitions.v b/theories7/Relations/Relation_Definitions.v
new file mode 100755
index 00000000..1e38e753
--- /dev/null
+++ b/theories7/Relations/Relation_Definitions.v
@@ -0,0 +1,83 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Relation_Definitions.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+Section Relation_Definition.
+
+   Variable A: Type.
+   
+   Definition relation :=  A -> A -> Prop.
+
+   Variable R: relation.
+   
+
+Section General_Properties_of_Relations.
+
+  Definition reflexive : Prop :=  (x: A) (R x x).
+  Definition transitive : Prop :=  (x,y,z: A) (R x y) -> (R y z) -> (R x z).
+  Definition symmetric : Prop :=  (x,y: A) (R x y) -> (R y x).
+  Definition antisymmetric : Prop :=  (x,y: A) (R x y) -> (R y x) -> x=y.
+
+  (* for compatibility with Equivalence in  ../PROGRAMS/ALG/  *)
+  Definition equiv := reflexive /\ transitive /\ symmetric.
+
+End General_Properties_of_Relations.
+
+
+
+Section Sets_of_Relations.
+
+   Record preorder : Prop := {
+       preord_refl  : reflexive;
+       preord_trans : transitive }.
+
+   Record order : Prop := {
+       ord_refl    : reflexive;
+       ord_trans   : transitive;
+       ord_antisym : antisymmetric }.
+
+   Record equivalence : Prop := {
+       equiv_refl  : reflexive;
+       equiv_trans : transitive;
+       equiv_sym   : symmetric }.
+   
+   Record PER : Prop := {
+       per_sym   : symmetric;
+       per_trans : transitive }.
+
+End Sets_of_Relations.
+
+
+
+Section Relations_of_Relations.
+
+  Definition inclusion : relation -> relation -> Prop :=
+      [R1,R2: relation] (x,y:A) (R1 x y) -> (R2 x y).
+
+  Definition same_relation : relation -> relation -> Prop :=
+      [R1,R2: relation] (inclusion R1 R2) /\ (inclusion R2 R1).
+   
+  Definition commut : relation -> relation -> Prop :=
+      [R1,R2:relation] (x,y:A) (R1 y x) -> (z:A) (R2 z y)
+                          -> (EX y':A |(R2 y' x) & (R1 z y')).
+
+End Relations_of_Relations.
+
+   
+End Relation_Definition.
+
+Hints Unfold reflexive transitive antisymmetric symmetric : sets v62.
+
+Hints Resolve Build_preorder Build_order Build_equivalence 
+	Build_PER preord_refl preord_trans 
+	ord_refl ord_trans ord_antisym
+	equiv_refl equiv_trans equiv_sym
+	per_sym per_trans : sets v62.
+
+Hints Unfold inclusion same_relation commut : sets v62.
diff --git a/theories7/Relations/Relation_Operators.v b/theories7/Relations/Relation_Operators.v
new file mode 100755
index 00000000..14c2ae30
--- /dev/null
+++ b/theories7/Relations/Relation_Operators.v
@@ -0,0 +1,157 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Relation_Operators.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+(****************************************************************************)
+(*                      Bruno Barras, Cristina Cornes                       *)
+(*                                                                          *)
+(*  Some of these definitons were taken from :                              *)
+(*     Constructing Recursion Operators in Type Theory                      *)
+(*     L. Paulson  JSC (1986) 2, 325-355                                    *)
+(****************************************************************************)
+
+Require Relation_Definitions.
+Require PolyList.
+Require PolyListSyntax.
+
+(** Some operators to build relations *)
+
+Section Transitive_Closure.
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Inductive clos_trans : A->A->Prop :=
+     t_step: (x,y:A)(R x y)->(clos_trans x y)
+   | t_trans: (x,y,z:A)(clos_trans x y)->(clos_trans y z)->(clos_trans x z).
+End Transitive_Closure.
+
+
+Section Reflexive_Transitive_Closure.
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Inductive clos_refl_trans: (relation A) :=
+    rt_step: (x,y:A)(R x y)->(clos_refl_trans x y)
+  | rt_refl: (x:A)(clos_refl_trans x x)
+  | rt_trans: (x,y,z: A)(clos_refl_trans x y)->(clos_refl_trans y z)
+                      ->(clos_refl_trans x z).
+End Reflexive_Transitive_Closure.
+
+
+Section Reflexive_Symetric_Transitive_Closure.
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Inductive clos_refl_sym_trans: (relation A) :=
+    rst_step: (x,y:A)(R x y)->(clos_refl_sym_trans x y)
+  | rst_refl: (x:A)(clos_refl_sym_trans x x)
+  | rst_sym: (x,y:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y x)
+  | rst_trans: (x,y,z:A)(clos_refl_sym_trans x y)->(clos_refl_sym_trans y z)
+                      ->(clos_refl_sym_trans x z).
+End Reflexive_Symetric_Transitive_Closure.
+
+
+Section Transposee.
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Definition transp := [x,y:A](R y x).
+End Transposee.
+
+
+Section Union.
+  Variable A: Set.
+  Variable R1,R2: (relation A).
+
+  Definition union := [x,y:A](R1 x y)\/(R2 x y).
+End Union.
+
+
+Section Disjoint_Union.
+Variable A,B:Set.
+Variable leA: A->A->Prop.
+Variable leB: B->B->Prop.
+
+Inductive le_AsB : A+B->A+B->Prop :=
+   le_aa: (x,y:A) (leA x y) -> (le_AsB (inl A B x) (inl A B y))
+|  le_ab: (x:A)(y:B) (le_AsB (inl A B x) (inr A B y))
+|  le_bb: (x,y:B)  (leB x y) -> (le_AsB (inr A B x) (inr A B y)).
+
+End Disjoint_Union. 
+
+
+
+Section Lexicographic_Product.
+(* Lexicographic order on dependent pairs *)
+
+Variable A:Set.
+Variable B:A->Set.
+Variable leA: A->A->Prop.
+Variable leB: (x:A)(B x)->(B x)->Prop.
+
+Inductive lexprod : (sigS A B) -> (sigS A B) ->Prop :=
+  left_lex : (x,x':A)(y:(B x)) (y':(B x')) 
+               (leA x x') ->(lexprod (existS A B x y) (existS A B x' y'))
+| right_lex : (x:A) (y,y':(B x)) 
+                (leB x y y') -> (lexprod (existS A B x y) (existS A B x y')).
+End Lexicographic_Product.
+
+
+Section Symmetric_Product.
+  Variable A:Set.
+  Variable B:Set.
+  Variable leA: A->A->Prop.
+  Variable leB: B->B->Prop.
+
+  Inductive symprod : (A*B) -> (A*B) ->Prop :=
+     left_sym : (x,x':A)(leA x x')->(y:B)(symprod (x,y) (x',y))
+  | right_sym : (y,y':B)(leB y y')->(x:A)(symprod (x,y) (x,y')).
+
+End Symmetric_Product.
+
+
+Section Swap.
+  Variable A:Set.
+  Variable R:A->A->Prop.
+
+  Inductive swapprod: (A*A)->(A*A)->Prop :=
+     sp_noswap: (x,x':A*A)(symprod A A R R x x')->(swapprod x x')
+   | sp_swap: (x,y:A)(p:A*A)(symprod A A R R (x,y) p)->(swapprod (y,x) p).
+End Swap.
+
+
+Section Lexicographic_Exponentiation.
+
+Variable A : Set.
+Variable leA : A->A->Prop.
+Local Nil := (nil A).
+Local List := (list A).
+
+Inductive Ltl : List->List->Prop :=
+  Lt_nil: (a:A)(x:List)(Ltl Nil (cons a x))
+| Lt_hd : (a,b:A) (leA a b)-> (x,y:(list A))(Ltl (cons a x) (cons b y))
+| Lt_tl : (a:A)(x,y:List)(Ltl x y) -> (Ltl (cons a x) (cons a y)).
+
+
+Inductive Desc : List->Prop :=
+   d_nil : (Desc Nil)
+|  d_one : (x:A)(Desc (cons x Nil))
+|  d_conc : (x,y:A)(l:List)(leA x y) 
+              -> (Desc l^(cons y Nil))->(Desc (l^(cons y Nil))^(cons x Nil)).
+
+Definition  Pow :Set := (sig List Desc).
+
+Definition lex_exp : Pow -> Pow ->Prop := 
+      [a,b:Pow](Ltl (proj1_sig List Desc a) (proj1_sig  List Desc b)).
+
+End Lexicographic_Exponentiation.
+
+Hints Unfold transp union : sets v62.
+Hints Resolve t_step rt_step rt_refl rst_step rst_refl : sets v62.
+Hints Immediate rst_sym : sets v62.
diff --git a/theories7/Relations/Relations.v b/theories7/Relations/Relations.v
new file mode 100755
index 00000000..694d0eec
--- /dev/null
+++ b/theories7/Relations/Relations.v
@@ -0,0 +1,28 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Relations.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+Require Export Relation_Definitions.
+Require Export Relation_Operators.
+Require Export Operators_Properties.
+
+Lemma inverse_image_of_equivalence : (A,B:Set)(f:A->B)
+  (r:(relation B))(equivalence B r)->(equivalence A [x,y:A](r (f x) (f y))).
+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 : (A,B:Set)(f:A->B)
+  (equivalence A [x,y:A](f x)=(f y)).
+Split; Red;
+[ (* reflexivity *)  Reflexivity
+| (* transitivity *) Intros; Transitivity (f y); Assumption
+| (* symmetry *) Intros; Symmetry; Assumption
+].
+Qed.
diff --git a/theories7/Relations/Rstar.v b/theories7/Relations/Rstar.v
new file mode 100755
index 00000000..3747b45e
--- /dev/null
+++ b/theories7/Relations/Rstar.v
@@ -0,0 +1,78 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Rstar.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+(** Properties of a binary relation [R] on type [A] *)
+
+Section Rstar.
+
+Variable A : Type.  
+Variable R : A->A->Prop.  
+
+(** Definition of the reflexive-transitive closure [R*] of [R] *)
+(** Smallest reflexive [P] containing [R o P] *)
+
+Definition Rstar  := [x,y:A](P:A->A->Prop)
+   ((u:A)(P u u))->((u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)) -> (P x y).  
+
+Theorem Rstar_reflexive:  (x:A)(Rstar x x).
+ Proof [x:A][P:A->A->Prop]
+       [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
+       (h1 x).  
+  
+Theorem Rstar_R: (x:A)(y:A)(z:A)(R x y)->(Rstar y z)->(Rstar x z).
+ Proof [x:A][y:A][z:A][t1:(R x y)][t2:(Rstar y z)]
+       [P:A->A->Prop]
+       [h1:(u:A)(P u u)][h2:(u:A)(v:A)(w:A)(R u v)->(P v w)->(P u w)]
+       (h2 x y z t1 (t2 P h1 h2)).  
+  
+(** We conclude with transitivity of [Rstar] : *)
+
+Theorem  Rstar_transitive:  (x:A)(y:A)(z:A)(Rstar x y)->(Rstar y z)->(Rstar x z).
+ Proof  [x:A][y:A][z:A][h:(Rstar x y)]
+        (h ([u:A][v:A](Rstar v z)->(Rstar u z))
+           ([u:A][t:(Rstar u z)]t)
+           ([u:A][v:A][w:A][t1:(R u v)][t2:(Rstar w z)->(Rstar v z)]
+            [t3:(Rstar w z)](Rstar_R u v z t1 (t2 t3)))).  
+
+(** Another characterization of [R*] *)
+(** Smallest reflexive [P] containing [R o R*] *)
+
+Definition Rstar' := [x:A][y:A](P:A->A->Prop)
+    ((P x x))->((u:A)(R x u)->(Rstar u y)->(P x y)) -> (P x y).  
+
+Theorem Rstar'_reflexive: (x:A)(Rstar' x x).
+ Proof  [x:A][P:A->A->Prop][h:(P x x)][h':(u:A)(R x u)->(Rstar u x)->(P x x)]h.
+  
+Theorem Rstar'_R: (x:A)(y:A)(z:A)(R x z)->(Rstar z y)->(Rstar' x y).
+ Proof  [x:A][y:A][z:A][t1:(R x z)][t2:(Rstar z y)]
+        [P:A->A->Prop][h1:(P x x)]
+        [h2:(u:A)(R x u)->(Rstar u y)->(P x y)](h2 z t1 t2).  
+  
+(** Equivalence of the two definitions: *)
+
+Theorem Rstar'_Rstar:  (x:A)(y:A)(Rstar' x y)->(Rstar x y).
+ Proof  [x:A][y:A][h:(Rstar' x y)]
+        (h Rstar (Rstar_reflexive x) ([u:A](Rstar_R x u y))).  
+  
+Theorem Rstar_Rstar':  (x:A)(y:A)(Rstar x y)->(Rstar' x y).
+ Proof  [x:A][y:A][h:(Rstar x y)](h Rstar' ([u:A](Rstar'_reflexive u))
+         ([u:A][v:A][w:A][h1:(R u v)][h2:(Rstar' v w)]
+          (Rstar'_R u w v h1 (Rstar'_Rstar v w h2)))).  
+
+
+(** Property of Commutativity of two relations *)
+
+Definition commut := [A:Set][R1,R2:A->A->Prop]
+                       (x,y:A)(R1 y x)->(z:A)(R2 z y)
+                        ->(EX y':A |(R2 y' x) & (R1 z y')).
+
+
+End Rstar.
+
diff --git a/theories7/Setoids/Setoid.v b/theories7/Setoids/Setoid.v
new file mode 100644
index 00000000..f8176f60
--- /dev/null
+++ b/theories7/Setoids/Setoid.v
@@ -0,0 +1,73 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Setoid.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $: i*)
+
+Section Setoid.
+
+Variable A : Type.
+Variable Aeq : A -> A -> Prop.
+
+Record Setoid_Theory : Prop :=
+{ Seq_refl : (x:A) (Aeq x x);
+  Seq_sym : (x,y:A) (Aeq x y) -> (Aeq y x);
+  Seq_trans : (x,y,z:A) (Aeq x y) -> (Aeq y z) -> (Aeq x z)
+}.
+
+End Setoid.
+
+Definition Prop_S : (Setoid_Theory Prop iff).
+Split; [Exact iff_refl | Exact iff_sym | Exact iff_trans].
+Qed.
+
+Add Setoid Prop iff Prop_S.
+
+Hint prop_set : setoid := Resolve (Seq_refl Prop iff Prop_S).
+Hint prop_set : setoid := Resolve (Seq_sym Prop iff Prop_S).
+Hint prop_set : setoid := Resolve (Seq_trans Prop iff Prop_S).
+
+Add Morphism or : or_ext.
+Intros.
+Inversion H1.
+Left.
+Inversion H.
+Apply (H3 H2).
+
+Right.
+Inversion H0.
+Apply (H3 H2).
+Qed.
+
+Add Morphism and : and_ext.
+Intros.
+Inversion H1.
+Split.
+Inversion H.
+Apply (H4 H2).
+
+Inversion H0.
+Apply (H4 H3).
+Qed.
+
+Add Morphism not : not_ext.
+Red ; Intros.
+Apply H0.
+Inversion H.
+Apply (H3 H1).
+Qed.
+
+Definition fleche [A,B:Prop] := A -> B.
+
+Add Morphism fleche : fleche_ext.
+Unfold fleche.
+Intros.
+Inversion H0.
+Inversion H.
+Apply (H3 (H1 (H6 H2))).
+Qed.
+
diff --git a/theories7/Sets/Classical_sets.v b/theories7/Sets/Classical_sets.v
new file mode 100755
index 00000000..a6928ffd
--- /dev/null
+++ b/theories7/Sets/Classical_sets.v
@@ -0,0 +1,133 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Classical_sets.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Constructive_sets.
+Require Export Classical_Type.
+
+(* Hints Unfold  not . *)
+
+Section Ensembles_classical.
+Variable U: Type.
+
+Lemma not_included_empty_Inhabited: 
+  (A: (Ensemble  U)) ~ (Included U A (Empty_set U)) -> (Inhabited U A).
+Proof.
+Intros A NI.
+Elim (not_all_ex_not U [x:U]~(In U A x)).
+Intros x H; Apply Inhabited_intro with x.
+Apply NNPP; Auto with sets.
+Red; Intro.
+Apply NI; Red.
+Intros x H'; Elim (H x); Trivial with sets.
+Qed.
+Hints Resolve not_included_empty_Inhabited.
+
+Lemma not_empty_Inhabited: 
+  (A: (Ensemble  U)) ~ A == (Empty_set U) -> (Inhabited U A).
+Proof.
+Intros; Apply not_included_empty_Inhabited.
+Red; Auto with sets.
+Qed.
+
+Lemma Inhabited_Setminus :
+(X, Y: (Ensemble U)) (Included U X Y) -> ~ (Included U Y X) ->
+       (Inhabited U (Setminus U Y X)).
+Proof.
+Intros X Y I NI. 
+Elim (not_all_ex_not U [x:U](In U Y x)->(In U X x) NI).
+Intros x YX.
+Apply Inhabited_intro with x.
+Apply Setminus_intro.
+Apply not_imply_elim with (In U X x); Trivial with sets.
+Auto with sets.
+Qed.
+Hints Resolve Inhabited_Setminus.
+
+Lemma Strict_super_set_contains_new_element:
+  (X, Y: (Ensemble U)) (Included U X Y) -> ~ X == Y ->
+   (Inhabited U (Setminus U Y X)).
+Proof.
+Auto 7 with sets.
+Qed.
+Hints Resolve Strict_super_set_contains_new_element.
+
+Lemma Subtract_intro:
+  (A: (Ensemble U)) (x, y: U) (In U A y) -> ~ x == y ->
+   (In U (Subtract U A x) y).
+Proof.
+Unfold 1 Subtract; Auto with sets.
+Qed.
+Hints Resolve Subtract_intro.
+
+Lemma Subtract_inv:
+  (A: (Ensemble U)) (x, y: U) (In U (Subtract U A x) y) ->
+   (In U A y) /\ ~ x == y.
+Proof.
+Intros A x y H'; Elim H'; Auto with sets.
+Qed.
+
+Lemma Included_Strict_Included:
+  (X, Y: (Ensemble U)) (Included U X Y) -> (Strict_Included U X Y) \/ X == Y.
+Proof.
+Intros X Y H'; Try Assumption.
+Elim (classic X == Y); Auto with sets.
+Qed.
+
+Lemma Strict_Included_inv:
+  (X, Y: (Ensemble U)) (Strict_Included U X Y) ->
+   (Included U X Y) /\ (Inhabited U (Setminus U Y X)).
+Proof.
+Intros X Y H'; Red in H'.
+Split; [Tauto | Idtac].
+Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
+Apply Strict_super_set_contains_new_element; Auto with sets.
+Qed.
+
+Lemma not_SIncl_empty: 
+    (X: (Ensemble U)) ~ (Strict_Included U X (Empty_set U)).
+Proof.
+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.
+Intro H'3; Elim H'3.
+Qed.
+
+Lemma Complement_Complement :
+  (A: (Ensemble U)) (Complement U (Complement U A)) == A.
+Proof.
+Unfold Complement; Intros; Apply Extensionality_Ensembles; Auto with sets.
+Red; Split; Auto with sets.
+Red; Intros; Apply NNPP; Auto with sets.
+Qed.
+
+End Ensembles_classical.
+
+Hints Resolve Strict_super_set_contains_new_element Subtract_intro 
+	not_SIncl_empty : sets v62.
diff --git a/theories7/Sets/Constructive_sets.v b/theories7/Sets/Constructive_sets.v
new file mode 100755
index 00000000..35c88e9d
--- /dev/null
+++ b/theories7/Sets/Constructive_sets.v
@@ -0,0 +1,162 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Constructive_sets.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+Require Export Ensembles.
+
+Section Ensembles_facts.
+Variable U: Type.
+
+Lemma Extension: (B, C: (Ensemble U)) B == C -> (Same_set U B C).
+Proof.
+Intros B C H'; Rewrite H'; Auto with sets.
+Qed.
+
+Lemma Noone_in_empty: (x: U) ~ (In U (Empty_set U) x).
+Proof.
+Red; NewDestruct 1.
+Qed.
+Hints Resolve Noone_in_empty.
+
+Lemma Included_Empty: (A: (Ensemble U))(Included U (Empty_set U) A).
+Proof.
+Intro; Red.
+Intros x H; Elim (Noone_in_empty x); Auto with sets.
+Qed.
+Hints Resolve Included_Empty.
+
+Lemma Add_intro1:
+  (A: (Ensemble U)) (x, y: U) (In U A y) -> (In U (Add U A x) y).
+Proof.
+Unfold 1 Add; Auto with sets.
+Qed.
+Hints Resolve Add_intro1.
+
+Lemma Add_intro2: (A: (Ensemble U)) (x: U) (In U (Add U A x) x).
+Proof.
+Unfold 1 Add; Auto with sets.
+Qed.
+Hints Resolve Add_intro2.
+
+Lemma Inhabited_add: (A: (Ensemble U)) (x: U) (Inhabited U (Add U A x)).
+Proof.
+Intros A x.
+Apply Inhabited_intro with x := x; Auto with sets.
+Qed.
+Hints Resolve Inhabited_add.
+
+Lemma Inhabited_not_empty:
+  (X: (Ensemble U)) (Inhabited U X) -> ~ X == (Empty_set U).
+Proof.
+Intros X H'; Elim H'.
+Intros x H'0; Red; Intro H'1.
+Absurd (In U X x); Auto with sets.
+Rewrite H'1; Auto with sets.
+Qed.
+Hints Resolve Inhabited_not_empty.
+
+Lemma Add_not_Empty :
+ (A: (Ensemble U)) (x: U) ~ (Add U A x) == (Empty_set U).
+Proof.
+Auto with sets.
+Qed.
+Hints Resolve Add_not_Empty.
+
+Lemma not_Empty_Add :
+ (A: (Ensemble U)) (x: U) ~ (Empty_set U) == (Add U A x).
+Proof.
+Intros; Red; Intro H; Generalize (Add_not_Empty A x); Auto with sets.
+Qed.
+Hints Resolve not_Empty_Add.
+
+Lemma Singleton_inv: (x, y: U) (In U (Singleton U x) y) -> x == y.
+Proof.
+Intros x y H'; Elim H'; Trivial with sets.
+Qed.
+Hints Resolve Singleton_inv.
+
+Lemma Singleton_intro: (x, y: U) x == y -> (In U (Singleton U x) y).
+Proof.
+Intros x y H'; Rewrite H'; Trivial with sets.
+Qed.
+Hints Resolve Singleton_intro.
+
+Lemma Union_inv:  (B, C: (Ensemble U)) (x: U) 
+  (In U (Union U B C) x) -> (In U B x) \/ (In U C x).
+Proof.
+Intros B C x H'; Elim H'; Auto with sets.
+Qed.
+
+Lemma Add_inv:
+  (A: (Ensemble U)) (x, y: U) (In U (Add U A x) y) -> (In U A y) \/ x == y.
+Proof.
+Intros A x y H'; Elim H'; Auto with sets.
+Qed.
+
+Lemma Intersection_inv:
+  (B, C: (Ensemble U)) (x: U) (In U (Intersection U B C) x) ->
+   (In U B x) /\ (In U C x).
+Proof.
+Intros B C x H'; Elim H'; Auto with sets.
+Qed.
+Hints Resolve Intersection_inv.
+
+Lemma Couple_inv: (x, y, z: U) (In U (Couple U x y) z) -> z == x \/ z == y.
+Proof.
+Intros x y z H'; Elim H'; Auto with sets.
+Qed.
+Hints Resolve Couple_inv.
+
+Lemma Setminus_intro:
+  (A, B: (Ensemble U)) (x: U) (In U A x) -> ~ (In U B x) ->
+   (In U (Setminus U A B) x).
+Proof.
+Unfold 1 Setminus; Red; Auto with sets.
+Qed.
+Hints Resolve Setminus_intro.
+ 
+Lemma Strict_Included_intro:
+  (X, Y: (Ensemble U)) (Included U X Y) /\ ~ X == Y -> 
+                       (Strict_Included U X Y).
+Proof.
+Auto with sets.
+Qed.
+Hints Resolve Strict_Included_intro.
+
+Lemma Strict_Included_strict: (X: (Ensemble U)) ~ (Strict_Included U X X).
+Proof.
+Intro X; Red; Intro H'; Elim H'.
+Intros H'0 H'1; Elim H'1; Auto with sets.
+Qed.
+Hints Resolve Strict_Included_strict.
+
+End Ensembles_facts.
+
+Hints Resolve Singleton_inv Singleton_intro Add_intro1 Add_intro2 
+	Intersection_inv Couple_inv Setminus_intro Strict_Included_intro
+	Strict_Included_strict Noone_in_empty Inhabited_not_empty
+	Add_not_Empty  not_Empty_Add Inhabited_add Included_Empty : sets v62.
diff --git a/theories7/Sets/Cpo.v b/theories7/Sets/Cpo.v
new file mode 100755
index 00000000..2fe46be6
--- /dev/null
+++ b/theories7/Sets/Cpo.v
@@ -0,0 +1,107 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Cpo.v,v 1.1.2.1 2004/07/16 19:31:38 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Relations_1.
+Require Export Partial_Order.
+
+Section Bounds.
+Variable U: Type.
+Variable D: (PO U).
+
+Local C :=  (Carrier_of U D).
+
+Local R :=  (Rel_of U D).
+
+Inductive Upper_Bound [B:(Ensemble U); x:U]: Prop :=
+      Upper_Bound_definition:
+        (In U C x) -> ((y: U) (In U B y) -> (R y x)) -> (Upper_Bound B x).
+
+Inductive Lower_Bound [B:(Ensemble U); x:U]: Prop :=
+      Lower_Bound_definition:
+        (In U C x) -> ((y: U) (In U B y) -> (R x y)) -> (Lower_Bound B x).
+
+Inductive Lub [B:(Ensemble U); x:U]: Prop :=
+      Lub_definition:
+        (Upper_Bound B x) -> ((y: U) (Upper_Bound B y) -> (R x y)) -> (Lub B x).
+
+Inductive Glb [B:(Ensemble U); x:U]: Prop :=
+      Glb_definition:
+        (Lower_Bound B x) -> ((y: U) (Lower_Bound B y) -> (R y x)) -> (Glb B x).
+
+Inductive Bottom [bot:U]: Prop :=
+      Bottom_definition:
+        (In U C bot) -> ((y: U) (In U C y) -> (R bot y)) -> (Bottom bot).
+
+Inductive Totally_ordered [B:(Ensemble U)]: Prop :=
+      Totally_ordered_definition:
+        ((Included U B C) ->
+          (x: U) (y: U) (Included U (Couple U x y) B) -> (R x y) \/ (R y x)) ->
+         (Totally_ordered B).
+
+Definition Compatible : (Relation U) :=
+   [x: U] [y: U] (In U C x) -> (In U C y) ->
+    (EXT z | (In U C z) /\ (Upper_Bound (Couple U x y) z)).
+	
+Inductive Directed [X:(Ensemble U)]: Prop :=
+      Definition_of_Directed:
+        (Included U X C) ->
+        (Inhabited U X) ->
+        ((x1: U) (x2: U) (Included U (Couple U x1 x2) X) ->
+          (EXT x3 | (In U X x3) /\ (Upper_Bound (Couple U x1 x2) x3))) ->
+         (Directed X).
+
+Inductive Complete : Prop :=
+      Definition_of_Complete:
+        ((EXT bot | (Bottom bot))) ->
+        ((X: (Ensemble U)) (Directed X) -> (EXT bsup | (Lub X bsup))) ->
+         Complete.
+
+Inductive Conditionally_complete : Prop :=
+      Definition_of_Conditionally_complete:
+        ((X: (Ensemble U))
+         (Included U X C) -> (EXT maj | (Upper_Bound X maj)) ->
+          (EXT bsup | (Lub X bsup))) -> Conditionally_complete.
+End Bounds.
+Hints Resolve Totally_ordered_definition Upper_Bound_definition 
+	Lower_Bound_definition Lub_definition Glb_definition
+	Bottom_definition Definition_of_Complete
+  	 Definition_of_Complete Definition_of_Conditionally_complete.
+
+Section Specific_orders.
+Variable U: Type.
+
+Record Cpo : Type := Definition_of_cpo {
+   PO_of_cpo: (PO U);
+   Cpo_cond: (Complete U PO_of_cpo) }.
+
+Record Chain : Type := Definition_of_chain {
+   PO_of_chain: (PO U);
+   Chain_cond: (Totally_ordered U PO_of_chain (Carrier_of U PO_of_chain)) }.
+
+End Specific_orders.
diff --git a/theories7/Sets/Ensembles.v b/theories7/Sets/Ensembles.v
new file mode 100755
index 00000000..c3a044c0
--- /dev/null
+++ b/theories7/Sets/Ensembles.v
@@ -0,0 +1,108 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Ensembles.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Section Ensembles.
+Variable U: Type.
+
+Definition Ensemble :=  U -> Prop. 
+
+Definition In : Ensemble -> U -> Prop :=  [A: Ensemble] [x: U] (A x).
+
+Definition Included : Ensemble -> Ensemble -> Prop :=
+   [B, C: Ensemble] (x: U) (In B x) -> (In C x).
+
+Inductive Empty_set : Ensemble :=
+   .
+
+Inductive Full_set : Ensemble :=
+     Full_intro: (x: U) (In Full_set x).
+
+(** NB: The following definition builds-in equality of elements in [U] as 
+   Leibniz equality. 
+
+   This may have to be changed if we replace [U] by a Setoid on [U] 
+   with its own equality [eqs], with  
+   [In_singleton: (y: U)(eqs x y) -> (In (Singleton x) y)]. *)
+
+Inductive Singleton [x:U] : Ensemble :=
+      In_singleton: (In (Singleton x) x).
+
+Inductive Union [B, C: Ensemble] : Ensemble :=
+     Union_introl: (x: U) (In B x) -> (In (Union B C) x)
+   | Union_intror: (x: U) (In C x) -> (In (Union B C) x).
+
+Definition Add : Ensemble -> U -> Ensemble :=
+   [B: Ensemble] [x: U] (Union B (Singleton x)).
+
+Inductive Intersection [B, C:Ensemble] : Ensemble :=
+      Intersection_intro:
+        (x: U) (In B x) -> (In C x) -> (In (Intersection B C) x).
+
+Inductive Couple [x,y:U] : Ensemble :=
+     Couple_l: (In (Couple x y) x)
+   | Couple_r: (In (Couple x y) y).
+
+Inductive Triple[x, y, z:U] : Ensemble :=
+    Triple_l: (In (Triple x y z) x)
+  | Triple_m: (In (Triple x y z) y)
+  | Triple_r: (In (Triple x y z) z).
+
+Definition Complement : Ensemble -> Ensemble :=
+   [A: Ensemble] [x: U] ~ (In A x).
+
+Definition Setminus : Ensemble -> Ensemble -> Ensemble :=
+   [B: Ensemble] [C: Ensemble] [x: U] (In B x) /\ ~ (In C x).
+
+Definition Subtract : Ensemble -> U -> Ensemble :=
+   [B: Ensemble] [x: U] (Setminus B (Singleton x)).
+
+Inductive Disjoint [B, C:Ensemble] : Prop :=
+      Disjoint_intro: ((x: U) ~ (In (Intersection B C) x)) -> (Disjoint B C).
+
+Inductive Inhabited [B:Ensemble] : Prop :=
+      Inhabited_intro: (x: U) (In B x) -> (Inhabited B).
+
+Definition Strict_Included : Ensemble -> Ensemble -> Prop :=
+   [B, C: Ensemble] (Included B C) /\ ~ B == C.
+
+Definition Same_set : Ensemble -> Ensemble -> Prop :=
+   [B, C: Ensemble] (Included B C) /\ (Included C B).
+
+(** Extensionality Axiom *)
+
+Axiom Extensionality_Ensembles:
+   (A,B: Ensemble) (Same_set A B) -> A == B.
+Hints Resolve Extensionality_Ensembles.
+
+End Ensembles.
+
+Hints Unfold In Included Same_set Strict_Included Add Setminus Subtract : sets v62.
+
+Hints Resolve Union_introl Union_intror Intersection_intro In_singleton Couple_l
+	Couple_r Triple_l Triple_m Triple_r Disjoint_intro 
+	Extensionality_Ensembles : sets v62.
diff --git a/theories7/Sets/Finite_sets.v b/theories7/Sets/Finite_sets.v
new file mode 100755
index 00000000..fb53994d
--- /dev/null
+++ b/theories7/Sets/Finite_sets.v
@@ -0,0 +1,74 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Finite_sets.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Ensembles.
+
+Section Ensembles_finis.
+Variable U: Type.
+
+Inductive Finite : (Ensemble U) -> Prop :=
+      Empty_is_finite: (Finite (Empty_set U))
+   |  Union_is_finite:
+      (A: (Ensemble U)) (Finite A) -> 
+      (x: U) ~ (In U A x) -> (Finite (Add U A x)).
+
+Inductive cardinal : (Ensemble U) -> nat -> Prop :=
+      card_empty: (cardinal (Empty_set U) O)
+   |  card_add:
+       (A: (Ensemble U)) (n: nat) (cardinal A n) ->
+        (x: U) ~ (In U A x) -> (cardinal (Add U A x) (S n)).
+
+End Ensembles_finis.
+
+Hints Resolve Empty_is_finite Union_is_finite : sets v62.
+Hints Resolve card_empty card_add : sets v62.
+
+Require Constructive_sets.
+
+Section Ensembles_finis_facts.
+Variable U: Type.
+
+Lemma cardinal_invert :
+ (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
+           X == (Empty_set U)
+   [n:nat] (EXT A | (EXT x | 
+           X == (Add U A x) /\ ~ (In U A x) /\ (cardinal U A n))) end.
+Proof.
+NewInduction 1; Simpl; Auto.
+Exists A; Exists x; Auto.
+Qed.
+
+Lemma cardinal_elim :
+ (X: (Ensemble U)) (p:nat)(cardinal U X p) -> Case p of
+                              X == (Empty_set U)
+                             [n:nat](Inhabited U X) end.
+Proof.
+Intros X p C; Elim C; Simpl; Trivial with sets.
+Qed.
+
+End Ensembles_finis_facts.
diff --git a/theories7/Sets/Finite_sets_facts.v b/theories7/Sets/Finite_sets_facts.v
new file mode 100755
index 00000000..63d4d2ad
--- /dev/null
+++ b/theories7/Sets/Finite_sets_facts.v
@@ -0,0 +1,345 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Finite_sets_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Finite_sets.
+Require Export Constructive_sets.
+Require Export Classical_Type.
+Require Export Classical_sets.
+Require Export Powerset.
+Require Export Powerset_facts.
+Require Export Powerset_Classical_facts.
+Require Export Gt.
+Require Export Lt.
+
+Section Finite_sets_facts.
+Variable U: Type.
+
+Lemma finite_cardinal :
+ (X: (Ensemble U)) (Finite U X) -> (EX n:nat |(cardinal U X n)).
+Proof.
+NewInduction 1 as [|A _ [n H]].
+Exists O; Auto with sets.
+Exists (S n); Auto with sets.
+Qed.
+
+Lemma cardinal_finite:
+  (X: (Ensemble U)) (n: nat) (cardinal U X n) -> (Finite U X).
+Proof.
+NewInduction 1; Auto with sets.
+Qed.
+
+Theorem Add_preserves_Finite:
+  (X: (Ensemble U)) (x: U) (Finite U X) -> (Finite U (Add U X x)).
+Proof.
+Intros X x H'.
+Elim (classic (In U X x)); Intro H'0; Auto with sets.
+Rewrite (Non_disjoint_union U X x); Auto with sets.
+Qed.
+Hints Resolve Add_preserves_Finite.
+
+Theorem Singleton_is_finite: (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)); Auto with sets.
+Qed.
+Hints Resolve Singleton_is_finite.
+
+Theorem Union_preserves_Finite:
+  (X, Y: (Ensemble U)) (Finite U X) -> (Finite U Y) -> 
+                       (Finite U (Union U X Y)).
+Proof.
+Intros X Y H'; Elim H'.
+Rewrite (Empty_set_zero U Y); Auto with sets.
+Intros A H'0 H'1 x H'2 H'3.
+Rewrite (Union_commutative U (Add U A x) Y).
+Rewrite <- (Union_add U Y A x).
+Rewrite (Union_commutative U Y A); Auto with sets.
+Qed.
+
+Lemma Finite_downward_closed:
+  (A: (Ensemble U)) (Finite U A) ->
+   (X: (Ensemble U)) (Included U X A) -> (Finite U X).
+Proof.
+Intros A H'; Elim H'; Auto with sets.
+Intros X H'0.
+Rewrite (less_than_empty U X H'0); Auto with sets.
+Intros; Elim Included_Add with U X A0 x; Auto with sets.
+NewDestruct 1 as [A' [H5 H6]].
+Rewrite H5; Auto with sets.
+Qed.
+
+Lemma Intersection_preserves_finite:
+  (A: (Ensemble U)) (Finite U A) ->
+   (X: (Ensemble U)) (Finite U (Intersection U X A)).
+Proof.
+Intros A H' X; Apply Finite_downward_closed with A; Auto with sets.
+Qed.
+
+Lemma cardinalO_empty:
+  (X: (Ensemble U)) (cardinal U X O) -> X == (Empty_set U).
+Proof.
+Intros X H; Apply (cardinal_invert U X O); Trivial with sets.
+Qed.
+Hints Resolve cardinalO_empty.
+
+Lemma inh_card_gt_O:
+  (X: (Ensemble U)) (Inhabited U X) -> (n: nat) (cardinal U X n) -> (gt n O).
+Proof.
+NewInduction 1 as [x H'].
+Intros n H'0.
+Elim (gt_O_eq n); Auto with sets.
+Intro H'1; Generalize H'; Generalize H'0.
+Rewrite <- H'1; Intro H'2.
+Rewrite (cardinalO_empty X); Auto with sets.
+Intro H'3; Elim H'3.
+Qed.
+
+Lemma card_soustr_1:
+  (X: (Ensemble U)) (n: nat) (cardinal U X n) ->
+   (x: U) (In U X x) -> (cardinal U (Subtract U X x) (pred n)).
+Proof.
+Intros X n H'; Elim H'.
+Intros x H'0; Elim H'0.
+Clear H' n X.
+Intros X n H' H'0 x H'1 x0 H'2.
+Elim (classic (In U X x0)).
+Intro H'4; Rewrite (add_soustr_xy U X x x0).
+Elim (classic x == x0).
+Intro H'5.
+Absurd (In U X x0); Auto with sets.
+Rewrite <- H'5; Auto with sets.
+Intro H'3; Try Assumption.
+Cut (S (pred n)) = (pred (S n)).
+Intro H'5; Rewrite <- H'5.
+Apply card_add; Auto with sets.
+Red; Intro H'6; Elim H'6.
+Intros H'7 H'8; Try Assumption.
+Elim H'1; Auto with sets.
+Unfold 2 pred; Symmetry.
+Apply S_pred with m := O.
+Change (gt n O).
+Apply inh_card_gt_O with X := X; Auto with sets.
+Apply Inhabited_intro with x := x0; Auto with sets.
+Red; Intro H'3.
+Apply H'1.
+Elim H'3; Auto with sets.
+Rewrite H'3; Auto with sets.
+Elim (classic x == x0).
+Intro H'3; Rewrite <- H'3.
+Cut (Subtract U (Add U X x) x) == X; Auto with sets.
+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; Intro H'5; Try Exact H'5.
+LApply (Add_inv U X x x0); Tauto.
+Qed.
+
+Lemma cardinal_is_functional:
+  (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
+   (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> X == Y ->
+    c1 = c2.
+Proof.
+Intros X c1 H'; Elim H'.
+Intros Y c2 H'0; Elim H'0; Auto with sets.
+Intros A n H'1 H'2 x H'3 H'5.
+Elim (not_Empty_Add U A x); Auto with sets.
+Clear H' c1 X.
+Intros X n H' H'0 x H'1 Y c2 H'2.
+Elim H'2.
+Intro H'3.
+Elim (not_Empty_Add U X x); Auto with sets.
+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.
+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.
+Apply H'0 with Y := X0; Auto with sets.
+Apply Simplify_add with x := x; Auto with sets.
+Pattern 2 x; 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; Intro H'.
+LApply (Extension U (Add U X x) (Add U X0 x0)); Auto with sets.
+Clear H'.
+Intro H'; Red in H'.
+Elim H'; Intros H'0 H'1; Red in H'0; Clear H' H'1.
+Absurd (In U (Add U X0 x0) x); Auto with sets.
+LApply (Add_inv U X0 x0 x); [ Intuition | Apply (H'0 x); Apply Add_intro2 ].
+Qed.
+
+Lemma cardinal_Empty : (m:nat)(cardinal U (Empty_set U) m) -> O = m.
+Proof.
+Intros m Cm; Generalize (cardinal_invert U (Empty_set U) m Cm).
+Elim m; Auto with sets.
+Intros; Elim H0; Intros; Elim H1; Intros; Elim H2; Intros.
+Elim (not_Empty_Add U x x0 H3).
+Qed.
+
+Lemma cardinal_unicity :
+  (X: (Ensemble U)) (n: nat) (cardinal U X n) -> 
+                    (m: nat) (cardinal U X m) -> n = m.
+Proof.
+Intros; Apply cardinal_is_functional with X X; Auto with sets.
+Qed.
+
+Lemma card_Add_gen:
+  (A: (Ensemble U))
+  (x: U) (n, n': nat) (cardinal U A n) -> (cardinal U (Add U A x) n') ->
+   (le n' (S n)).
+Proof.
+Intros A x n n' H'.
+Elim (classic (In U A x)).
+Intro H'0.
+Rewrite (Non_disjoint_union U A x H'0).
+Intro H'1; Cut n = n'.
+Intro E; Rewrite E; Auto with sets.
+Apply cardinal_unicity with A; Auto with sets.
+Intros H'0 H'1.
+Cut n'=(S n).
+Intro E; Rewrite E; Auto with sets.
+Apply cardinal_unicity with (Add U A x); Auto with sets.
+Qed.
+
+Lemma incl_st_card_lt:
+  (X: (Ensemble U)) (c1: nat) (cardinal U X c1) ->
+  (Y: (Ensemble U)) (c2: nat) (cardinal U Y c2) -> (Strict_Included U X Y) ->
+    (gt c2 c1).
+Proof.
+Intros X c1 H'; Elim H'.
+Intros Y c2 H'0; Elim H'0; Auto with sets arith.
+Intro H'1.
+Elim (Strict_Included_strict U (Empty_set U)); Auto with sets arith.
+Clear H' c1 X.
+Intros X n H' H'0 x H'1 Y c2 H'2.
+Elim H'2.
+Intro H'3; Elim (not_SIncl_empty U (Add U X x)); Auto with sets arith.
+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 gt_n_S.
+Apply H'0 with Y := (Subtract U (Add U X0 x0) x).
+ElimType (pred (S c2)) = c2; Auto with sets arith.
+Apply card_soustr_1; Auto with sets arith.
+Apply incl_st_add_soustr; Auto with sets arith.
+Elim (classic x == x0).
+Intros H'6 H'7; Apply gt_n_S.
+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 1 x0; 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.
+Generalize (H'8 x).
+Intro H'5; LApply H'5; Auto with sets arith.
+Intro H; Elim Add_inv with U X0 x0 x; Auto with sets arith.
+Intro; Absurd (In U X0 x); Auto with sets arith.
+Intro; Absurd x==x0; Auto with sets arith.
+Qed.
+
+Lemma incl_card_le:
+  (X,Y: (Ensemble U)) (n,m: nat) (cardinal U X n) -> (cardinal U Y m) -> 
+  (Included U X Y) -> (le n m).
+Proof.
+Intros;
+Elim Included_Strict_Included with U X Y; Auto with sets arith; Intro.
+Cut (gt m n); Auto with sets arith.
+Apply incl_st_card_lt with X := X Y := Y; Auto with sets arith.
+Generalize H0; Rewrite <- H2; Intro.
+Cut n=m.
+Intro E; Rewrite E; Auto with sets arith.
+Apply cardinal_unicity with X; Auto with sets arith.
+Qed.
+
+Lemma G_aux:
+  (P:(Ensemble U) ->Prop)
+  ((X:(Ensemble U))
+   (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
+  (P (Empty_set U)).
+Proof.
+Intros P H'; Try Assumption.
+Apply H'; Auto with sets.
+Clear H'; Auto with sets.
+Intros Y H'; Try Assumption.
+Red in H'.
+Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
+LApply (less_than_empty U Y); [Intro H'3; Try Exact H'3 | Assumption].
+Elim H'1; Auto with sets.
+Qed.
+
+Hints Unfold  not.
+
+Lemma Generalized_induction_on_finite_sets:
+  (P:(Ensemble U) ->Prop)
+  ((X:(Ensemble U))
+   (Finite U X) -> ((Y:(Ensemble U)) (Strict_Included U Y X) ->(P Y)) ->(P X)) ->
+  (X:(Ensemble U)) (Finite U X) ->(P X).
+Proof.
+Intros P H'0 X H'1.
+Generalize P H'0; Clear H'0 P.
+Elim H'1.
+Intros P H'0.
+Apply G_aux; Auto with sets.
+Clear H'1 X.
+Intros A H' H'0 x H'1 P H'3.
+Cut (Y:(Ensemble U)) (Included U Y (Add U A x)) ->(P Y); Auto with sets.
+Generalize H'1.
+Apply H'0.
+Intros X K H'5 L Y H'6; Apply H'3; Auto with sets.
+Apply Finite_downward_closed with A := (Add U X x); Auto with sets.
+Intros Y0 H'7.
+Elim (Strict_inclusion_is_transitive_with_inclusion U Y0 Y (Add U X x)); Auto with sets.
+Intros H'2 H'4.
+Elim (Included_Add U Y0 X x);
+ [Intro H'14 |
+   Intro H'14; Elim H'14; Intros A' E; Elim E; Intros H'15 H'16; Clear E H'14 |
+   Idtac]; Auto with sets.
+Elim (Included_Strict_Included U Y0 X); Auto with sets.
+Intro H'9; Apply H'5 with Y := Y0; Auto with sets.
+Intro H'9; Rewrite H'9.
+Apply H'3; Auto with sets.
+Intros Y1 H'8; Elim H'8.
+Intros H'10 H'11; Apply H'5 with Y := Y1; Auto with sets.
+Elim (Included_Strict_Included U A' X); Auto with sets.
+Intro H'8; Apply H'5 with Y := A'; Auto with sets.
+Rewrite <- H'15; Auto with sets.
+Intro H'8.
+Elim H'7.
+Intros H'9 H'10; Apply H'10 Orelse Elim H'10; Try Assumption.
+Generalize H'6.
+Rewrite <- H'8.
+Rewrite <- H'15; Auto with sets.
+Qed.
+
+End Finite_sets_facts.
diff --git a/theories7/Sets/Image.v b/theories7/Sets/Image.v
new file mode 100755
index 00000000..0794a3bb
--- /dev/null
+++ b/theories7/Sets/Image.v
@@ -0,0 +1,199 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Image.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Finite_sets.
+Require Export Constructive_sets.
+Require Export Classical_Type.
+Require Export Classical_sets.
+Require Export Powerset.
+Require Export Powerset_facts.
+Require Export Powerset_Classical_facts.
+Require Export Gt.
+Require Export Lt.
+Require Export Le.
+Require Export Finite_sets_facts.
+
+Section Image.
+Variables U, V: Type.
+
+Inductive Im [X:(Ensemble U); f:U -> V]: (Ensemble V) :=
+      Im_intro: (x: U) (In ? X x) -> (y: V) y == (f x) -> (In ? (Im X f) y).
+
+Lemma Im_def:
+  (X: (Ensemble U)) (f: U -> V) (x: U) (In ? X x) -> (In ? (Im X f) (f x)).
+Proof.
+Intros X f x H'; Try Assumption.
+Apply Im_intro with x := x; Auto with sets.
+Qed.
+Hints Resolve Im_def.
+
+Lemma Im_add:
+  (X: (Ensemble U)) (x: U) (f: U -> V)
+      (Im (Add ? X x) f) == (Add ? (Im X f) (f x)).
+Proof.
+Intros X x f.
+Apply Extensionality_Ensembles.
+Split; Red; Intros x0 H'.
+Elim H'; Intros.
+Rewrite H0.
+Elim Add_inv with U X x x1; Auto with sets.
+NewDestruct 1; Auto with sets.
+Elim Add_inv with V (Im X f) (f x) x0; Auto with sets.
+NewDestruct 1 as [x0 H y H0].
+Rewrite H0; Auto with sets.
+NewDestruct 1; Auto with sets.
+Qed.
+
+Lemma image_empty: (f: U -> V) (Im (Empty_set U) f) == (Empty_set V).
+Proof.
+Intro f; Try Assumption.
+Apply Extensionality_Ensembles.
+Split; Auto with sets.
+Red.
+Intros x H'; Elim H'.
+Intros x0 H'0; Elim H'0; Auto with sets.
+Qed.
+Hints Resolve image_empty.
+
+Lemma finite_image:
+  (X: (Ensemble U)) (f: U -> V) (Finite ? X) -> (Finite ? (Im X f)).
+Proof.
+Intros X f H'; Elim H'.
+Rewrite (image_empty f); Auto with sets.
+Intros A H'0 H'1 x H'2; Clear H' X.
+Rewrite (Im_add A x f); Auto with sets.
+Apply Add_preserves_Finite; Auto with sets.
+Qed.
+Hints Resolve finite_image.
+
+Lemma Im_inv:
+  (X: (Ensemble U)) (f: U -> V) (y: V) (In ? (Im X f) y) ->
+   (exT ? [x: U] (In ? X x) /\ (f x) == y).
+Proof.
+Intros X f y H'; Elim H'.
+Intros x H'0 y0 H'1; Rewrite H'1.
+Exists x; Auto with sets.
+Qed.
+
+Definition injective :=  [f: U -> V] (x, y: U) (f x) == (f y) -> x == y.
+
+Lemma not_injective_elim:
+  (f: U -> V) ~ (injective f) ->
+   (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
+Proof.
+Unfold injective; Intros f H.
+Cut (EXT x | ~ ((y: U) (f x) == (f y) -> x == y)).
+2: Apply not_all_ex_not with P:=[x:U](y: U) (f x) == (f y) -> x == y; 
+   Trivial with sets.
+NewDestruct 1 as [x C]; Exists x.
+Cut (EXT y | ~((f x)==(f y)->x==y)).
+2: Apply not_all_ex_not with P:=[y:U](f x)==(f y)->x==y; Trivial with sets.
+NewDestruct 1 as [y D]; Exists y.
+Apply imply_to_and; Trivial with sets.
+Qed.
+
+Lemma cardinal_Im_intro:
+  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
+   (EX p: nat | (cardinal ? (Im A f) p)).
+Proof.
+Intros.
+Apply finite_cardinal; Apply finite_image.
+Apply cardinal_finite with n; Trivial with sets.
+Qed.
+
+Lemma In_Image_elim:
+  (A: (Ensemble U)) (f: U -> V) (injective f) ->
+   (x: U) (In ? (Im A f) (f x)) -> (In ? A x).
+Proof.
+Intros.
+Elim Im_inv with A f (f x); Trivial with sets.
+Intros z C; Elim C; Intros InAz E.
+Elim (H z x E); Trivial with sets.
+Qed.
+
+Lemma injective_preserves_cardinal:
+  (A: (Ensemble U)) (f: U -> V) (n: nat) (injective f) -> (cardinal ? A n) ->
+   (n': nat) (cardinal ? (Im A f) n') -> n' = n.
+Proof.
+NewInduction 2 as [|A n H'0 H'1 x H'2]; Auto with sets.
+Rewrite (image_empty f).
+Intros n' CE.
+Apply cardinal_unicity with V (Empty_set V); Auto with sets.
+Intro n'.
+Rewrite (Im_add A x f).
+Intro H'3.
+Elim cardinal_Im_intro with A f n; Trivial with sets.
+Intros i CI.
+LApply (H'1 i); Trivial with sets.
+Cut ~ (In ? (Im A f) (f x)).
+Intros H0 H1.
+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; Intro; Apply H'2.
+Apply In_Image_elim with f; Trivial with sets.
+Qed.
+
+Lemma cardinal_decreases:
+  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
+   (n': nat) (cardinal V (Im A f) n') -> (le n' n).
+Proof.
+NewInduction 1 as [|A n H'0 H'1 x H'2]; Auto with sets.
+Rewrite (image_empty f); Intros.
+Cut n' = O.
+Intro E; Rewrite E; Trivial with sets.
+Apply cardinal_unicity with V (Empty_set V); Auto with sets.
+Intro n'.
+Rewrite (Im_add A x f).
+Elim cardinal_Im_intro with A f n; Trivial with sets.
+Intros p C H'3.
+Apply le_trans with (S p).
+Apply card_Add_gen with V (Im A f) (f x); Trivial with sets.
+Apply le_n_S; Auto with sets.
+Qed.
+
+Theorem Pigeonhole:
+  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal U A n) ->
+   (n': nat) (cardinal V (Im A f) n') -> (lt n' n) -> ~ (injective f).
+Proof.
+Unfold not; Intros A f n CAn n' CIfn' ltn'n I.
+Cut n' = n.
+Intro E; Generalize ltn'n; Rewrite E; Exact (lt_n_n n).
+Apply injective_preserves_cardinal with A := A f := f n := n; Trivial with sets.
+Qed.
+
+Lemma Pigeonhole_principle:
+  (A: (Ensemble U)) (f: U -> V) (n: nat) (cardinal ? A n) ->
+   (n': nat) (cardinal ? (Im A f) n') -> (lt n' n) ->
+    (EXT x | (EXT y | (f x) == (f y) /\ ~ x == y)).
+Proof.
+Intros; Apply not_injective_elim.
+Apply Pigeonhole with A n n'; Trivial with sets.
+Qed.
+End Image.
+Hints Resolve Im_def image_empty finite_image : sets v62.
diff --git a/theories7/Sets/Infinite_sets.v b/theories7/Sets/Infinite_sets.v
new file mode 100755
index 00000000..bf423753
--- /dev/null
+++ b/theories7/Sets/Infinite_sets.v
@@ -0,0 +1,232 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Infinite_sets.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Finite_sets.
+Require Export Constructive_sets.
+Require Export Classical_Type.
+Require Export Classical_sets.
+Require Export Powerset.
+Require Export Powerset_facts.
+Require Export Powerset_Classical_facts.
+Require Export Gt.
+Require Export Lt.
+Require Export Le.
+Require Export Finite_sets_facts.
+Require Export Image.
+
+Section Approx.
+Variable U: Type.
+
+Inductive Approximant [A, X:(Ensemble U)] : Prop :=
+  Defn_of_Approximant: (Finite U X) -> (Included U X A) -> (Approximant A X).
+End Approx.
+
+Hints Resolve Defn_of_Approximant.
+
+Section Infinite_sets.
+Variable U: Type.
+
+Lemma make_new_approximant:
+  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) -> (Approximant U A X) ->
+   (Inhabited U (Setminus U A X)).
+Proof.
+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; Intro H'3; Apply H'.
+Rewrite <- H'3; Auto with sets.
+Qed.
+
+Lemma approximants_grow:
+  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
+   (n: nat) (cardinal U X n) -> (Included U X A) ->
+    (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
+Proof.
+Intros A X H' n H'0; Elim H'0; Auto with sets.
+Intro H'1.
+Cut (Inhabited U (Setminus U A (Empty_set U))).
+Intro H'2; Elim H'2.
+Intros x H'3.
+Exists (Add U (Empty_set U) x); Auto with sets.
+Split.
+Apply card_add; Auto with sets.
+Cut (In U A x).
+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.
+Apply make_new_approximant; Auto with sets.
+Intros A0 n0 H'1 H'2 x H'3 H'5.
+LApply H'2; [Intro H'6; Elim H'6; Clear H'2 | Clear H'2]; Auto with sets.
+Intros x0 H'2; Try Assumption.
+Elim H'2; Intros H'7 H'8; Try Exact H'8; Clear H'2.
+Elim (make_new_approximant A x0); Auto with sets.
+Intros x1 H'2; Try Assumption.
+Exists (Add U x0 x1); Auto with sets.
+Split.
+Apply card_add; Auto with sets.
+Elim H'2; Auto with sets.
+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.
+Auto with sets.
+Apply Defn_of_Approximant; Auto with sets.
+Apply cardinal_finite with n := (S n0); Auto with sets.
+Qed.
+
+Lemma approximants_grow':
+  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
+   (n: nat) (cardinal U X n) -> (Approximant U A X) ->
+    (EXT Y | (cardinal U Y (S n)) /\ (Approximant U A Y)).
+Proof.
+Intros A X H' n H'0 H'1; Try Assumption.
+Elim H'1.
+Intros H'2 H'3.
+ElimType (EXT Y | (cardinal U Y (S n)) /\ (Included U Y A)).
+Intros x H'4; Elim H'4; Intros H'5 H'6; Try Exact H'5; Clear H'4.
+Exists x; Auto with sets.
+Split; [Auto with sets | Idtac].
+Apply Defn_of_Approximant; Auto with sets.
+Apply cardinal_finite with n := (S n); Auto with sets.
+Apply approximants_grow with X := X; Auto with sets.
+Qed.
+
+Lemma approximant_can_be_any_size:
+  (A: (Ensemble U)) (X: (Ensemble U)) ~ (Finite U A) ->
+   (n: nat) (EXT Y | (cardinal U Y n) /\ (Approximant U A Y)).
+Proof.
+Intros A H' H'0 n; Elim n.
+Exists (Empty_set U); Auto with sets.
+Intros n0 H'1; Elim H'1.
+Intros x H'2.
+Apply approximants_grow' with X := x; Tauto.
+Qed.
+
+Variable V: Type.
+
+Theorem Image_set_continuous:
+  (A: (Ensemble U))
+  (f: U -> V) (X: (Ensemble V)) (Finite V X) -> (Included V X (Im U V A f)) ->
+   (EX n |
+   (EXT Y | ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
+Proof.
+Intros A f X H'; Elim H'.
+Intro H'0; Exists O.
+Exists (Empty_set U); Auto with sets.
+Intros A0 H'0 H'1 x H'2 H'3; Try Assumption.
+LApply H'1;
+ [Intro H'4; Elim H'4; Intros n E; Elim E; Clear H'4 H'1 | Clear H'1]; Auto with sets.
+Intros x0 H'1; Try Assumption.
+Exists (S n); Try Assumption.
+Elim H'1; Intros H'4 H'5; Elim H'4; Intros H'6 H'7; Try Exact H'6; Clear H'4 H'1.
+Clear E.
+Generalize H'2.
+Rewrite <- H'5.
+Intro H'1; Try Assumption.
+Red in H'3.
+Generalize (H'3 x).
+Intro H'4; LApply H'4; [Intro H'8; Try Exact H'8; Clear H'4 | Clear H'4]; Auto with sets.
+Specialize 5 Im_inv with U := U V:=V X := A f := f y := x; Intro H'11; 
+ LApply H'11; [Intro H'13; Elim H'11; Clear H'11 | Clear H'11]; Auto with sets.
+Intros x1 H'4; Try Assumption.
+Apply exT_intro with x := (Add U x0 x1).
+Split; [Split; [Try Assumption | Idtac] | Idtac].
+Apply card_add; Auto with sets.
+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; 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.
+Apply Im_add; Auto with sets.
+Qed.
+
+Theorem Image_set_continuous':
+  (A: (Ensemble U))
+  (f: U -> V) (X: (Ensemble V)) (Approximant V (Im U V A f) X) ->
+   (EXT Y | (Approximant U A Y) /\ (Im U V Y f) == X).
+Proof.
+Intros A f X H'; Try Assumption.
+Cut (EX n | (EXT Y |
+    ((cardinal U Y n) /\ (Included U Y A)) /\ (Im U V Y f) == X)).
+Intro H'0; Elim H'0; Intros n E; Elim E; Clear H'0.
+Intros x H'0; Try Assumption.
+Elim H'0; Intros H'1 H'2; Elim H'1; Intros H'3 H'4; Try Exact H'3;
+ Clear H'1 H'0; Auto with sets.
+Exists x.
+Split; [Idtac | Try Assumption].
+Apply Defn_of_Approximant; Auto with sets.
+Apply cardinal_finite with n := n; Auto with sets.
+Apply Image_set_continuous; Auto with sets.
+Elim H'; Auto with sets.
+Elim H'; Auto with sets.
+Qed.
+
+Theorem Pigeonhole_bis:
+  (A: (Ensemble U)) (f: U -> V) ~ (Finite U A) -> (Finite V (Im U V A f)) ->
+   ~ (injective U V f).
+Proof.
+Intros A f H'0 H'1; Try Assumption.
+Elim (Image_set_continuous' A f (Im U V A f)); Auto with sets.
+Intros x H'2; Elim H'2; Intros H'3 H'4; Try Exact H'3; Clear H'2.
+Elim (make_new_approximant A x); Auto with sets.
+Intros x0 H'2; Elim H'2.
+Intros H'5 H'6.
+Elim (finite_cardinal V (Im U V A f)); Auto with sets.
+Intros n E.
+Elim (finite_cardinal U x); Auto with sets.
+Intros n0 E0.
+Apply Pigeonhole with A := (Add U x x0) n := (S n0) n' := n.
+Apply card_add; Auto with sets.
+Rewrite (Im_add U V x x0 f); Auto with sets.
+Cut (In V (Im U V x f) (f x0)).
+Intro H'8.
+Rewrite (Non_disjoint_union V (Im U V x f) (f x0)); Auto with sets.
+Rewrite H'4; Auto with sets.
+Elim (Extension V (Im U V x f) (Im U V A f)); Auto with sets.
+Apply le_lt_n_Sm.
+Apply cardinal_decreases with U := U V := V A := x f := f; Auto with sets.
+Rewrite H'4; Auto with sets.
+Elim H'3; Auto with sets.
+Qed.
+
+Theorem Pigeonhole_ter:
+  (A: (Ensemble U))
+  (f: U -> V) (n: nat) (injective U V f) -> (Finite V (Im U V A f)) ->
+   (Finite U A).
+Proof.
+Intros A f H' H'0 H'1.
+Apply NNPP.
+Red; Intro H'2.
+Elim (Pigeonhole_bis A f); Auto with sets.
+Qed.
+
+End Infinite_sets.
diff --git a/theories7/Sets/Integers.v b/theories7/Sets/Integers.v
new file mode 100755
index 00000000..7dee371f
--- /dev/null
+++ b/theories7/Sets/Integers.v
@@ -0,0 +1,166 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Integers.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Finite_sets.
+Require Export Constructive_sets.
+Require Export Classical_Type.
+Require Export Classical_sets.
+Require Export Powerset.
+Require Export Powerset_facts.
+Require Export Powerset_Classical_facts.
+Require Export Gt.
+Require Export Lt.
+Require Export Le.
+Require Export Finite_sets_facts.
+Require Export Image.
+Require Export Infinite_sets.
+Require Export Compare_dec.
+Require Export Relations_1.
+Require Export Partial_Order.
+Require Export Cpo.
+
+Section Integers_sect.
+
+Inductive Integers : (Ensemble nat) :=
+      Integers_defn: (x: nat) (In nat Integers x).
+Hints Resolve Integers_defn.
+
+Lemma le_reflexive: (Reflexive nat le).
+Proof.
+Red; Auto with arith.
+Qed.
+
+Lemma le_antisym: (Antisymmetric nat le).
+Proof.
+Red; Intros x y H H';Rewrite (le_antisym x y);Auto.
+Qed.
+
+Lemma le_trans: (Transitive nat le).
+Proof.
+Red; Intros; Apply le_trans with y;Auto.
+Qed.
+Hints Resolve le_reflexive le_antisym le_trans.
+
+Lemma le_Order: (Order nat le).
+Proof.
+Auto with sets arith.
+Qed.
+Hints Resolve le_Order.
+
+Lemma triv_nat: (n: nat) (In nat Integers n).
+Proof.
+Auto with sets arith.
+Qed.
+Hints Resolve triv_nat.
+
+Definition nat_po: (PO nat).
+Apply Definition_of_PO with Carrier_of := Integers Rel_of := le; Auto with sets arith.
+Apply Inhabited_intro with x := O; Auto with sets arith.
+Defined.
+Hints Unfold nat_po.
+
+Lemma le_total_order: (Totally_ordered nat nat_po Integers).
+Proof.
+Apply Totally_ordered_definition.
+Simpl.
+Intros H' x y H'0.
+Specialize 2 le_or_lt with n := x m := y; Intro H'2; Elim H'2.
+Intro H'1; Left; Auto with sets arith.
+Intro H'1; Right.
+Cut (le y x); Auto with sets arith.
+Qed.
+Hints Resolve le_total_order.
+
+Lemma Finite_subset_has_lub:
+  (X: (Ensemble nat)) (Finite nat X) ->
+   (EXT m: nat | (Upper_Bound nat nat_po X m)).
+Proof.
+Intros X H'; Elim H'.
+Exists O.
+Apply Upper_Bound_definition; Auto with sets arith.
+Intros y H'0; Elim H'0; Auto with sets arith.
+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.
+Intro H'1; Try Assumption.
+LApply H'1; [Intro H'4; Idtac | Try Assumption]; Auto with sets arith.
+Generalize (H'4 x0 x).
+Clear H'4.
+Clear H'1.
+Intro H'1; LApply H'1;
+ [Intro H'4; Elim H'4;
+   [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; Auto with sets arith; Simpl.
+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; Auto with sets arith.
+Elim H'3; Simpl; Auto with sets arith.
+Intros x1 H'4; Elim H'4; Auto with sets arith.
+Exists x0.
+Apply Upper_Bound_definition; Auto with sets arith; Simpl.
+Intros y H'1; Elim H'1.
+Intros x1 H'4; Try Assumption.
+Elim H'3; Simpl; Auto with sets arith.
+Intros x1 H'4; Elim H'4; Auto with sets arith.
+Red.
+Intros x1 H'1; Elim H'1; Auto with sets arith.
+Qed.
+
+Lemma Integers_has_no_ub: ~ (EXT m:nat | (Upper_Bound nat nat_po Integers m)).
+Proof.
+Red; Intro H'; Elim H'.
+Intros x H'0.
+Elim H'0; Intros H'1 H'2.
+Cut (In nat Integers (S x)).
+Intro H'3.
+Specialize 1 H'2 with y := (S x); Intro H'4; LApply H'4;
+ [Intro H'5; Clear H'4 | Try Assumption; Clear H'4].
+Simpl in H'5.
+Absurd (le (S x) x); Auto with arith.
+Auto with sets arith.
+Qed.
+
+Lemma Integers_infinite: ~ (Finite nat Integers).
+Proof.
+Generalize Integers_has_no_ub.
+Intro H'; Red; Intro H'0; Try Exact H'0.
+Apply H'.
+Apply Finite_subset_has_lub; Auto with sets arith.
+Qed.
+
+End Integers_sect.
+
+
+
+
+
diff --git a/theories7/Sets/Multiset.v b/theories7/Sets/Multiset.v
new file mode 100755
index 00000000..b5d5edf7
--- /dev/null
+++ b/theories7/Sets/Multiset.v
@@ -0,0 +1,186 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Multiset.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+(* G. Huet 1-9-95 *)
+
+Require Permut.
+
+Set Implicit Arguments.
+
+Section multiset_defs.
+
+Variable A : Set.
+Variable eqA : A -> A -> Prop.
+Hypothesis Aeq_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+
+Inductive multiset : Set := 
+      Bag : (A->nat) -> multiset.
+
+Definition EmptyBag := (Bag [a:A]O).
+Definition SingletonBag := [a:A]
+	(Bag [a':A]Cases (Aeq_dec a a') of
+                      (left _) => (S O) 
+	           | (right _) => O 
+                   end
+	).
+
+Definition multiplicity : multiset -> A -> nat :=
+  [m:multiset][a:A]let (f) = m in (f a).
+
+(** multiset equality *)
+Definition meq := [m1,m2:multiset]
+    (a:A)(multiplicity m1 a)=(multiplicity m2 a).
+
+Hints Unfold  meq multiplicity.
+
+Lemma meq_refl : (x:multiset)(meq x x).
+Proof.
+NewDestruct x; Auto.
+Qed.
+Hints Resolve meq_refl.
+
+Lemma meq_trans : (x,y,z:multiset)(meq x y)->(meq y z)->(meq x z).
+Proof.
+Unfold meq.
+NewDestruct x; NewDestruct y; NewDestruct z.
+Intros; Rewrite H; Auto.
+Qed.
+
+Lemma meq_sym : (x,y:multiset)(meq x y)->(meq y x).
+Proof.
+Unfold meq.
+NewDestruct x; NewDestruct y; Auto.
+Qed.
+Hints Immediate meq_sym.
+
+(** multiset union *)
+Definition munion := [m1,m2:multiset]
+    (Bag [a:A](plus (multiplicity m1 a)(multiplicity m2 a))).
+
+Lemma munion_empty_left :
+     (x:multiset)(meq x (munion EmptyBag x)).
+Proof.
+Unfold meq; Unfold munion; Simpl; Auto.
+Qed.
+Hints Resolve munion_empty_left.
+
+Lemma munion_empty_right :
+     (x:multiset)(meq x (munion x EmptyBag)).
+Proof.
+Unfold meq; Unfold munion; Simpl; Auto.
+Qed.
+
+
+Require Plus. (* comm. and ass. of plus *)
+
+Lemma munion_comm : (x,y:multiset)(meq (munion x y) (munion y x)).
+Proof.
+Unfold meq; Unfold multiplicity; Unfold munion.
+NewDestruct x; NewDestruct y; Auto with arith.
+Qed.
+Hints Resolve munion_comm.
+
+Lemma munion_ass : 
+      (x,y,z:multiset)(meq (munion (munion x y) z) (munion x (munion y z))).
+Proof.
+Unfold meq; Unfold munion; Unfold multiplicity.
+NewDestruct x; NewDestruct y; NewDestruct z; Auto with arith.
+Qed.
+Hints Resolve munion_ass.
+
+Lemma meq_left :  (x,y,z:multiset)(meq x y)->(meq (munion x z) (munion y z)).
+Proof.
+Unfold meq; Unfold munion; Unfold multiplicity.
+NewDestruct x; NewDestruct y; NewDestruct z.
+Intros; Elim H; Auto with arith.
+Qed.
+Hints Resolve meq_left.
+
+Lemma meq_right : (x,y,z:multiset)(meq x y)->(meq (munion z x) (munion z y)).
+Proof.
+Unfold meq; Unfold munion; Unfold multiplicity.
+NewDestruct x; NewDestruct y; NewDestruct z.
+Intros; Elim H; Auto.
+Qed.
+Hints Resolve meq_right.
+
+
+(** Here we should make multiset an abstract datatype, by hiding [Bag],
+    [munion], [multiplicity]; all further properties are proved abstractly *)
+
+Lemma munion_rotate :
+   (x,y,z:multiset)(meq (munion x (munion y z)) (munion z (munion x y))).
+Proof.
+Intros; Apply (op_rotate multiset munion meq); Auto.
+Exact meq_trans.
+Qed.
+
+Lemma meq_congr : (x,y,z,t:multiset)(meq x y)->(meq z t)->
+                  (meq (munion x z) (munion y t)).
+Proof.
+Intros; Apply (cong_congr multiset munion meq); Auto.
+Exact meq_trans.
+Qed.
+
+Lemma munion_perm_left :
+   (x,y,z:multiset)(meq (munion x (munion y z)) (munion y (munion x z))).
+Proof.
+Intros; Apply (perm_left multiset munion meq); Auto.
+Exact meq_trans.
+Qed.
+
+Lemma multiset_twist1 : (x,y,z,t:multiset)
+   (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x t)) z)).
+Proof.
+Intros; Apply (twist multiset munion meq); Auto.
+Exact meq_trans.
+Qed.
+
+Lemma multiset_twist2 : (x,y,z,t:multiset)
+   (meq (munion x (munion (munion y z) t)) (munion (munion y (munion x z)) t)).
+Proof.
+Intros; Apply meq_trans with (munion (munion x (munion y z)) t).
+Apply meq_sym; Apply munion_ass.
+Apply meq_left; Apply munion_perm_left.
+Qed.
+
+(** specific for treesort *)
+
+Lemma treesort_twist1 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
+   (meq (munion x (munion u t)) (munion (munion y (munion x t)) z)).
+Proof.
+Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
+Apply meq_right; Apply meq_left; Trivial.
+Apply multiset_twist1.
+Qed.
+
+Lemma treesort_twist2 : (x,y,z,t,u:multiset) (meq u (munion y z)) ->
+   (meq (munion x (munion u t)) (munion (munion y (munion x z)) t)).
+Proof.
+Intros; Apply meq_trans with (munion x (munion (munion y z) t)).
+Apply meq_right; Apply meq_left; Trivial.
+Apply multiset_twist2.
+Qed.
+
+
+(*i theory of minter to do similarly 
+Require Min.
+(* multiset intersection *)
+Definition minter := [m1,m2:multiset]
+    (Bag [a:A](min (multiplicity m1 a)(multiplicity m2 a))).
+i*)
+
+End multiset_defs.
+
+Unset Implicit Arguments.
+
+Hints Unfold meq multiplicity : v62 datatypes.
+Hints Resolve munion_empty_right munion_comm munion_ass meq_left meq_right munion_empty_left : v62 datatypes.
+Hints Immediate meq_sym : v62 datatypes.
diff --git a/theories7/Sets/Partial_Order.v b/theories7/Sets/Partial_Order.v
new file mode 100755
index 00000000..759cf4e2
--- /dev/null
+++ b/theories7/Sets/Partial_Order.v
@@ -0,0 +1,100 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Partial_Order.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Relations_1.
+
+Section Partial_orders.
+Variable U: Type.
+
+Definition Carrier :=  (Ensemble U).
+
+Definition Rel :=  (Relation U).
+
+Record PO : Type := Definition_of_PO {
+   Carrier_of: (Ensemble U);
+   Rel_of: (Relation U);
+   PO_cond1: (Inhabited U Carrier_of);
+   PO_cond2: (Order U Rel_of) }.
+Variable p: PO.
+
+Definition Strict_Rel_of : Rel :=  [x, y: U] (Rel_of p x y) /\ ~ x == y.
+
+Inductive covers [y, x:U]: Prop :=
+      Definition_of_covers:
+      (Strict_Rel_of x y) -> 
+          ~ (EXT z | (Strict_Rel_of x z) /\ (Strict_Rel_of z y)) -> 
+          (covers y x).
+
+End Partial_orders.
+
+Hints Unfold Carrier_of Rel_of  Strict_Rel_of : sets v62.
+Hints Resolve Definition_of_covers : sets v62.
+
+
+Section Partial_order_facts.
+Variable U:Type.
+Variable D:(PO U).
+
+Lemma Strict_Rel_Transitive_with_Rel:
+  (x:U) (y:U) (z:U) (Strict_Rel_of U D x y) -> (Rel_of U D y z) ->
+  (Strict_Rel_of U D x z).
+Unfold 1 Strict_Rel_of.
+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; 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.
+Qed.
+
+Lemma Strict_Rel_Transitive_with_Rel_left:
+  (x:U) (y:U) (z:U) (Rel_of U D x y) -> (Strict_Rel_of U D y z) ->
+  (Strict_Rel_of U D x z).
+Unfold 1 Strict_Rel_of.
+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; 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.
+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.
diff --git a/theories7/Sets/Permut.v b/theories7/Sets/Permut.v
new file mode 100755
index 00000000..2d0413a8
--- /dev/null
+++ b/theories7/Sets/Permut.v
@@ -0,0 +1,91 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Permut.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+(* G. Huet 1-9-95 *)
+
+(** We consider a Set [U], given with a commutative-associative operator [op],
+    and a congruence [cong]; we show permutation lemmas *)
+
+Section Axiomatisation.
+
+Variable U: Set.
+
+Variable op: U -> U -> U.
+
+Variable cong : U -> U -> Prop.
+
+Hypothesis op_comm : (x,y:U)(cong (op x y) (op y x)).
+Hypothesis op_ass  : (x,y,z:U)(cong (op (op x y) z) (op x (op y z))).
+
+Hypothesis cong_left :  (x,y,z:U)(cong x y)->(cong (op x z) (op y z)).
+Hypothesis cong_right : (x,y,z:U)(cong x y)->(cong (op z x) (op z y)).
+Hypothesis cong_trans : (x,y,z:U)(cong x y)->(cong y z)->(cong x z).
+Hypothesis cong_sym : (x,y:U)(cong x y)->(cong y x).
+
+(** Remark. we do not need: [Hypothesis cong_refl : (x:U)(cong x x)]. *)
+
+Lemma cong_congr :
+ (x,y,z,t:U)(cong x y)->(cong z t)->(cong (op x z) (op y t)).
+Proof.
+Intros; Apply cong_trans with (op y z).
+Apply cong_left; Trivial.
+Apply cong_right; Trivial.
+Qed.
+
+Lemma comm_right : (x,y,z:U)(cong (op x (op y z)) (op x (op z y))).
+Proof.
+Intros; Apply cong_right; Apply op_comm.
+Qed.
+
+Lemma comm_left : (x,y,z:U)(cong (op (op x y) z) (op (op y x) z)).
+Proof.
+Intros; Apply cong_left; Apply op_comm.
+Qed.
+
+Lemma perm_right : (x,y,z:U)(cong (op (op x y) z) (op (op x z) y)).
+Proof.
+Intros.
+Apply cong_trans with (op x (op y z)).
+Apply op_ass.
+Apply cong_trans with (op x (op z y)). 
+Apply cong_right; Apply op_comm.
+Apply cong_sym; Apply op_ass.
+Qed.
+
+Lemma perm_left : (x,y,z:U)(cong (op x (op y z)) (op y (op x z))).
+Proof.
+Intros.
+Apply cong_trans with (op (op x y) z).
+Apply cong_sym; Apply op_ass.
+Apply cong_trans with (op (op y x) z).
+Apply cong_left; Apply op_comm.
+Apply op_ass.
+Qed.
+
+Lemma op_rotate : (x,y,z,t:U)(cong (op x (op y z)) (op z (op x y))).
+Proof.
+Intros; Apply cong_trans with (op (op x y) z).
+Apply cong_sym; Apply op_ass.
+Apply op_comm.
+Qed.
+
+(* Needed for treesort ... *)
+Lemma twist : (x,y,z,t:U)
+   (cong (op x (op (op y z) t)) (op (op y (op x t)) z)).
+Proof.
+Intros.
+Apply cong_trans with (op x (op (op y t) z)).
+Apply cong_right; Apply perm_right.
+Apply cong_trans with (op (op x (op y t)) z).
+Apply cong_sym; Apply op_ass.
+Apply cong_left; Apply perm_left.
+Qed.
+
+End Axiomatisation.
diff --git a/theories7/Sets/Powerset.v b/theories7/Sets/Powerset.v
new file mode 100755
index 00000000..b1fa892c
--- /dev/null
+++ b/theories7/Sets/Powerset.v
@@ -0,0 +1,188 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Powerset.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Relations_1.
+Require Export Relations_1_facts.
+Require Export Partial_Order.
+Require Export Cpo.
+
+Section The_power_set_partial_order.
+Variable U: Type.
+
+Inductive Power_set [A:(Ensemble U)]: (Ensemble (Ensemble U)) :=
+    Definition_of_Power_set:
+     (X: (Ensemble U)) (Included U X A) -> (In (Ensemble U) (Power_set A) X).
+Hints Resolve Definition_of_Power_set.
+
+Theorem Empty_set_minimal: (X: (Ensemble U)) (Included U (Empty_set U) X).
+Intro X; Red.
+Intros x H'; Elim H'.
+Qed.
+Hints Resolve Empty_set_minimal.
+
+Theorem Power_set_Inhabited:
+  (X: (Ensemble U)) (Inhabited (Ensemble U) (Power_set X)).
+Intro X.
+Apply Inhabited_intro with (Empty_set U); Auto with sets.
+Qed.
+Hints Resolve Power_set_Inhabited.
+
+Theorem Inclusion_is_an_order: (Order (Ensemble U) (Included U)).
+Auto 6 with sets.
+Qed.
+Hints Resolve Inclusion_is_an_order.
+
+Theorem Inclusion_is_transitive: (Transitive (Ensemble U) (Included U)).
+Elim Inclusion_is_an_order; Auto with sets.
+Qed.
+Hints Resolve Inclusion_is_transitive.
+
+Definition Power_set_PO: (Ensemble U) -> (PO (Ensemble U)).
+Intro A; Try Assumption.
+Apply Definition_of_PO with (Power_set A) (Included U); Auto with sets.
+Defined.
+Hints Unfold  Power_set_PO.
+
+Theorem Strict_Rel_is_Strict_Included:
+  (same_relation
+     (Ensemble U) (Strict_Included U)
+     (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U)))).
+Auto with sets.
+Qed.
+Hints Resolve Strict_Rel_Transitive Strict_Rel_is_Strict_Included.
+
+Lemma Strict_inclusion_is_transitive_with_inclusion:
+  (x, y, z:(Ensemble U)) (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.
+Intros H'1 H'2; Try Assumption.
+Apply H'1.
+Apply Strict_Rel_Transitive_with_Rel with y := y; Auto with sets.
+Qed.
+
+Lemma Strict_inclusion_is_transitive_with_inclusion_left:
+  (x, y, z:(Ensemble U)) (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.
+Intros H'1 H'2; Try Assumption.
+Apply H'1.
+Apply Strict_Rel_Transitive_with_Rel_left with y := y; Auto with sets.
+Qed.
+
+Lemma Strict_inclusion_is_transitive:
+  (Transitive (Ensemble U) (Strict_Included U)).
+Apply cong_transitive_same_relation
+     with R := (Strict_Rel_of (Ensemble U) (Power_set_PO (Full_set U))); Auto with sets.
+Qed.
+
+Theorem Empty_set_is_Bottom:
+  (A: (Ensemble U)) (Bottom (Ensemble U) (Power_set_PO A) (Empty_set U)).
+Intro A; Apply Bottom_definition; Simpl; Auto with sets.
+Qed.
+Hints Resolve Empty_set_is_Bottom.
+
+Theorem Union_minimal:
+  (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.
+Intros x H'1; Elim H'1; Auto with sets.
+Qed.
+Hints Resolve Union_minimal.
+
+Theorem Intersection_maximal:
+  (a, b, X: (Ensemble U)) (Included U X a) -> (Included U X b) ->
+   (Included U X (Intersection U a b)).
+Auto with sets.
+Qed.
+
+Theorem Union_increases_l: (a, b: (Ensemble U)) (Included U a (Union U a b)).
+Auto with sets.
+Qed.
+
+Theorem Union_increases_r: (a, b: (Ensemble U)) (Included U b (Union U a b)).
+Auto with sets.
+Qed.
+
+Theorem Intersection_decreases_l:
+  (a, b: (Ensemble U)) (Included U (Intersection U a b) a).
+Intros a b; Red.
+Intros x H'; Elim H'; Auto with sets.
+Qed.
+
+Theorem Intersection_decreases_r:
+  (a, b: (Ensemble U)) (Included U (Intersection U a b) b).
+Intros a b; Red.
+Intros x H'; Elim H'; Auto with sets.
+Qed.
+Hints Resolve Union_increases_l Union_increases_r Intersection_decreases_l
+     Intersection_decreases_r.
+
+Theorem Union_is_Lub:
+  (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (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.
+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; Auto with sets.
+Qed.
+
+Theorem Intersection_is_Glb:
+  (A: (Ensemble U)) (a, b: (Ensemble U)) (Included U a A) -> (Included U b A) ->
+   (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.
+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; Auto with sets.
+Qed.
+
+End The_power_set_partial_order.
+
+Hints Resolve Empty_set_minimal : sets v62.
+Hints Resolve Power_set_Inhabited : sets v62.
+Hints Resolve Inclusion_is_an_order : sets v62.
+Hints Resolve Inclusion_is_transitive : sets v62.
+Hints Resolve Union_minimal : sets v62.
+Hints Resolve Union_increases_l : sets v62.
+Hints Resolve Union_increases_r : sets v62.
+Hints Resolve Intersection_decreases_l : sets v62.
+Hints Resolve Intersection_decreases_r : sets v62.
+Hints Resolve Empty_set_is_Bottom : sets v62.
+Hints Resolve Strict_inclusion_is_transitive : sets v62.
diff --git a/theories7/Sets/Powerset_Classical_facts.v b/theories7/Sets/Powerset_Classical_facts.v
new file mode 100755
index 00000000..1a51c562
--- /dev/null
+++ b/theories7/Sets/Powerset_Classical_facts.v
@@ -0,0 +1,338 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Powerset_Classical_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Constructive_sets.
+Require Export Relations_1.
+Require Export Relations_1_facts.
+Require Export Partial_Order.
+Require Export Cpo.
+Require Export Powerset.
+Require Export Powerset_facts.
+Require Export Classical_Type.
+Require Export Classical_sets.
+
+Section Sets_as_an_algebra.
+
+Variable U: Type.
+
+Lemma sincl_add_x:
+  (A, B: (Ensemble U))
+  (x: U) ~ (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.
+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; Intro H'2.
+Elim H'0; Clear H'0.
+Rewrite <- H'2; Auto with sets.
+Qed.
+
+Lemma incl_soustr_in:
+  (X: (Ensemble U)) (x: U) (In U X x) -> (Included U (Subtract U X x) X).
+Proof.
+Intros X x H'; Red.
+Intros x0 H'0; Elim H'0; Auto with sets.
+Qed.
+Hints Resolve incl_soustr_in : sets v62.
+
+Lemma incl_soustr:
+  (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.
+Intros x0 H'0; Elim H'0.
+Intros H'1 H'2.
+Apply Subtract_intro; Auto with sets.
+Qed.
+Hints Resolve incl_soustr : sets v62.
+
+
+Lemma incl_soustr_add_l:
+  (X: (Ensemble U)) (x: U) (Included U (Subtract U (Add U X x) x) X).
+Proof.
+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.
+Qed.
+Hints Resolve incl_soustr_add_l : sets v62.
+
+Lemma incl_soustr_add_r:
+  (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.
+Intros x0 H'0; Try Assumption.
+Apply Subtract_intro; Auto with sets.
+Red; Intro H'1; Apply H'; Rewrite H'1; Auto with sets.
+Qed.
+Hints Resolve incl_soustr_add_r : sets v62.
+
+Lemma add_soustr_2:
+  (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.
+Intros x0 H'0; Try Assumption.
+Elim (classic x == x0); Intro K; Auto with sets.
+Elim K; Auto with sets.
+Qed.
+
+Lemma add_soustr_1:
+  (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.
+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.
+Rewrite <- (Singleton_inv U x t); Auto with sets.
+Qed.
+Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
+
+Lemma add_soustr_xy:
+  (X: (Ensemble U)) (x, y: U) ~ 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.
+Intros x0 H'0; Elim H'0; Auto with sets.
+Intro H'1; Elim H'1.
+Intros u H'2 H'3; Try Assumption.
+Apply Add_intro1.
+Apply Subtract_intro; Auto with sets.
+Intros t H'2 H'3; Try Assumption.
+Elim (Singleton_inv U x t); Auto with sets.
+Intros u H'2; Try Assumption.
+Elim (Add_inv U (Subtract U X y) x u); Auto with sets.
+Intro H'0; Elim H'0; Auto with sets.
+Intro H'0; Rewrite <- H'0; Auto with sets.
+Qed.
+Hints Resolve add_soustr_xy : sets v62.
+
+Lemma incl_st_add_soustr:
+  (X, Y: (Ensemble U)) (x: U) ~ (In U X x) -> 
+   (Strict_Included U (Add U X x) Y) ->
+   (Strict_Included U X (Subtract U Y x)).
+Proof.
+Intros X Y x H' H'0; Apply sincl_add_x with x := x; Auto with sets.
+Split.
+Elim H'0.
+Intros H'1 H'2.
+Generalize (Inclusion_is_transitive U).
+Intro H'4; Red in H'4.
+Apply H'4 with y := Y; Auto with sets.
+Red in H'0.
+Elim H'0; Intros H'1 H'2; Try Exact H'1; Clear H'0. (* PB *)
+Red; Intro H'0; Apply H'2.
+Rewrite H'0; Auto 8 with sets.
+Qed.
+
+Lemma Sub_Add_new:
+  (X: (Ensemble U)) (x: U) ~ (In U X x) -> X == (Subtract U (Add U X x) x).
+Proof.
+Auto with sets.
+Qed.
+
+Lemma Simplify_add:
+  (X, X0 : (Ensemble U)) (x: U)
+  ~ (In U X x) -> ~ (In U X0 x) ->  (Add U X x) == (Add U X0 x) -> X == X0.
+Proof.
+Intros X X0 x H' H'0 H'1; Try Assumption.
+Rewrite (Sub_Add_new X x); Auto with sets.
+Rewrite (Sub_Add_new X0 x); Auto with sets.
+Rewrite H'1; Auto with sets.
+Qed.
+
+Lemma Included_Add:
+  (X, A: (Ensemble U)) (x: U) (Included U X (Add U A x)) ->
+   (Included U X A) \/
+   (EXT A' | X == (Add U A' x) /\ (Included U A' A)).
+Proof.
+Intros X A x H'0; Try Assumption.
+Elim (classic (In U X x)).
+Intro H'1; Right; Try Assumption.
+Exists (Subtract U X x).
+Split; Auto with sets.
+Red in H'0.
+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.
+LApply (H'0 x0); Auto with sets.
+Intro H'3; Try Assumption.
+LApply (Add_inv U A x x0); Auto with sets.
+Intro H'4; Elim H'4;
+ [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
+Elim K'; Auto with sets.
+Intro H'1; Left; Try Assumption.
+Red in H'0.
+Red.
+Intros x0 H'2; Try Assumption.
+LApply (H'0 x0); Auto with sets.
+Intro H'3; Try Assumption.
+LApply (Add_inv U A x x0); Auto with sets.
+Intro H'4; Elim H'4;
+ [Intro H'5; Try Exact H'5; Clear H'4 | Intro H'5; Clear H'4].
+Absurd (In U X x0); Auto with sets.
+Rewrite <- H'5; Auto with sets.
+Qed.
+
+Lemma setcover_inv:
+ (A: (Ensemble U))
+ (x, y: (Ensemble U)) (covers (Ensemble U) (Power_set_PO U A) y x) ->
+ (Strict_Included U x y) /\
+ ((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; 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.
+Intro H'4; Right; Try Assumption.
+Elim (classic  z == y); Auto with sets.
+Intro H'5; Try Assumption.
+Elim H'1.
+Exists z; Auto with sets.
+Qed.
+
+Theorem Add_covers:
+  (A: (Ensemble U)) (a: (Ensemble U)) (Included U a A) ->
+   (x: U) (In U A x) -> ~ (In U a x) ->
+    (covers (Ensemble U) (Power_set_PO U A) (Add U a x) a).
+Proof.
+Intros A a H' x H'0 H'1; Try Assumption.
+Apply setcover_intro; 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; 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.
+Intros x0 H'2; Elim H'2.
+Intros H'5 H'6; Try Assumption.
+Generalize H'4; Intro K.
+Red in H'4.
+Elim H'4; Intros H'8 H'9; Red in H'8; Clear H'4.
+LApply (H'8 x0); Auto with sets.
+Intro H'7; Try Assumption.
+Elim (Add_inv U a x x0); Auto with sets.
+Intro H'15.
+Cut (Included U (Add U a x) z).
+Intro H'10; Try Assumption.
+Red in K.
+Elim K; Intros H'11 H'12; Apply H'12; Clear K; Auto with sets.
+Rewrite H'15.
+Red.
+Intros x1 H'10; Elim H'10; Auto with sets.
+Intros x2 H'11; Elim H'11; Auto with sets.
+Qed.
+
+Theorem covers_Add:
+  (A: (Ensemble U))
+  (a, a': (Ensemble U))
+  (Included U a A) ->
+  (Included U a' A) -> (covers (Ensemble U) (Power_set_PO U A) a' a) ->
+   (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x))).
+Proof.
+Intros A a a' H' H'0 H'1; Try Assumption.
+Elim (setcover_inv A a a'); Auto with sets.
+Intros H'6 H'7.
+Clear H'1.
+Elim (Strict_Included_inv U a a'); Auto with sets.
+Intros H'5 H'8; Elim H'8.
+Intros x H'1; Elim H'1.
+Intros H'2 H'3; Try Assumption.
+Exists x.
+Split; [Try Assumption | Idtac].
+Clear H'8 H'1.
+Elim (H'7 (Add U a x)); Auto with sets.
+Intro H'1.
+Absurd a ==(Add U a x); Auto with sets.
+Red; Intro H'8; Try Exact H'8.
+Apply H'3.
+Rewrite H'8; Auto with sets.
+Auto with sets.
+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].
+Red in H'0; Auto with sets.
+Qed.
+
+Theorem covers_is_Add:
+  (A: (Ensemble U))
+  (a, a': (Ensemble U)) (Included U a A) -> (Included U a' A) ->
+   (iff
+      (covers (Ensemble U) (Power_set_PO U A) a' a)
+      (EXT x | a' == (Add U a x) /\ ((In U A x) /\ ~ (In U a x)))).
+Proof.
+Intros A a a' H' H'0; Split; Intro K.
+Apply covers_Add with A := A; Auto with sets.
+Elim K.
+Intros x H'1; Elim H'1; Intros H'2 H'3; Rewrite H'2; Clear H'1.
+Apply Add_covers; Intuition.
+Qed.
+
+Theorem Singleton_atomic:
+  (x:U) (A:(Ensemble U)) (In U A x) ->
+  (covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U)).
+Intros x A H'.
+Rewrite <- (Empty_set_zero' U x).
+Apply Add_covers; Auto with sets.
+Qed.
+
+Lemma less_than_singleton:
+  (X:(Ensemble U)) (x:U) (Strict_Included U X (Singleton U x)) ->
+  X ==(Empty_set U).
+Intros X x H'; Try Assumption.
+Red in H'.
+LApply (Singleton_atomic x (Full_set U));
+ [Intro H'2; Try Exact H'2 | Apply Full_intro].
+Elim H'; Intros H'0 H'1; Try Exact H'1; Clear H'.
+Elim (setcover_inv (Full_set U) (Empty_set U) (Singleton U x));
+ [Intros H'6 H'7; Try Exact H'7 | Idtac]; Auto with sets.
+Elim (H'7 X); [Intro H'5; Try Exact H'5 | Intro H'5 | Idtac | Idtac]; Auto with sets.
+Elim H'1; Auto with sets.
+Qed.
+
+End Sets_as_an_algebra.
+
+Hints Resolve incl_soustr_in : sets v62.
+Hints Resolve incl_soustr : sets v62.
+Hints Resolve incl_soustr_add_l : sets v62.
+Hints Resolve incl_soustr_add_r : sets v62.
+Hints Resolve add_soustr_1 add_soustr_2 : sets v62.
+Hints Resolve add_soustr_xy : sets v62.
diff --git a/theories7/Sets/Powerset_facts.v b/theories7/Sets/Powerset_facts.v
new file mode 100755
index 00000000..fbe7d93e
--- /dev/null
+++ b/theories7/Sets/Powerset_facts.v
@@ -0,0 +1,276 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Powerset_facts.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Require Export Ensembles.
+Require Export Constructive_sets.
+Require Export Relations_1.
+Require Export Relations_1_facts.
+Require Export Partial_Order.
+Require Export Cpo.
+Require Export Powerset.
+
+Section Sets_as_an_algebra.
+Variable U: Type.
+Hints Unfold not.
+
+Theorem Empty_set_zero :
+  (X: (Ensemble U)) (Union U (Empty_set U) X) == X.
+Proof.
+Auto 6 with sets.
+Qed.
+Hints Resolve Empty_set_zero.
+
+Theorem Empty_set_zero' :
+  (x: U) (Add U (Empty_set U) x) == (Singleton U x).
+Proof.
+Unfold 1 Add; Auto with sets.
+Qed.
+Hints Resolve Empty_set_zero'.
+
+Lemma less_than_empty :
+  (X: (Ensemble U)) (Included U X (Empty_set U)) -> X == (Empty_set U).
+Proof.
+Auto with sets.
+Qed.
+Hints Resolve less_than_empty.
+
+Theorem Union_commutative :
+  (A,B: (Ensemble U)) (Union U A B) == (Union U B A).
+Proof.
+Auto with sets.
+Qed.
+
+Theorem Union_associative :
+  (A, B, C: (Ensemble U))
+  (Union U (Union U A B) C) == (Union U A (Union U B C)).
+Proof.
+Auto 9 with sets.
+Qed.
+Hints Resolve Union_associative.
+
+Theorem Union_idempotent : (A: (Ensemble U)) (Union U A A) == A.
+Proof.
+Auto 7 with sets.
+Qed.
+
+Lemma Union_absorbs :
+  (A, B: (Ensemble U)) (Included U B A) -> (Union U A B) == A.
+Proof.
+Auto 7 with sets.
+Qed.
+
+Theorem Couple_as_union:
+  (x, y: U) (Union U (Singleton U x) (Singleton U y)) == (Couple U x y).
+Proof.
+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.
+
+Theorem Triple_as_union :
+  (x, y, z: U)
+  (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.
+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.
+Intros x0 H'; Elim H'; Auto with sets.
+Qed.
+
+Theorem Triple_as_Couple : (x, y: U) (Couple U x y) == (Triple U x x y).
+Proof.
+Intros x y.
+Rewrite <- (Couple_as_union x y).
+Rewrite <- (Union_idempotent (Singleton U x)).
+Apply Triple_as_union.
+Qed.
+
+Theorem Triple_as_Couple_Singleton :
+  (x, y, z: U) (Triple U x y z) == (Union U (Couple U x y) (Singleton U z)).
+Proof.
+Intros x y z.
+Rewrite <- (Triple_as_union x y z).
+Rewrite <- (Couple_as_union x y); Auto with sets.
+Qed.
+
+Theorem Intersection_commutative :
+  (A,B: (Ensemble U)) (Intersection U A B) == (Intersection U B A).
+Proof.
+Intros A B.
+Apply Extensionality_Ensembles.
+Split; Red; Intros x H'; Elim H'; Auto with sets.
+Qed.
+
+Theorem Distributivity :
+  (A, B, C: (Ensemble U))
+     (Intersection U A (Union U B C)) ==
+     (Union U (Intersection U A B) (Intersection U A C)).
+Proof.
+Intros A B C.
+Apply Extensionality_Ensembles.
+Split; Red; Intros x H'.
+Elim H'.
+Intros x0 H'0 H'1; Generalize H'0.
+Elim H'1; Auto with sets.
+Elim H'; Intros x0 H'0; Elim H'0; Auto with sets.
+Qed.
+
+Theorem Distributivity' :
+  (A, B, C: (Ensemble U))
+     (Union U A (Intersection U B C)) ==
+     (Intersection U (Union U A B) (Union U A C)).
+Proof.
+Intros A B C.
+Apply Extensionality_Ensembles.
+Split; Red; Intros x H'.
+Elim H'; Auto with sets.
+Intros x0 H'0; Elim H'0; Auto with sets.
+Elim H'.
+Intros x0 H'0; Elim H'0; Auto with sets.
+Intros x1 H'1 H'2; Try Exact H'2.
+Generalize H'1.
+Elim H'2; Auto with sets.
+Qed.
+
+Theorem Union_add :
+  (A, B: (Ensemble U)) (x: U)
+    (Add U (Union U A B) x) == (Union U A (Add U B x)).
+Proof.
+Unfold Add; Auto with sets.
+Qed.
+Hints Resolve Union_add.
+
+Theorem Non_disjoint_union :
+  (X: (Ensemble U)) (x: U) (In U X x) -> (Add U X x) == X.
+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.
+
+Theorem Non_disjoint_union' :
+  (X: (Ensemble U)) (x: U) ~ (In U X x) -> (Subtract U X x) == X.
+Proof.
+Intros X x H'; Unfold Subtract.
+Apply Extensionality_Ensembles.
+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; 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.
+
+Lemma singlx : (x, y: U) (In U (Add U (Empty_set U) x) y) -> x == y.
+Proof.
+Intro x; Rewrite (Empty_set_zero' x); Auto with sets.
+Qed.
+Hints Resolve singlx.
+
+Lemma incl_add :
+  (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; Auto with sets.
+Intros x0 H'0.
+LApply (Add_inv U A x x0); Auto with sets.
+Intro H'1; Elim H'1;
+ [Intro H'2; Clear H'1 | Intro H'2; Rewrite <- H'2; Clear H'1]; Auto with sets.
+Qed.
+Hints Resolve incl_add.
+
+Lemma incl_add_x :
+  (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.
+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.
+Intro H'3; Elim H'3;
+ [Intro H'4; Try Exact H'4; Clear H'3 | Intro H'4; Clear H'3].
+Absurd (In U A x0); Auto with sets.
+Rewrite <- H'4; Auto with sets.
+Qed.
+
+Lemma Add_commutative :
+  (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.
+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)); Auto with sets.
+Qed.
+
+Lemma Add_commutative' :
+  (A: (Ensemble U)) (x, y, z: U)
+    (Add U (Add U (Add U A x) y) z) == (Add U (Add U (Add U A z) x) y).
+Proof.
+Intros A x y z.
+Rewrite (Add_commutative (Add U A x) y z).
+Rewrite (Add_commutative A x z); Auto with sets.
+Qed.
+
+Lemma Add_distributes :
+  (A, B: (Ensemble U)) (x, y: U) (Included U B A) ->
+  (Add U (Add U A x) y) == (Union U (Add U A x) (Add U B y)).
+Proof.
+Intros A B x y H'; Try Assumption.
+Rewrite <- (Union_add (Add U A x) B y).
+Unfold 4 Add.
+Rewrite (Union_commutative A (Singleton U x)).
+Rewrite Union_associative.
+Rewrite (Union_absorbs A B H').
+Rewrite (Union_commutative (Singleton U x) A).
+Auto with sets.
+Qed.
+
+Lemma setcover_intro :
+  (U: Type)
+  (A: (Ensemble U))
+  (x, y: (Ensemble U))
+  (Strict_Included U x y) ->
+  ~ (EXT z | (Strict_Included U x z) 
+              /\ (Strict_Included U z y)) ->
+   (covers (Ensemble U) (Power_set_PO U A) y x).
+Proof.
+Intros; Apply Definition_of_covers; Auto with sets.
+Qed.
+Hints Resolve setcover_intro.
+
+End Sets_as_an_algebra.
+
+Hints Resolve Empty_set_zero Empty_set_zero' Union_associative Union_add
+	singlx incl_add : sets v62.
+
+
diff --git a/theories7/Sets/Relations_1.v b/theories7/Sets/Relations_1.v
new file mode 100755
index 00000000..d4ed823b
--- /dev/null
+++ b/theories7/Sets/Relations_1.v
@@ -0,0 +1,67 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_1.v,v 1.1.2.1 2004/07/16 19:31:39 herbelin Exp $ i*)
+
+Section Relations_1.
+   Variable U: Type.
+   
+   Definition Relation :=  U -> U -> Prop.
+   Variable R: Relation.
+   
+   Definition Reflexive : Prop :=  (x: U) (R x x).
+   
+   Definition Transitive : Prop :=  (x,y,z: U) (R x y) -> (R y z) -> (R x z).
+   
+   Definition Symmetric : Prop :=  (x,y: U) (R x y) -> (R y x).
+   
+   Definition Antisymmetric : Prop :=
+      (x: U) (y: U) (R x y) -> (R y x) -> x == y.
+   
+   Definition contains : Relation -> Relation -> Prop :=
+      [R,R': Relation] (x: U) (y: U) (R' x y) -> (R x y).
+   
+   Definition same_relation : Relation -> Relation -> Prop :=
+      [R,R': Relation] (contains R R') /\ (contains R' R).
+   
+   Inductive Preorder : Prop :=
+         Definition_of_preorder: Reflexive -> Transitive -> Preorder.
+   
+   Inductive Order : Prop :=
+         Definition_of_order: Reflexive -> Transitive -> Antisymmetric -> Order.
+   
+   Inductive Equivalence : Prop :=
+         Definition_of_equivalence:
+           Reflexive -> Transitive -> Symmetric -> Equivalence.
+   
+   Inductive PER : Prop :=
+         Definition_of_PER: Symmetric -> Transitive -> PER.
+   
+End Relations_1.
+Hints Unfold Reflexive Transitive Antisymmetric Symmetric contains 
+	same_relation : sets v62.
+Hints Resolve Definition_of_preorder Definition_of_order 
+	Definition_of_equivalence Definition_of_PER : sets v62.
diff --git a/theories7/Sets/Relations_1_facts.v b/theories7/Sets/Relations_1_facts.v
new file mode 100755
index 00000000..cf73ce8b
--- /dev/null
+++ b/theories7/Sets/Relations_1_facts.v
@@ -0,0 +1,109 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_1_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+Require Export Relations_1.
+
+Definition Complement : (U: Type) (Relation U) -> (Relation U) :=
+   [U: Type] [R: (Relation U)] [x,y: U] ~ (R x y).
+
+Theorem Rsym_imp_notRsym: (U: Type) (R: (Relation U)) (Symmetric U R) ->
+            (Symmetric U (Complement U R)).
+Proof.
+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 :
+  (U: Type) (R: (Relation U)) (Preorder U R) ->
+            (Equivalence U [x,y: U] (R x y) /\ (R y x)).
+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; 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.
+Qed.
+Hints Resolve Equiv_from_preorder.
+
+Theorem Equiv_from_order :
+  (U: Type) (R: (Relation U)) (Order U R) ->
+            (Equivalence U [x,y: U] (R x y) /\ (R y x)).
+Proof.
+Intros U R H'; Elim H'; Auto 10 with sets.
+Qed.
+Hints Resolve Equiv_from_order.
+
+Theorem contains_is_preorder :
+  (U: Type) (Preorder (Relation U) (contains U)).
+Proof.
+Auto 10 with sets.
+Qed.
+Hints Resolve contains_is_preorder.
+
+Theorem same_relation_is_equivalence :
+  (U: Type) (Equivalence (Relation U) (same_relation U)).
+Proof.
+Unfold 1 same_relation; Auto 10 with sets.
+Qed.
+Hints Resolve same_relation_is_equivalence.
+
+Theorem cong_reflexive_same_relation:
+  (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Reflexive U R) ->
+  (Reflexive U R').
+Proof.
+Unfold same_relation; Intuition.
+Qed.
+
+Theorem cong_symmetric_same_relation:
+  (U:Type) (R, R':(Relation U)) (same_relation U R R') -> (Symmetric U R) ->
+  (Symmetric U R').
+Proof.
+  Compute;Intros;Elim H;Intros;Clear H;Apply (H3 y x (H0 x y (H2 x y H1))).
+(*Intuition.*)
+Qed.
+
+Theorem cong_antisymmetric_same_relation:
+  (U:Type) (R, R':(Relation U)) (same_relation U R R') ->
+           (Antisymmetric U R) -> (Antisymmetric U R').
+Proof.
+  Compute;Intros;Elim H;Intros;Clear H;Apply (H0 x y (H3 x y H1) (H3 y x H2)).
+(*Intuition.*)
+Qed.
+
+Theorem cong_transitive_same_relation:
+  (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.
+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.
diff --git a/theories7/Sets/Relations_2.v b/theories7/Sets/Relations_2.v
new file mode 100755
index 00000000..92a1236e
--- /dev/null
+++ b/theories7/Sets/Relations_2.v
@@ -0,0 +1,56 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_2.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+Require Export Relations_1.
+
+Section Relations_2.
+Variable U: Type.
+Variable R: (Relation U).
+
+Inductive Rstar : (Relation U) :=
+     Rstar_0: (x: U) (Rstar x x)
+   | Rstar_n: (x, y, z: U) (R x y) -> (Rstar y z) -> (Rstar x z).
+
+Inductive Rstar1 : (Relation U) :=
+     Rstar1_0: (x: U) (Rstar1 x x)
+   | Rstar1_1: (x: U) (y: U) (R x y) -> (Rstar1 x y)
+   | Rstar1_n: (x, y, z: U) (Rstar1 x y) -> (Rstar1 y z) -> (Rstar1 x z).
+
+Inductive Rplus : (Relation U) :=
+     Rplus_0: (x, y: U) (R x y) -> (Rplus x y)
+   | Rplus_n: (x, y, z: U) (R x y) -> (Rplus y z) -> (Rplus x z).
+
+Definition Strongly_confluent : Prop :=
+   (x, a, b: U) (R x a) -> (R x b) -> (exT U [z: U] (R a z) /\ (R b z)).
+
+End Relations_2.
+
+Hints Resolve Rstar_0 : sets v62.
+Hints Resolve Rstar1_0 : sets v62.
+Hints Resolve Rstar1_1 : sets v62.
+Hints Resolve Rplus_0 : sets v62.
diff --git a/theories7/Sets/Relations_2_facts.v b/theories7/Sets/Relations_2_facts.v
new file mode 100755
index 00000000..b82438eb
--- /dev/null
+++ b/theories7/Sets/Relations_2_facts.v
@@ -0,0 +1,151 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_2_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+Require Export Relations_1.
+Require Export Relations_1_facts.
+Require Export Relations_2.
+
+Theorem Rstar_reflexive : 
+  (U: Type) (R: (Relation U)) (Reflexive U (Rstar U R)).
+Proof.
+Auto with sets.
+Qed.
+
+Theorem Rplus_contains_R :
+  (U: Type) (R: (Relation U)) (contains U (Rplus U R) R).
+Proof.
+Auto with sets.
+Qed.
+
+Theorem Rstar_contains_R :
+  (U: Type) (R: (Relation U)) (contains U (Rstar U R) R).
+Proof.
+Intros U R; Red; Intros x y H'; Apply Rstar_n with y; Auto with sets.
+Qed.
+
+Theorem Rstar_contains_Rplus :
+  (U: Type) (R: (Relation U)) (contains U (Rstar U R) (Rplus U R)).
+Proof.
+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.
+Qed.
+
+Theorem Rstar_transitive :
+  (U: Type) (R: (Relation U)) (Transitive U (Rstar U R)).
+Proof.
+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.
+
+Theorem Rstar_cases :
+  (U: Type) (R: (Relation U)) (x, y: U) (Rstar U R x y) ->
+    x == y \/ (EXT u | (R x u) /\ (Rstar U R u y)).
+Proof.
+Intros U R x y H'; Elim H'; Auto with sets.
+Intros x0 y0 z H'0 H'1 H'2; Right; Exists y0; Auto with sets.
+Qed.
+
+Theorem Rstar_equiv_Rstar1 :
+  (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.
+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.
+Intros x0 y0 z H'0 H'1 H'2; Apply Rstar1_n with y0; Auto with sets.
+Qed.
+
+Theorem Rsym_imp_Rstarsym :
+  (U: Type) (R: (Relation U)) (Symmetric U R) -> (Symmetric U (Rstar U R)).
+Proof.
+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.
+Apply T1 with y0; Auto with sets.
+Apply Rstar_n with x0; Auto with sets.
+Qed.
+
+Theorem Sstar_contains_Rstar :
+  (U: Type) (R, S: (Relation U)) (contains U (Rstar U S) R) ->
+   (contains U (Rstar U S) (Rstar U R)).
+Proof.
+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.
+Qed.
+
+Theorem star_monotone :
+  (U: Type) (R, S: (Relation U)) (contains U S R) ->
+   (contains U (Rstar U S) (Rstar U R)).
+Proof.
+Intros U R S H'.
+Apply Sstar_contains_Rstar; Auto with sets.
+Generalize (Rstar_contains_R U S); Auto with sets.
+Qed.
+
+Theorem RstarRplus_RRstar :
+  (U: Type) (R: (Relation U)) (x, y, z: U) 
+    (Rstar U R x y) -> (Rplus U R y z) ->
+    (EXT u | (R x u) /\ (Rstar U R u z)).
+Proof.
+Generalize Rstar_contains_Rplus; Intro T; Red in T.
+Generalize Rstar_transitive; Intro T1; Red in T1.
+Intros U R x y z H'; Elim H'.
+Intros x0 H'0; Elim H'0.
+Intros x1 y0 H'1; Exists y0; Auto with sets.
+Intros x1 y0 z0 H'1 H'2 H'3; Exists y0; Auto with sets.
+Intros x0 y0 z0 H'0 H'1 H'2 H'3; Exists y0.
+Split; [Try Assumption | Idtac].
+Apply T1 with z0; Auto with sets.
+Qed.
+
+Theorem Lemma1 : 
+  (U: Type) (R: (Relation U)) (Strongly_confluent U R) ->
+   (x, b: U) (Rstar U R x b) ->
+    (a: U) (R x a) -> (EXT z | (Rstar U R a z) /\ (R b z)).
+Proof.
+Intros U R H' x b H'0; Elim H'0.
+Intros x0 a H'1; Exists a; Auto with sets.
+Intros x0 y z H'1 H'2 H'3 a H'4.
+Red in H'.
+Specialize 3 H' with x := x0 a := a b := y; Intro H'7; LApply H'7;
+ [Intro H'8; LApply H'8;
+   [Intro H'9; Try Exact H'9; Clear H'8 H'7 | Clear H'8 H'7] | Clear H'7]; Auto with sets.
+Elim H'9.
+Intros t H'5; Elim H'5; Intros H'6 H'7; Try Exact H'6; Clear H'5.
+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.
diff --git a/theories7/Sets/Relations_3.v b/theories7/Sets/Relations_3.v
new file mode 100755
index 00000000..092fc534
--- /dev/null
+++ b/theories7/Sets/Relations_3.v
@@ -0,0 +1,63 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_3.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+Require Export Relations_1.
+Require Export Relations_2.
+
+Section Relations_3.
+   Variable U: Type.
+   Variable R: (Relation U).
+   
+   Definition coherent : U -> U -> Prop :=
+      [x,y: U]  (EXT z | (Rstar U R x z) /\ (Rstar U R y z)).
+   
+   Definition locally_confluent : U -> Prop :=
+      [x: U] (y,z: U) (R x y) -> (R x z) -> (coherent y z).
+   
+   Definition Locally_confluent : Prop :=  (x: U) (locally_confluent x).
+   
+   Definition confluent : U -> Prop :=
+      [x: U] (y,z: U) (Rstar U R x y) -> (Rstar U R x z) -> (coherent y z).
+   
+   Definition Confluent : Prop :=  (x: U) (confluent x).
+   
+   Inductive  noetherian : U -> Prop :=
+         definition_of_noetherian:
+           (x: U) ((y: U) (R x y) -> (noetherian y)) -> (noetherian x).
+   
+   Definition Noetherian : Prop :=  (x: U) (noetherian x).
+   
+End Relations_3.
+Hints Unfold  coherent : sets v62.
+Hints Unfold  locally_confluent : sets v62.
+Hints Unfold  confluent : sets v62.
+Hints Unfold  Confluent : sets v62.
+Hints Resolve definition_of_noetherian : sets v62.
+Hints Unfold  Noetherian : sets v62.
+
+
diff --git a/theories7/Sets/Relations_3_facts.v b/theories7/Sets/Relations_3_facts.v
new file mode 100755
index 00000000..822f550a
--- /dev/null
+++ b/theories7/Sets/Relations_3_facts.v
@@ -0,0 +1,157 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(****************************************************************************)
+(*                                                                          *)
+(*                         Naive Set Theory in Coq                          *)
+(*                                                                          *)
+(*                     INRIA                        INRIA                   *)
+(*              Rocquencourt                        Sophia-Antipolis        *)
+(*                                                                          *)
+(*                                 Coq V6.1                                 *)
+(*									    *)
+(*			         Gilles Kahn 				    *)
+(*				 Gerard Huet				    *)
+(*									    *)
+(*									    *)
+(*                                                                          *)
+(* Acknowledgments: This work was started in July 1993 by F. Prost. Thanks  *)
+(* to the Newton Institute for providing an exceptional work environment    *)
+(* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
+(****************************************************************************)
+
+(*i $Id: Relations_3_facts.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+Require Export Relations_1.
+Require Export Relations_1_facts.
+Require Export Relations_2.
+Require Export Relations_2_facts.
+Require Export Relations_3.
+
+Theorem Rstar_imp_coherent :
+  (U: Type) (R: (Relation U)) (x: U) (y: U) (Rstar U R x y) ->
+   (coherent U R x y).
+Proof.
+Intros U R x y H'; Red.
+Exists y; Auto with sets.
+Qed.
+Hints Resolve Rstar_imp_coherent.
+
+Theorem coherent_symmetric :
+  (U: Type) (R: (Relation U)) (Symmetric U (coherent U R)).
+Proof.
+Unfold 1 coherent.
+Intros U R; Red.
+Intros x y H'; Elim H'.
+Intros z H'0; Exists z; Tauto.
+Qed.
+
+Theorem Strong_confluence :
+  (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
+Proof.
+Intros U R H'; Red.
+Intro x; Red; Intros a b H'0.
+Unfold 1 coherent.
+Generalize b; Clear b.
+Elim H'0; Clear H'0.
+Intros x0 b H'1; Exists b; Auto with sets.
+Intros x0 y z H'1 H'2 H'3 b H'4.
+Generalize (Lemma1 U R); Intro h; LApply h;
+  [Intro H'0; Generalize (H'0 x0 b); Intro h0; LApply h0;
+    [Intro H'5; Generalize (H'5 y); Intro h1; LApply h1;
+      [Intro h2; Elim h2; Intros z0 h3; Elim h3; Intros H'6 H'7;
+        Clear h h0 h1 h2 h3 | Clear h h0 h1] | Clear h h0] | Clear h]; Auto with sets.
+Generalize (H'3 z0); Intro h; LApply h;
+  [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h h0 h1 |
+    Clear h]; Auto with sets.
+Exists z1; Split; Auto with sets.
+Apply Rstar_n with z0; Auto with sets.
+Qed.
+
+Theorem Strong_confluence_direct :
+  (U: Type) (R: (Relation U)) (Strongly_confluent U R) -> (Confluent U R).
+Proof.
+Intros U R H'; Red.
+Intro x; Red; Intros a b H'0.
+Unfold 1 coherent.
+Generalize b; Clear b.
+Elim H'0; Clear H'0.
+Intros x0 b H'1; Exists b; Auto with sets.
+Intros x0 y z H'1 H'2 H'3 b H'4.
+Cut (exT U [t: U] (Rstar U R y t) /\ (R b t)).
+Intro h; Elim h; Intros t h0; Elim h0; Intros H'0 H'5; Clear h h0.
+Generalize (H'3 t); Intro h; LApply h;
+  [Intro h0; Elim h0; Intros z0 h1; Elim h1; Intros H'6 H'7; Clear h h0 h1 |
+    Clear h]; Auto with sets.
+Exists z0; Split; [Assumption | Idtac].
+Apply Rstar_n with t; Auto with sets.
+Generalize H'1; Generalize y; Clear H'1.
+Elim H'4.
+Intros x1 y0 H'0; Exists y0; Auto with sets.
+Intros x1 y0 z0 H'0 H'1 H'5 y1 H'6.
+Red in H'.
+Generalize (H' x1 y0 y1); Intro h; LApply h;
+  [Intro H'7; LApply H'7;
+    [Intro h0; Elim h0; Intros z1 h1; Elim h1; Intros H'8 H'9; Clear h H'7 h0 h1 |
+      Clear h] | Clear h]; Auto with sets.
+Generalize (H'5 z1); Intro h; LApply h;
+  [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'7 H'10; Clear h h0 h1 |
+    Clear h]; Auto with sets.
+Exists t; Split; Auto with sets.
+Apply Rstar_n with z1; Auto with sets.
+Qed.
+
+Theorem Noetherian_contains_Noetherian :
+  (U: Type) (R, R': (Relation U)) (Noetherian U R) -> (contains U R R') ->
+   (Noetherian U R').
+Proof.
+Unfold 2 Noetherian.
+Intros U R R' H' H'0 x.
+Elim (H' x); Auto with sets.
+Qed.
+
+Theorem Newman :
+  (U: Type) (R: (Relation U)) (Noetherian U R) -> (Locally_confluent U R) ->
+   (Confluent U R).
+Proof.
+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;
+    [Clear h h0; Intro h1 |
+      Intro h1; Elim h1; Intros u h2; Elim h2; Intros H'5 H'6; Clear h h0 h1 h2] |
+    Clear h]; Auto with sets.
+Elim h1; Auto with sets.
+Generalize (Rstar_cases U R x0 z); Intro h; LApply h;
+  [Intro h0; Elim h0;
+    [Clear h h0; Intro h1 |
+      Intro h1; Elim h1; Intros v h2; Elim h2; Intros H'7 H'8; Clear h h0 h1 h2] |
+    Clear h]; Auto with sets.
+Elim h1; Generalize coherent_symmetric; Intro t; Red in t; Auto with sets.
+Unfold Locally_confluent locally_confluent coherent in H'0.
+Generalize (H'0 x0 u v); Intro h; LApply h;
+  [Intro H'9; LApply H'9;
+    [Intro h0; Elim h0; Intros t h1; Elim h1; Intros H'10 H'11;
+      Clear h H'9 h0 h1 | Clear h] | Clear h]; Auto with sets.
+Clear H'0.
+Unfold 1 coherent in H'2.
+Generalize (H'2 u); Intro h; LApply h;
+  [Intro H'0; Generalize (H'0 y t); Intro h0; LApply h0;
+    [Intro H'9; LApply H'9;
+      [Intro h1; Elim h1; Intros y1 h2; Elim h2; Intros H'12 H'13;
+        Clear h h0 H'9 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; Auto with sets.
+Generalize Rstar_transitive; Intro T; Red in T.
+Generalize (H'2 v); Intro h; LApply h;
+  [Intro H'9; Generalize (H'9 y1 z); Intro h0; LApply h0;
+    [Intro H'14; LApply H'14;
+      [Intro h1; Elim h1; Intros z1 h2; Elim h2; Intros H'15 H'16;
+        Clear h h0 H'14 h1 h2 | Clear h h0] | Clear h h0] | Clear h]; 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.
diff --git a/theories7/Sets/Uniset.v b/theories7/Sets/Uniset.v
new file mode 100644
index 00000000..33880214
--- /dev/null
+++ b/theories7/Sets/Uniset.v
@@ -0,0 +1,212 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Uniset.v,v 1.1.2.1 2004/07/16 19:31:40 herbelin Exp $ i*)
+
+(** Sets as characteristic functions *)
+
+(* G. Huet 1-9-95 *)
+(* Updated Papageno 12/98 *)
+
+Require Bool.
+
+Set Implicit Arguments.
+
+Section defs.
+
+Variable A : Set.
+Variable eqA : A -> A -> Prop.
+Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+
+Inductive uniset : Set := 
+      Charac : (A->bool) -> uniset.
+
+Definition charac : uniset -> A -> bool :=
+  [s:uniset][a:A]Case s of [f:A->bool](f a) end.
+
+Definition Emptyset := (Charac [a:A]false).
+
+Definition Fullset  := (Charac [a:A]true).
+
+Definition Singleton := [a:A](Charac [a':A]
+              Case (eqA_dec a a') of 
+                   [h:(eqA a a')]  true
+                   [h: ~(eqA a a')] false end).
+
+Definition In : uniset -> A -> Prop :=
+     [s:uniset][a:A](charac s a)=true.
+Hints Unfold In.
+
+(** uniset inclusion *)
+Definition incl := [s1,s2:uniset]
+    (a:A)(leb (charac s1 a) (charac s2 a)).
+Hints Unfold incl.
+
+(** uniset equality *)
+Definition seq := [s1,s2:uniset]
+    (a:A)(charac s1 a) = (charac s2 a).
+Hints Unfold seq.
+
+Lemma leb_refl : (b:bool)(leb b b).
+Proof.
+NewDestruct b; Simpl; Auto.
+Qed.
+Hints Resolve leb_refl.
+
+Lemma incl_left : (s1,s2:uniset)(seq s1 s2)->(incl s1 s2).
+Proof.
+Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
+Qed.
+
+Lemma incl_right : (s1,s2:uniset)(seq s1 s2)->(incl s2 s1).
+Proof.
+Unfold incl; Intros s1 s2 E a; Elim (E a); Auto.
+Qed.
+
+Lemma seq_refl : (x:uniset)(seq x x).
+Proof.
+NewDestruct x; Unfold seq; Auto.
+Qed.
+Hints Resolve seq_refl.
+
+Lemma seq_trans : (x,y,z:uniset)(seq x y)->(seq y z)->(seq x z).
+Proof.
+Unfold seq.
+NewDestruct x; NewDestruct y; NewDestruct z; Simpl; Intros.
+Rewrite H; Auto.
+Qed.
+
+Lemma seq_sym : (x,y:uniset)(seq x y)->(seq y x).
+Proof.
+Unfold seq.
+NewDestruct x; NewDestruct y; Simpl; Auto.
+Qed.
+
+(** uniset union *)
+Definition union := [m1,m2:uniset]
+    (Charac [a:A](orb (charac m1 a)(charac m2 a))).
+
+Lemma union_empty_left :
+     (x:uniset)(seq x (union Emptyset x)).  
+Proof.  
+Unfold seq; Unfold union; Simpl; Auto.  
+Qed. 
+Hints Resolve union_empty_left.
+
+Lemma union_empty_right :
+     (x:uniset)(seq x (union x Emptyset)).
+Proof.
+Unfold seq; Unfold union; Simpl.
+Intros x a; Rewrite (orb_b_false (charac x a)); Auto.
+Qed.
+Hints Resolve union_empty_right.
+
+Lemma union_comm : (x,y:uniset)(seq (union x y) (union y x)).
+Proof.
+Unfold seq; Unfold charac; Unfold union.
+NewDestruct x; NewDestruct y; Auto with bool.
+Qed.
+Hints Resolve union_comm.
+
+Lemma union_ass : 
+      (x,y,z:uniset)(seq (union (union x y) z) (union x (union y z))).
+Proof.
+Unfold seq; Unfold union; Unfold charac.
+NewDestruct x; NewDestruct y; NewDestruct z; Auto with bool.
+Qed.
+Hints Resolve union_ass.
+
+Lemma seq_left :  (x,y,z:uniset)(seq x y)->(seq (union x z) (union y z)).
+Proof.
+Unfold seq; Unfold union; Unfold charac.
+NewDestruct x; NewDestruct y; NewDestruct z.
+Intros; Elim H; Auto.
+Qed.
+Hints Resolve seq_left.
+
+Lemma seq_right : (x,y,z:uniset)(seq x y)->(seq (union z x) (union z y)).
+Proof.
+Unfold seq; Unfold union; Unfold charac.
+NewDestruct x; NewDestruct y; NewDestruct z.
+Intros; Elim H; Auto.
+Qed.
+Hints Resolve seq_right.
+
+
+(** All the proofs that follow duplicate [Multiset_of_A] *)
+
+(** Here we should make uniset an abstract datatype, by hiding [Charac],
+    [union], [charac]; all further properties are proved abstractly *)
+
+Require Permut.
+
+Lemma union_rotate :
+   (x,y,z:uniset)(seq (union x (union y z)) (union z (union x y))).
+Proof.
+Intros; Apply (op_rotate uniset union seq); Auto.
+Exact seq_trans.
+Qed.
+
+Lemma seq_congr : (x,y,z,t:uniset)(seq x y)->(seq z t)->
+                  (seq (union x z) (union y t)).
+Proof.
+Intros; Apply (cong_congr uniset union seq); Auto.
+Exact seq_trans.
+Qed.
+
+Lemma union_perm_left :
+   (x,y,z:uniset)(seq (union x (union y z)) (union y (union x z))).
+Proof.
+Intros; Apply (perm_left uniset union seq); Auto.
+Exact seq_trans.
+Qed.
+
+Lemma uniset_twist1 : (x,y,z,t:uniset)
+   (seq (union x (union (union y z) t)) (union (union y (union x t)) z)).
+Proof.
+Intros; Apply (twist uniset union seq); Auto.
+Exact seq_trans.
+Qed.
+
+Lemma uniset_twist2 : (x,y,z,t:uniset)
+   (seq (union x (union (union y z) t)) (union (union y (union x z)) t)).
+Proof.
+Intros; Apply seq_trans with (union (union x (union y z)) t).
+Apply seq_sym; Apply union_ass.
+Apply seq_left; Apply union_perm_left.
+Qed.
+
+(** specific for treesort *)
+
+Lemma treesort_twist1 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
+   (seq (union x (union u t)) (union (union y (union x t)) z)).
+Proof.
+Intros; Apply seq_trans with (union x (union (union y z) t)).
+Apply seq_right; Apply seq_left; Trivial.
+Apply uniset_twist1.
+Qed.
+
+Lemma treesort_twist2 : (x,y,z,t,u:uniset) (seq u (union y z)) ->
+   (seq (union x (union u t)) (union (union y (union x z)) t)).
+Proof.
+Intros; Apply seq_trans with (union x (union (union y z) t)).
+Apply seq_right; Apply seq_left; Trivial.
+Apply uniset_twist2.
+Qed.
+
+
+(*i theory of minter to do similarly 
+Require Min.
+(* uniset intersection *)
+Definition minter := [m1,m2:uniset]
+    (Charac [a:A](andb (charac m1 a)(charac m2 a))).
+i*)
+
+End defs.
+
+Unset Implicit Arguments.
diff --git a/theories7/Sorting/Heap.v b/theories7/Sorting/Heap.v
new file mode 100644
index 00000000..63e7f324
--- /dev/null
+++ b/theories7/Sorting/Heap.v
@@ -0,0 +1,223 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Heap.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+(** A development of Treesort on Heap trees *)
+
+(* G. Huet 1-9-95 uses Multiset *)
+
+Require PolyList.
+Require Multiset.
+Require Permutation.
+Require Relations.
+Require Sorting.
+
+
+Section defs.
+
+Variable A : Set.
+Variable leA : (relation A).
+Variable eqA : (relation A).
+
+Local gtA := [x,y:A]~(leA x y).
+
+Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
+Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
+Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
+Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+
+Hints Resolve leA_refl.
+Hints Immediate eqA_dec leA_dec leA_antisym.
+
+Local emptyBag := (EmptyBag A).
+Local singletonBag := (SingletonBag eqA_dec).
+
+Inductive Tree : Set :=
+      Tree_Leaf : Tree
+    | Tree_Node : A -> Tree -> Tree -> Tree.
+
+(** [a] is lower than a Tree [T] if [T] is a Leaf
+    or [T] is a Node holding [b>a] *)
+
+Definition leA_Tree := [a:A; t:Tree]
+ Cases t of 
+   Tree_Leaf           => True
+ | (Tree_Node b T1 T2) => (leA a b)
+ end.
+
+Lemma leA_Tree_Leaf : (a:A)(leA_Tree a Tree_Leaf).
+Proof.
+Simpl; Auto with datatypes.
+Qed.
+
+Lemma leA_Tree_Node : (a,b:A)(G,D:Tree)(leA a b) ->
+                        (leA_Tree a (Tree_Node b G D)).
+Proof.
+Simpl; Auto with datatypes.
+Qed.
+
+Hints Resolve leA_Tree_Leaf leA_Tree_Node.
+
+
+(** The heap property *)
+
+Inductive is_heap : Tree -> Prop :=
+      nil_is_heap : (is_heap Tree_Leaf)
+    | node_is_heap : (a:A)(T1,T2:Tree)
+                     (leA_Tree a T1) ->
+                     (leA_Tree a T2) ->
+                     (is_heap T1) -> (is_heap T2) ->
+                     (is_heap (Tree_Node a T1 T2)).
+
+Hint constr_is_heap := Constructors is_heap.
+
+Lemma invert_heap : (a:A)(T1,T2:Tree)(is_heap (Tree_Node a T1 T2))->
+  (leA_Tree a T1) /\ (leA_Tree a T2) /\
+  (is_heap T1) /\ (is_heap T2).
+Proof.
+Intros; Inversion H; Auto with datatypes.
+Qed.
+
+(* This lemma ought to be generated automatically by the Inversion tools *)
+Lemma is_heap_rec : (P:Tree->Set)
+        (P Tree_Leaf)->
+         ((a:A)
+           (T1:Tree)
+            (T2:Tree)
+             (leA_Tree a T1)->
+              (leA_Tree a T2)->
+               (is_heap T1)->
+                (P T1)->(is_heap T2)->(P T2)->(P (Tree_Node a T1 T2)))
+         -> (T:Tree)(is_heap T) -> (P T).
+Proof.
+Induction T; Auto with datatypes.
+Intros a G PG D PD PN. 
+Elim (invert_heap a G D); Auto with datatypes.
+Intros H1 H2; Elim H2; Intros H3 H4; Elim H4; Intros.
+Apply H0; Auto with datatypes.
+Qed.
+
+Lemma low_trans : 
+  (T:Tree)(a,b:A)(leA a b) -> (leA_Tree b T) -> (leA_Tree a T).
+Proof.
+Induction T; Auto with datatypes.
+Intros; Simpl; Apply leA_trans with b; Auto with datatypes.
+Qed.
+
+(** contents of a tree as a multiset *)
+
+(** Nota Bene : In what follows the definition of SingletonBag
+    in not used. Actually, we could just take as postulate:
+    [Parameter SingletonBag : A->multiset].  *)
+
+Fixpoint  contents [t:Tree] : (multiset A) :=
+ Cases t of
+   Tree_Leaf           => emptyBag
+ | (Tree_Node a t1 t2) => (munion (contents t1) 
+                          (munion (contents t2) (singletonBag a)))
+end.
+
+
+(** equivalence of two trees is equality of corresponding multisets *)
+
+Definition equiv_Tree := [t1,t2:Tree](meq (contents t1) (contents t2)).
+
+
+(** specification of heap insertion *)
+
+Inductive insert_spec [a:A; T:Tree] : Set :=
+   insert_exist : (T1:Tree)(is_heap T1) ->
+                  (meq (contents T1) (munion (contents T) (singletonBag a))) ->
+                  ((b:A)(leA b a)->(leA_Tree b T)->(leA_Tree b T1)) ->
+                  (insert_spec a T).
+
+
+Lemma insert : (T:Tree)(is_heap T) -> (a:A)(insert_spec a T).
+Proof.
+Induction 1; Intros.
+Apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf); Auto with datatypes.
+Simpl; Unfold meq munion; Auto with datatypes.
+Elim (leA_dec a a0); Intros.
+Elim (H3 a0); Intros.
+Apply insert_exist with (Tree_Node a T2 T0); Auto with datatypes.
+Simpl; Apply treesort_twist1; Trivial with datatypes. 
+Elim (H3 a); Intros T3 HeapT3 ConT3 LeA.
+Apply insert_exist with (Tree_Node a0 T2 T3); Auto with datatypes.
+Apply node_is_heap; Auto with datatypes.
+Apply low_trans with a; Auto with datatypes.
+Apply LeA; Auto with datatypes.
+Apply low_trans with a; Auto with datatypes.
+Simpl; Apply treesort_twist2; Trivial with datatypes. 
+Qed.
+
+(** building a heap from a list *)
+
+Inductive build_heap [l:(list A)] : Set :=
+   heap_exist : (T:Tree)(is_heap T) ->
+                (meq (list_contents eqA_dec l)(contents T)) ->
+                (build_heap l).
+
+Lemma list_to_heap : (l:(list A))(build_heap l).
+Proof.
+Induction l.
+Apply (heap_exist (nil  A) Tree_Leaf); Auto with datatypes.
+Simpl; Unfold meq; Auto with datatypes.
+Induction 1.
+Intros T i m; Elim (insert T i a).
+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.
+Apply munion_comm.
+Apply meq_sym; Trivial with datatypes.
+Qed.
+
+
+(** building the sorted list *)
+
+Inductive flat_spec [T:Tree] : Set :=
+ flat_exist : (l:(list A))(sort leA l) ->
+              ((a:A)(leA_Tree a T)->(lelistA leA a l)) ->
+              (meq (contents T) (list_contents eqA_dec l)) ->
+              (flat_spec T).
+
+Lemma heap_to_list : (T:Tree)(is_heap T) -> (flat_spec T).
+Proof.
+  Intros T h; Elim h; Intros.
+  Apply flat_exist with (nil A); Auto with datatypes.
+  Elim H2; Intros l1 s1 i1 m1; Elim H4; Intros l2 s2 i2 m2.
+  Elim (merge leA_dec eqA_dec s1 s2); Intros.
+  Apply flat_exist with (cons a l); Simpl; Auto with datatypes.
+  Apply meq_trans with 
+    (munion (list_contents eqA_dec l1) (munion (list_contents eqA_dec l2) 
+                                               (singletonBag a))).
+  Apply meq_congr; Auto with datatypes.
+  Apply meq_trans with 
+    (munion (singletonBag a) (munion (list_contents eqA_dec l1) 
+                                     (list_contents eqA_dec  l2))).
+  Apply munion_rotate.
+  Apply meq_right; Apply meq_sym; Trivial with datatypes.
+Qed.
+
+(** specification of treesort *)
+
+Theorem treesort : (l:(list A))
+  {m:(list A) | (sort leA m) & (permutation eqA_dec l m)}.
+Proof.
+  Intro l; Unfold permutation.
+  Elim (list_to_heap l).
+  Intros.
+  Elim (heap_to_list T); Auto with datatypes.
+  Intros.
+  Exists l0; Auto with datatypes.
+  Apply meq_trans with (contents T); Trivial with datatypes.
+Qed.
+
+End defs.
diff --git a/theories7/Sorting/Permutation.v b/theories7/Sorting/Permutation.v
new file mode 100644
index 00000000..46b8da00
--- /dev/null
+++ b/theories7/Sorting/Permutation.v
@@ -0,0 +1,111 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Permutation.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+Require Relations.
+Require PolyList.
+Require Multiset.
+
+Set Implicit Arguments.
+
+Section defs.
+
+Variable A : Set.
+Variable leA : (relation A).
+Variable eqA : (relation A).
+
+Local gtA := [x,y:A]~(leA x y).
+
+Hypothesis leA_dec : (x,y:A){(leA x y)}+{~(leA x y)}.
+Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
+Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
+Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+
+Hints Resolve leA_refl : default.
+Hints Immediate eqA_dec leA_dec leA_antisym : default.
+
+Local emptyBag := (EmptyBag A).
+Local singletonBag := (SingletonBag eqA_dec).
+
+(** contents of a list *)
+
+Fixpoint list_contents [l:(list A)] : (multiset A) :=
+ Cases l of
+   nil        => emptyBag
+ | (cons a l) => (munion (singletonBag a) (list_contents l))
+ end.
+
+Lemma list_contents_app : (l,m:(list A))
+  (meq (list_contents (app l m)) (munion (list_contents l) (list_contents m))).
+Proof.
+Induction l; Simpl; Auto with datatypes.
+Intros.
+Apply meq_trans with  
+ (munion (singletonBag a) (munion (list_contents l0) (list_contents m))); Auto with datatypes.
+Qed.
+Hints Resolve list_contents_app.
+
+Definition permutation := [l,m:(list A)](meq (list_contents l) (list_contents m)).
+
+Lemma permut_refl : (l:(list A))(permutation l l).
+Proof.
+Unfold permutation; Auto with datatypes.
+Qed.
+Hints Resolve permut_refl.
+
+Lemma permut_tran : (l,m,n:(list A))
+   (permutation l m) -> (permutation m n) -> (permutation l n).
+Proof.
+Unfold permutation; Intros.
+Apply meq_trans with (list_contents m); Auto with datatypes.
+Qed.
+
+Lemma permut_right : (l,m:(list A))
+   (permutation l m) -> (a:A)(permutation (cons a l) (cons a m)).
+Proof.
+Unfold permutation; Simpl; Auto with datatypes.
+Qed.
+Hints Resolve permut_right.
+
+Lemma permut_app : (l,l',m,m':(list A))
+   (permutation l l') -> (permutation m m') ->
+   (permutation (app l m) (app l' m')).
+Proof.
+Unfold permutation; Intros.
+Apply meq_trans with (munion (list_contents l) (list_contents m)); Auto with datatypes.
+Apply meq_trans with (munion (list_contents l') (list_contents m')); Auto with datatypes.
+Apply meq_trans with (munion (list_contents l') (list_contents m)); Auto with datatypes.
+Qed.
+Hints Resolve permut_app.
+
+Lemma permut_cons : (l,m:(list A))(permutation l m) ->
+    (a:A)(permutation (cons a l) (cons a m)).
+Proof.
+Intros l m H a.
+Change (permutation (app (cons a (nil A)) l) (app (cons a (nil A)) m)).
+Apply permut_app; Auto with datatypes.
+Qed.
+Hints Resolve permut_cons.
+
+Lemma permut_middle : (l,m:(list A))
+   (a:A)(permutation (cons a (app l m)) (app l (cons a m))).
+Proof.
+Unfold permutation.
+Induction l; Simpl; Auto with datatypes.
+Intros.
+Apply meq_trans with (munion (singletonBag a)
+          (munion (singletonBag a0) (list_contents (app l0 m)))); Auto with datatypes.
+Apply munion_perm_left; Auto with datatypes.
+Qed.
+Hints Resolve permut_middle.
+
+End defs.
+Unset Implicit Arguments.
+
diff --git a/theories7/Sorting/Sorting.v b/theories7/Sorting/Sorting.v
new file mode 100644
index 00000000..a6e38976
--- /dev/null
+++ b/theories7/Sorting/Sorting.v
@@ -0,0 +1,117 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Sorting.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+Require PolyList.
+Require Multiset.
+Require Permutation.
+Require Relations.
+
+Set Implicit Arguments.
+
+Section defs.
+
+Variable A : Set.
+Variable leA : (relation A).
+Variable eqA : (relation A).
+
+Local gtA := [x,y:A]~(leA x y).
+
+Hypothesis leA_dec : (x,y:A){(leA x y)}+{(leA y x)}.
+Hypothesis eqA_dec : (x,y:A){(eqA x y)}+{~(eqA x y)}.
+Hypothesis leA_refl : (x,y:A) (eqA x y) -> (leA x y).
+Hypothesis leA_trans : (x,y,z:A) (leA x y) -> (leA y z) -> (leA x z).
+Hypothesis leA_antisym : (x,y:A)(leA x y) -> (leA y x) -> (eqA x y).
+
+Hints Resolve leA_refl.
+Hints Immediate eqA_dec leA_dec leA_antisym.
+
+Local emptyBag := (EmptyBag A).
+Local singletonBag := (SingletonBag eqA_dec).
+
+(** [lelistA] *)
+
+Inductive lelistA [a:A] : (list A) -> Prop :=
+      nil_leA : (lelistA a (nil A))
+    | cons_leA : (b:A)(l:(list A))(leA a b)->(lelistA a (cons b l)).
+Hint constr_lelistA := Constructors lelistA.
+
+Lemma lelistA_inv : (a,b:A)(l:(list A))
+      (lelistA a (cons b l)) -> (leA a b).
+Proof.
+  Intros; Inversion H; Trivial with datatypes.
+Qed.
+
+(** definition for a list to be sorted *)
+
+Inductive sort : (list A) -> Prop :=
+   nil_sort : (sort (nil A))
+ | cons_sort : (a:A)(l:(list A))(sort l) -> (lelistA a l) -> (sort (cons a l)).
+Hint constr_sort := Constructors sort.
+
+Lemma sort_inv : (a:A)(l:(list A))(sort (cons a l))->(sort l) /\ (lelistA a l).
+Proof.
+Intros; Inversion H; Auto with datatypes.
+Qed.
+
+Lemma sort_rec : (P:(list A)->Set)
+     (P (nil A)) ->
+     ((a:A)(l:(list A))(sort l)->(P l)->(lelistA a l)->(P (cons a l))) ->
+     (y:(list A))(sort y) -> (P y).
+Proof.
+Induction y; Auto with datatypes.
+Intros; Elim (!sort_inv a l); Auto with datatypes.
+Qed.
+
+(** merging two sorted lists *)
+
+Inductive merge_lem [l1:(list A);l2:(list A)] : Set :=
+  merge_exist : (l:(list A))(sort l) ->
+    (meq (list_contents eqA_dec l)
+         (munion (list_contents eqA_dec l1) (list_contents eqA_dec l2))) ->
+    ((a:A)(lelistA a l1)->(lelistA a l2)->(lelistA a l)) ->
+    (merge_lem l1 l2).
+
+Lemma merge : (l1:(list A))(sort l1)->(l2:(list A))(sort l2)->(merge_lem l1 l2).
+Proof.
+  Induction 1; Intros.
+  Apply merge_exist with l2; Auto with datatypes.
+  Elim H3; Intros.
+  Apply merge_exist with (cons a l); Simpl; Auto with datatypes.
+  Elim (leA_dec a a0); Intros.
+
+(* 1 (leA a a0) *)
+  Cut (merge_lem l (cons a0 l0)); Auto with datatypes.
+  Intros (l3, l3sorted, l3contents, Hrec).
+  Apply merge_exist with (cons a l3); Simpl; Auto with datatypes.
+  Apply meq_trans with (munion (singletonBag a)
+	                       (munion (list_contents eqA_dec l)
+                                       (list_contents eqA_dec (cons a0 l0)))).
+  Apply meq_right; Trivial with datatypes.
+  Apply meq_sym; Apply munion_ass.
+  Intros; Apply cons_leA.
+  Apply lelistA_inv with l; Trivial with datatypes.
+
+(* 2 (leA a0 a) *)
+  Elim H5; Simpl; Intros.
+  Apply merge_exist with (cons a0 l3); Simpl; Auto with datatypes.
+  Apply meq_trans with (munion (singletonBag a0)
+                               (munion (munion (singletonBag a) 
+                                               (list_contents eqA_dec l))
+                               (list_contents eqA_dec l0))).
+  Apply meq_right; Trivial with datatypes.
+  Apply munion_perm_left.
+  Intros; Apply cons_leA; Apply lelistA_inv with l0; Trivial with datatypes.
+Qed.
+
+End defs.
+
+Unset Implicit Arguments.
+Hint constr_sort : datatypes v62 := Constructors sort.
+Hint constr_lelistA : datatypes v62 := Constructors lelistA.
diff --git a/theories7/Wellfounded/Disjoint_Union.v b/theories7/Wellfounded/Disjoint_Union.v
new file mode 100644
index 00000000..04930170
--- /dev/null
+++ b/theories7/Wellfounded/Disjoint_Union.v
@@ -0,0 +1,56 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Disjoint_Union.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+(** Author: Cristina Cornes
+    From : Constructing Recursion Operators in Type Theory                 
+           L. Paulson  JSC (1986) 2, 325-355 *) 
+
+Require Relation_Operators.
+
+Section Wf_Disjoint_Union.
+Variable A,B:Set.
+Variable leA: A->A->Prop.
+Variable leB: B->B->Prop.
+
+Notation Le_AsB := (le_AsB A B leA leB).
+
+Lemma acc_A_sum: (x:A)(Acc A leA x)->(Acc A+B Le_AsB (inl A B x)).
+Proof.
+ NewInduction 1.
+ Apply Acc_intro;Intros y H2.
+ Inversion_clear H2.
+ Auto with sets.
+Qed.
+
+Lemma acc_B_sum: (well_founded A leA) ->(x:B)(Acc B leB x)
+                        ->(Acc A+B Le_AsB (inr A B x)).
+Proof.
+ NewInduction 2.
+ Apply Acc_intro;Intros y H3.
+ Inversion_clear H3;Auto with sets.
+ Apply acc_A_sum;Auto with sets.
+Qed.
+
+
+Lemma wf_disjoint_sum:
+ (well_founded A leA) 
+    -> (well_founded B leB) -> (well_founded A+B Le_AsB).
+Proof.
+ Intros.
+ Unfold well_founded .
+ NewDestruct a as [a|b].
+ Apply (acc_A_sum a).
+ Apply (H a).
+
+ Apply (acc_B_sum H b).
+ Apply (H0 b).
+Qed.
+
+End Wf_Disjoint_Union.
diff --git a/theories7/Wellfounded/Inclusion.v b/theories7/Wellfounded/Inclusion.v
new file mode 100644
index 00000000..6a515333
--- /dev/null
+++ b/theories7/Wellfounded/Inclusion.v
@@ -0,0 +1,33 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Inclusion.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+(** Author: Bruno Barras *)
+
+Require Relation_Definitions.
+
+Section WfInclusion.
+  Variable A:Set.
+  Variable R1,R2:A->A->Prop.
+
+  Lemma Acc_incl: (inclusion A R1 R2)->(z:A)(Acc A R2 z)->(Acc A R1 z).
+  Proof.
+    NewInduction 2.
+    Apply Acc_intro;Auto with sets.
+  Qed.
+
+  Hints Resolve Acc_incl.
+
+  Theorem wf_incl: 
+         (inclusion A R1 R2)->(well_founded A R2)->(well_founded A R1).
+  Proof.
+    Unfold well_founded ;Auto with sets.
+  Qed.
+
+End WfInclusion.
diff --git a/theories7/Wellfounded/Inverse_Image.v b/theories7/Wellfounded/Inverse_Image.v
new file mode 100644
index 00000000..6c9c3e65
--- /dev/null
+++ b/theories7/Wellfounded/Inverse_Image.v
@@ -0,0 +1,58 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Inverse_Image.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+(** Author: Bruno Barras *)
+
+Section Inverse_Image.
+
+  Variables A,B:Set.
+  Variable R : B->B->Prop.
+  Variable f:A->B.
+
+  Local Rof : A->A->Prop := [x,y:A](R (f x) (f y)).
+
+  Remark Acc_lemma : (y:B)(Acc B R y)->(x:A)(y=(f x))->(Acc A Rof x).
+    NewInduction 1 as [y _ IHAcc]; Intros x H.
+    Apply Acc_intro; Intros y0 H1.
+    Apply (IHAcc (f y0)); Try Trivial.
+    Rewrite H; Trivial.
+  Qed.
+
+  Lemma Acc_inverse_image : (x:A)(Acc B R (f x)) -> (Acc A Rof x).
+    Intros; Apply (Acc_lemma (f x)); Trivial.
+  Qed.
+
+  Theorem wf_inverse_image: (well_founded B R)->(well_founded A Rof).
+    Red; Intros; Apply Acc_inverse_image; Auto.
+  Qed.
+
+  Variable F : A -> B -> Prop.
+  Local RoF : A -> A -> Prop := [x,y]
+    (EX b : B | (F x b) & (c:B)(F y c)->(R b c)).
+
+Lemma Acc_inverse_rel :
+   (b:B)(Acc B R b)->(x:A)(F x b)->(Acc A RoF x).
+NewInduction 1 as [x _ IHAcc]; Intros x0 H2.
+Constructor; Intros y H3.
+NewDestruct H3.
+Apply (IHAcc x1); Auto.
+Save.
+
+
+Theorem wf_inverse_rel : 
+   (well_founded B R)->(well_founded A RoF).
+    Red; Constructor; Intros.
+    Case H0; Intros.
+    Apply (Acc_inverse_rel x); Auto.
+Save.
+
+End Inverse_Image.
+
+
diff --git a/theories7/Wellfounded/Lexicographic_Exponentiation.v b/theories7/Wellfounded/Lexicographic_Exponentiation.v
new file mode 100644
index 00000000..17f6d650
--- /dev/null
+++ b/theories7/Wellfounded/Lexicographic_Exponentiation.v
@@ -0,0 +1,386 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Lexicographic_Exponentiation.v,v 1.1.2.1 2004/07/16 19:31:41 herbelin Exp $ i*)
+
+(** Author: Cristina Cornes
+
+    From : Constructing Recursion Operators in Type Theory                
+           L. Paulson  JSC (1986) 2, 325-355  *)
+
+Require Eqdep.
+Require PolyList.
+Require PolyListSyntax.
+Require Relation_Operators.
+Require Transitive_Closure.
+
+Section Wf_Lexicographic_Exponentiation.
+Variable A:Set.
+Variable leA: A->A->Prop.
+
+Notation Power := (Pow A leA).
+Notation Lex_Exp := (lex_exp A leA).
+Notation ltl := (Ltl A leA).
+Notation Descl := (Desc A leA).
+
+Notation List := (list A).
+Notation Nil := (nil A).
+(* useless but symmetric *)
+Notation Cons := (cons 1!A).
+Notation "<< x , y >>" := (exist List Descl x y) (at level 0)
+  V8only (at level 0, x,y at level 100).
+
+V7only[
+Syntax constr
+  level 1:
+    List [ (list A) ] -> ["List"]
+  | Nil  [ (nil A) ] -> ["Nil"]
+  | Cons [ (cons A) ] -> ["Cons"]
+  ;
+  level 10:
+    Cons2 [ (cons A $e $l) ] -> ["Cons " $e:L " " $l:L ].
+
+Syntax constr
+  level 1:
+  pair_sig [ (exist (list A) Desc $e $d) ] -> ["<<" $e:L "," $d:L ">>"].
+].
+Hints Resolve d_one d_nil  t_step.
+
+Lemma left_prefix : (x,y,z:List)(ltl x^y z)-> (ltl x z).
+Proof.
+ Induction x.
+ Induction z.
+ Simpl;Intros H.
+ Inversion_clear H. 
+ Simpl;Intros;Apply (Lt_nil A leA).
+ Intros a l HInd.
+ Simpl.
+ Intros.
+ Inversion_clear H.
+ Apply (Lt_hd A leA);Auto with sets.
+ Apply (Lt_tl A leA).
+ Apply (HInd y y0);Auto with sets.
+Qed.
+
+
+Lemma  right_prefix : 
+  (x,y,z:List)(ltl x y^z)-> (ltl x y) \/ (EX y':List | x=(y^y') /\ (ltl y' z)).
+Proof.
+ Intros x y;Generalize x.
+ Elim y;Simpl.
+ Right.
+ Exists x0 ;Auto with sets.
+ Intros.
+ Inversion H0.
+ Left;Apply (Lt_nil A leA).
+ Left;Apply (Lt_hd A leA);Auto with sets.
+ Generalize (H x1 z H3) .
+ Induction 1.
+ Left;Apply (Lt_tl A leA);Auto with sets.
+ Induction 1.
+ Induction 1;Intros.
+ Rewrite -> H8.
+ Right;Exists x2 ;Auto with sets.
+Qed.
+
+
+
+Lemma desc_prefix: (x:List)(a:A)(Descl x^(Cons a Nil))->(Descl x).
+Proof.
+ Intros.
+ Inversion H.
+ Generalize (app_cons_not_nil H1); Induction 1. 
+ Cut (x^(Cons a Nil))=(Cons x0 Nil); Auto with sets.
+ Intro.
+ Generalize (app_eq_unit H0) .
+ Induction 1; Induction 1; Intros.
+ Rewrite -> H4; Auto with sets.
+ Discriminate H5.
+ Generalize (app_inj_tail H0) .
+ Induction 1; Intros.
+ Rewrite <- H4; Auto with sets.
+Qed.
+
+Lemma desc_tail: (x:List)(a,b:A)
+          (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
+Proof.
+ Intro.
+ Apply rev_ind with  A:=A
+             P:=[x:List](a,b:A)
+          (Descl (Cons b (x^(Cons a Nil))))-> (clos_trans A leA a b).
+ Intros.
+
+ Inversion  H.
+ Cut (Cons b (Cons a Nil))= ((Nil^(Cons b Nil))^ (Cons a Nil)); Auto with sets; Intro.
+ Generalize H0.
+ Intro.
+ Generalize (app_inj_tail 2!(l^(Cons y Nil)) 3!(Nil^(Cons b Nil)) H4);
+ Induction 1.
+ Intros.
+
+ Generalize (app_inj_tail H6); Induction 1; Intros.
+ Generalize H1.
+ Rewrite <- H10; Rewrite <- H7; Intro.
+ Apply (t_step A leA); Auto with sets.
+
+
+
+ Intros.
+ Inversion H0.
+ Generalize  (app_cons_not_nil H3); Intro.
+ Elim H1.
+
+ Generalize H0.
+ Generalize (app_comm_cons (l^(Cons x0 Nil)) (Cons a Nil) b); Induction 1.
+ Intro.
+ Generalize (desc_prefix (Cons b (l^(Cons x0 Nil))) a H5); Intro.
+ Generalize (H x0 b H6).
+ Intro.
+ Apply t_trans with A:=A  y:=x0; Auto with sets.
+
+ Apply  t_step.
+ Generalize H1.
+ Rewrite -> H4; Intro.
+
+ Generalize (app_inj_tail H8); Induction 1.
+ Intros.
+ Generalize H2; Generalize (app_comm_cons l (Cons x0 Nil) b).
+ Intro.
+ Generalize H10.
+ Rewrite ->H12; Intro.
+ Generalize (app_inj_tail H13); Induction 1.
+ Intros.
+ Rewrite <- H11; Rewrite <- H16; Auto with sets.
+Qed.
+
+
+Lemma dist_aux : (z:List)(Descl z)->(x,y:List)z=(x^y)->(Descl x)/\ (Descl y).
+Proof.
+ Intros z D.
+ Elim D.
+ Intros.
+ Cut (x^y)=Nil;Auto with sets; Intro.
+ Generalize (app_eq_nil H0) ; Induction 1.
+ Intros.
+ Rewrite -> H2;Rewrite -> H3; Split;Apply d_nil.
+
+ Intros.
+ Cut (x0^y)=(Cons x Nil); Auto with sets.
+ Intros E.
+ Generalize (app_eq_unit E); Induction 1.
+ Induction 1;Intros.
+ Rewrite -> H2;Rewrite -> H3; Split.
+ Apply d_nil.
+
+ Apply d_one.
+
+ Induction 1; Intros.
+ Rewrite -> H2;Rewrite -> H3; Split.
+ Apply d_one.
+
+ Apply d_nil.
+
+ Do 5 Intro.
+ Intros Hind.
+ Do 2 Intro.
+ Generalize x0 .
+ Apply rev_ind with A:=A 
+      P:=[y0:List]
+          (x0:List)
+          ((l^(Cons y Nil))^(Cons x Nil))=(x0^y0)->(Descl x0)/\(Descl y0).
+
+ Intro.
+ Generalize (app_nil_end x1) ; Induction 1; Induction 1.
+ Split. Apply d_conc; Auto with sets.
+
+ Apply d_nil.
+
+ Do 3 Intro.
+ Generalize x1 .
+ Apply rev_ind with 
+  A:=A 
+  P:=[l0:List]
+     (x1:A)
+      (x0:List)
+       ((l^(Cons y Nil))^(Cons x Nil))=(x0^(l0^(Cons x1 Nil)))
+         ->(Descl x0)/\(Descl (l0^(Cons x1 Nil))).
+
+
+ Simpl.
+ Split.
+ Generalize (app_inj_tail H2) ;Induction 1.
+ Induction 1;Auto with sets.
+
+ Apply d_one.
+ Do 5 Intro.
+ Generalize (app_ass x4 (l1^(Cons x2 Nil)) (Cons x3 Nil)) .
+ Induction 1.
+ Generalize (app_ass x4 l1 (Cons x2 Nil)) ;Induction 1.
+ Intro E.
+ Generalize (app_inj_tail E) .
+ Induction 1;Intros.
+ Generalize (app_inj_tail H6) ;Induction 1;Intros.
+ Rewrite <- H7;  Rewrite <- H10; Generalize H6.
+ Generalize (app_ass x4 l1 (Cons x2 Nil)); Intro E1.
+ Rewrite -> E1.
+ Intro.
+ Generalize (Hind x4 (l1^(Cons x2 Nil))  H11) .
+ Induction 1;Split.
+ Auto with sets.
+
+ Generalize H14.
+ Rewrite <- H10; Intro.
+ Apply d_conc;Auto with sets.
+Qed.
+
+
+
+Lemma dist_Desc_concat : (x,y:List)(Descl x^y)->(Descl x)/\(Descl y).
+Proof.
+  Intros.
+  Apply (dist_aux (x^y) H x y); Auto with sets.
+Qed.
+
+
+Lemma desc_end:(a,b:A)(x:List) 
+   (Descl x^(Cons a Nil)) /\ (ltl x^(Cons a Nil) (Cons b Nil))
+     -> (clos_trans A leA a b). 
+
+Proof.
+ Intros a b x.
+ Case x.
+ Simpl.
+ Induction 1.
+ Intros.
+ Inversion H1;Auto with sets.
+ Inversion H3.
+
+ Induction 1.
+ Generalize (app_comm_cons l (Cons a Nil) a0).
+ Intros E; Rewrite <- E; Intros.
+ Generalize (desc_tail l a a0 H0); Intro.
+ Inversion H1.
+ Apply t_trans with y:=a0 ;Auto with sets.
+
+ Inversion H4.
+Qed.
+
+
+
+
+Lemma  ltl_unit: (x:List)(a,b:A)
+ (Descl (x^(Cons a Nil))) -> (ltl x^(Cons a Nil) (Cons b Nil))
+               -> (ltl x (Cons b Nil)).
+Proof.
+ Intro.
+ Case x.
+ Intros;Apply (Lt_nil A leA).
+
+ Simpl;Intros.
+ Inversion_clear H0.
+ Apply (Lt_hd A leA  a b);Auto with sets.
+ 
+ Inversion_clear H1.
+Qed.
+
+
+Lemma acc_app: 
+    (x1,x2:List)(y1:(Descl x1^x2))
+     (Acc Power Lex_Exp (exist List Descl (x1^x2)  y1))
+     ->(x:List)
+        (y:(Descl x))
+         (ltl x (x1^x2))->(Acc Power Lex_Exp (exist List Descl x y)).
+Proof.
+ Intros.
+ Apply (Acc_inv Power Lex_Exp (exist List Descl (x1^x2) y1)).
+ Auto with sets.
+
+ Unfold lex_exp ;Simpl;Auto with sets.
+Qed.
+
+
+Theorem wf_lex_exp :
+  (well_founded A leA)->(well_founded Power Lex_Exp).
+Proof.
+ Unfold 2 well_founded .
+ Induction a;Intros x y.
+ Apply Acc_intro.
+ Induction y0.
+ Unfold 1 lex_exp ;Simpl.
+ Apply rev_ind with A:=A P:=[x:List]
+                            (x0:List)
+                             (y:(Descl x0))
+                              (ltl x0 x)
+                               ->(Acc Power Lex_Exp (exist List Descl x0 y)) .
+ Intros.
+ Inversion_clear H0.
+
+ Intro.
+ Generalize (well_founded_ind A (clos_trans A leA) (wf_clos_trans A leA H)).
+ Intros GR.
+ Apply GR with P:=[x0:A]
+                  (l:List)
+                   ((x1:List)
+                     (y:(Descl x1))
+                      (ltl x1 l)
+                       ->(Acc Power Lex_Exp (exist List Descl x1 y)))
+                    ->(x1:List)
+                       (y:(Descl x1))
+                        (ltl x1 (l^(Cons x0 Nil)))
+                         ->(Acc Power Lex_Exp (exist List Descl x1 y)) .
+ Intro;Intros HInd; Intros.
+ Generalize (right_prefix x2 l (Cons x1 Nil) H1) .
+ Induction 1.
+ Intro; Apply (H0 x2 y1 H3).
+
+ Induction 1.
+ Intro;Induction 1.
+ Clear  H4  H2.
+ Intro;Generalize y1 ;Clear  y1.
+ Rewrite -> H2.
+ Apply rev_ind with A:=A P:=[x3:List]
+                            (y1:(Descl (l^x3)))
+                             (ltl x3 (Cons x1 Nil))
+                              ->(Acc Power Lex_Exp
+                                  (exist List Descl (l^x3) y1)) .
+ Intros.
+ Generalize (app_nil_end l) ;Intros Heq.
+ Generalize y1 .
+ Clear  y1.
+ Rewrite <- Heq.
+ Intro.
+ Apply Acc_intro.
+ Induction y2.
+ Unfold 1 lex_exp .
+ Simpl;Intros x4 y3. Intros.
+ Apply (H0 x4 y3);Auto with sets.
+
+ Intros. 
+ Generalize (dist_Desc_concat l (l0^(Cons x4 Nil)) y1) .
+ Induction 1.
+ Intros.
+ Generalize (desc_end x4 x1 l0  (conj ? ? H8 H5)) ; Intros.
+ Generalize y1 .
+ Rewrite <- (app_ass l l0 (Cons x4 Nil)); Intro.
+ Generalize (HInd x4 H9 (l^l0)) ; Intros HInd2.
+ Generalize (ltl_unit l0 x4 x1 H8 H5); Intro.
+ Generalize (dist_Desc_concat (l^l0) (Cons x4 Nil) y2) .
+ Induction 1;Intros.
+ Generalize (H4 H12 H10); Intro.
+ Generalize (Acc_inv Power Lex_Exp (exist List Descl (l^l0) H12) H14) .
+ Generalize (acc_app l l0 H12 H14).
+ Intros f g.
+ Generalize (HInd2 f);Intro.
+ Apply Acc_intro.
+ Induction y3.
+ Unfold 1 lex_exp ;Simpl; Intros.
+ Apply H15;Auto with sets.
+Qed.
+
+
+End Wf_Lexicographic_Exponentiation.
diff --git a/theories7/Wellfounded/Lexicographic_Product.v b/theories7/Wellfounded/Lexicographic_Product.v
new file mode 100644
index 00000000..f31d8c3f
--- /dev/null
+++ b/theories7/Wellfounded/Lexicographic_Product.v
@@ -0,0 +1,191 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Lexicographic_Product.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Authors: Bruno Barras, Cristina Cornes *)
+
+Require Eqdep.
+Require Relation_Operators.
+Require Transitive_Closure.
+
+(**  From : Constructing Recursion Operators in Type Theory            
+     L. Paulson  JSC (1986) 2, 325-355 *)
+
+Section WfLexicographic_Product.
+Variable A:Set.
+Variable B:A->Set.
+Variable leA: A->A->Prop.
+Variable leB: (x:A)(B x)->(B x)->Prop.
+
+Notation LexProd := (lexprod A B leA leB).
+
+Hints Resolve t_step Acc_clos_trans wf_clos_trans.
+
+Lemma acc_A_B_lexprod : (x:A)(Acc A leA x)
+        ->((x0:A)(clos_trans A leA x0 x)->(well_founded (B x0) (leB x0)))
+                ->(y:(B x))(Acc (B x) (leB x) y)
+                        ->(Acc (sigS A B) LexProd (existS A B x y)).
+Proof.
+ NewInduction 1 as [x _ IHAcc]; Intros H2 y.
+ NewInduction 1 as [x0 H IHAcc0];Intros.
+ Apply Acc_intro.
+ NewDestruct y as [x2 y1]; Intro H6.
+ Simple Inversion H6; Intro.
+ Cut (leA x2 x);Intros.
+ Apply IHAcc;Auto with sets.
+ Intros.
+ Apply H2.
+ Apply t_trans with x2 ;Auto with sets.
+
+ Red in H2.
+ Apply H2.
+ Auto with sets.
+
+ Injection H1.
+ NewDestruct 2.
+ Injection H3.
+ NewDestruct 2;Auto with sets.
+
+ Rewrite <- H1.
+ Injection H3; Intros _ Hx1.
+ Subst x1.
+ Apply IHAcc0.
+ Elim inj_pair2 with A B x y' x0; Assumption.
+Qed.
+
+Theorem wf_lexprod: 
+   (well_founded A leA) ->((x:A) (well_founded (B x) (leB x))) 
+             -> (well_founded (sigS A B) LexProd).
+Proof.
+ Intros wfA wfB;Unfold well_founded .
+ NewDestruct a.
+ Apply acc_A_B_lexprod;Auto with sets;Intros.
+ Red in wfB.
+ Auto with sets.
+Qed.
+
+
+End WfLexicographic_Product.
+
+
+Section Wf_Symmetric_Product.
+  Variable A:Set.
+  Variable B:Set.
+  Variable leA: A->A->Prop.
+  Variable leB: B->B->Prop.
+
+  Notation Symprod := (symprod A B leA leB).
+
+(*i
+  Local sig_prod:=
+         [x:A*B]<{_:A&B}>Case x of [a:A][b:B](existS A [_:A]B a b) end.
+
+Lemma incl_sym_lexprod: (included (A*B) Symprod  
+            (R_o_f (A*B) {_:A&B} sig_prod (lexprod A [_:A]B leA [_:A]leB))).
+Proof.
+ Red.
+ Induction x.
+ (Induction y1;Intros).
+ Red.
+ Unfold sig_prod .
+ Inversion_clear H.
+ (Apply left_lex;Auto with sets).
+
+ (Apply right_lex;Auto with sets).
+Qed.
+i*)
+
+  Lemma Acc_symprod: (x:A)(Acc A leA x)->(y:B)(Acc B leB y)
+                        ->(Acc (A*B) Symprod (x,y)).
+ Proof.
+ NewInduction 1 as [x _ IHAcc]; Intros y H2.
+ NewInduction H2 as [x1 H3 IHAcc1].
+ Apply Acc_intro;Intros y H5.
+ Inversion_clear H5;Auto with sets.
+ Apply IHAcc; Auto.
+ Apply Acc_intro;Trivial.
+Qed.
+
+
+Lemma wf_symprod: (well_founded A leA)->(well_founded B leB)
+                        ->(well_founded (A*B) Symprod).
+Proof.
+ Red.
+ NewDestruct a.
+ Apply Acc_symprod;Auto with sets.
+Qed.
+
+End Wf_Symmetric_Product.
+
+
+Section Swap.
+
+  Variable A:Set.
+  Variable R:A->A->Prop.
+
+  Notation SwapProd :=(swapprod A R).
+
+
+  Lemma swap_Acc: (x,y:A)(Acc A*A SwapProd (x,y))->(Acc A*A SwapProd (y,x)).
+Proof.
+ Intros.
+ Inversion_clear H.
+ Apply Acc_intro.
+ NewDestruct y0;Intros.
+ Inversion_clear H;Inversion_clear H1;Apply H0.
+ Apply sp_swap.
+ Apply right_sym;Auto with sets.
+
+ Apply sp_swap.
+ Apply left_sym;Auto with sets.
+
+ Apply sp_noswap.
+ Apply right_sym;Auto with sets.
+
+ Apply sp_noswap.
+ Apply left_sym;Auto with sets.
+Qed.
+
+
+  Lemma Acc_swapprod: (x,y:A)(Acc A R x)->(Acc A R y)
+                                ->(Acc A*A SwapProd (x,y)).
+Proof.
+ NewInduction 1 as [x0 _ IHAcc0];Intros H2.
+ Cut (y0:A)(R y0 x0)->(Acc ? SwapProd (y0,y)).
+ Clear  IHAcc0.
+ NewInduction H2 as [x1 _ IHAcc1]; Intros H4.
+ Cut (y:A)(R y x1)->(Acc ? SwapProd (x0,y)).
+ Clear  IHAcc1.
+ Intro.
+ Apply Acc_intro.
+ NewDestruct y; Intro H5.
+ Inversion_clear H5.
+ Inversion_clear H0;Auto with sets.
+
+ Apply swap_Acc.
+ Inversion_clear H0;Auto with sets.
+
+ Intros.
+ Apply IHAcc1;Auto with sets;Intros.
+ Apply Acc_inv with (y0,x1) ;Auto with sets.
+ Apply sp_noswap.
+ Apply right_sym;Auto with sets.
+
+ Auto with sets.
+Qed.
+
+
+  Lemma wf_swapprod: (well_founded A R)->(well_founded A*A SwapProd).
+Proof.
+ Red.
+ NewDestruct a;Intros.
+ Apply Acc_swapprod;Auto with sets.
+Qed.
+
+End Swap.
diff --git a/theories7/Wellfounded/Transitive_Closure.v b/theories7/Wellfounded/Transitive_Closure.v
new file mode 100644
index 00000000..4d6cbe28
--- /dev/null
+++ b/theories7/Wellfounded/Transitive_Closure.v
@@ -0,0 +1,47 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Transitive_Closure.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Author: Bruno Barras *)
+
+Require Relation_Definitions.
+Require Relation_Operators.
+
+Section Wf_Transitive_Closure.
+  Variable A: Set.
+  Variable R: (relation A).
+
+  Notation trans_clos := (clos_trans A R).
+ 
+  Lemma incl_clos_trans: (inclusion A R trans_clos).
+    Red;Auto with sets.
+  Qed.
+
+  Lemma Acc_clos_trans: (x:A)(Acc A R x)->(Acc A trans_clos x).
+    NewInduction 1 as [x0 _ H1].
+    Apply Acc_intro.
+    Intros y H2.
+    NewInduction H2;Auto with sets.
+    Apply Acc_inv with y ;Auto with sets.
+  Qed.
+
+  Hints Resolve Acc_clos_trans.
+
+  Lemma Acc_inv_trans: (x,y:A)(trans_clos y x)->(Acc A R x)->(Acc A R y).
+  Proof.
+    NewInduction 1 as [|x y];Auto with sets.
+    Intro; Apply Acc_inv with y; Assumption.
+  Qed.
+
+  Theorem wf_clos_trans: (well_founded A R)  ->(well_founded A trans_clos).
+  Proof.
+    Unfold well_founded;Auto with sets.
+  Qed.
+
+End Wf_Transitive_Closure.
diff --git a/theories7/Wellfounded/Union.v b/theories7/Wellfounded/Union.v
new file mode 100644
index 00000000..9b31f72d
--- /dev/null
+++ b/theories7/Wellfounded/Union.v
@@ -0,0 +1,74 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Union.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Author: Bruno Barras *)
+
+Require Relation_Operators.
+Require Relation_Definitions.
+Require Transitive_Closure.
+
+Section WfUnion.
+  Variable A: Set.
+  Variable R1,R2: (relation A).
+  
+ Notation Union := (union A R1 R2).
+
+ Hints Resolve Acc_clos_trans wf_clos_trans.
+
+Remark strip_commut: 
+      (commut A R1 R2)->(x,y:A)(clos_trans A R1 y x)->(z:A)(R2 z y)
+            ->(EX y':A | (R2 y' x) & (clos_trans A R1 z y')).
+Proof.
+ NewInduction 2 as [x y|x y z H0 IH1 H1 IH2]; Intros.
+ Elim H with y x z ;Auto with sets;Intros x0 H2 H3.
+ Exists x0;Auto with sets.
+
+ Elim IH1 with z0 ;Auto with sets;Intros.
+ Elim IH2 with x0 ;Auto with sets;Intros.
+ Exists x1;Auto with sets.
+ Apply t_trans with x0; Auto with sets.
+Qed.
+
+
+  Lemma Acc_union:  (commut A R1 R2)->((x:A)(Acc A R2 x)->(Acc A R1 x))
+                         ->(a:A)(Acc A R2 a)->(Acc A Union a).
+Proof.
+ NewInduction 3 as [x H1 H2].
+ Apply Acc_intro;Intros.
+ Elim H3;Intros;Auto with sets.
+ Cut (clos_trans A  R1 y x);Auto with sets.
+ ElimType (Acc A (clos_trans A R1) y);Intros.
+ Apply Acc_intro;Intros.
+ Elim H8;Intros.
+ Apply H6;Auto with sets.
+ Apply t_trans with x0 ;Auto with sets.
+
+ Elim strip_commut with x x0 y0 ;Auto with sets;Intros.
+ Apply Acc_inv_trans with x1 ;Auto with sets.
+ Unfold union .
+ Elim H11;Auto with sets;Intros.
+ Apply t_trans with y1 ;Auto with sets.
+
+ Apply (Acc_clos_trans A).
+ Apply Acc_inv with x ;Auto with sets.
+ Apply H0.
+ Apply Acc_intro;Auto with sets.
+Qed.
+
+
+  Theorem wf_union:  (commut A R1 R2)->(well_founded A R1)->(well_founded A R2)
+                  ->(well_founded A Union).
+Proof.
+ Unfold well_founded .
+ Intros.
+ Apply Acc_union;Auto with sets.
+Qed.
+
+End WfUnion.
diff --git a/theories7/Wellfounded/Well_Ordering.v b/theories7/Wellfounded/Well_Ordering.v
new file mode 100644
index 00000000..5c2b2405
--- /dev/null
+++ b/theories7/Wellfounded/Well_Ordering.v
@@ -0,0 +1,72 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Well_Ordering.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Author: Cristina Cornes.
+    From: Constructing Recursion Operators in Type Theory
+    L. Paulson  JSC (1986) 2, 325-355 *)
+
+Require Eqdep.
+
+Section WellOrdering.
+Variable A:Set.
+Variable B:A->Set. 
+
+Inductive WO : Set :=
+   sup : (a:A)(f:(B a)->WO)WO.
+
+
+Inductive le_WO  : WO->WO->Prop :=
+  le_sup : (a:A)(f:(B a)->WO)(v:(B a)) (le_WO  (f v) (sup a f)).
+ 
+
+Theorem wf_WO : (well_founded WO le_WO ).
+Proof.
+ Unfold well_founded ;Intro.
+ Apply Acc_intro.
+ Elim a.
+ Intros.
+ Inversion H0.
+ Apply Acc_intro.
+ Generalize H4 ;Generalize H1 ;Generalize f0 ;Generalize v.
+ Rewrite -> H3.
+ Intros.
+ Apply (H v0 y0).
+ Cut (eq ? f f1).
+ Intros E;Rewrite -> E;Auto.
+ Symmetry.
+ Apply (inj_pair2 A [a0:A](B a0)->WO a0 f1 f H5).
+Qed.
+
+End WellOrdering.
+
+
+Section Characterisation_wf_relations.
+
+(** Wellfounded relations are the inverse image of wellordering types *)
+(*  in course of development                                          *)
+
+
+Variable A:Set.
+Variable leA:A->A->Prop.
+
+Definition B:= [a:A] {x:A | (leA x a)}.
+
+Definition  wof: (well_founded A leA)-> A-> (WO A B).
+Proof.
+ Intros.
+ Apply (well_founded_induction A leA H [a:A](WO A B));Auto.
+ Intros.
+ Apply (sup A B x).
+ Unfold 1 B .
+ NewDestruct 1 as [x0].
+ Apply (H1 x0);Auto.
+Qed.
+
+End Characterisation_wf_relations.
diff --git a/theories7/Wellfounded/Wellfounded.v b/theories7/Wellfounded/Wellfounded.v
new file mode 100644
index 00000000..d1a8dd01
--- /dev/null
+++ b/theories7/Wellfounded/Wellfounded.v
@@ -0,0 +1,20 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Wellfounded.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+Require Export Disjoint_Union.
+Require Export Inclusion.
+Require Export Inverse_Image.
+Require Export Lexicographic_Exponentiation.
+Require Export Lexicographic_Product.
+Require Export Transitive_Closure.
+Require Export Union.
+Require Export Well_Ordering.
+
+
diff --git a/theories7/ZArith/BinInt.v b/theories7/ZArith/BinInt.v
new file mode 100644
index 00000000..9071896b
--- /dev/null
+++ b/theories7/ZArith/BinInt.v
@@ -0,0 +1,1005 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: BinInt.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(***********************************************************)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(***********************************************************)
+
+Require Export BinPos.
+Require Export Pnat.
+Require BinNat.
+Require Plus.
+Require Mult.
+(**********************************************************************)
+(** Binary integer numbers *)
+
+Inductive Z : Set := 
+  ZERO : Z | POS : positive -> Z | NEG : positive -> Z.
+
+(** Declare Scope Z_scope with Key Z *)
+Delimits Scope Z_scope with Z.
+
+(** Automatically open scope positive_scope for the constructors of Z *)
+Bind Scope Z_scope with Z.
+Arguments Scope POS [ positive_scope ].
+Arguments Scope NEG [ positive_scope ].
+
+(** Subtraction of positive into Z *)
+
+Definition Zdouble_plus_one [x:Z] :=
+  Cases x of 
+  | ZERO    => (POS xH)
+  | (POS p) => (POS (xI p))
+  | (NEG p) => (NEG (double_moins_un p))
+  end.
+
+Definition Zdouble_minus_one [x:Z] :=
+  Cases x of 
+  | ZERO    => (NEG xH)
+  | (NEG p) => (NEG (xI p))
+  | (POS p) => (POS (double_moins_un p))
+  end.
+
+Definition Zdouble [x:Z] :=
+  Cases x of
+  | ZERO => ZERO
+  | (POS p) => (POS (xO p))
+  | (NEG p) => (NEG (xO p))
+ end.
+
+Fixpoint ZPminus [x,y:positive] : Z :=
+  Cases x y of
+  | (xI x') (xI y') => (Zdouble (ZPminus x' y'))
+  | (xI x') (xO y') => (Zdouble_plus_one (ZPminus x' y'))
+  | (xI x') xH      => (POS (xO x'))
+  | (xO x') (xI y') => (Zdouble_minus_one (ZPminus x' y'))
+  | (xO x') (xO y') => (Zdouble (ZPminus x' y'))
+  | (xO x') xH      => (POS (double_moins_un x'))
+  | xH      (xI y') => (NEG (xO y'))
+  | xH      (xO y') => (NEG (double_moins_un y'))
+  | xH      xH      => ZERO
+  end.
+
+(** Addition on integers *)
+
+Definition Zplus := [x,y:Z]
+  Cases x y of
+    ZERO      y       => y
+  | x         ZERO    => x
+  | (POS x') (POS y') => (POS (add x' y'))
+  | (POS x') (NEG y') => 
+      Cases (compare x' y' EGAL) of
+      | EGAL => ZERO
+      | INFERIEUR => (NEG (true_sub y' x'))
+      | SUPERIEUR => (POS (true_sub x' y'))
+      end
+  | (NEG x') (POS y') =>
+      Cases (compare x' y' EGAL) of
+      | EGAL => ZERO
+      | INFERIEUR => (POS (true_sub y' x'))
+      | SUPERIEUR => (NEG (true_sub x' y'))
+      end
+  | (NEG x') (NEG y') => (NEG (add x' y'))
+  end.
+
+V8Infix "+" Zplus : Z_scope.
+
+(** Opposite *)
+
+Definition Zopp := [x:Z]
+ Cases x of
+      ZERO => ZERO
+    | (POS x) => (NEG x)
+    | (NEG x) => (POS x)
+    end.
+
+V8Notation "- x" := (Zopp x) : Z_scope.
+
+(** Successor on integers *)
+
+Definition Zs := [x:Z](Zplus x (POS xH)).
+
+(** Predecessor on integers *)
+
+Definition Zpred := [x:Z](Zplus x (NEG xH)).
+
+(** Subtraction on integers *)
+
+Definition Zminus := [m,n:Z](Zplus m (Zopp n)).
+
+V8Infix "-" Zminus : Z_scope.
+
+(** Multiplication on integers *)
+
+Definition Zmult := [x,y:Z]
+  Cases x y of
+  | ZERO     _        => ZERO
+  | _        ZERO     => ZERO
+  | (POS x') (POS y') => (POS (times x' y'))
+  | (POS x') (NEG y') => (NEG (times x' y'))
+  | (NEG x') (POS y') => (NEG (times x' y'))
+  | (NEG x') (NEG y') => (POS (times x' y'))
+  end.
+
+V8Infix "*" Zmult : Z_scope.
+
+(** Comparison of integers *)
+
+Definition Zcompare := [x,y:Z]
+  Cases x y of
+  | ZERO     ZERO     => EGAL
+  | ZERO     (POS y') => INFERIEUR
+  | ZERO     (NEG y') => SUPERIEUR
+  | (POS x') ZERO     => SUPERIEUR
+  | (POS x') (POS y') => (compare x' y' EGAL)
+  | (POS x') (NEG y') => SUPERIEUR
+  | (NEG x') ZERO     => INFERIEUR
+  | (NEG x') (POS y') => INFERIEUR
+  | (NEG x') (NEG y') => (Op (compare x' y' EGAL))
+  end.
+
+V8Infix "?=" Zcompare (at level 70, no associativity) : Z_scope.
+
+Tactic Definition ElimCompare com1 com2:=
+  Case (Dcompare (Zcompare com1 com2)); [ Idtac | 
+     Let x = FreshId "H" In Intro x; Case x; Clear x ].
+
+(** Sign function *)
+
+Definition Zsgn [z:Z] : Z :=
+  Cases z of 
+     ZERO   => ZERO
+  | (POS p) => (POS xH)
+  | (NEG p) => (NEG xH)
+  end.
+
+(** Direct, easier to handle variants of successor and addition *)
+
+Definition Zsucc' [x:Z] :=
+  Cases x of
+  | ZERO => (POS xH)
+  | (POS x') => (POS (add_un x'))
+  | (NEG x') => (ZPminus xH x')
+  end.
+
+Definition Zpred' [x:Z] :=
+  Cases x of
+  | ZERO => (NEG xH)
+  | (POS x') => (ZPminus x' xH)
+  | (NEG x') => (NEG (add_un x'))
+  end.
+
+Definition Zplus' := [x,y:Z]
+  Cases x y of
+    ZERO      y       => y
+  | x         ZERO    => x
+  | (POS x') (POS y') => (POS (add x' y'))
+  | (POS x') (NEG y') => (ZPminus x' y')
+  | (NEG x') (POS y') => (ZPminus y' x')
+  | (NEG x') (NEG y') => (NEG (add x' y'))
+  end.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Inductive specification of Z *)
+
+Theorem Zind : (P:(Z ->Prop))
+  (P ZERO) -> ((x:Z)(P x) ->(P (Zsucc' x))) -> ((x:Z)(P x) ->(P (Zpred' x))) ->
+     (z:Z)(P z).
+Proof.
+Intros P H0 Hs Hp z; NewDestruct z.
+  Assumption.
+  Apply Pind with P:=[p](P (POS p)).
+    Change (P (Zsucc' ZERO)); Apply Hs; Apply H0.
+    Intro n; Exact (Hs (POS n)).
+  Apply Pind with P:=[p](P (NEG p)).
+    Change (P (Zpred' ZERO)); Apply Hp; Apply H0.
+    Intro n; Exact (Hp (NEG n)).
+Qed.
+
+(**********************************************************************)
+(** Properties of opposite on binary integer numbers *)
+
+Theorem Zopp_NEG : (x:positive) (Zopp (NEG x)) = (POS x).
+Proof.
+Reflexivity.
+Qed.
+
+(** [opp] is involutive *)
+
+Theorem Zopp_Zopp: (x:Z) (Zopp (Zopp x)) = x.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+(** Injectivity of the opposite *)
+
+Theorem Zopp_intro : (x,y:Z) (Zopp x) = (Zopp y) -> x = y.
+Proof.
+Intros x y;Case x;Case y;Simpl;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 ].
+Qed.
+
+(**********************************************************************)
+(* Properties of the direct definition of successor and predecessor *)
+
+Lemma Zpred'_succ' : (x:Z)(Zpred' (Zsucc' x))=x.
+Proof.
+Intro x; NewDestruct x; Simpl.
+  Reflexivity.
+NewDestruct p; Simpl; Try Rewrite double_moins_un_add_un_xI; Reflexivity.
+NewDestruct p; Simpl; Try Rewrite is_double_moins_un; Reflexivity.
+Qed.
+
+Lemma Zsucc'_discr : (x:Z)x<>(Zsucc' x).
+Proof.
+Intro x; NewDestruct x; Simpl.
+  Discriminate.
+  Injection; Apply add_un_discr.
+  NewDestruct p; Simpl.
+    Discriminate.
+    Intro H; Symmetry in H; Injection H; Apply double_moins_un_xO_discr.
+    Discriminate.
+Qed.
+
+(**********************************************************************)
+(** Other properties of binary integer numbers *)
+
+Lemma ZL0 : (S (S O))=(plus (S O) (S O)).
+Proof.
+Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Properties of the addition on integers *)
+
+(** zero is left neutral for addition *)
+
+Theorem Zero_left: (x:Z) (Zplus ZERO x) = x.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+(** zero is right neutral for addition *)
+
+Theorem Zero_right: (x:Z) (Zplus x ZERO) = x.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+(** addition is commutative *)
+
+Theorem Zplus_sym: (x,y:Z) (Zplus x y) = (Zplus y x).
+Proof.
+Intro x;NewInduction x as [|p|p];Intro y; NewDestruct y as [|q|q];Simpl;Try Reflexivity.
+  Rewrite add_sym; Reflexivity.
+  Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
+  Rewrite ZC4; NewDestruct (compare q p EGAL); Reflexivity.
+  Rewrite add_sym; Reflexivity.
+Qed.
+
+(** opposite distributes over addition *)
+
+Theorem Zopp_Zplus: 
+  (x,y:Z) (Zopp (Zplus x y)) = (Zplus (Zopp x) (Zopp y)).
+Proof.
+Intro x; NewDestruct x as [|p|p]; Intro y; NewDestruct y as [|q|q]; Simpl;
+  Reflexivity Orelse NewDestruct  (compare p q EGAL); Reflexivity.
+Qed.
+
+(** opposite is inverse for addition *)
+
+Theorem Zplus_inverse_r: (x:Z) (Zplus x (Zopp x)) = ZERO.
+Proof.
+Intro x; NewDestruct x as [|p|p]; Simpl; [
+  Reflexivity
+| Rewrite (convert_compare_EGAL p); Reflexivity
+| Rewrite (convert_compare_EGAL p); Reflexivity ].
+Qed.
+
+Theorem Zplus_inverse_l: (x:Z) (Zplus (Zopp x) x) = ZERO.
+Proof.
+Intro; Rewrite Zplus_sym; Apply Zplus_inverse_r.
+Qed.
+
+Hints Local Resolve Zero_left Zero_right.
+
+(** addition is associative *)
+
+Lemma weak_assoc :
+  (x,y:positive)(z:Z) (Zplus (POS x) (Zplus (POS y) z))=
+                       (Zplus (Zplus (POS x) (POS y)) z).
+Proof.
+Intros x y z';Case z'; [
+  Auto with arith
+| Intros z;Simpl; Rewrite add_assoc;Auto with arith
+| Intros z; Simpl; ElimPcompare y z;
+  Intros E0;Rewrite E0;
+  ElimPcompare '(add x y) 'z;Intros E1;Rewrite E1; [
+    Absurd (compare (add x y) z EGAL)=EGAL; [    (* Case 1 *)
+      Rewrite convert_compare_SUPERIEUR; [
+        Discriminate
+      | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
+        Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
+        Apply le_plus_r ]
+    | Assumption ]
+  | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 2 *)
+      Rewrite convert_compare_SUPERIEUR; [
+        Discriminate
+      | Rewrite convert_add; Rewrite (compare_convert_EGAL y z E0);
+        Elim (ZL4 x);Intros k E2;Rewrite E2; Simpl; Unfold gt lt; Apply le_n_S;
+        Apply le_plus_r]
+    | Assumption ]
+  | Rewrite (compare_convert_EGAL y z E0); (* Case 3 *)
+    Elim (sub_pos_SUPERIEUR (add x z) z);[
+      Intros t H; Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
+      Unfold true_sub; Rewrite H1; Cut x=t; [
+        Intros E;Rewrite E;Auto with arith
+      | Apply simpl_add_r with z:=z; Rewrite <- H3; Rewrite add_sym; Trivial with arith ]
+    | Pattern 1 z; Rewrite <- (compare_convert_EGAL y z E0); Assumption ]
+  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 4 *)
+      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4; Unfold 1 true_sub;
+      Rewrite H1; Cut x=k; [
+        Intros E;Rewrite E; Rewrite (convert_compare_EGAL k); Trivial with arith
+      | Apply simpl_add_r with z:=y; Rewrite (add_sym k y); Rewrite H3;
+        Apply compare_convert_EGAL; Assumption ]
+    | Apply ZC2;Assumption]
+  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 5 *)
+      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
+      Unfold 1 3 5 true_sub; Rewrite H1;
+      Cut (compare x k EGAL)=INFERIEUR; [
+        Intros E2;Rewrite E2; Elim (sub_pos_SUPERIEUR k x); [
+          Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
+          Elim (sub_pos_SUPERIEUR z (add x y)); [
+            Intros j H10;Elim H10;Intros H11 H12;Elim H12;Intros H13 H14;
+            Unfold true_sub ;Rewrite H6;Rewrite H11; Cut i=j; [
+              Intros E;Rewrite E;Auto with arith
+            | Apply (simpl_add_l (add x y)); Rewrite H13; 
+              Rewrite (add_sym x y); Rewrite <- add_assoc; Rewrite H8;
+              Assumption ]
+          | Apply ZC2; Assumption]
+        | Apply ZC2;Assumption]
+      | Apply convert_compare_INFERIEUR;
+        Apply simpl_lt_plus_l with p:=(convert y);
+        Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
+        Rewrite H3; Rewrite add_sym; Assumption ]
+    | Apply ZC2; Assumption ]
+  | Elim (sub_pos_SUPERIEUR z y); [ (* Case 6 *)
+      Intros k H;Elim H;Intros H1 H2;Elim H2;Intros H3 H4;
+      Elim (sub_pos_SUPERIEUR (add x y) z); [
+        Intros i H5;Elim H5;Intros H6 H7;Elim H7;Intros H8 H9;
+        Unfold true_sub; Rewrite H1;Rewrite H6;
+        Cut (compare x k EGAL)=SUPERIEUR; [
+          Intros H10;Elim (sub_pos_SUPERIEUR 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 (simpl_add_l (add z k)); Rewrite <- (add_assoc z k j);
+            Rewrite H14; Rewrite (add_sym z k); Rewrite <- add_assoc;
+            Rewrite H8; Rewrite (add_sym x y); Rewrite add_assoc;
+            Rewrite (add_sym k y); Rewrite H3; Trivial with arith]
+        | Apply convert_compare_SUPERIEUR; Unfold lt gt;
+          Apply simpl_lt_plus_l with p:=(convert y);
+          Do 2 Rewrite <- convert_add; Apply compare_convert_INFERIEUR;
+          Rewrite H3; Rewrite add_sym; Apply ZC1; Assumption ]
+      | Assumption ]
+    | Apply ZC2;Assumption ]
+  | Absurd (compare (add x y) z EGAL)=EGAL; [ (* Case 7 *)
+      Rewrite convert_compare_SUPERIEUR; [
+        Discriminate
+      | Rewrite convert_add; Unfold gt;Apply lt_le_trans with m:=(convert y);[
+          Apply compare_convert_INFERIEUR; Apply ZC1; Assumption
+        | Apply le_plus_r]]
+    | Assumption ]
+  | Absurd (compare (add x y) z EGAL)=INFERIEUR; [ (* Case 8 *)
+      Rewrite convert_compare_SUPERIEUR; [
+        Discriminate
+      | Unfold gt; Apply lt_le_trans with m:=(convert y);[
+          Exact (compare_convert_SUPERIEUR y z E0)
+        | Rewrite convert_add; Apply le_plus_r]]
+    | Assumption ]
+  | Elim sub_pos_SUPERIEUR with 1:=E0;Intros k H1; (* Case 9 *)
+    Elim sub_pos_SUPERIEUR 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 true_sub ;Rewrite H3;Rewrite H7; Cut (add x k)=i; [
+      Intros E;Rewrite E;Auto with arith
+    | Apply (simpl_add_l z);Rewrite (add_sym x k);
+      Rewrite add_assoc; Rewrite H5;Rewrite H9;
+      Rewrite add_sym; Trivial with arith ]]].
+Qed.
+
+Hints Local Resolve weak_assoc.
+
+Theorem Zplus_assoc :
+  (n,m,p:Z) (Zplus n (Zplus m p))= (Zplus (Zplus n m) p).
+Proof.
+Intros x y z;Case x;Case y;Case z;Auto with arith; Intros; [
+  Rewrite (Zplus_sym (NEG p0)); Rewrite weak_assoc;
+  Rewrite (Zplus_sym (Zplus (POS p1) (NEG p0))); Rewrite weak_assoc;
+  Rewrite (Zplus_sym (POS p1)); Trivial with arith
+| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; 
+  Do 2 Rewrite Zopp_NEG; Rewrite Zplus_sym; Rewrite <- weak_assoc;
+  Rewrite (Zplus_sym (Zopp (POS p1)));
+  Rewrite (Zplus_sym (Zplus (POS p0) (Zopp (POS p1))));
+  Rewrite (weak_assoc p); Rewrite weak_assoc; Rewrite (Zplus_sym (POS p0)); 
+  Trivial with arith
+| Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0) (POS p));
+  Rewrite <- weak_assoc; Rewrite Zplus_sym; Rewrite (Zplus_sym (POS p0));
+  Trivial with arith
+| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; 
+  Do 2 Rewrite Zopp_NEG; Rewrite (Zplus_sym (Zopp (POS p0)));
+  Rewrite weak_assoc; Rewrite (Zplus_sym (Zplus (POS p1) (Zopp (POS p0))));
+  Rewrite weak_assoc;Rewrite (Zplus_sym (POS p)); Trivial with arith
+| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
+  Apply weak_assoc
+| Apply Zopp_intro; Do 4 Rewrite Zopp_Zplus; Do 2 Rewrite Zopp_NEG;
+   Apply weak_assoc]
+.
+Qed.
+
+V7only [Notation Zplus_assoc_l := Zplus_assoc.].
+
+Lemma Zplus_assoc_r : (n,m,p:Z)(Zplus (Zplus n m) p) =(Zplus n (Zplus m p)).
+Proof.
+Intros; Symmetry; Apply Zplus_assoc.
+Qed.
+
+(** Associativity mixed with commutativity *)
+
+Theorem Zplus_permute : (n,m,p:Z) (Zplus n (Zplus m p))=(Zplus m (Zplus n p)).
+Proof.
+Intros n m p;
+Rewrite Zplus_sym;Rewrite <- Zplus_assoc; Rewrite (Zplus_sym p n); Trivial with arith.
+Qed.
+
+(** addition simplifies *)
+
+Theorem Zsimpl_plus_l : (n,m,p:Z)(Zplus n m)=(Zplus n p)->m=p.
+Intros n m p H; Cut (Zplus (Zopp n) (Zplus n m))=(Zplus (Zopp n) (Zplus n p));[
+  Do 2 Rewrite -> Zplus_assoc; Rewrite -> (Zplus_sym (Zopp n) n);
+  Rewrite -> Zplus_inverse_r;Simpl; Trivial with arith
+| Rewrite -> H; Trivial with arith ].
+Qed.
+
+(** addition and successor permutes *)
+
+Lemma Zplus_S_n: (x,y:Z) (Zplus (Zs x) y) = (Zs (Zplus x y)).
+Proof.
+Intros x y; Unfold Zs; Rewrite (Zplus_sym (Zplus x y)); Rewrite Zplus_assoc;
+Rewrite (Zplus_sym (POS xH)); Trivial with arith.
+Qed.
+
+Lemma Zplus_n_Sm : (n,m:Z) (Zs (Zplus n m))=(Zplus n (Zs m)).
+Proof.
+Intros n m; Unfold Zs; Rewrite Zplus_assoc; Trivial with arith.
+Qed.
+
+Lemma Zplus_Snm_nSm : (n,m:Z)(Zplus (Zs n) m)=(Zplus n (Zs m)).
+Proof.
+Unfold Zs ;Intros n m; Rewrite <- Zplus_assoc; Rewrite (Zplus_sym (POS xH));
+Trivial with arith.
+Qed.
+
+(** Misc properties, usually redundant or non natural *)
+
+Lemma Zplus_n_O : (n:Z) n=(Zplus n ZERO).
+Proof.
+Symmetry; Apply Zero_right.
+Qed.
+
+Lemma Zplus_unit_left : (n,m:Z) (Zplus n ZERO)=m -> n=m.
+Proof.
+Intros n m; Rewrite Zero_right; Intro; Assumption.
+Qed.
+
+Lemma Zplus_unit_right : (n,m:Z) n=(Zplus m ZERO) -> n=m.
+Proof.
+Intros n m; Rewrite Zero_right; Intro; Assumption.
+Qed.
+
+Lemma Zplus_simpl : (x,y,z,t:Z) x=y -> z=t -> (Zplus x z)=(Zplus y t).
+Proof.
+Intros; Rewrite H; Rewrite H0; Reflexivity.
+Qed.
+
+Lemma Zplus_Zopp_expand : (x,y,z:Z)
+  (Zplus x (Zopp y))=(Zplus (Zplus x (Zopp z)) (Zplus z (Zopp y))).
+Proof.
+Intros x y z.
+Rewrite <- (Zplus_assoc x).
+Rewrite (Zplus_assoc (Zopp z)).
+Rewrite Zplus_inverse_l.
+Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Properties of successor and predecessor on binary integer numbers *)
+
+Theorem Zn_Sn : (x:Z) ~ x=(Zs x).
+Proof.
+Intros n;Cut ~ZERO=(POS xH);[
+  Unfold not ;Intros H1 H2;Apply H1;Apply (Zsimpl_plus_l n);Rewrite Zero_right;
+  Exact H2
+| Discriminate ].
+Qed.
+
+Theorem add_un_Zs : (x:positive) (POS (add_un x)) = (Zs (POS x)).
+Proof.
+Intro; Rewrite -> ZL12; Unfold Zs; Simpl; Trivial with arith.
+Qed.
+
+(** successor and predecessor are inverse functions *)
+
+Theorem Zs_pred : (n:Z) n=(Zs (Zpred n)).
+Proof.
+Intros n; Unfold Zs Zpred ;Rewrite <- Zplus_assoc; Simpl; Rewrite Zero_right;
+Trivial with arith.
+Qed. 
+
+Hints Immediate Zs_pred : zarith.
+ 
+Theorem Zpred_Sn : (x:Z) x=(Zpred (Zs x)).
+Proof.
+Intros m; Unfold Zpred Zs; Rewrite <- Zplus_assoc; Simpl; 
+Rewrite Zplus_sym; Auto with arith.
+Qed.
+
+Theorem Zeq_add_S : (n,m:Z) (Zs n)=(Zs m) -> n=m.
+Proof.
+Intros n m H.
+Change (Zplus (Zplus (NEG xH) (POS xH)) n)=
+       (Zplus (Zplus (NEG xH) (POS xH)) m);
+Do 2 Rewrite <- Zplus_assoc; Do 2 Rewrite (Zplus_sym (POS xH));
+Unfold Zs in H;Rewrite H; Trivial with arith.
+Qed.
+ 
+(** Misc properties, usually redundant or non natural *)
+
+Lemma Zeq_S : (n,m:Z) n=m -> (Zs n)=(Zs m).
+Proof.
+Intros n m H; Rewrite H; Reflexivity.
+Qed.
+
+Lemma Znot_eq_S : (n,m:Z) ~(n=m) -> ~((Zs n)=(Zs m)).
+Proof.
+Unfold not ;Intros n m H1 H2;Apply H1;Apply Zeq_add_S; Assumption.
+Qed.
+
+(**********************************************************************)
+(** Properties of subtraction on binary integer numbers *)
+
+Lemma Zminus_0_r : (x:Z) (Zminus x ZERO)=x.
+Proof.
+Intro; Unfold Zminus; Simpl;Rewrite Zero_right; Trivial with arith.
+Qed.
+
+Lemma Zminus_n_O : (x:Z) x=(Zminus x ZERO).
+Proof.
+Intro; Symmetry; Apply Zminus_0_r.
+Qed.
+
+Lemma Zminus_diag : (n:Z)(Zminus n n)=ZERO.
+Proof.
+Intro; Unfold Zminus; Rewrite Zplus_inverse_r; Trivial with arith.
+Qed.
+
+Lemma Zminus_n_n : (n:Z)(ZERO=(Zminus n n)).
+Proof.
+Intro; Symmetry; Apply Zminus_diag.
+Qed.
+
+Lemma Zplus_minus : (x,y,z:Z)(x=(Zplus y z))->(z=(Zminus x y)).
+Proof.
+Intros n m p H;Unfold Zminus;Apply (Zsimpl_plus_l m); 
+Rewrite (Zplus_sym m (Zplus n (Zopp m))); Rewrite <- Zplus_assoc;
+Rewrite Zplus_inverse_l; Rewrite Zero_right; Rewrite H; Trivial with arith.
+Qed.
+
+Lemma Zminus_plus : (x,y:Z)(Zminus (Zplus x y) x)=y.
+Proof.
+Intros n m;Unfold Zminus ;Rewrite -> (Zplus_sym n m);Rewrite <- Zplus_assoc;
+Rewrite -> Zplus_inverse_r; Apply Zero_right.
+Qed.
+
+Lemma Zle_plus_minus : (n,m:Z) (Zplus n (Zminus m n))=m.
+Proof.
+Unfold Zminus; Intros n m; Rewrite Zplus_permute; Rewrite Zplus_inverse_r;
+Apply Zero_right.
+Qed.
+
+Lemma Zminus_Sn_m : (n,m:Z)((Zs (Zminus n m))=(Zminus (Zs n) m)).
+Proof.
+Intros n m;Unfold Zminus Zs; Rewrite (Zplus_sym n (Zopp m));
+Rewrite <- Zplus_assoc;Apply Zplus_sym.
+Qed.
+
+Lemma Zminus_plus_simpl_l : 
+  (x,y,z:Z)(Zminus (Zplus z x) (Zplus z y))=(Zminus x y).
+Proof.
+Intros n m p;Unfold Zminus; Rewrite Zopp_Zplus; Rewrite Zplus_assoc;
+Rewrite (Zplus_sym p); Rewrite <- (Zplus_assoc n p); Rewrite Zplus_inverse_r;
+Rewrite Zero_right; Trivial with arith.
+Qed.
+
+Lemma Zminus_plus_simpl : 
+  (x,y,z:Z)((Zminus x y)=(Zminus (Zplus z x) (Zplus z y))).
+Proof.
+Intros; Symmetry; Apply Zminus_plus_simpl_l.
+Qed.
+
+Lemma Zminus_Zplus_compatible :
+  (x,y,z:Z) (Zminus (Zplus x z) (Zplus y z)) = (Zminus x y).
+Intros x y n.
+Unfold Zminus.
+Rewrite -> Zopp_Zplus.
+Rewrite -> (Zplus_sym (Zopp y) (Zopp n)).
+Rewrite -> Zplus_assoc.
+Rewrite <- (Zplus_assoc x n (Zopp n)).
+Rewrite -> (Zplus_inverse_r n).
+Rewrite <- Zplus_n_O.
+Reflexivity.
+Qed.
+
+(** Misc redundant properties *)
+
+V7only [Set Implicit Arguments.].
+
+Lemma Zeq_Zminus : (x,y:Z)x=y -> (Zminus x y)=ZERO.
+Proof.
+Intros x y H; Rewrite H; Symmetry; Apply Zminus_n_n.
+Qed.
+
+Lemma Zminus_Zeq : (x,y:Z)(Zminus x y)=ZERO -> x=y.
+Proof.
+Intros x y H; Rewrite <- (Zle_plus_minus y x); Rewrite H; Apply Zero_right.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
+(**********************************************************************)
+(** Properties of multiplication on binary integer numbers *)
+
+(** One is neutral for multiplication *)
+
+Theorem Zmult_1_n : (n:Z)(Zmult (POS xH) n)=n.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+V7only [Notation Zmult_one := Zmult_1_n.].
+
+Theorem Zmult_n_1 : (n:Z)(Zmult n (POS xH))=n.
+Proof.
+Intro x; NewDestruct x; Simpl; Try Rewrite times_x_1; Reflexivity.
+Qed.
+
+(** Zero property of multiplication *)
+
+Theorem Zero_mult_left: (x:Z) (Zmult ZERO x) = ZERO.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+Theorem Zero_mult_right: (x:Z) (Zmult x ZERO) = ZERO.
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+Hints Local Resolve Zero_mult_left Zero_mult_right.
+
+Lemma Zmult_n_O : (n:Z) ZERO=(Zmult n ZERO).
+Proof.
+Intro x; NewDestruct x; Reflexivity.
+Qed.
+
+(** Commutativity of multiplication *)
+
+Theorem Zmult_sym : (x,y:Z) (Zmult x y) = (Zmult y x).
+Proof.
+Intros x y; NewDestruct x as [|p|p]; NewDestruct y as [|q|q]; Simpl; 
+  Try Rewrite (times_sym p q); Reflexivity.
+Qed.
+
+(** Associativity of multiplication *)
+
+Theorem Zmult_assoc :
+  (x,y,z:Z) (Zmult x (Zmult y z))= (Zmult (Zmult x y) z).
+Proof.
+Intros x y z; NewDestruct x; NewDestruct y; NewDestruct z; Simpl; 
+  Try Rewrite times_assoc; Reflexivity.
+Qed.
+V7only [Notation Zmult_assoc_l := Zmult_assoc.].
+
+Lemma Zmult_assoc_r : (n,m,p:Z)((Zmult (Zmult n m) p) = (Zmult n (Zmult m p))).
+Proof.
+Intros n m p; Rewrite Zmult_assoc; Trivial with arith.
+Qed.
+
+(** Associativity mixed with commutativity *)
+
+Theorem Zmult_permute : (n,m,p:Z)(Zmult n (Zmult m p)) = (Zmult m (Zmult n p)).
+Proof.
+Intros x y z; Rewrite -> (Zmult_assoc y x z); Rewrite -> (Zmult_sym y x).
+Apply Zmult_assoc.
+Qed.
+
+(** Z is integral *)
+
+Theorem Zmult_eq: (x,y:Z) ~(x=ZERO) -> (Zmult y x) = ZERO -> y = ZERO.
+Proof.
+Intros x y; NewDestruct x as [|p|p].
+  Intro H; Absurd ZERO=ZERO; Trivial.
+  Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
+  Intros _ H; NewDestruct y as [|q|q]; Reflexivity Orelse Discriminate.
+Qed.
+
+V7only [Set Implicit Arguments.].
+
+Theorem Zmult_zero : (x,y:Z)(Zmult x y)=ZERO -> x=ZERO \/ y=ZERO.
+Proof.
+Intros x y; NewDestruct x; NewDestruct y; Auto; Simpl; Intro H; Discriminate H.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
+Lemma Zmult_1_inversion_l : 
+ (x,y:Z) (Zmult x y)=(POS xH) -> x=(POS xH) \/ x=(NEG xH).
+Proof.
+Intros x y; NewDestruct x as [|p|p]; Intro; [ Discriminate | Left | Right ];
+  (NewDestruct y as [|q|q]; Try Discriminate;
+  Simpl in H; Injection H; Clear H; Intro H;
+  Rewrite times_one_inversion_l with 1:=H; Reflexivity).
+Qed.
+
+(** Multiplication and Opposite *)
+
+Theorem Zopp_Zmult_l : (x,y:Z)(Zopp (Zmult x y)) = (Zmult (Zopp x) y).
+Proof.
+Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
+Qed.
+
+Theorem Zopp_Zmult_r : (x,y:Z)(Zopp (Zmult x y)) = (Zmult x (Zopp y)).
+Intros x y; Rewrite (Zmult_sym x y); Rewrite Zopp_Zmult_l; Apply Zmult_sym.
+Qed.
+
+Lemma Zopp_Zmult: (x,y:Z) (Zmult (Zopp x) y) = (Zopp (Zmult x y)).
+Proof.
+Intros x y; Symmetry; Apply Zopp_Zmult_l.
+Qed.
+
+Theorem Zmult_Zopp_left :  (x,y:Z)(Zmult (Zopp x) y) = (Zmult x (Zopp y)).
+Intros x y; Rewrite Zopp_Zmult; Rewrite Zopp_Zmult_r; Trivial with arith.
+Qed.
+
+Theorem Zmult_Zopp_Zopp: (x,y:Z) (Zmult (Zopp x) (Zopp y)) = (Zmult x y).
+Proof.
+Intros x y; NewDestruct x; NewDestruct y; Reflexivity.
+Qed.
+
+Theorem Zopp_one : (x:Z)(Zopp x)=(Zmult x (NEG xH)).
+Intro x; NewInduction x; Intros; Rewrite Zmult_sym; Auto with arith.
+Qed.
+
+(** Distributivity of multiplication over addition *)
+
+Lemma weak_Zmult_plus_distr_r:
+  (x:positive)(y,z:Z)
+   (Zmult (POS x) (Zplus y z)) = (Zplus (Zmult (POS x) y) (Zmult (POS x) z)).
+Proof.
+Intros x y' z';Case y';Case z';Auto with arith;Intros y z;
+  (Simpl; Rewrite times_add_distr; Trivial with arith)
+Orelse
+  (Simpl; ElimPcompare z y; Intros E0;Rewrite E0; [
+    Rewrite (compare_convert_EGAL z y E0);
+    Rewrite (convert_compare_EGAL (times x y)); Trivial with arith
+  | Cut (compare (times x z) (times x y) EGAL)=INFERIEUR; [
+      Intros E;Rewrite E; Rewrite times_true_sub_distr; [
+        Trivial with arith
+      | Apply ZC2;Assumption ]
+    | Apply convert_compare_INFERIEUR;Do 2 Rewrite times_convert; 
+      Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
+      Exact (compare_convert_INFERIEUR z y E0)]
+  | Cut (compare (times x z) (times x y) EGAL)=SUPERIEUR; [
+      Intros E;Rewrite E; Rewrite times_true_sub_distr; Auto with arith
+    | Apply convert_compare_SUPERIEUR; Unfold gt; Do 2 Rewrite times_convert;
+      Elim (ZL4 x);Intros h H1;Rewrite H1;Apply lt_mult_left;
+      Exact (compare_convert_SUPERIEUR z y E0) ]]).
+Qed.
+
+Theorem Zmult_plus_distr_r:
+  (x,y,z:Z) (Zmult x (Zplus y z)) = (Zplus (Zmult x y) (Zmult x z)).
+Proof.
+Intros x y z; Case x; [
+  Auto with arith
+| Intros x';Apply weak_Zmult_plus_distr_r
+| Intros p; Apply Zopp_intro; Rewrite Zopp_Zplus; 
+  Do 3 Rewrite <- Zopp_Zmult; Rewrite Zopp_NEG; 
+  Apply weak_Zmult_plus_distr_r ].
+Qed.
+
+Theorem Zmult_plus_distr_l : 
+  (n,m,p:Z)((Zmult (Zplus n m) p)=(Zplus (Zmult n p) (Zmult m p))).
+Proof.
+Intros n m p;Rewrite Zmult_sym;Rewrite Zmult_plus_distr_r; 
+Do 2 Rewrite -> (Zmult_sym p); Trivial with arith.
+Qed.
+
+(** Distributivity of multiplication over subtraction *)
+
+Lemma Zmult_Zminus_distr_l :
+  (x,y,z:Z)((Zmult (Zminus x y) z)=(Zminus (Zmult x z) (Zmult y z))).
+Proof.
+Intros x y z; Unfold Zminus.
+Rewrite <- Zopp_Zmult.
+Apply Zmult_plus_distr_l.
+Qed.
+
+V7only [Notation Zmult_minus_distr := Zmult_Zminus_distr_l.].
+ 
+Lemma  Zmult_Zminus_distr_r :
+  (x,y,z:Z)(Zmult z (Zminus x y)) = (Zminus (Zmult z x) (Zmult z y)).
+Proof.
+Intros x y z; Rewrite (Zmult_sym z (Zminus x y)).
+Rewrite (Zmult_sym  z x).
+Rewrite (Zmult_sym z y).
+Apply Zmult_Zminus_distr_l.
+Qed.
+
+(** Simplification of multiplication for non-zero integers *)
+V7only [Set Implicit Arguments.].
+
+Lemma Zmult_reg_left : (x,y,z:Z) z<>ZERO -> (Zmult z x)=(Zmult z y) -> x=y.
+Proof.
+Intros x y z H H0.
+Generalize (Zeq_Zminus H0).
+Intro.
+Apply Zminus_Zeq.
+Rewrite <- Zmult_Zminus_distr_r in H1.
+Clear H0; NewDestruct (Zmult_zero H1).
+Contradiction.
+Trivial.
+Qed.
+
+Lemma Zmult_reg_right : (x,y,z:Z) z<>ZERO -> (Zmult x z)=(Zmult y z) -> x=y.
+Proof.
+Intros x y z Hz.
+Rewrite (Zmult_sym x z).
+Rewrite (Zmult_sym y z).
+Intro; Apply Zmult_reg_left with z; Assumption.
+Qed.
+V7only [Unset Implicit Arguments.].
+
+(** Addition and multiplication by 2 *)
+
+Lemma Zplus_Zmult_2 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
+Proof.
+Intros x; Pattern 1 2 x ; Rewrite <- (Zmult_n_1 x);
+Rewrite <- Zmult_plus_distr_r; Reflexivity.
+Qed.
+
+(** Multiplication and successor *)
+
+Lemma Zmult_succ_r : (n,m:Z) (Zmult n (Zs m))=(Zplus (Zmult n m) n).
+Proof.
+Intros n m;Unfold Zs; Rewrite Zmult_plus_distr_r;
+Rewrite (Zmult_sym n (POS xH));Rewrite Zmult_one; Trivial with arith.
+Qed.
+
+Lemma Zmult_n_Sm : (n,m:Z) (Zplus (Zmult n m) n)=(Zmult n (Zs m)).
+Proof.
+Intros; Symmetry; Apply Zmult_succ_r.
+Qed.
+
+Lemma Zmult_succ_l : (n,m:Z) (Zmult (Zs n) m)=(Zplus (Zmult n m) m).
+Proof.
+Intros n m; Unfold Zs; Rewrite Zmult_plus_distr_l; Rewrite Zmult_1_n;
+Trivial with arith.
+Qed.
+
+Lemma Zmult_Sm_n : (n,m:Z) (Zplus (Zmult n m) m)=(Zmult (Zs n) m).
+Proof.
+Intros; Symmetry; Apply Zmult_succ_l.
+Qed.
+
+(** Misc redundant properties *)
+
+Lemma Z_eq_mult:
+  (x,y:Z)  y = ZERO -> (Zmult y x) = ZERO.
+Intros x y H; Rewrite H; Auto with arith.
+Qed.
+
+(**********************************************************************)
+(** Relating binary positive numbers and binary integers *)
+
+Lemma POS_xI : (p:positive) (POS (xI p))=(Zplus (Zmult (POS (xO xH)) (POS p)) (POS xH)).
+Proof.
+Intro; Apply refl_equal.
+Qed.
+
+Lemma POS_xO : (p:positive) (POS (xO p))=(Zmult (POS (xO xH)) (POS p)).
+Proof.
+Intro; Apply refl_equal.
+Qed.
+
+Lemma NEG_xI : (p:positive) (NEG (xI p))=(Zminus (Zmult (POS (xO xH)) (NEG p)) (POS xH)).
+Proof.
+Intro; Apply refl_equal.
+Qed.
+
+Lemma NEG_xO : (p:positive) (NEG (xO p))=(Zmult (POS (xO xH)) (NEG p)).
+Proof.
+Reflexivity.
+Qed.
+
+Lemma POS_add : (p,p':positive)(POS (add p p'))=(Zplus (POS p) (POS p')).
+Proof.
+Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
+Qed.
+
+Lemma NEG_add : (p,p':positive)(NEG (add p p'))=(Zplus (NEG p) (NEG p')).
+Proof.
+Intros p p'; NewDestruct p; NewDestruct p'; Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** Order relations *)
+
+Definition Zlt := [x,y:Z](Zcompare x y) = INFERIEUR.
+Definition Zgt := [x,y:Z](Zcompare x y) = SUPERIEUR.
+Definition Zle := [x,y:Z]~(Zcompare x y) = SUPERIEUR.
+Definition Zge := [x,y:Z]~(Zcompare x y) = INFERIEUR.
+Definition Zne := [x,y:Z] ~(x=y).
+
+V8Infix "<=" Zle : Z_scope.
+V8Infix "<"  Zlt : Z_scope.
+V8Infix ">=" Zge : Z_scope.
+V8Infix ">"  Zgt : Z_scope.
+
+V8Notation "x <= y <= z" := (Zle x y)/\(Zle y z) :Z_scope.
+V8Notation "x <= y < z"  := (Zle x y)/\(Zlt y z) :Z_scope.
+V8Notation  "x < y < z"  := (Zlt x y)/\(Zlt y z) :Z_scope.
+V8Notation  "x < y <= z" := (Zlt x y)/\(Zle y z) :Z_scope.
+
+(**********************************************************************)
+(** Absolute value on integers *)
+
+Definition absolu [x:Z] : nat :=
+  Cases x of
+     ZERO   => O
+  | (POS p) => (convert p)
+  | (NEG p) => (convert p)
+  end.
+
+Definition Zabs [z:Z] : Z :=
+  Cases z of 
+     ZERO   => ZERO
+  | (POS p) => (POS p)
+  | (NEG p) => (POS p)
+  end.
+
+(**********************************************************************)
+(** From [nat] to [Z] *)
+
+Definition inject_nat := 
+  [x:nat]Cases x of
+           O => ZERO
+         | (S y) => (POS (anti_convert y))
+         end.
+
+Require BinNat.
+
+Definition entier_of_Z :=
+  [z:Z]Cases z of ZERO => Nul | (POS p) => (Pos p) | (NEG p) => (Pos p) end.
+
+Definition Z_of_entier :=
+  [x:entier]Cases x of Nul => ZERO | (Pos p) => (POS p) end.
diff --git a/theories7/ZArith/Wf_Z.v b/theories7/ZArith/Wf_Z.v
new file mode 100644
index 00000000..e6cf4610
--- /dev/null
+++ b/theories7/ZArith/Wf_Z.v
@@ -0,0 +1,194 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Wf_Z.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+Require BinInt.
+Require Zcompare.
+Require Zorder.
+Require Znat.
+Require Zmisc.
+Require Zsyntax.
+Require Wf_nat.
+V7only [Import Z_scope.].
+Open Local 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)
+
+       	     /\
+             ||
+             ||
+
+  (Q O) (n:nat)(Q n)->(Q (S n)) <=== (P 0) (x:Z) (P x) -> (P (Zs x))
+
+      	       	       	       	<=== (inject_nat (S n))=(Zs (inject_nat n))
+
+      	       	       	       	<=== inject_nat_complete
+>>
+  Then the  diagram will be closed and the theorem proved. *)
+
+Lemma inject_nat_complete :
+  (x:Z)`0 <= x` -> (EX n:nat | x=(inject_nat n)).
+Intro x; NewDestruct x; Intros;
+[ Exists  O; Auto with arith
+| Specialize (ZL4 p); Intros Hp; Elim Hp; Intros;
+  Exists (S x); Intros; Simpl;
+  Specialize (bij1 x); Intro Hx0;
+  Rewrite <- H0 in Hx0;
+  Apply f_equal with f:=POS;
+  Apply convert_intro; Auto with arith
+| Absurd `0 <= (NEG p)`;
+  [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
+  | Assumption]
+].
+Qed.
+
+Lemma ZL4_inf: (y:positive) { h:nat | (convert y)=(S h) }.
+Intro y; NewInduction y as [p H|p H1|]; [
+  Elim H; Intros x H1; Exists (plus (S x) (S x));
+  Unfold convert ;Simpl; Rewrite ZL0; Rewrite ZL2; Unfold convert in H1;
+  Rewrite H1; Auto with arith
+| Elim H1;Intros x H2; Exists (plus x (S x)); Unfold convert;
+  Simpl; Rewrite ZL0; Rewrite ZL2;Unfold convert in H2; Rewrite H2; Auto with arith
+| Exists O ;Auto with arith].
+Qed.
+
+Lemma inject_nat_complete_inf :
+  (x:Z)`0 <= x` -> { n:nat | (x=(inject_nat n)) }.
+Intro x; NewDestruct x; Intros;
+[ Exists  O; Auto with arith
+| Specialize (ZL4_inf p); Intros Hp; Elim Hp; Intros x0 H0;
+  Exists (S x0); Intros; Simpl;
+  Specialize (bij1 x0); Intro Hx0;
+  Rewrite <- H0 in Hx0;
+  Apply f_equal with f:=POS;
+  Apply convert_intro; Auto with arith
+| Absurd `0 <= (NEG p)`;
+  [ Unfold Zle; Simpl; Do 2 (Unfold not); Auto with arith
+  | Assumption]
+].
+Qed.
+
+Lemma inject_nat_prop :
+  (P:Z->Prop)((n:nat)(P (inject_nat n))) -> 
+    (x:Z) `0 <= x` -> (P x).
+Intros P H x H0.
+Specialize (inject_nat_complete x H0).
+Intros Hn; Elim Hn; Intros.
+Rewrite -> H1; Apply H.
+Qed.
+
+Lemma inject_nat_set :
+  (P:Z->Set)((n:nat)(P (inject_nat n))) -> 
+    (x:Z) `0 <= x` -> (P x).
+Intros P H x H0.
+Specialize (inject_nat_complete_inf x H0).
+Intros Hn; Elim Hn; Intros.
+Rewrite -> p; Apply H.
+Qed.
+
+Lemma natlike_ind : (P:Z->Prop) (P `0`) ->
+  ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
+  (x:Z) `0 <= x` -> (P x).
+Intros P H H0 x H1; Apply inject_nat_prop;
+[ Induction n;
+  [ Simpl; Assumption
+  | Intros; Rewrite -> (inj_S n0);
+    Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
+| Assumption].
+Qed.
+
+Lemma natlike_rec : (P:Z->Set) (P `0`) ->
+  ((x:Z)(`0 <= x` -> (P x) -> (P (Zs x)))) ->
+  (x:Z) `0 <= x` -> (P x).
+Intros P H H0 x H1; Apply inject_nat_set;
+[ Induction n;
+  [ Simpl; Assumption
+  | Intros; Rewrite -> (inj_S n0);
+    Exact (H0 (inject_nat n0) (ZERO_le_inj n0) H2) ]
+| Assumption].
+Qed.
+
+Section Efficient_Rec. 
+
+(** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed 
+     to give a better extracted term. *)
+
+Local R := [a,b:Z]`0<=a`/\`a<b`.
+
+Local R_wf : (well_founded Z R).
+Proof.
+LetTac f := [z]Cases z of (POS p) => (convert p) | ZERO => O | (NEG _) => O end.
+Apply  well_founded_lt_compat with f.
+Unfold R f; Clear f R.
+Intros x y; Case x; Intros; Elim H; Clear H.
+Case y; Intros; Apply compare_convert_O Orelse Inversion H0.
+Case y; Intros; Apply compare_convert_INFERIEUR Orelse Inversion H0; Auto.
+Intros; Elim H; Auto.
+Qed.
+
+Lemma natlike_rec2 : (P:Z->Type)(P `0`) -> 
+        ((z:Z)`0<=z` -> (P z) -> (P (Zs z))) -> (z:Z)`0<=z` -> (P z).
+Proof.
+Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
+Intro x; Case x.
+Trivial.
+Intros.
+Assert `0<=(Zpred (POS p))`.
+Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
+Rewrite Zs_pred.
+Apply Hrec.
+Auto.
+Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
+Intros; Elim H; Simpl; Trivial.
+Qed.
+
+(** A variant of the previous using [Zpred] instead of [Zs]. *)
+
+Lemma natlike_rec3 : (P:Z->Type)(P `0`) -> 
+        ((z:Z)`0<z` -> (P (Zpred z)) -> (P z)) -> (z:Z)`0<=z` -> (P z).
+Proof.
+Intros P Ho Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
+Intro x; Case x.
+Trivial.
+Intros; Apply Hrec.
+Unfold Zlt; Trivial.
+Assert `0<=(Zpred (POS p))`.
+Apply Zlt_ZERO_pred_le_ZERO; Unfold Zlt; Simpl; Trivial.
+Apply X; Auto; Unfold R; Intuition; Apply Zlt_pred_n_n.
+Intros; Elim H; Simpl; Trivial.
+Qed.
+
+(** A more general induction principal using [Zlt]. *)
+
+Lemma Z_lt_rec : (P:Z->Type)
+ ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x)) -> (x:Z)`0 <= x`->(P x).
+Proof.
+Intros P Hrec z; Pattern z; Apply (well_founded_induction_type Z R R_wf).
+Intro x; Case x; Intros.
+Apply Hrec; Intros.
+Assert H2: `0<0`.
+  Apply Zle_lt_trans with y; Intuition.
+Inversion H2.
+Firstorder.
+Unfold Zle Zcompare in H; Elim H; Auto.
+Defined.
+
+Lemma Z_lt_induction : 
+  (P:Z->Prop)
+     ((x:Z)((y:Z)`0 <= y < x`->(P y))->(P x))
+  -> (x:Z)`0 <= x`->(P x).
+Proof.
+Exact Z_lt_rec.
+Qed.
+
+End Efficient_Rec.
diff --git a/theories7/ZArith/ZArith.v b/theories7/ZArith/ZArith.v
new file mode 100644
index 00000000..e1746433
--- /dev/null
+++ b/theories7/ZArith/ZArith.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        *)
+(************************************************************************)
+
+(*i $Id: ZArith.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Library for manipulating integers based on binary encoding *)
+
+Require Export ZArith_base.
+
+(** Extra modules using [Omega] or [Ring]. *)
+
+Require Export Zcomplements.
+Require Export Zsqrt.
+Require Export Zpower.
+Require Export Zdiv.
+Require Export Zlogarithm.
+Require Export Zbool.
diff --git a/theories7/ZArith/ZArith_base.v b/theories7/ZArith/ZArith_base.v
new file mode 100644
index 00000000..7f2863d6
--- /dev/null
+++ b/theories7/ZArith/ZArith_base.v
@@ -0,0 +1,39 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: ZArith_base.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ *)
+
+(** 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]. *)
+
+V7only [
+Require Export fast_integer.
+Require Export zarith_aux.
+].
+Require Export BinPos.
+Require Export BinNat.
+Require Export BinInt.
+Require Export Zcompare.
+Require Export Zorder.
+Require Export Zeven.
+Require Export Zmin.
+Require Export Zabs.
+Require Export Znat.
+Require Export auxiliary.
+Require Export Zsyntax.
+Require Export ZArith_dec.
+Require Export Zbool.
+Require Export Zmisc.
+Require Export Wf_Z.
+
+Hints Resolve Zle_n Zplus_sym Zplus_assoc Zmult_sym Zmult_assoc
+  Zero_left Zero_right Zmult_one Zplus_inverse_l Zplus_inverse_r 
+  Zmult_plus_distr_l Zmult_plus_distr_r : zarith.
+
+Require Export Zhints.
diff --git a/theories7/ZArith/ZArith_dec.v b/theories7/ZArith/ZArith_dec.v
new file mode 100644
index 00000000..985f7601
--- /dev/null
+++ b/theories7/ZArith/ZArith_dec.v
@@ -0,0 +1,243 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: ZArith_dec.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+Require Sumbool.
+
+Require BinInt.
+Require Zorder.
+Require Zcompare.
+Require Zsyntax.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+Lemma Dcompare_inf : (r:relation) {r=EGAL} + {r=INFERIEUR} + {r=SUPERIEUR}.
+Proof.
+Induction r; Auto with arith. 
+Defined.
+
+Lemma Zcompare_rec :
+  (P:Set)(x,y:Z)
+    ((Zcompare x y)=EGAL -> P) ->
+    ((Zcompare x y)=INFERIEUR -> P) ->
+    ((Zcompare x y)=SUPERIEUR -> P) ->
+    P.
+Proof.
+Intros P x y H1 H2 H3.
+Elim (Dcompare_inf (Zcompare x y)).
+Intro H. Elim H; Auto with arith. Auto with arith.
+Defined.
+
+Section decidability.
+
+Variables x,y : Z.
+
+(** Decidability of equality on binary integers *)
+
+Definition Z_eq_dec : {x=y}+{~x=y}.
+Proof.
+Apply Zcompare_rec with x:=x y:=y.
+Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
+Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
+  Rewrite (H2 H4) in H3. Discriminate H3.
+Intro H3. Right. Elim (Zcompare_EGAL x y). Intros H1 H2. Unfold not. Intro H4.
+  Rewrite (H2 H4) in H3. Discriminate H3.
+Defined. 
+
+(** Decidability of order on binary integers *)
+
+Definition Z_lt_dec : {(Zlt x y)}+{~(Zlt x y)}.
+Proof.
+Unfold Zlt.
+Apply Zcompare_rec with x:=x y:=y; Intro H.
+Right. Rewrite H. Discriminate.
+Left; Assumption.
+Right. Rewrite H. Discriminate.
+Defined.
+
+Definition Z_le_dec : {(Zle x y)}+{~(Zle x y)}.
+Proof.
+Unfold Zle.
+Apply Zcompare_rec with x:=x y:=y; Intro H.
+Left. Rewrite H. Discriminate.
+Left. Rewrite H. Discriminate.
+Right. Tauto.
+Defined.
+
+Definition Z_gt_dec : {(Zgt x y)}+{~(Zgt x y)}.
+Proof.
+Unfold Zgt.
+Apply Zcompare_rec with x:=x y:=y; Intro H.
+Right. Rewrite H. Discriminate.
+Right. Rewrite H. Discriminate.
+Left; Assumption.
+Defined.
+
+Definition Z_ge_dec : {(Zge x y)}+{~(Zge x y)}.
+Proof.
+Unfold Zge.
+Apply Zcompare_rec with x:=x y:=y; Intro H.
+Left. Rewrite H. Discriminate.
+Right. Tauto.
+Left. Rewrite H. Discriminate.
+Defined.
+
+Definition Z_lt_ge_dec : {`x < y`}+{`x >= y`}.
+Proof.
+Exact Z_lt_dec.
+Defined.
+
+V7only [ (* From Zextensions *) ].
+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.
+Qed.
+
+Definition Z_le_gt_dec : {`x <= y`}+{`x > y`}.
+Proof.
+Elim Z_le_dec; Auto with arith.
+Intro. Right. Apply not_Zle; Auto with arith.
+Defined.
+
+Definition Z_gt_le_dec : {`x > y`}+{`x <= y`}.
+Proof.
+Exact Z_gt_dec.
+Defined.
+
+Definition Z_ge_lt_dec : {`x >= y`}+{`x < y`}.
+Proof.
+Elim Z_ge_dec; Auto with arith.
+Intro. Right. Apply not_Zge; Auto with arith.
+Defined.
+
+Definition Z_le_lt_eq_dec : `x <= y` -> {`x < y`}+{x=y}.
+Proof.
+Intro H.
+Apply Zcompare_rec with x:=x y:=y.
+Intro. Right. Elim (Zcompare_EGAL x y); Auto with arith.
+Intro. Left. Elim (Zcompare_EGAL x y); Auto with arith.
+Intro H1. Absurd `x > y`; Auto with arith.
+Defined.
+
+End decidability.
+
+(** Cotransitivity of order on binary integers *)
+
+Lemma Zlt_cotrans:(n,m:Z)`n<m`->(p:Z){`n<p`}+{`p<m`}.
+Proof.
+ Intros x y H z.
+ Case (Z_lt_ge_dec x z).
+ Intro.
+ Left.
+ Assumption.
+ Intro.
+ Right.
+ Apply Zle_lt_trans with m:=x.
+ Apply Zge_le.
+ Assumption.
+ Assumption.
+Defined.
+
+Lemma Zlt_cotrans_pos:(x,y:Z)`0<x+y`->{`0<x`}+{`0<y`}.
+Proof.
+ Intros x y H.
+ Case (Zlt_cotrans `0` `x+y` H x).
+ Intro.
+ Left.
+ Assumption.
+ Intro.
+ Right.
+ Apply Zsimpl_lt_plus_l with p:=`x`.
+ Rewrite Zero_right.
+ Assumption.
+Defined.
+
+Lemma Zlt_cotrans_neg:(x,y:Z)`x+y<0`->{`x<0`}+{`y<0`}.
+Proof.
+ Intros x y H;
+ Case (Zlt_cotrans `x+y` `0` H x);
+ Intro Hxy;
+ [ Right;
+   Apply Zsimpl_lt_plus_l with p:=`x`;
+   Rewrite Zero_right
+ | Left
+ ];
+ Assumption.
+Defined.
+
+Lemma not_Zeq_inf:(x,y:Z)`x<>y`->{`x<y`}+{`y<x`}.
+Proof.
+ Intros x y H.
+ Case Z_lt_ge_dec with x y.
+ Intro.
+ Left.
+ Assumption.
+ Intro H0.
+ Generalize (Zge_le ? ? H0).
+ Intro.
+ Case (Z_le_lt_eq_dec ? ? H1).
+ Intro.
+ Right.
+ Assumption.
+ Intro.
+ Apply False_rec.
+ Apply H.
+ Symmetry.
+ Assumption.
+Defined.
+
+Lemma Z_dec:(x,y:Z){`x<y`}+{`x>y`}+{`x=y`}.
+Proof.
+ Intros x y.
+ Case (Z_lt_ge_dec x y).
+ Intro H.
+ Left.
+ Left.
+ Assumption.
+ Intro H.
+ Generalize (Zge_le ? ? H).
+ Intro H0.
+ Case (Z_le_lt_eq_dec y x H0).
+ Intro H1.
+ Left.
+ Right.
+ Apply Zlt_gt.
+ Assumption.
+ Intro.
+ Right.
+ Symmetry.
+ Assumption.
+Defined.
+
+
+Lemma Z_dec':(x,y:Z){`x<y`}+{`y<x`}+{`x=y`}.
+Proof.
+ Intros x y.
+ Case (Z_eq_dec x y);
+ Intro H;
+ [ Right;
+   Assumption
+ | Left;
+   Apply (not_Zeq_inf ?? H)
+ ].
+Defined.
+
+
+
+Definition Z_zerop : (x:Z){(`x = 0`)}+{(`x <> 0`)}.
+Proof.
+Exact [x:Z](Z_eq_dec x ZERO).
+Defined.
+
+Definition Z_notzerop := [x:Z](sumbool_not ? ? (Z_zerop x)).
+
+Definition Z_noteq_dec := [x,y:Z](sumbool_not ? ? (Z_eq_dec x y)).
diff --git a/theories7/ZArith/Zabs.v b/theories7/ZArith/Zabs.v
new file mode 100644
index 00000000..57778cae
--- /dev/null
+++ b/theories7/ZArith/Zabs.v
@@ -0,0 +1,138 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: Zabs.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
+
+Require Arith.
+Require BinPos.
+Require BinInt.
+Require Zorder.
+Require Zsyntax.
+Require ZArith_dec.
+
+V7only [Import nat_scope.].
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Properties of absolute value *)
+
+Lemma Zabs_eq : (x:Z) (Zle ZERO x) -> (Zabs x)=x.
+Intro x; NewDestruct x; Auto with arith.
+Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
+Qed.
+
+Lemma Zabs_non_eq : (x:Z) (Zle x ZERO) -> (Zabs x)=(Zopp x).
+Proof.
+Intro x; NewDestruct x; Auto with arith.
+Compute; Intros; Absurd SUPERIEUR=SUPERIEUR; Trivial with arith.
+Qed.
+
+V7only [ (* From Zdivides *) ].
+Theorem Zabs_Zopp: (z : Z)  (Zabs (Zopp z)) = (Zabs z).
+Proof.
+Intros z; Case z; Simpl; Auto.
+Qed.
+
+(** Proving a property of the absolute value by cases *)
+
+Lemma Zabs_ind : 
+  (P:Z->Prop)(x:Z)(`x >= 0` -> (P x)) -> (`x <= 0` -> (P `-x`)) ->
+  (P `|x|`).
+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.
+Save.
+
+V7only [ (* From Zdivides *) ].
+Theorem Zabs_intro: (P : ?) (z : Z) (P (Zopp z)) -> (P z) ->  (P (Zabs z)).
+Intros P z; Case z; Simpl; Auto.
+Qed.
+
+Definition Zabs_dec : (x:Z){x=(Zabs x)}+{x=(Zopp (Zabs x))}.
+Proof.
+Intro x; NewDestruct x;Auto with arith.
+Defined.
+
+Lemma Zabs_pos : (x:Z)(Zle ZERO (Zabs x)).
+Intro x; NewDestruct x;Auto with arith; Compute; Intros H;Inversion H.
+Qed.
+
+V7only [ (* From Zdivides *) ].
+Theorem Zabs_eq_case:
+ (z1, z2 : Z) (Zabs z1) = (Zabs z2) ->  z1 = z2 \/ z1 = (Zopp z2).
+Proof.
+Intros z1 z2; Case z1; Case z2; Simpl; Auto; Try (Intros; Discriminate);
+ Intros p1 p2 H1; Injection H1; (Intros H2; Rewrite H2); Auto.
+Qed.
+
+(** Triangular inequality *)
+
+Hints Local Resolve Zle_NEG_POS :zarith.
+
+V7only [ (* From Zdivides *) ].
+Theorem Zabs_triangle:
+ (z1, z2 : Z)  (Zle (Zabs (Zplus z1 z2)) (Zplus (Zabs z1) (Zabs z2))).
+Proof.
+Intros z1 z2; Case z1; Case z2; Try (Simpl; Auto with zarith; Fail).
+Intros p1 p2;
+ Apply Zabs_intro
+      with P := [x : ?]  (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
+ Try Rewrite Zopp_Zplus; Auto with zarith.
+Apply Zle_plus_plus; Simpl; Auto with zarith.
+Apply Zle_plus_plus; Simpl; Auto with zarith.
+Intros p1 p2;
+ Apply Zabs_intro
+      with P := [x : ?]  (Zle x (Zplus (Zabs (POS p2)) (Zabs (NEG p1))));
+ Try Rewrite Zopp_Zplus; Auto with zarith.
+Apply Zle_plus_plus; Simpl; Auto with zarith.
+Apply Zle_plus_plus; Simpl; Auto with zarith.
+Qed.
+
+(** Absolute value and multiplication *)
+
+Lemma Zsgn_Zabs: (x:Z)(Zmult x (Zsgn x))=(Zabs x).
+Proof.
+Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
+Qed.
+
+Lemma Zabs_Zsgn: (x:Z)(Zmult (Zabs x) (Zsgn x))=x.
+Proof.
+Intro x; NewDestruct x; Rewrite Zmult_sym; Auto with arith.
+Qed.
+
+V7only [ (* From Zdivides *) ].
+Theorem Zabs_Zmult:
+ (z1, z2 : Z)  (Zabs (Zmult z1 z2)) = (Zmult (Zabs z1) (Zabs z2)).
+Proof.
+Intros z1 z2; Case z1; Case z2; Simpl; Auto.
+Qed.
+
+(** absolute value in nat is compatible with order *)
+
+Lemma absolu_lt : (x,y:Z) (Zle ZERO x)/\(Zlt x  y) -> (lt (absolu x) (absolu y)).
+Proof.
+Intros x y. Case x; Simpl. Case y; Simpl.
+
+Intro. Absurd (Zlt ZERO ZERO). Compute. Intro H0. Discriminate H0. Intuition.
+Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
+Intros. Elim (ZL4 p). Intros. Rewrite H0. Auto with arith.
+
+Case y; Simpl.
+Intros. Absurd (Zlt (POS p) ZERO). Compute. Intro H0. Discriminate H0. Intuition.
+Intros. Change (gt (convert p) (convert p0)).
+Apply compare_convert_SUPERIEUR.
+Elim H; Auto with arith. Intro. Exact (ZC2 p0 p).
+
+Intros. Absurd (Zlt (POS p0) (NEG p)).
+Compute. Intro H0. Discriminate H0. Intuition.
+
+Intros. Absurd (Zle ZERO (NEG p)). Compute. Auto with arith. Intuition.
+Qed.
diff --git a/theories7/ZArith/Zbinary.v b/theories7/ZArith/Zbinary.v
new file mode 100644
index 00000000..c3efbe1e
--- /dev/null
+++ b/theories7/ZArith/Zbinary.v
@@ -0,0 +1,425 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zbinary.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ i*)
+
+(** Bit vectors interpreted as integers. 
+    Contribution by Jean Duprat (ENS Lyon). *)
+
+Require Bvector.
+Require ZArith.
+Require Export Zpower.
+Require Omega.
+
+(*
+L'évaluation des vecteurs de booléens se font à la fois en binaire et
+en complément à deux. Le nombre appartient à Z. 
+On utilise donc Omega pour faire les calculs dans Z.
+De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur.
+	two_power_nat = [n:nat](POS (shift_nat n xH))
+     		: nat->Z
+	two_power_nat_S
+	     : (n:nat)`(two_power_nat (S n)) = 2*(two_power_nat n)`
+	Z_lt_ge_dec
+	     : (x,y:Z){`x < y`}+{`x >= y`}
+*)
+
+
+Section VALUE_OF_BOOLEAN_VECTORS.
+
+(*
+Les calculs sont effectués dans la convention positive usuelle.
+Les valeurs correspondent soit à l'écriture binaire (nat), 
+soit au complément à deux (int).
+On effectue le calcul suivant le schéma de Horner.
+Le complément à deux n'a de sens que sur les vecteurs de taille 
+supérieure ou égale à un, le bit de signe étant évalué négativement.
+*)
+
+Definition bit_value [b:bool] : Z :=
+Cases b of
+	| true => `1`
+	| false => `0`
+end.
+
+Lemma binary_value  : (n:nat) (Bvector n) -> Z.
+Proof.
+	Induction n; Intros.
+	Exact `0`.
+
+	Inversion H0.
+	Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
+Defined.
+
+Lemma two_compl_value : (n:nat) (Bvector (S n)) -> Z.
+Proof.
+	Induction n; Intros.
+	Inversion H.
+	Exact (Zopp (bit_value a)).
+
+	Inversion H0.
+	Exact (Zplus (bit_value a) (Zmult `2` (H H2))).
+Defined.
+
+(*
+Coq < Eval Compute in (binary_value (3) (Bcons true (2) (Bcons false (1) (Bcons true (0) Bnil)))).
+     = `5`
+     : Z
+*)
+
+(*
+Coq < Eval Compute in (two_compl_value (3) (Bcons true (3) (Bcons false (2) (Bcons true (1) (Bcons true (0) Bnil))))).
+     = `-3`
+     : Z
+*)
+
+End VALUE_OF_BOOLEAN_VECTORS.
+
+Section ENCODING_VALUE.
+
+(*
+On calcule la valeur binaire selon un schema de Horner.
+Le calcul s'arrete à la longueur du vecteur sans vérification.
+On definit une fonction Zmod2 calquee sur Zdiv2 mais donnant le quotient
+de la division z=2q+r avec 0<=r<=1.
+La valeur en complément à deux est calculée selon un schema de Horner
+avec Zmod2, le paramètre est la taille moins un.
+*)
+
+Definition Zmod2 := [z:Z] Cases z of
+  	|  ZERO => `0`
+ 	| ((POS p)) => Cases p of
+      		| (xI q) => (POS q)
+    		| (xO q) => (POS q)
+    		| xH => `0`
+    		end
+ 	| ((NEG p)) => Cases p of
+      		| (xI q) => `(NEG q) - 1`
+    		| (xO q) => (NEG q)
+    		| xH => `-1`
+    		end
+ 	end.
+
+V7only [
+Notation double_moins_un_add_un :=
+  [p](sym_eq ? ? ? (double_moins_un_add_un_xI p)).
+].
+
+Lemma Zmod2_twice : (z:Z)
+	`z = (2*(Zmod2 z) + (bit_value (Zodd_bool z)))`.
+Proof.
+	NewDestruct z; Simpl.
+	Trivial.
+
+	NewDestruct p; Simpl; Trivial.
+
+	NewDestruct p; Simpl.
+	NewDestruct p as [p|p|]; Simpl.
+	Rewrite <- (double_moins_un_add_un_xI p); Trivial.
+
+	Trivial.
+
+	Trivial.
+
+	Trivial.
+
+	Trivial.
+Save.
+
+Lemma Z_to_binary : (n:nat) Z -> (Bvector n).
+Proof.
+	Induction n; Intros.
+	Exact Bnil.
+
+	Exact (Bcons (Zodd_bool H0) n0 (H (Zdiv2 H0))).
+Defined.
+
+(*
+Eval Compute in (Z_to_binary (5) `5`).
+     = (Vcons bool true (4)
+          (Vcons bool false (3)
+            (Vcons bool true (2)
+              (Vcons bool false (1) (Vcons bool false (0) (Vnil bool))))))
+     :  (Bvector (5))
+*)
+
+Lemma Z_to_two_compl : (n:nat) Z -> (Bvector (S n)).
+Proof.
+	Induction n; Intros.
+	Exact (Bcons (Zodd_bool H) (0) Bnil).
+
+	Exact (Bcons (Zodd_bool H0) (S n0) (H (Zmod2 H0))).
+Defined.
+
+(*
+Eval Compute in (Z_to_two_compl (3) `0`).
+     =  (Vcons bool false (3)
+          (Vcons bool false (2)
+            (Vcons bool false (1) (Vcons bool false (0) (Vnil bool)))))
+     :  (vector bool (4))
+
+Eval Compute in (Z_to_two_compl (3) `5`).
+     = (Vcons bool true (3)
+          (Vcons bool false (2)
+            (Vcons bool true (1) (Vcons bool false (0) (Vnil bool)))))
+     :  (vector bool (4))
+
+Eval Compute in (Z_to_two_compl (3) `-5`).
+     =  (Vcons bool true (3)
+          (Vcons bool true (2)
+            (Vcons bool false (1) (Vcons bool true (0) (Vnil bool)))))
+     :  (vector bool (4))
+*)	
+
+End ENCODING_VALUE.
+
+Section Z_BRIC_A_BRAC.
+
+(*
+Bibliotheque de lemmes utiles dans la section suivante.
+Utilise largement ZArith.
+Meriterait d'etre reecrite.
+*)
+
+Lemma binary_value_Sn : (n:nat) (b:bool) (bv : (Bvector n))
+	(binary_value (S n) (Vcons bool b n bv))=`(bit_value b) + 2*(binary_value n bv)`.
+Proof.
+	Intros; Auto.
+Save.
+
+Lemma Z_to_binary_Sn : (n:nat) (b:bool) (z:Z)
+	`z>=0`->
+	(Z_to_binary (S n) `(bit_value b) + 2*z`)=(Bcons b n (Z_to_binary n z)).
+Proof.
+	NewDestruct b; NewDestruct z; Simpl; Auto.
+	Intro H; Elim H; Trivial.
+Save.
+
+Lemma binary_value_pos : (n:nat) (bv:(Bvector n))
+	`(binary_value n bv) >= 0`.
+Proof.
+	NewInduction bv as [|a n v IHbv]; Simpl.
+	Omega.
+
+	NewDestruct a; NewDestruct (binary_value n v); Simpl; Auto.
+	Auto with zarith.
+Save.
+
+V7only [Notation add_un_double_moins_un_xO := is_double_moins_un.].
+
+Lemma two_compl_value_Sn : (n:nat) (bv : (Bvector (S n))) (b:bool)
+	(two_compl_value (S n) (Bcons b (S n) bv)) =
+		`(bit_value b) + 2*(two_compl_value n bv)`.
+Proof.
+	Intros; Auto.
+Save.
+
+Lemma Z_to_two_compl_Sn : (n:nat) (b:bool) (z:Z) 
+	(Z_to_two_compl (S n) `(bit_value b) + 2*z`) =
+		(Bcons b (S n) (Z_to_two_compl n z)).
+Proof.
+	NewDestruct b; NewDestruct z as [|p|p]; Auto.
+	NewDestruct p as [p|p|]; Auto.
+	NewDestruct p as [p|p|]; Simpl; Auto.
+	Intros; Rewrite (add_un_double_moins_un_xO p); Trivial.
+Save.
+
+Lemma Z_to_binary_Sn_z : (n:nat) (z:Z)
+	(Z_to_binary (S n) z)=(Bcons (Zodd_bool z) n (Z_to_binary n (Zdiv2 z))).
+Proof.
+	Intros; Auto.
+Save.
+
+Lemma Z_div2_value : (z:Z)
+	` z>=0 `->
+	 `(bit_value (Zodd_bool z))+2*(Zdiv2 z) = z`.
+Proof.
+	NewDestruct z as [|p|p]; Auto.
+	NewDestruct p; Auto.
+  Intro H; Elim H; Trivial.
+Save.
+
+Lemma Zdiv2_pos : (z:Z)
+	` z >= 0 ` ->
+	`(Zdiv2 z) >= 0 `.
+Proof.
+	NewDestruct z as [|p|p].
+	Auto.
+
+	NewDestruct p; Auto.
+	Simpl; Intros; Omega.
+
+  Intro H; Elim H; Trivial.
+
+Save.
+
+Lemma Zdiv2_two_power_nat : (z:Z) (n:nat)
+	` z >= 0 ` ->
+	` z < (two_power_nat (S n)) ` ->
+	`(Zdiv2 z) < (two_power_nat n) `.
+Proof.
+	Intros.
+	Cut (Zlt (Zmult `2` (Zdiv2 z)) (Zmult `2` (two_power_nat n))); Intros.
+	Omega.
+
+	Rewrite <- two_power_nat_S.
+	NewDestruct (Zeven_odd_dec z); Intros.
+	Rewrite <- Zeven_div2; Auto.
+
+	Generalize (Zodd_div2 z H z0); Omega.
+Save.
+
+(*
+
+Lemma Z_minus_one_or_zero : (z:Z)
+	`z >= -1` ->
+	`z < 1` ->
+	{`z=-1`} + {`z=0`}.
+Proof.
+	NewDestruct z; Auto.
+	NewDestruct p; Auto.
+	Tauto.
+
+	Tauto.
+
+	Intros.
+	Right; Omega.
+
+	NewDestruct p.
+	Tauto.
+
+	Tauto.
+
+	Intros; Left; Omega.
+Save.
+*)
+
+Lemma Z_to_two_compl_Sn_z : (n:nat) (z:Z)
+	(Z_to_two_compl (S n) z)=(Bcons (Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z))).
+Proof.
+	Intros; Auto.
+Save.
+
+Lemma Zeven_bit_value : (z:Z)
+	(Zeven z) ->
+	`(bit_value (Zodd_bool z))=0`.
+Proof.
+	NewDestruct z; Unfold bit_value; Auto.
+	NewDestruct p; Tauto Orelse (Intro H; Elim H).
+ 	NewDestruct p; Tauto Orelse (Intro H; Elim H).
+Save.
+
+Lemma Zodd_bit_value : (z:Z)
+	(Zodd z) ->
+	`(bit_value (Zodd_bool z))=1`.
+Proof.
+	NewDestruct z; Unfold bit_value; Auto.
+  Intros; Elim H.
+  NewDestruct p; Tauto Orelse (Intros; Elim H).
+  NewDestruct p; Tauto Orelse (Intros; Elim H).
+Save.
+
+Lemma Zge_minus_two_power_nat_S : (n:nat) (z:Z)
+	`z >= (-(two_power_nat (S n)))`->
+	`(Zmod2 z) >= (-(two_power_nat n))`.
+Proof.
+	Intros n z; Rewrite (two_power_nat_S n).
+	Generalize (Zmod2_twice z).
+	NewDestruct (Zeven_odd_dec z) as [H|H].
+	Rewrite (Zeven_bit_value z H); Intros; Omega.
+
+        Rewrite (Zodd_bit_value z H); Intros; Omega.
+Save.
+
+Lemma Zlt_two_power_nat_S : (n:nat) (z:Z)
+	`z < (two_power_nat (S n))`->
+	`(Zmod2 z) < (two_power_nat n)`.
+Proof.
+	Intros n z; Rewrite (two_power_nat_S n).
+	Generalize (Zmod2_twice z).
+	NewDestruct (Zeven_odd_dec z) as [H|H].
+	Rewrite (Zeven_bit_value z H); Intros; Omega.
+
+	Rewrite (Zodd_bit_value z H); Intros; Omega.
+Save.
+
+End Z_BRIC_A_BRAC.
+
+Section COHERENT_VALUE.
+
+(*
+On vérifie que dans l'intervalle de définition les fonctions sont 
+réciproques l'une de l'autre.
+Elles utilisent les lemmes du bric-a-brac.
+*)
+
+Lemma binary_to_Z_to_binary : (n:nat) (bv : (Bvector n))
+	(Z_to_binary n (binary_value n bv))=bv.
+Proof.
+	NewInduction bv as [|a n bv IHbv].
+	Auto.
+
+	Rewrite binary_value_Sn.
+	Rewrite Z_to_binary_Sn.
+	Rewrite IHbv; Trivial.
+
+	Apply binary_value_pos.
+Save.
+		
+Lemma two_compl_to_Z_to_two_compl : (n:nat) (bv : (Bvector n)) (b:bool)
+	(Z_to_two_compl n (two_compl_value n (Bcons b n bv)))=
+		(Bcons b n bv).
+Proof.
+	NewInduction bv as [|a n bv IHbv]; Intro b.
+	NewDestruct b; Auto.
+
+	Rewrite two_compl_value_Sn.
+	Rewrite Z_to_two_compl_Sn.
+	Rewrite IHbv; Trivial.
+Save.
+
+Lemma Z_to_binary_to_Z : (n:nat) (z : Z)
+	`z >= 0 `->
+	`z < (two_power_nat n) `->
+	 (binary_value n (Z_to_binary n z))=z.
+Proof.
+	NewInduction n as [|n IHn].
+	Unfold two_power_nat shift_nat; Simpl; Intros; Omega.
+
+	Intros; Rewrite Z_to_binary_Sn_z.
+	Rewrite binary_value_Sn.
+	Rewrite IHn.
+	Apply Z_div2_value; Auto.
+
+	Apply Zdiv2_pos; Trivial.
+
+	Apply Zdiv2_two_power_nat; Trivial.
+Save.
+
+Lemma Z_to_two_compl_to_Z : (n:nat) (z : Z)
+	`z >= -(two_power_nat n) `->
+	`z < (two_power_nat n) `->
+	(two_compl_value n (Z_to_two_compl n  z))=z.
+Proof.
+	NewInduction n as [|n IHn].
+	Unfold two_power_nat shift_nat; Simpl; Intros.
+	Assert `z=-1`\/`z=0`. Omega.
+Intuition; Subst z; Trivial.
+
+	Intros; Rewrite Z_to_two_compl_Sn_z.
+	Rewrite two_compl_value_Sn.
+	Rewrite IHn.
+	Generalize (Zmod2_twice z); Omega.
+
+	Apply Zge_minus_two_power_nat_S; Auto.
+
+	Apply Zlt_two_power_nat_S; Auto.
+Save.
+
+End COHERENT_VALUE.
+
diff --git a/theories7/ZArith/Zbool.v b/theories7/ZArith/Zbool.v
new file mode 100644
index 00000000..258a485d
--- /dev/null
+++ b/theories7/ZArith/Zbool.v
@@ -0,0 +1,158 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: Zbool.v,v 1.1.2.1 2004/07/16 19:31:42 herbelin Exp $ *)
+
+Require BinInt.
+Require Zeven.
+Require Zorder.
+Require Zcompare.
+Require ZArith_dec.
+Require Zsyntax.
+Require Sumbool.
+
+(** The decidability of equality and order relations over
+    type [Z] give some boolean functions with the adequate specification. *)
+
+Definition Z_lt_ge_bool := [x,y:Z](bool_of_sumbool (Z_lt_ge_dec x y)).
+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_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)).
+
+(**********************************************************************)
+(** Boolean comparisons of binary integers *)
+
+Definition Zle_bool := 
+  [x,y:Z]Cases `x ?= y` of SUPERIEUR => false | _ => true end.
+Definition Zge_bool := 
+  [x,y:Z]Cases `x ?= y` of INFERIEUR => false | _ => true end.
+Definition Zlt_bool := 
+  [x,y:Z]Cases `x ?= y` of INFERIEUR => true | _ => false end.
+Definition Zgt_bool := 
+  [x,y:Z]Cases ` x ?= y` of SUPERIEUR => true | _ => false end.
+Definition Zeq_bool := 
+  [x,y:Z]Cases `x ?= y` of EGAL => true | _ => false end.
+Definition Zneq_bool := 
+  [x,y:Z]Cases `x ?= y` of EGAL => false | _ => true end.
+
+Lemma Zle_cases : (x,y:Z)if (Zle_bool x y) then `x<=y` else `x>y`.
+Proof.
+Intros x y; Unfold Zle_bool Zle Zgt.
+Case (Zcompare x y); Auto; Discriminate.
+Qed.
+
+Lemma Zlt_cases : (x,y:Z)if (Zlt_bool x y) then `x<y` else `x>=y`.
+Proof.
+Intros x y; Unfold Zlt_bool Zlt Zge.
+Case (Zcompare x y); Auto; Discriminate.
+Qed.
+
+Lemma Zge_cases : (x,y:Z)if (Zge_bool x y) then `x>=y` else `x<y`.
+Proof.
+Intros x y; Unfold Zge_bool Zge Zlt.
+Case (Zcompare x y); Auto; Discriminate.
+Qed.
+
+Lemma Zgt_cases : (x,y:Z)if (Zgt_bool x y) then `x>y` else `x<=y`.
+Proof.
+Intros x y; Unfold Zgt_bool Zgt Zle.
+Case (Zcompare x y); Auto; Discriminate.
+Qed.
+
+(** Lemmas on [Zle_bool] used in contrib/graphs *)
+
+Lemma Zle_bool_imp_le : (x,y:Z) (Zle_bool x y)=true -> (Zle x y).
+Proof.
+  Unfold Zle_bool Zle. Intros x y. Unfold not. 
+  Case (Zcompare x y); Intros; Discriminate.
+Qed.
+
+Lemma Zle_imp_le_bool : (x,y:Z) (Zle x y) -> (Zle_bool x y)=true.
+Proof.
+  Unfold Zle Zle_bool. Intros x y. Case (Zcompare x y); Trivial. Intro. Elim (H (refl_equal ? ?)).
+Qed.
+
+Lemma Zle_bool_refl : (x:Z) (Zle_bool x x)=true.
+Proof.
+  Intro. Apply Zle_imp_le_bool. Apply Zle_refl. Reflexivity.
+Qed.
+
+Lemma Zle_bool_antisym : (x,y:Z) (Zle_bool x y)=true -> (Zle_bool y x)=true -> x=y.
+Proof.
+  Intros. Apply Zle_antisym. Apply Zle_bool_imp_le. Assumption.
+  Apply Zle_bool_imp_le. Assumption.
+Qed.
+
+Lemma Zle_bool_trans : (x,y,z:Z) (Zle_bool x y)=true -> (Zle_bool y z)=true -> (Zle_bool x z)=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.
+Qed.
+
+Definition Zle_bool_total : (x,y:Z) {(Zle_bool x y)=true}+{(Zle_bool y x)=true}.
+Proof.
+  Intros x y; Intros. Unfold Zle_bool. Cut (Zcompare x y)=SUPERIEUR<->(Zcompare y x)=INFERIEUR.
+  Case (Zcompare x y). Left . Reflexivity.
+  Left . Reflexivity.
+  Right . Rewrite (proj1 ? ? H (refl_equal ? ?)). Reflexivity.
+  Apply Zcompare_ANTISYM.
+Defined.
+
+Lemma Zle_bool_plus_mono : (x,y,z,t:Z) (Zle_bool x y)=true -> (Zle_bool z t)=true ->
+                                (Zle_bool (Zplus x z) (Zplus y t))=true.
+Proof.
+  Intros. Apply Zle_imp_le_bool. Apply Zle_plus_plus. Apply Zle_bool_imp_le. Assumption.
+  Apply Zle_bool_imp_le. Assumption.
+Qed.
+
+Lemma Zone_pos : (Zle_bool `1` `0`)=false.
+Proof.
+  Reflexivity.
+Qed.
+
+Lemma Zone_min_pos : (x:Z) (Zle_bool x `0`)=false -> (Zle_bool `1` x)=true.
+Proof.
+  Intros x; Intros. Apply Zle_imp_le_bool. Change (Zle (Zs ZERO) x). Apply Zgt_le_S. Generalize H.
+  Unfold Zle_bool Zgt. Case (Zcompare x ZERO). Intro H0. Discriminate H0.
+  Intro H0. Discriminate H0.
+  Reflexivity.
+Qed.
+
+
+ Lemma Zle_is_le_bool : (x,y:Z) (Zle x y) <-> (Zle_bool x y)=true.
+  Proof.
+    Intros. Split. Intro. Apply Zle_imp_le_bool. Assumption.
+    Intro. Apply Zle_bool_imp_le. Assumption.
+  Qed.
+
+  Lemma Zge_is_le_bool : (x,y:Z) (Zge x y) <-> (Zle_bool y x)=true.
+  Proof.
+    Intros. Split. Intro. Apply Zle_imp_le_bool. Apply Zge_le. Assumption.
+    Intro. Apply Zle_ge. Apply Zle_bool_imp_le. Assumption.
+  Qed.
+
+  Lemma Zlt_is_le_bool : (x,y:Z) (Zlt x y) <-> (Zle_bool x `y-1`)=true.
+  Proof.
+    Intros x y. Split. Intro. Apply Zle_imp_le_bool. Apply Zlt_n_Sm_le. Rewrite (Zs_pred y) in H.
+    Assumption.
+    Intro. Rewrite (Zs_pred y). Apply Zle_lt_n_Sm. Apply Zle_bool_imp_le. Assumption.
+  Qed.
+
+  Lemma Zgt_is_le_bool : (x,y:Z) (Zgt x y) <-> (Zle_bool y `x-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).
+  Qed.
+
diff --git a/theories7/ZArith/Zcompare.v b/theories7/ZArith/Zcompare.v
new file mode 100644
index 00000000..fd11ae9b
--- /dev/null
+++ b/theories7/ZArith/Zcompare.v
@@ -0,0 +1,480 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $$ i*)
+
+Require Export BinPos.
+Require Export BinInt.
+Require Zsyntax.
+Require Lt.
+Require Gt.
+Require Plus.
+Require Mult.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France)            *)
+(**********************************************************************)
+
+(**********************************************************************)
+(** Comparison on integers *)
+
+Lemma Zcompare_x_x : (x:Z) (Zcompare x x) = EGAL.
+Proof.
+Intro x; NewDestruct x as [|p|p]; Simpl; [ Reflexivity | Apply convert_compare_EGAL
+  | Rewrite convert_compare_EGAL; Reflexivity ].
+Qed.
+
+Lemma Zcompare_EGAL_eq : (x,y:Z) (Zcompare x y) = EGAL -> x = y.
+Proof.
+Intros x y; NewDestruct x as [|x'|x'];NewDestruct y as [|y'|y'];Simpl;Intro H; Reflexivity Orelse Try Discriminate H; [
+    Rewrite (compare_convert_EGAL x' y' H); Reflexivity
+  | Rewrite (compare_convert_EGAL x' y'); [
+      Reflexivity
+    | NewDestruct (compare x' y' EGAL);
+      Reflexivity Orelse Discriminate]].
+Qed.
+
+Lemma Zcompare_EGAL : (x,y:Z) (Zcompare x y) = EGAL <-> x = y.
+Proof.
+Intros x y;Split; Intro E; [ Apply Zcompare_EGAL_eq; Assumption
+  | Rewrite E; Apply Zcompare_x_x ].
+Qed.
+
+Lemma Zcompare_antisym :
+  (x,y:Z)(Op (Zcompare x y)) = (Zcompare y x).
+Proof.
+Intros x y; NewDestruct x; NewDestruct y; Simpl;
+  Reflexivity Orelse Discriminate H Orelse 
+  Rewrite Pcompare_antisym; Reflexivity.
+Qed.
+
+Lemma Zcompare_ANTISYM : 
+  (x,y:Z) (Zcompare x y) = SUPERIEUR <->  (Zcompare y x) = INFERIEUR.
+Proof.
+Intros x y; Split; Intro H; [ 
+  Change INFERIEUR with (Op SUPERIEUR); 
+  Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity
+| Change SUPERIEUR with (Op INFERIEUR); 
+  Rewrite <- Zcompare_antisym; Rewrite H; Reflexivity ].
+Qed.
+
+(** Transitivity of comparison *)
+
+Lemma Zcompare_trans_SUPERIEUR : 
+  (x,y,z:Z) (Zcompare x y) = SUPERIEUR ->  
+            (Zcompare y z) = SUPERIEUR ->
+            (Zcompare x z) = SUPERIEUR.
+Proof.
+Intros x y z;Case x;Case y;Case z; Simpl;
+Try (Intros; Discriminate H Orelse Discriminate H0);
+Auto with arith; [
+  Intros p q r H H0;Apply convert_compare_SUPERIEUR; Unfold gt;
+  Apply lt_trans with m:=(convert q);
+  Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
+| Intros p q r; Do 3 Rewrite <- ZC4; Intros H H0;
+  Apply convert_compare_SUPERIEUR;Unfold gt;Apply lt_trans with m:=(convert q);
+  Apply compare_convert_INFERIEUR;Apply ZC1;Assumption ].
+Qed.
+
+(** Comparison and opposite *)
+
+Lemma Zcompare_Zopp :
+  (x,y:Z) (Zcompare x y) = (Zcompare (Zopp y) (Zopp x)).
+Proof.
+(Intros x y;Case x;Case y;Simpl;Auto with arith);
+Intros;Rewrite <- ZC4;Trivial with arith.
+Qed.
+
+Hints Local Resolve convert_compare_EGAL.
+
+(** Comparison first-order specification *)
+
+Lemma SUPERIEUR_POS :
+  (x,y:Z) (Zcompare x y) = SUPERIEUR ->
+  (EX h:positive |(Zplus x (Zopp y)) = (POS h)).
+Proof.
+Intros x y;Case x;Case y; [
+  Simpl; Intros H; Discriminate H
+| Simpl; Intros p H; Discriminate H
+| Intros p H; Exists p; Simpl; Auto with arith
+| Intros p H; Exists p; Simpl; Auto with arith
+| Intros q p H; Exists (true_sub p q); Unfold Zplus Zopp;
+  Unfold Zcompare in H; Rewrite H; Trivial with arith
+| Intros q p H; Exists (add p q); Simpl; Trivial with arith
+| Simpl; Intros p H; Discriminate H
+| Simpl; Intros q p H; Discriminate H
+| Unfold Zcompare; Intros q p; Rewrite <- ZC4; Intros H; Exists (true_sub q p);
+  Simpl; Rewrite (ZC1 q p H); Trivial with arith].
+Qed.
+
+(** Comparison and addition *)
+
+Lemma weaken_Zcompare_Zplus_compatible : 
+  ((n,m:Z) (p:positive) 
+    (Zcompare (Zplus (POS p) n) (Zplus (POS p) m)) = (Zcompare n m)) ->
+   (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
+Proof.
+Intros H x y z; NewDestruct z; [
+  Reflexivity
+| Apply H
+| Rewrite (Zcompare_Zopp x y); Rewrite Zcompare_Zopp; 
+  Do 2 Rewrite Zopp_Zplus; Rewrite Zopp_NEG; Apply H ].
+Qed.
+
+Hints Local Resolve ZC4.
+
+Lemma weak_Zcompare_Zplus_compatible : 
+  (x,y:Z) (z:positive) 
+    (Zcompare (Zplus (POS z) x) (Zplus (POS z) y)) = (Zcompare x y).
+Proof.
+Intros x y z;Case x;Case y;Simpl;Auto with arith; [
+  Intros p;Apply convert_compare_INFERIEUR; Apply ZL17
+| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith;
+  Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [ Unfold gt ;
+  Apply ZL16 | Assumption ]
+| Intros p;ElimPcompare z p;
+  Intros E;Auto with arith; Apply convert_compare_SUPERIEUR;
+  Unfold gt;Apply ZL17
+| Intros p q;
+  ElimPcompare q p;
+  Intros E;Rewrite E;[
+    Rewrite (compare_convert_EGAL q p E); Apply convert_compare_EGAL
+  | Apply convert_compare_INFERIEUR;Do 2 Rewrite convert_add;Apply lt_reg_l;
+    Apply compare_convert_INFERIEUR with 1:=E
+  | Apply convert_compare_SUPERIEUR;Unfold gt ;Do 2 Rewrite convert_add;
+    Apply lt_reg_l;Exact (compare_convert_SUPERIEUR q p E) ]
+| Intros p q; 
+  ElimPcompare z p;
+  Intros E;Rewrite E;Auto with arith;
+  Apply convert_compare_SUPERIEUR; Rewrite true_sub_convert; [
+    Unfold gt; Apply lt_trans with m:=(convert z); [Apply ZL16 | Apply ZL17]
+  | Assumption ]
+| Intros p;ElimPcompare z p;Intros E;Rewrite E;Auto with arith; Simpl;
+  Apply convert_compare_INFERIEUR;Rewrite true_sub_convert;[Apply ZL16|
+  Assumption]
+| Intros p q;
+  ElimPcompare z q;
+  Intros E;Rewrite E;Auto with arith; Simpl;Apply convert_compare_INFERIEUR;
+  Rewrite true_sub_convert;[
+    Apply lt_trans with m:=(convert 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 (compare q p EGAL)=INFERIEUR; [
+      Rewrite <- (compare_convert_EGAL z q E0);
+      Rewrite <- (compare_convert_EGAL z p E1); 
+      Rewrite (convert_compare_EGAL z); Discriminate
+    | Assumption ]
+  | Absurd (compare q p EGAL)=SUPERIEUR; [
+      Rewrite <- (compare_convert_EGAL z q E0);
+      Rewrite <- (compare_convert_EGAL z p E1);
+      Rewrite (convert_compare_EGAL z);Discriminate
+    | Assumption]
+  | Absurd (compare z p EGAL)=INFERIEUR; [
+      Rewrite (compare_convert_EGAL z q E0); 
+      Rewrite <- (compare_convert_EGAL q p E2);
+      Rewrite (convert_compare_EGAL q);Discriminate
+    | Assumption ]
+  | Absurd (compare z p EGAL)=INFERIEUR; [
+      Rewrite (compare_convert_EGAL z q E0); Rewrite E2;Discriminate
+    | Assumption]
+  | Absurd (compare z p EGAL)=SUPERIEUR;[
+      Rewrite (compare_convert_EGAL z q E0);
+      Rewrite <- (compare_convert_EGAL q p E2);
+      Rewrite (convert_compare_EGAL q);Discriminate
+    | Assumption]
+  | Absurd (compare z p EGAL)=SUPERIEUR;[
+      Rewrite (compare_convert_EGAL z q E0);Rewrite E2;Discriminate
+    | Assumption]
+  | Absurd (compare z q EGAL)=INFERIEUR;[
+      Rewrite (compare_convert_EGAL z p E1);
+      Rewrite (compare_convert_EGAL q p E2);
+      Rewrite (convert_compare_EGAL p); Discriminate
+    | Assumption]
+  | Absurd (compare p q EGAL)=SUPERIEUR; [
+      Rewrite <- (compare_convert_EGAL z p E1);
+      Rewrite E0; Discriminate
+    | Apply ZC2;Assumption ]
+  | Simpl; Rewrite (compare_convert_EGAL q p E2);
+    Rewrite (convert_compare_EGAL (true_sub p z)); Auto with arith
+  | Simpl; Rewrite <- ZC4; Apply convert_compare_SUPERIEUR;
+    Rewrite true_sub_convert; [
+      Rewrite true_sub_convert; [
+        Unfold gt; Apply simpl_lt_plus_l with p:=(convert z);
+        Rewrite le_plus_minus_r; [
+          Rewrite le_plus_minus_r; [
+            Apply compare_convert_INFERIEUR;Assumption
+          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
+        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
+      | Apply ZC2;Assumption ]
+    | Apply ZC2;Assumption ]
+  | Simpl; Rewrite <- ZC4; Apply convert_compare_INFERIEUR; 
+    Rewrite true_sub_convert; [
+      Rewrite true_sub_convert; [
+        Apply simpl_lt_plus_l with p:=(convert z);
+        Rewrite le_plus_minus_r; [
+          Rewrite le_plus_minus_r; [
+            Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
+          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
+        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Assumption ]
+      | Apply ZC2;Assumption]
+    | Apply ZC2;Assumption ]
+  | Absurd (compare z q EGAL)=INFERIEUR; [
+      Rewrite (compare_convert_EGAL q p E2);Rewrite E1;Discriminate
+    | Assumption ]
+  | Absurd (compare q p EGAL)=INFERIEUR; [
+      Cut (compare q p EGAL)=SUPERIEUR; [
+        Intros E;Rewrite E;Discriminate
+      | Apply convert_compare_SUPERIEUR; Unfold gt;
+        Apply lt_trans with m:=(convert z); [
+          Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
+        | Apply compare_convert_INFERIEUR;Assumption ]]
+    | Assumption ]
+  | Absurd (compare z q EGAL)=SUPERIEUR; [
+      Rewrite (compare_convert_EGAL z p E1);
+      Rewrite (compare_convert_EGAL q p E2);
+      Rewrite (convert_compare_EGAL p); Discriminate
+    | Assumption ]
+  | Absurd (compare z q EGAL)=SUPERIEUR; [
+      Rewrite (compare_convert_EGAL z p E1);
+      Rewrite ZC1; [Discriminate | Assumption ]
+    | Assumption ]
+  | Absurd (compare z q EGAL)=SUPERIEUR; [
+      Rewrite (compare_convert_EGAL q p E2); Rewrite E1; Discriminate
+    | Assumption ]
+  | Absurd (compare q p EGAL)=SUPERIEUR; [
+      Rewrite ZC1; [ 
+        Discriminate 
+      | Apply convert_compare_SUPERIEUR; Unfold gt; 
+        Apply lt_trans with m:=(convert z); [
+          Apply compare_convert_INFERIEUR;Apply ZC1;Assumption
+        | Apply compare_convert_INFERIEUR;Assumption ]]
+    | Assumption ]
+  | Simpl; Rewrite (compare_convert_EGAL q p E2); Apply convert_compare_EGAL
+  | Simpl; Apply convert_compare_SUPERIEUR; Unfold gt;
+    Rewrite true_sub_convert; [
+      Rewrite true_sub_convert; [
+        Apply simpl_lt_plus_l with p:=(convert p); Rewrite le_plus_minus_r; [
+          Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert q);
+          Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
+            Rewrite (plus_sym (convert q)); Apply lt_reg_l;
+            Apply compare_convert_INFERIEUR;Assumption
+          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;
+            Apply ZC1;Assumption ]
+        | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1; 
+          Assumption ]
+      | Assumption ]
+    | Assumption ]
+  | Simpl; Apply convert_compare_INFERIEUR; Rewrite true_sub_convert; [
+      Rewrite true_sub_convert; [
+        Apply simpl_lt_plus_l with p:=(convert q); Rewrite le_plus_minus_r; [
+          Rewrite plus_sym; Apply simpl_lt_plus_l with p:=(convert p);
+          Rewrite plus_assoc_l; Rewrite le_plus_minus_r; [
+            Rewrite (plus_sym (convert p)); Apply lt_reg_l;
+            Apply compare_convert_INFERIEUR;Apply ZC1;Assumption 
+          | Apply lt_le_weak; Apply compare_convert_INFERIEUR;Apply ZC1;
+            Assumption ]
+        | Apply lt_le_weak;Apply compare_convert_INFERIEUR;Apply ZC1;Assumption]
+      | Assumption]
+    | Assumption]]].
+Qed.
+
+Lemma Zcompare_Zplus_compatible : 
+   (x,y,z:Z) (Zcompare (Zplus z x) (Zplus z y)) = (Zcompare x y).
+Proof.
+Exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
+Qed.
+
+Lemma Zcompare_Zplus_compatible2 :
+  (r:relation)(x,y,z,t:Z)
+    (Zcompare x y) = r -> (Zcompare z t) = r ->
+    (Zcompare (Zplus x z) (Zplus y t)) = r.
+Proof.
+Intros r x y z t; Case r; [
+  Intros H1 H2; Elim (Zcompare_EGAL x y); Elim (Zcompare_EGAL z t);
+  Intros H3 H4 H5 H6; Rewrite H3; [ 
+    Rewrite H5; [ Elim (Zcompare_EGAL (Zplus y t) (Zplus y t)); Auto with arith | Auto with arith ]
+  | Auto with arith ]
+| Intros H1 H2; Elim (Zcompare_ANTISYM (Zplus y t) (Zplus x z));
+  Intros H3 H4; Apply H3;
+  Apply Zcompare_trans_SUPERIEUR with y:=(Zplus y z) ; [
+    Rewrite Zcompare_Zplus_compatible;
+    Elim (Zcompare_ANTISYM t z); Auto with arith
+  | Do 2 Rewrite <- (Zplus_sym z); 
+    Rewrite Zcompare_Zplus_compatible;
+    Elim (Zcompare_ANTISYM y x); Auto with arith]
+| Intros H1 H2;
+  Apply Zcompare_trans_SUPERIEUR with y:=(Zplus x t) ; [
+    Rewrite Zcompare_Zplus_compatible; Assumption
+  | Do 2 Rewrite <- (Zplus_sym t);
+    Rewrite Zcompare_Zplus_compatible; Assumption]].
+Qed.
+
+Lemma Zcompare_Zs_SUPERIEUR : (x:Z)(Zcompare (Zs x) x)=SUPERIEUR.
+Proof.
+Intro x; Unfold Zs; Pattern 2 x; Rewrite <- (Zero_right x); 
+Rewrite Zcompare_Zplus_compatible;Reflexivity.
+Qed.
+
+Lemma Zcompare_et_un: 
+  (x,y:Z) (Zcompare x y)=SUPERIEUR <-> 
+    ~(Zcompare x (Zplus y (POS xH)))=INFERIEUR.
+Proof.
+Intros x y; Split; [
+  Intro H; (ElimCompare 'x '(Zplus y (POS xH)));[
+    Intro H1; Rewrite H1; Discriminate
+  | Intros H1; Elim SUPERIEUR_POS with 1:=H; Intros h H2; 
+    Absurd (gt (convert h) O) /\ (lt (convert h) (S O)); [
+      Unfold not ;Intros H3;Elim H3;Intros H4 H5; Absurd (gt (convert h) O); [
+        Unfold gt ;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 (lt (convert h) (convert xH)); 
+        Apply compare_convert_INFERIEUR;
+        Change (Zcompare (POS h) (POS xH))=INFERIEUR;
+        Rewrite <- H2; Rewrite <- [m,n:Z](Zcompare_Zplus_compatible m n y);
+        Rewrite (Zplus_sym x);Rewrite Zplus_assoc; Rewrite Zplus_inverse_r;
+        Simpl; Exact H1 ]]
+  | Intros H1;Rewrite -> H1;Discriminate ]
+| Intros H; (ElimCompare 'x '(Zplus y (POS xH))); [
+    Intros H1;Elim (Zcompare_EGAL x (Zplus y (POS xH))); Intros H2 H3;
+    Rewrite  (H2 H1); Exact (Zcompare_Zs_SUPERIEUR y)
+  | Intros H1;Absurd (Zcompare x (Zplus y (POS xH)))=INFERIEUR;Assumption
+  | Intros H1; Apply Zcompare_trans_SUPERIEUR with y:=(Zs y); 
+      [ Exact H1 | Exact (Zcompare_Zs_SUPERIEUR y)]]].
+Qed.
+
+(** Successor and comparison *)
+
+Lemma Zcompare_n_S : (n,m:Z)(Zcompare (Zs n) (Zs m)) = (Zcompare n m).
+Proof.
+Intros n m;Unfold Zs ;Do 2 Rewrite -> [t:Z](Zplus_sym t (POS xH));
+Rewrite -> Zcompare_Zplus_compatible;Auto with arith.
+Qed.
+ 
+(** Multiplication and comparison *)
+
+Lemma Zcompare_Zmult_compatible : 
+   (x:positive)(y,z:Z)
+      (Zcompare (Zmult (POS x) y) (Zmult (POS x) z)) = (Zcompare y z).
+Proof.
+Intros x; NewInduction x as [p H|p H|]; [
+  Intros y z;
+  Cut (POS (xI p))=(Zplus (Zplus (POS p) (POS p)) (POS xH)); [
+    Intros E; Rewrite E; Do 4 Rewrite Zmult_plus_distr_l; 
+    Do 2 Rewrite Zmult_one;
+    Apply Zcompare_Zplus_compatible2; [
+      Apply Zcompare_Zplus_compatible2; Apply H
+    | Trivial with arith]
+  | Simpl; Rewrite (add_x_x p); Trivial with arith]
+| Intros y z; Cut (POS (xO p))=(Zplus (POS p) (POS p)); [
+    Intros E; Rewrite E; Do 2 Rewrite Zmult_plus_distr_l;
+      Apply Zcompare_Zplus_compatible2; Apply H
+    | Simpl; Rewrite (add_x_x p); Trivial with arith]
+  | Intros y z; Do 2 Rewrite Zmult_one; Trivial with arith].
+Qed.
+
+
+(** Reverting [x ?= y] to trichotomy *)
+
+Lemma rename : (A:Set)(P:A->Prop)(x:A) ((y:A)(x=y)->(P y)) -> (P x).
+Proof.
+Auto with arith. 
+Qed.
+
+Lemma Zcompare_elim :
+  (c1,c2,c3:Prop)(x,y:Z)
+    ((x=y) -> c1) ->(`x<y` -> c2) ->(`x>y`-> c3)
+     -> Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
+Proof.
+Intros c1 c2 c3 x y; Intros.
+Apply rename with x:=(Zcompare x y); Intro r; Elim r;
+[ Intro; Apply H; Apply (Zcompare_EGAL_eq x y); Assumption
+| Unfold Zlt in H0; Assumption
+| Unfold Zgt in H1; Assumption ].
+Qed.
+
+Lemma Zcompare_eq_case : 
+  (c1,c2,c3:Prop)(x,y:Z) c1 -> x=y ->
+  Cases (Zcompare x y) of EGAL => c1 | INFERIEUR => c2 | SUPERIEUR => c3 end.
+Proof.
+Intros c1 c2 c3 x y; Intros.
+Rewrite H0; Rewrite (Zcompare_x_x).
+Assumption.
+Qed.
+
+(** Decompose an egality between two [?=] relations into 3 implications *)
+
+Lemma Zcompare_egal_dec :
+   (x1,y1,x2,y2:Z)
+    (`x1<y1`->`x2<y2`)
+     ->((Zcompare x1 y1)=EGAL -> (Zcompare x2 y2)=EGAL)
+        ->(`x1>y1`->`x2>y2`)->(Zcompare x1 y1)=(Zcompare x2 y2).
+Proof.
+Intros x1 y1 x2 y2.
+Unfold Zgt; Unfold Zlt;
+Case (Zcompare x1 y1); Case (Zcompare x2 y2); Auto with arith; Symmetry; Auto with arith.
+Qed.
+
+(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
+
+Lemma Zle_Zcompare :
+  (x,y:Z)`x<=y` ->
+  Cases (Zcompare x y) of EGAL => True | INFERIEUR => True | SUPERIEUR => False end.
+Proof.
+Intros x y; Unfold Zle; Elim (Zcompare x y); Auto with arith.
+Qed.
+
+Lemma Zlt_Zcompare :
+  (x,y:Z)`x<y`  ->
+  Cases (Zcompare x y) of EGAL => False | INFERIEUR => True | SUPERIEUR => False end.
+Proof.
+Intros x y; Unfold Zlt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
+Qed.
+
+Lemma Zge_Zcompare :
+  (x,y:Z)`x>=y`->
+  Cases (Zcompare x y) of EGAL => True | INFERIEUR => False | SUPERIEUR => True end.
+Proof.
+Intros x y; Unfold Zge; Elim (Zcompare x y); Auto with arith. 
+Qed.
+
+Lemma Zgt_Zcompare :
+  (x,y:Z)`x>y` ->
+  Cases (Zcompare x y) of EGAL => False | INFERIEUR => False | SUPERIEUR => True end.
+Proof.
+Intros x y; Unfold Zgt; Elim (Zcompare x y); Intros; Discriminate Orelse Trivial with arith.
+Qed.
+
+(**********************************************************************)
+(* Other properties *)
+
+V7only [Set Implicit Arguments.].
+
+Lemma  Zcompare_Zmult_left : (x,y,z:Z)`z>0` -> `x ?= y`=`z*x ?= z*y`.
+Proof.
+Intros x y z H; NewDestruct z.
+  Discriminate H.
+  Rewrite Zcompare_Zmult_compatible; Reflexivity.
+  Discriminate H.
+Qed.
+
+Lemma Zcompare_Zmult_right : (x,y,z:Z)` z>0` -> `x ?= y`=`x*z ?= y*z`.
+Proof.
+Intros x y z H;
+Rewrite (Zmult_sym x z);
+Rewrite (Zmult_sym y z);
+Apply Zcompare_Zmult_left; Assumption.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
diff --git a/theories7/ZArith/Zcomplements.v b/theories7/ZArith/Zcomplements.v
new file mode 100644
index 00000000..72d837b6
--- /dev/null
+++ b/theories7/ZArith/Zcomplements.v
@@ -0,0 +1,212 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zcomplements.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+Require ZArithRing.
+Require ZArith_base.
+Require Omega.
+Require Wf_nat.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+V7only [Set Implicit Arguments.].
+
+(**********************************************************************)
+(** About parity *)
+
+Lemma two_or_two_plus_one : (x:Z) { y:Z | `x = 2*y`}+{ y:Z | `x = 2*y+1`}. 
+Proof.
+Intro x; NewDestruct x.
+Left ; Split with ZERO; Reflexivity.
+
+NewDestruct p.
+Right ; Split with (POS p); Reflexivity.
+
+Left ; Split with (POS p); Reflexivity.
+
+Right ; Split with ZERO; Reflexivity.
+
+NewDestruct p.
+Right ; Split with (NEG (add xH p)).
+Rewrite NEG_xI.
+Rewrite NEG_add.
+Omega.
+
+Left ; Split with (NEG p); Reflexivity.
+
+Right ; Split with `-1`; Reflexivity.
+Qed.
+
+(**********************************************************************)
+(** The biggest power of 2 that is stricly less than [a]
+
+    Easy to compute: replace all "1" of the binary representation by
+    "0", except the first "1" (or the first one :-) *)
+
+Fixpoint floor_pos [a : positive] : positive :=
+  Cases a of
+  | xH => xH
+  | (xO a') => (xO (floor_pos a'))
+  | (xI b') => (xO (floor_pos b'))
+  end.
+
+Definition floor := [a:positive](POS (floor_pos a)).
+
+Lemma floor_gt0 : (x:positive) `(floor x) > 0`.
+Proof.
+Intro.
+Compute.
+Trivial.
+Qed.
+
+Lemma floor_ok : (a:positive) 
+  `(floor a) <=  (POS a) < 2*(floor a)`. 
+Proof.
+Unfold floor.
+Intro a; NewInduction a as [p|p|].
+
+Simpl.
+Repeat Rewrite POS_xI.
+Rewrite (POS_xO (xO (floor_pos p))). 
+Rewrite (POS_xO (floor_pos p)).
+Omega.
+
+Simpl.
+Repeat Rewrite POS_xI.
+Rewrite (POS_xO (xO (floor_pos p))).
+Rewrite (POS_xO (floor_pos p)).
+Rewrite (POS_xO p).
+Omega.
+
+Simpl; Omega.
+Qed.
+
+(**********************************************************************)
+(** Two more induction principles over [Z]. *)
+
+Theorem Z_lt_abs_rec : (P: Z -> Set)
+  ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
+Proof.
+Intros P HP p.
+LetTac Q:=[z]`0<=z`->(P z)*(P `-z`).
+Cut (Q `|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;Clear Q;Intros.
+Apply pair;Apply HP.
+Rewrite Zabs_eq;Auto;Intros.
+Elim (H `|m|`);Intros;Auto with zarith.
+Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+Rewrite Zabs_non_eq;Auto with zarith.
+Rewrite Zopp_Zopp;Intros.
+Elim (H `|m|`);Intros;Auto with zarith.
+Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+Qed.
+
+Theorem Z_lt_abs_induction : (P: Z -> Prop)
+  ((n: Z) ((m: Z) `|m|<|n|` -> (P m)) -> (P n)) -> (p: Z) (P p).
+Proof.
+Intros P HP p.
+LetTac Q:=[z]`0<=z`->(P z) /\ (P `-z`).
+Cut (Q `|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;Clear Q;Intros.
+Split;Apply HP.
+Rewrite Zabs_eq;Auto;Intros.
+Elim (H `|m|`);Intros;Auto with zarith.
+Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+Rewrite Zabs_non_eq;Auto with zarith.
+Rewrite Zopp_Zopp;Intros.
+Elim (H `|m|`);Intros;Auto with zarith.
+Elim (Zabs_dec m);Intro eq;Rewrite eq;Trivial.
+Qed.
+V7only [Unset Implicit Arguments.].
+
+(** To do case analysis over the sign of [z] *) 
+
+Lemma Zcase_sign : (x:Z)(P:Prop)
+ (`x=0` -> P) ->
+ (`x>0` -> P) ->
+ (`x<0` -> P) -> P.
+Proof.
+Intros x P Hzero Hpos Hneg.
+Induction x.
+Apply Hzero; Trivial.
+Apply Hpos; Apply POS_gt_ZERO.
+Apply Hneg; Apply NEG_lt_ZERO.
+Save.
+
+Lemma sqr_pos : (x:Z)`x*x >= 0`.
+Proof.
+Intro x.
+Apply (Zcase_sign x `x*x >= 0`).
+Intros H; Rewrite H; Omega.
+Intros H; Replace `0` with `0*0`.
+Apply Zge_Zmult_pos_compat; Omega.
+Omega.
+Intros H; Replace `0` with `0*0`.
+Replace `x*x` with `(-x)*(-x)`.
+Apply Zge_Zmult_pos_compat; Omega.
+Ring.
+Omega.
+Save.
+
+(**********************************************************************)
+(** A list length in Z, tail recursive.  *)
+
+Require PolyList.
+
+Fixpoint Zlength_aux [acc: Z; A:Set; l:(list A)] : Z := Cases l of 
+    nil => acc
+  | (cons _ l) => (Zlength_aux (Zs acc) A l)
+end. 
+
+Definition Zlength := (Zlength_aux 0).
+Implicits Zlength [1].
+
+Section Zlength_properties.
+
+Variable A:Set.
+
+Implicit Variable Type l:(list A).
+
+Lemma Zlength_correct : (l:(list A))(Zlength l)=(inject_nat (length l)).
+Proof.
+Assert (l:(list A))(acc:Z)(Zlength_aux acc A l)=acc+(inject_nat (length l)). 
+Induction l.
+Simpl; Auto with zarith.
+Intros; Simpl (length (cons a l0)); Rewrite inj_S.
+Simpl; Rewrite H; Auto with zarith.
+Unfold Zlength; Intros; Rewrite H; Auto.
+Qed.
+
+Lemma Zlength_nil : (Zlength 1!A (nil A))=0.
+Proof.
+Auto.
+Qed.
+
+Lemma Zlength_cons : (x:A)(l:(list A))(Zlength (cons x l))=(Zs (Zlength l)).
+Proof.
+Intros; Do 2 Rewrite Zlength_correct.
+Simpl (length (cons x l)); Rewrite inj_S; Auto.
+Qed.
+
+Lemma Zlength_nil_inv : (l:(list A))(Zlength l)=0 -> l=(nil ?).
+Proof.
+Intro l; Rewrite Zlength_correct.
+Case l; Auto.
+Intros x l'; Simpl (length (cons x l')).
+Rewrite inj_S.
+Intros; ElimType False; Generalize (ZERO_le_inj (length l')); Omega.
+Qed.
+
+End Zlength_properties.
+
+Implicits Zlength_correct [1].
+Implicits Zlength_cons [1].
+Implicits Zlength_nil_inv [1].
diff --git a/theories7/ZArith/Zdiv.v b/theories7/ZArith/Zdiv.v
new file mode 100644
index 00000000..84d53931
--- /dev/null
+++ b/theories7/ZArith/Zdiv.v
@@ -0,0 +1,432 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zdiv.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+(* 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.
+
+*)
+
+Require Export ZArith_base.
+Require Zbool.
+Require Omega.
+Require ZArithRing.
+Require Zcomplements.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+(**
+
+  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
+  
+*)
+
+Fixpoint Zdiv_eucl_POS [a:positive] : Z -> Z*Z := [b:Z]
+ Cases a of
+ | xH => if `(Zge_bool b 2)` then `(0,1)` else `(1,0)` 
+ | (xO a') => 
+    let (q,r) = (Zdiv_eucl_POS a' b) in 
+    [r':=`2*r`] 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 
+    [r':=`2*r+1`] 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|.
+
+*)
+
+Definition Zdiv_eucl [a,b:Z] : Z*Z :=
+  Cases a b of
+  | ZERO _  => `(0,0)`
+  | _ ZERO  => `(0,0)`
+  | (POS a') (POS _) => (Zdiv_eucl_POS a' b)
+  | (NEG a') (POS _) => 
+      let (q,r) = (Zdiv_eucl_POS a' b) in 
+      Cases r of 
+      | ZERO => `(-q,0)`
+      | _    => `(-(q+1),b-r)`
+      end
+  | (NEG a') (NEG b') => 
+	 let (q,r) = (Zdiv_eucl_POS a' (POS b')) in `(q,-r)`
+  | (POS a') (NEG b') =>
+      let (q,r) = (Zdiv_eucl_POS a' (POS b')) in 
+      Cases r of 
+      | ZERO => `(-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. 
+
+(* Tests:
+
+Eval Compute in `(Zdiv_eucl 7 3)`. 
+
+Eval Compute in `(Zdiv_eucl (-7) 3)`.
+
+Eval Compute in `(Zdiv_eucl 7 (-3))`.
+
+Eval Compute in `(Zdiv_eucl (-7) (-3))`.
+
+*)
+
+
+(**
+
+  Main division theorem. 
+
+  First a lemma for positive
+
+*)
+
+Lemma Z_div_mod_POS : (b:Z)`b > 0` -> (a:positive)
+  let (q,r)=(Zdiv_eucl_POS a b) in `(POS a) = b*q + r`/\`0<=r<b`.
+Proof.
+Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
+
+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 POS_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 POS_xO; Change (POS (xO p)) with `2*(POS p)`; 
+ Rewrite H0; (Split; [Ring | Omega]).
+
+Generalize (Zge_cases b `2`).
+Case (Zge_bool b `2`); (Intros; Split; [Ring | Omega ]).
+Omega.
+Qed.
+
+
+Theorem Z_div_mod : (a,b:Z)`b > 0` -> 
+  let (q,r) = (Zdiv_eucl a b) in `a = b*q + r` /\ `0<=r<b`.
+Proof.
+Intros a b; Case a; Case b; Try (Simpl; Intros; Omega).
+Unfold Zdiv_eucl; Intros; Apply Z_div_mod_POS; Trivial.
+
+Intros; Discriminate.
+
+Intros.
+Generalize (Z_div_mod_POS (POS p) H p0).
+Unfold Zdiv_eucl.
+Case (Zdiv_eucl_POS p0 (POS p)).
+Intros z z0.
+Case z0.
+
+Intros [H1 H2].
+Split; Trivial.
+Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
+
+Intros p1 [H1 H2].
+Split; Trivial.
+Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
+Generalize (POS_gt_ZERO p1); Omega.
+
+Intros p1 [H1 H2].
+Split; Trivial.
+Replace (NEG p0) with `-(POS p0)`; [ Rewrite H1; Ring | Trivial ].
+Generalize (NEG_lt_ZERO p1); Omega.
+
+Intros; Discriminate.
+Qed.
+
+(** Existence theorems *)
+
+Theorem Zdiv_eucl_exist : (b:Z)`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).
+Exact (Z_div_mod a b Hb).
+Qed.
+
+Implicits Zdiv_eucl_exist.
+
+Theorem Zdiv_eucl_extended : (b:Z)`b <> 0` -> (a:Z)
+  { qr:Z*Z | let (q,r)=qr in `a=b*q+r` /\ `0 <= r < |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].
+Cut `-b>0`;[Intro Hb''|Omega].
+Elim (Zdiv_eucl_exist Hb'' a);Intros qr.
+Elim qr;Intros q r Hqr.
+Exists (pair ? ? `-q` r).
+Elim Hqr;Intros.
+Split.
+Rewrite <- Zmult_Zopp_left;Assumption.
+Rewrite Zabs_non_eq;[Assumption|Omega].
+Qed.
+
+Implicits Zdiv_eucl_extended.
+
+(** Auxiliary lemmas about [Zdiv] and [Zmod] *)
+
+Lemma Z_div_mod_eq : (a,b:Z)`b > 0` -> `a = b * (Zdiv a b) + (Zmod a b)`.
+Proof.
+Unfold Zdiv Zmod.
+Intros a b Hb.
+Generalize (Z_div_mod a b Hb).
+Case (Zdiv_eucl); Tauto.
+Save.
+
+Lemma Z_mod_lt : (a,b:Z)`b > 0` -> `0 <= (Zmod a b) < b`.
+Proof.
+Unfold Zmod.
+Intros a b Hb.
+Generalize (Z_div_mod a b Hb).
+Case (Zdiv_eucl a b); Tauto.
+Save.
+
+Lemma Z_div_POS_ge0 : (b:Z)(a:positive)
+  let (q,_) = (Zdiv_eucl_POS a b) in `q >= 0`.
+Proof.
+Induction a; Unfold Zdiv_eucl_POS; Fold Zdiv_eucl_POS.
+Intro p; Case (Zdiv_eucl_POS p b).
+Intros; Case (Zgt_bool b `2*z0+1`); Intros; Omega.
+Intro p; Case (Zdiv_eucl_POS p b).
+Intros; Case (Zgt_bool b `2*z0`); Intros; Omega.
+Case (Zge_bool b `2`); Simpl; Omega.
+Save.
+
+Lemma Z_div_ge0 : (a,b:Z)`b > 0` -> `a >= 0` -> `(Zdiv a b) >= 0`.
+Proof.
+Intros a b Hb; Unfold Zdiv Zdiv_eucl; Case a; Simpl; Intros.
+Case b; Simpl; Trivial.
+Generalize Hb; Case b; Try Trivial.
+Auto with zarith.
+Intros p0 Hp0; Generalize (Z_div_POS_ge0 (POS p0) p).
+Case (Zdiv_eucl_POS p (POS p0)); Simpl; Tauto.
+Intros; Discriminate.
+Elim H; Trivial.
+Save.
+
+Lemma Z_div_lt : (a,b:Z)`b >= 2` -> `a > 0` -> `(Zdiv 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; 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.
+Save.
+
+(** Syntax *)
+
+V7only[
+Grammar znatural expr2 : constr :=
+  expr_div  [ expr2($p) "/" expr2($c) ] -> [ (Zdiv $p $c) ]
+| expr_mod  [ expr2($p) "%" expr2($c) ] -> [ (Zmod $p $c) ]
+.
+
+Syntax constr
+  level 6:
+    Zdiv [ (Zdiv $n1 $n2) ]
+      -> [ [<hov 0> "`"(ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L "`"] ]
+  | Zmod [ (Zmod $n1 $n2) ]
+      -> [ [<hov 0> "`"(ZEXPR $n1):E "%" [0 0] (ZEXPR $n2):L "`"] ]
+  | Zdiv_inside
+      [ << (ZEXPR <<(Zdiv $n1 $n2)>>) >> ]
+      	 -> [ (ZEXPR $n1):E "/" [0 0] (ZEXPR $n2):L ]
+  | Zmod_inside
+      [ << (ZEXPR <<(Zmod $n1 $n2)>>) >> ]
+      	 -> [ (ZEXPR $n1):E " %" [1 0] (ZEXPR $n2):L ]
+.
+].
+
+
+Infix 3 "/" Zdiv (no associativity) : Z_scope V8only.
+Infix 3 "mod" Zmod (no associativity) : Z_scope.
+
+(** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *)
+
+Lemma Z_div_ge : (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.
+Rewrite -> H0.
+Rewrite -> H2.
+Assert `c*(b/c)+b % c-(c*(a/c)+a % c) = c*(b/c - a/c) + b % c - a % c`.
+Ring.
+Rewrite H3.
+Assert `c*(b/c-a/c) >= c*1`.
+Apply Zge_Zmult_pos_left.
+Omega.
+Omega.
+Assert `c*1=c`.
+Ring.
+Omega.
+Save.
+
+Lemma Z_mod_plus : (a,b,c:Z)`c > 0`->`(a+b*c) % c = a % c`.
+Proof.
+Intros a b c cPos.
+Generalize (Z_div_mod_eq a c cPos).
+Generalize (Z_mod_lt a c cPos).
+Generalize (Z_div_mod_eq `a+b*c` c cPos).
+Generalize (Z_mod_lt `a+b*c` c cPos).
+Intros.
+
+Assert `(a+b*c) % c - a % c = c*(b+a/c - (a+b*c)/c)`.
+Replace `(a+b*c) % c` with `a+b*c - c*((a+b*c)/c)`.
+Replace `a % c` with `a - c*(a/c)`.
+Ring.
+Omega.
+Omega.
+LetTac q := `b+a/c-(a+b*c)/c`.
+Apply (Zcase_sign q); Intros.
+Assert `c*q=0`.
+Rewrite H4; Ring.
+Rewrite H5 in H3.
+Omega.
+
+Assert `c*q >= c`.
+Pattern 2 c; Replace c with `c*1`.
+Apply Zge_Zmult_pos_left; Omega.
+Ring.
+Omega.
+
+Assert `c*q <= -c`.
+Replace `-c` with `c*(-1)`.
+Apply Zle_Zmult_pos_left; Omega.
+Ring.
+Omega.
+Save.
+
+Lemma Z_div_plus : (a,b,c:Z)`c > 0`->`(a+b*c)/c = a/c+b`.
+Proof.
+Intros a b c cPos.
+Generalize (Z_div_mod_eq a c cPos).
+Generalize (Z_mod_lt a c cPos).
+Generalize (Z_div_mod_eq `a+b*c` c cPos).
+Generalize (Z_mod_lt `a+b*c` c cPos).
+Intros.
+Apply Zmult_reg_left with c. Omega.
+Replace `c*((a+b*c)/c)` with `a+b*c-(a+b*c) % c`.
+Rewrite (Z_mod_plus a b c cPos).
+Pattern 1 a; Rewrite H2.
+Ring.
+Pattern 1 `a+b*c`; Rewrite H0.
+Ring.
+Save.
+
+Lemma Z_div_mult : (a,b:Z)`b > 0`->`(a*b)/b = a`.
+Intros; Replace `a*b` with `0+a*b`; Auto.
+Rewrite Z_div_plus; Auto.
+Save.
+
+Lemma Z_mult_div_ge : (a,b:Z)`b>0`->`b*(a/b) <= a`.
+Proof.
+Intros a b bPos.
+Generalize (Z_div_mod_eq `a` ? bPos); Intros.
+Generalize (Z_mod_lt `a` ? bPos); Intros.
+Pattern 2 a; Rewrite H.
+Omega.
+Save.
+
+Lemma Z_mod_same : (a:Z)`a>0`->`a % a=0`.
+Proof.
+Intros a aPos.
+Generalize (Z_mod_plus `0` `1` a aPos).
+Replace `0+1*a` with `a`.
+Intros.
+Rewrite H.
+Compute.
+Trivial.
+Ring.
+Save.
+
+Lemma Z_div_same : (a:Z)`a>0`->`a/a=1`.
+Proof.
+Intros a aPos.
+Generalize (Z_div_plus `0` `1` a aPos).
+Replace `0+1*a` with `a`.
+Intros.
+Rewrite H.
+Compute.
+Trivial.
+Ring.
+Save.
+
+Lemma Z_div_exact_1 : (a,b:Z)`b>0` -> `a = b*(a/b)` -> `a%b = 0`.
+Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
+Case (Zdiv_eucl a b); Intros q r; Omega.
+Save.
+
+Lemma Z_div_exact_2 : (a,b:Z)`b>0` -> `a%b = 0` -> `a = b*(a/b)`.
+Intros a b Hb; Generalize (Z_div_mod a b Hb); Unfold Zmod Zdiv.
+Case (Zdiv_eucl a b); Intros q r; Omega.
+Save.
+
+Lemma Z_mod_zero_opp : (a,b:Z)`b>0` -> `a%b = 0` -> `(-a)%b = 0`.
+Intros a b Hb.
+Intros.
+Rewrite Z_div_exact_2 with a b; Auto.
+Replace `-(b*(a/b))` with `0+(-(a/b))*b`.
+Rewrite Z_mod_plus; Auto.
+Ring.
+Save.
+
diff --git a/theories7/ZArith/Zeven.v b/theories7/ZArith/Zeven.v
new file mode 100644
index 00000000..04b3ec09
--- /dev/null
+++ b/theories7/ZArith/Zeven.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        *)
+(************************************************************************)
+
+(*i $Id: Zeven.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+Require BinInt.
+Require Zsyntax.
+
+(**********************************************************************)
+(** About parity: even and odd predicates on Z, division by 2 on Z *)
+
+(**********************************************************************)
+(** [Zeven], [Zodd], [Zdiv2] and their related properties *)
+
+Definition Zeven := 
+  [z:Z]Cases z of ZERO => True
+                | (POS (xO _)) => True
+		| (NEG (xO _)) => True
+		| _ => False
+               end.
+
+Definition Zodd := 
+  [z:Z]Cases z of (POS xH) => True
+                | (NEG xH) => True
+                | (POS (xI _)) => True
+		| (NEG (xI _)) => True
+		| _ => False
+               end.
+
+Definition Zeven_bool :=
+  [z:Z]Cases z of ZERO => true
+                | (POS (xO _)) => true
+		| (NEG (xO _)) => true
+		| _ => false
+               end.
+
+Definition Zodd_bool := 
+  [z:Z]Cases z of ZERO => false
+                | (POS (xO _)) => false
+		| (NEG (xO _)) => false
+		| _ => true
+               end.
+
+Definition Zeven_odd_dec : (z:Z) { (Zeven z) }+{ (Zodd z) }.
+Proof.
+  Intro z. Case z;
+  [ Left; Compute; Trivial
+  | Intro p; Case p; Intros; 
+    (Right; Compute; Exact I) Orelse (Left; Compute; Exact I)
+  | Intro p; Case p; Intros; 
+    (Right; Compute; Exact I) Orelse (Left; Compute; Exact I) ].
+Defined.
+
+Definition Zeven_dec : (z:Z) { (Zeven z) }+{ ~(Zeven z) }.
+Proof.
+  Intro z. Case z;
+  [ Left; Compute; Trivial
+  | Intro p; Case p; Intros; 
+    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) 
+  | Intro p; Case p; Intros; 
+    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
+Defined.
+
+Definition Zodd_dec : (z:Z) { (Zodd z) }+{ ~(Zodd z) }.
+Proof.
+  Intro z. Case z;
+  [ Right; Compute; Trivial
+  | Intro p; Case p; Intros; 
+    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) 
+  | Intro p; Case p; Intros; 
+    (Left; Compute; Exact I) Orelse (Right; Compute; Trivial) ].
+Defined.
+
+Lemma Zeven_not_Zodd : (z:Z)(Zeven z) -> ~(Zodd z).
+Proof.
+  Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p  ]; Compute; Trivial.
+Qed.
+
+Lemma Zodd_not_Zeven : (z:Z)(Zodd z) -> ~(Zeven z).
+Proof.
+  Intro z; NewDestruct z; [ Idtac | NewDestruct p | NewDestruct p  ]; Compute; Trivial.
+Qed.
+
+Lemma Zeven_Sn : (z:Z)(Zodd z) -> (Zeven (Zs z)).
+Proof.
+ Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
+ Unfold double_moins_un; Case p; Simpl; Auto.
+Qed.
+
+Lemma Zodd_Sn : (z:Z)(Zeven z) -> (Zodd (Zs z)).
+Proof.
+ Intro z; NewDestruct z; Unfold Zs; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
+ Unfold double_moins_un; Case p; Simpl; Auto.
+Qed.
+
+Lemma Zeven_pred : (z:Z)(Zodd z) -> (Zeven (Zpred z)).
+Proof.
+ Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
+ Unfold double_moins_un; Case p; Simpl; Auto.
+Qed.
+
+Lemma Zodd_pred : (z:Z)(Zeven z) -> (Zodd (Zpred z)).
+Proof.
+ Intro z; NewDestruct z; Unfold Zpred; [ Idtac | NewDestruct p | NewDestruct p  ]; Simpl; Trivial. 
+ Unfold double_moins_un; Case p; Simpl; Auto.
+Qed.
+
+Hints Unfold Zeven Zodd : zarith.
+
+(**********************************************************************)
+(** [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] *)
+
+Definition Zdiv2 :=
+  [z:Z]Cases z of ZERO => ZERO
+                | (POS xH) => ZERO
+                | (POS p) => (POS (Zdiv2_pos p))
+		| (NEG xH) => ZERO
+		| (NEG p) => (NEG (Zdiv2_pos p))
+	       end.
+
+Lemma Zeven_div2 : (x:Z) (Zeven x) -> `x = 2*(Zdiv2 x)`.
+Proof.
+Intro x; NewDestruct x.
+Auto with arith.
+NewDestruct p; Auto with arith.
+Intros. Absurd (Zeven (POS (xI p))); Red; Auto with arith.
+Intros. Absurd (Zeven `1`); Red; Auto with arith.
+NewDestruct p; Auto with arith.
+Intros. Absurd (Zeven (NEG (xI p))); Red; Auto with arith.
+Intros. Absurd (Zeven `-1`); Red; Auto with arith.
+Qed.
+
+Lemma Zodd_div2 : (x:Z) `x >= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)+1`.
+Proof.
+Intro x; NewDestruct x.
+Intros. Absurd (Zodd `0`); Red; Auto with arith.
+NewDestruct p; Auto with arith.
+Intros. Absurd (Zodd (POS (xO p))); Red; Auto with arith.
+Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
+Qed.
+
+Lemma Zodd_div2_neg : (x:Z) `x <= 0` -> (Zodd x) -> `x = 2*(Zdiv2 x)-1`.
+Proof.
+Intro x; NewDestruct x.
+Intros. Absurd (Zodd `0`); Red; Auto with arith.
+Intros. Absurd `(NEG p) >= 0`; Red; Auto with arith.
+NewDestruct p; Auto with arith.
+Intros. Absurd (Zodd (NEG (xO p))); Red; Auto with arith.
+Qed.
+
+Lemma Z_modulo_2 : (x:Z) { y:Z | `x=2*y` }+{ y:Z | `x=2*y+1` }.
+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 (POS p)). Apply (Zodd_div2 (POS p)); Trivial.
+Unfold Zge Zcompare; Simpl; Discriminate.
+Intro p; Split with (Zdiv2 (Zpred (NEG p))).
+Pattern 1 (NEG p); Rewrite (Zs_pred (NEG p)).
+Pattern 1 (Zpred (NEG p)); Rewrite (Zeven_div2 (Zpred (NEG p))).
+Reflexivity.
+Apply Zeven_pred; Assumption.
+Qed.
+
+Lemma Zsplit2 :  (x:Z) { p : Z*Z | let (x1,x2)=p in (`x=x1+x2` /\ (x1=x2 \/ `x2=x1+1`)) }.
+Proof.
+Intros x.
+Elim (Z_modulo_2 x); Intros (y,Hy); Rewrite Zmult_sym in Hy; Rewrite <- Zplus_Zmult_2 in Hy.
+Exists (y,y); Split. 
+Assumption.
+Left; Reflexivity.
+Exists (y,`y+1`); Split.
+Rewrite Zplus_assoc; Assumption.
+Right; Reflexivity.
+Qed.
diff --git a/theories7/ZArith/Zhints.v b/theories7/ZArith/Zhints.v
new file mode 100644
index 00000000..01860d18
--- /dev/null
+++ b/theories7/ZArith/Zhints.v
@@ -0,0 +1,387 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zhints.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+(** This file centralizes the lemmas about [Z], classifying them
+    according to the way they can be used in automatic search  *)
+
+(*i*)
+
+(* Lemmas which clearly leads to simplification during proof search are *)
+(* declared as Hints. A definite status (Hint or not) for the other lemmas *)
+(* remains to be given *)
+
+(* Structure of the file *)
+(* - simplification lemmas (only those are declared as Hints) *)
+(* - reversible lemmas relating operators *)
+(* - useful Bottom-up lemmas              *)
+(* - irreversible lemmas with meta-variables *)
+(* - unclear or too specific lemmas       *)
+(* - lemmas to be used as rewrite rules   *)
+
+(* Lemmas involving positive and compare are not taken into account *)
+
+Require BinInt.
+Require Zorder.
+Require Zmin.
+Require Zabs.
+Require Zcompare.
+Require Znat.
+Require auxiliary.
+Require Zsyntax.
+Require Zmisc.
+Require Wf_Z.
+
+(**********************************************************************)
+(*                  Simplification lemmas                             *)
+(* No subgoal or smaller subgoals                                     *)
+
+Hints Resolve
+  (* A) Reversible simplification lemmas (no loss of information)      *)
+  (* Should clearly declared as hints                                  *)
+  
+  (* Lemmas ending by eq *)
+  Zeq_S (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
+  
+  (* Lemmas ending by Zgt *)
+  Zgt_n_S (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
+  Zgt_Sn_n (* :(n:Z)`(Zs n) > n` *)
+  POS_gt_ZERO (* :(p:positive)`(POS p) > 0` *)
+  Zgt_reg_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
+  Zgt_reg_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
+  
+  (* Lemmas ending by Zlt *)
+  Zlt_n_Sn (* :(n:Z)`n < (Zs n)` *)
+  Zlt_n_S (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
+  Zlt_pred_n_n (* :(n:Z)`(Zpred n) < n` *)
+  Zlt_reg_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
+  Zlt_reg_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
+  
+  (* Lemmas ending by Zle *)
+  ZERO_le_inj (* :(n:nat)`0 <= (inject_nat n)` *)
+  ZERO_le_POS (* :(p:positive)`0 <= (POS p)` *)
+  Zle_n (* :(n:Z)`n <= n` *)
+  Zle_n_Sn (* :(n:Z)`n <= (Zs n)` *)
+  Zle_n_S (* :(n,m:Z)`m <= n`->`(Zs m) <= (Zs n)` *)
+  Zle_pred_n (* :(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` *)
+  Zle_reg_l (* :(n,m,p:Z)`n <= m`->`p+n <= p+m` *)
+  Zle_reg_r (* :(a,b,c:Z)`a <= b`->`a+c <= b+c` *)
+  Zabs_pos (* :(x:Z)`0 <= |x|` *)
+  
+  (* B) Irreversible simplification lemmas : Probably to be declared as *)
+  (* hints, when no other simplification is possible *)
+  
+  (* Lemmas ending by eq *)
+  Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
+  Zplus_simpl (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
+  
+  (* Lemmas ending by Zge *)
+  Zge_Zmult_pos_right (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
+  Zge_Zmult_pos_left (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
+  Zge_Zmult_pos_compat (* :
+    (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
+  
+  (* Lemmas ending by Zlt *)
+  Zgt_ZERO_mult (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
+  Zlt_S (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
+  
+  (* Lemmas ending by Zle *)
+  Zle_ZERO_mult (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
+  Zle_Zmult_pos_right (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
+  Zle_Zmult_pos_left (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
+  OMEGA2 (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x+y` *)
+  Zle_le_S (* :(x,y:Z)`x <= y`->`x <= (Zs y)` *)
+  Zle_plus_plus (* :(n,m,p,q:Z)`n <= m`->`p <= q`->`n+p <= m+q` *)
+
+: zarith.
+  
+(**********************************************************************)
+(*         Reversible lemmas relating operators                       *)
+(* Probably to be declared as hints but need to define precedences    *)
+
+(* A) 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)`
+
+(* B) 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)`
+
+(* C) 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`
+
+(* D) 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`
+
+(* 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                            *)
+
+(* A) 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`
+
+(* B) Bottom-up irreversible (syntactic) simplification *)
+
+(* Lemmas ending by Zle *)
+Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m`
+
+(* C) 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 ??                                                  *)
+
+(* A) 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`
+
+
+(* B) 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`
+
+(* C) 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`
+*)
+
+(*i*)
diff --git a/theories7/ZArith/Zlogarithm.v b/theories7/ZArith/Zlogarithm.v
new file mode 100644
index 00000000..dc850738
--- /dev/null
+++ b/theories7/ZArith/Zlogarithm.v
@@ -0,0 +1,272 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zlogarithm.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+(**********************************************************************)
+(** The integer logarithms with base 2. 
+
+    There are three logarithms,
+    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]
+    - [Log_sup]: [y = (Log_sup x) iff 2^(y-1) < x <= 2^y]
+      i.e. [Log_inf x] is the smallest integer that is bigger than [Log x]
+    - [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 ZArith_base.
+Require Omega.
+Require Zcomplements.
+Require Zpower.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+Section Log_pos. (* Log of positive integers *)
+
+(** First we build [log_inf] and [log_sup] *)
+
+Fixpoint log_inf [p:positive] : Z :=  
+  Cases p of
+    xH => `0`	 				(* 1 *)
+  | (xO q) => (Zs (log_inf q))		(* 2n *)
+  | (xI q) => (Zs (log_inf q))		(* 2n+1 *)
+  end.
+Fixpoint log_sup [p:positive] : Z :=
+  Cases p of
+    xH => `0`					(* 1 *)
+  | (xO n) => (Zs (log_sup n)) 		(* 2n *)
+  | (xI n) => (Zs (Zs (log_inf n)))		(* 2n+1 *)
+  end.
+
+Hints Unfold log_inf log_sup.
+
+(** Then we give the specifications of [log_inf] and [log_sup] 
+    and prove their validity *)
+
+(*i Hints Resolve ZERO_le_S : zarith. i*)
+Hints Resolve Zle_trans : zarith.
+
+Theorem log_inf_correct : (x:positive) ` 0 <= (log_inf x)` /\
+  ` (two_p (log_inf x)) <= (POS x) < (two_p (Zs (log_inf x)))`.
+Induction x; Intros; Simpl;
+[ Elim H; Intros Hp HR; Clear H; Split;
+  [ Auto with zarith
+  | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
+    Conditional Trivial Rewrite two_p_S;
+    Conditional Trivial Rewrite two_p_S in HR;
+    Rewrite (POS_xI p); Omega ]
+| Elim H; Intros Hp HR; Clear H; Split;
+  [ Auto with zarith
+  | Conditional (Apply Zle_le_S; Trivial) Rewrite two_p_S with x:=(Zs (log_inf p));
+    Conditional Trivial Rewrite two_p_S;
+    Conditional Trivial Rewrite two_p_S in HR;
+    Rewrite (POS_xO p); Omega ]
+| Unfold two_power_pos; Unfold shift_pos; Simpl; Omega 
+].
+Qed.
+
+Definition log_inf_correct1 :=
+	[p:positive](proj1 ? ? (log_inf_correct p)).
+Definition log_inf_correct2 := 
+	[p:positive](proj2 ? ? (log_inf_correct p)).
+
+Opaque log_inf_correct1 log_inf_correct2.
+
+Hints Resolve log_inf_correct1 log_inf_correct2 : zarith.
+
+Lemma log_sup_correct1 : (p:positive)` 0 <= (log_sup p)`.
+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)]
+    either [(log_sup p)=(log_inf p)+1] *)
+
+Theorem log_sup_log_inf : (p:positive)
+  IF (POS p)=(two_p (log_inf p)) 
+  then (POS p)=(two_p (log_sup p))
+  else ` (log_sup p)=(Zs (log_inf p))`.
+
+Induction p; Intros;
+[ Elim H; Right; Simpl;
+  Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+  Rewrite POS_xI; Unfold Zs; Omega
+| Elim H; Clear H; Intro Hif;
+  [ 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;
+    Rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+    Rewrite POS_xO; Unfold Zs; Omega ]
+| Left; Auto ].
+Qed.
+
+Theorem log_sup_correct2 : (x:positive)
+  ` (two_p (Zpred (log_sup x))) < (POS x) <= (two_p (log_sup x))`.
+
+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_n ].
+Intros (E1,E2); Rewrite E2.
+Rewrite <- (Zpred_Sn (log_inf x)).
+Generalize (log_inf_correct2 x); Omega.
+Qed.
+
+Lemma log_inf_le_log_sup : 
+	(p:positive) `(log_inf p) <= (log_sup p)`.
+Induction p; Simpl; Intros; Omega.
+Qed.
+
+Lemma log_sup_le_Slog_inf : 
+	(p:positive) `(log_sup p) <= (Zs (log_inf p))`.
+Induction p; Simpl; Intros; Omega.
+Qed.
+
+(** Now it's possible to specify and build the [Log] rounded to the nearest *)
+
+Fixpoint log_near[x:positive] : Z :=
+  Cases x of 
+    xH => `0`
+  | (xO xH) => `1`
+  | (xI xH) => `2`
+  | (xO y)  => (Zs (log_near y))
+  | (xI y)  => (Zs (log_near y))
+  end.    
+
+Theorem log_near_correct1 : (p:positive)` 0 <= (log_near p)`.
+Induction p; Simpl; Intros; 
+[Elim p0; Auto with zarith | Elim p0; Auto with zarith | Trivial with zarith ].
+Intros; Apply Zle_le_S.
+Generalize H0; Elim p1; Intros; Simpl;
+    [ Assumption | Assumption | Apply ZERO_le_POS ].
+Intros; Apply Zle_le_S.
+Generalize H0; Elim p1; Intros; Simpl;
+    [ Assumption | Assumption | Apply ZERO_le_POS ].
+Qed.
+
+Theorem log_near_correct2: (p:positive)
+  (log_near p)=(log_inf p)
+\/(log_near p)=(log_sup p).
+Induction p.
+Intros p0 [Einf|Esup].
+Simpl. Rewrite Einf.
+Case p0; [Left | Left | Right]; Reflexivity.
+Simpl; Rewrite Esup.
+Elim (log_sup_log_inf p0).
+Generalize (log_inf_le_log_sup p0).
+Generalize (log_sup_le_Slog_inf p0).
+Case p0; Auto with zarith.
+Intros; Omega.
+Case p0; Intros; Auto with zarith.
+Intros p0 [Einf|Esup].
+Simpl.
+Repeat Rewrite Einf.
+Case p0; Intros; Auto with zarith.
+Simpl.
+Repeat Rewrite Esup.
+Case p0; Intros; Auto with zarith.
+Auto.
+Qed.
+
+(*i******************
+Theorem log_near_correct: (p:positive)
+  `| (two_p (log_near p)) - (POS p) | <= (POS p)-(two_p (log_inf p))`
+  /\`| (two_p (log_near p)) - (POS p) | <= (two_p (log_sup p))-(POS p)`.
+Intro.
+Induction p.
+Intros p0 [(Einf1,Einf2)|(Esup1,Esup2)].
+Unfold log_near log_inf log_sup. Fold log_near log_inf log_sup.
+Rewrite Einf1.
+Repeat Rewrite two_p_S.
+Case p0; [Left | Left | Right].
+
+Split.
+Simpl.
+Rewrite E1; Case p0; Try Reflexivity.
+Compute.
+Unfold log_near; Fold log_near.
+Unfold log_inf; Fold log_inf.
+Repeat Rewrite E1.
+Split.
+**********************************i*)
+
+End Log_pos.
+
+Section divers.
+
+(** Number of significative digits. *)
+
+Definition N_digits :=
+  [x:Z]Cases x of 
+       	  (POS p) => (log_inf p)
+        | (NEG p) => (log_inf p)
+	|  ZERO   => `0`
+       end.
+
+Lemma ZERO_le_N_digits : (x:Z) ` 0 <= (N_digits x)`.
+Induction x; Simpl;
+[ Apply Zle_n
+| Exact log_inf_correct1
+| Exact log_inf_correct1].
+Qed.
+
+Lemma log_inf_shift_nat : 
+  (n:nat)(log_inf (shift_nat n xH))=(inject_nat n).
+Induction n; Intros;
+[ Try Trivial
+| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
+Qed.
+
+Lemma log_sup_shift_nat : 
+  (n:nat)(log_sup (shift_nat n xH))=(inject_nat n).
+Induction n; Intros;
+[ Try Trivial
+| Rewrite -> inj_S; Rewrite <- H; Reflexivity].
+Qed.
+
+(** [Is_power p] means that p is a power of two *)
+Fixpoint Is_power[p:positive] : Prop :=
+  Cases p of
+    xH => True
+  | (xO q) => (Is_power q)
+  | (xI q) => False
+  end.
+
+Lemma Is_power_correct :
+  (p:positive) (Is_power p) <-> (Ex [y:nat](p=(shift_nat y xH))).
+
+Split; 
+[ Elim p; 
+   [ Simpl; Tauto
+   | Simpl; Intros; Generalize (H H0); Intro H1; Elim H1; Intros y0 Hy0;
+     Exists (S y0); Rewrite Hy0; Reflexivity
+   | Intro; Exists O; Reflexivity]
+| Intros; Elim H; Intros; Rewrite -> H0; Elim x; Intros; Simpl; Trivial].
+Qed.
+
+Lemma Is_power_or : (p:positive) (Is_power p)\/~(Is_power p).
+Induction p;
+[ Intros; Right; Simpl; Tauto
+| Intros; Elim H; 
+   [ Intros; Left; Simpl; Exact H0
+   | Intros; Right; Simpl; Exact H0]
+| Left; Simpl; Trivial].
+Qed.
+
+End divers.
+
+
+
+
+
+
+
diff --git a/theories7/ZArith/Zmin.v b/theories7/ZArith/Zmin.v
new file mode 100644
index 00000000..753fe461
--- /dev/null
+++ b/theories7/ZArith/Zmin.v
@@ -0,0 +1,102 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: Zmin.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
+
+Require Arith.
+Require BinInt.
+Require Zcompare.
+Require Zorder.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Minimum on binary integer numbers *)
+
+Definition Zmin := [n,m:Z]
+ <Z>Cases (Zcompare n m) of
+      EGAL      => n
+    | INFERIEUR => n
+    | SUPERIEUR => m
+    end.
+
+(** Properties of minimum on binary integer numbers *)
+
+Lemma Zmin_SS : (n,m:Z)((Zs (Zmin n m))=(Zmin (Zs n) (Zs m))).
+Proof.
+Intros n m;Unfold Zmin; Rewrite (Zcompare_n_S n m);
+(ElimCompare 'n 'm);Intros E;Rewrite E;Auto with arith.
+Qed.
+
+Lemma Zle_min_l : (n,m:Z)(Zle (Zmin n m) n).
+Proof.
+Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;
+  [ Apply Zle_n | Apply Zle_n | Apply Zlt_le_weak; Apply Zgt_lt;Exact E ].
+Qed.
+
+Lemma Zle_min_r : (n,m:Z)(Zle (Zmin n m) m).
+Proof.
+Intros n m;Unfold Zmin ; (ElimCompare 'n 'm);Intros E;Rewrite -> E;[
+  Unfold Zle ;Rewrite -> E;Discriminate
+| Unfold Zle ;Rewrite -> E;Discriminate
+| Apply Zle_n ].
+Qed.
+
+Lemma Zmin_case : (n,m:Z)(P:Z->Set)(P n)->(P m)->(P (Zmin n m)).
+Proof.
+Intros n m P H1 H2; Unfold Zmin; Case (Zcompare n m);Auto with arith.
+Qed.
+
+Lemma Zmin_or : (n,m:Z)(Zmin n m)=n \/ (Zmin n m)=m.
+Proof.
+Unfold Zmin; Intros; Elim (Zcompare n m); Auto.
+Qed.
+
+Lemma Zmin_n_n : (n:Z) (Zmin n n)=n.
+Proof.
+Unfold Zmin; Intros; Elim (Zcompare n n); Auto.
+Qed.
+
+Lemma Zmin_plus :
+ (x,y,n:Z)(Zmin (Zplus x n) (Zplus y n))=(Zplus (Zmin x y) n).
+Proof.
+Intros x y n; Unfold Zmin.
+Rewrite (Zplus_sym x n);
+Rewrite (Zplus_sym y n);
+Rewrite (Zcompare_Zplus_compatible x y n).
+Case (Zcompare x y); Apply Zplus_sym.
+Qed.
+
+(**********************************************************************)
+(** Maximum of two binary integer numbers *)
+V7only [ (* From Zdivides *) ].
+
+Definition Zmax :=
+   [a, b : ?]  Cases (Zcompare a b) of INFERIEUR => b | _ => a end.
+
+(** Properties of maximum on binary integer numbers *)
+
+Tactic Definition CaseEq name :=
+Generalize (refl_equal ? name); Pattern -1 name; Case name.
+
+Theorem Zmax1: (a, b : ?)  (Zle a (Zmax a b)).
+Proof.
+Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
+Unfold Zle; Intros H; Rewrite H; Red; Intros; Discriminate.
+Qed.
+
+Theorem Zmax2: (a, b : ?)  (Zle b (Zmax a b)).
+Proof.
+Intros a b; Unfold Zmax; (CaseEq '(Zcompare a b)); Simpl; Auto with zarith.
+Intros H;
+ (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
+Intros H;
+ (Case (Zle_or_lt b a); Auto; Unfold Zlt; Rewrite H; Intros; Discriminate).
+Qed.
+
diff --git a/theories7/ZArith/Zmisc.v b/theories7/ZArith/Zmisc.v
new file mode 100644
index 00000000..bd89ec66
--- /dev/null
+++ b/theories7/ZArith/Zmisc.v
@@ -0,0 +1,188 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zmisc.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+Require BinInt.
+Require Zcompare.
+Require Zorder.
+Require Zsyntax.
+Require Bool.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Iterators *)
+
+(** [n]th iteration of the function [f] *)
+Fixpoint iter_nat[n:nat]  : (A:Set)(f:A->A)A->A :=
+  [A:Set][f:A->A][x:A]
+    Cases n of
+      O => x
+    | (S n') => (f (iter_nat n' A f x))
+    end.
+
+Fixpoint iter_pos[n:positive] : (A:Set)(f:A->A)A->A :=
+  [A:Set][f:A->A][x:A]
+    Cases n of
+     	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:Set][f:A->A][x:A]Cases n of
+    ZERO => x
+  | (POS p) => (iter_pos p A f x)
+  | (NEG p) => x
+  end.
+
+Theorem iter_nat_plus :
+  (n,m:nat)(A:Set)(f:A->A)(x:A)
+    (iter_nat (plus n m) A f x)=(iter_nat n A f (iter_nat m A f x)).
+Proof.    
+Induction n;
+[ Simpl; Auto with arith
+| Intros; Simpl; Apply f_equal with f:=f; Apply H
+].  
+Qed.
+
+Theorem iter_convert : (n:positive)(A:Set)(f:A->A)(x:A)
+  (iter_pos n A f x) = (iter_nat (convert n) A f x).
+Proof.    
+Intro n; NewInduction n as [p H|p H|];
+[ Intros; Simpl; Rewrite -> (H A f x);
+  Rewrite -> (H A f (iter_nat (convert p) A f x));
+  Rewrite -> (ZL6 p); Symmetry; Apply f_equal with f:=f;
+  Apply iter_nat_plus
+| Intros; Unfold convert; Simpl; Rewrite -> (H A f x);
+  Rewrite -> (H A f (iter_nat (convert p) A f x));
+  Rewrite -> (ZL6 p); Symmetry;
+  Apply iter_nat_plus
+| Simpl; Auto with arith
+].
+Qed.
+
+Theorem iter_pos_add :
+  (n,m:positive)(A:Set)(f:A->A)(x:A)
+    (iter_pos (add n m) A f x)=(iter_pos n A f (iter_pos m A f x)).
+Proof.    
+Intros n m; Intros.
+Rewrite -> (iter_convert m A f x).
+Rewrite -> (iter_convert n A f (iter_nat (convert m) A f x)).
+Rewrite -> (iter_convert (add n m) A f x).
+Rewrite -> (convert_add 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 :
+  (n:nat)(A:Set)(f:A->A)(Inv:A->Prop)
+  ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_nat n A f x)).
+Proof.    
+Induction n; Intros;
+[ Trivial with arith
+| Simpl; Apply H0 with x:=(iter_nat n0 A f x); Apply H; Trivial with arith].
+Qed.
+
+Theorem iter_pos_invariant :
+  (n:positive)(A:Set)(f:A->A)(Inv:A->Prop)
+  ((x:A)(Inv x)->(Inv (f x)))->(x:A)(Inv x)->(Inv (iter_pos n A f x)).
+Proof.    
+Intros; Rewrite iter_convert; Apply iter_nat_invariant; Trivial with arith.
+Qed.
+
+V7only [
+(* Compatibility *)
+Require Zbool.
+Require Zeven.
+Require Zabs.
+Require Zmin.
+Notation rename := rename.
+Notation POS_xI := POS_xI.
+Notation POS_xO := POS_xO.
+Notation NEG_xI := NEG_xI.
+Notation NEG_xO := NEG_xO.
+Notation POS_add := POS_add.
+Notation NEG_add := NEG_add.
+Notation Zle_cases := Zle_cases.
+Notation Zlt_cases := Zlt_cases.
+Notation Zge_cases := Zge_cases.
+Notation Zgt_cases := Zgt_cases.
+Notation POS_gt_ZERO := POS_gt_ZERO.
+Notation ZERO_le_POS := ZERO_le_POS.
+Notation Zlt_ZERO_pred_le_ZERO := Zlt_ZERO_pred_le_ZERO.
+Notation NEG_lt_ZERO := NEG_lt_ZERO.
+Notation Zeven_not_Zodd := Zeven_not_Zodd.
+Notation Zodd_not_Zeven := Zodd_not_Zeven.
+Notation Zeven_Sn := Zeven_Sn.
+Notation Zodd_Sn := Zodd_Sn.
+Notation Zeven_pred := Zeven_pred.
+Notation Zodd_pred := Zodd_pred.
+Notation Zeven_div2 := Zeven_div2.
+Notation Zodd_div2 := Zodd_div2.
+Notation Zodd_div2_neg := Zodd_div2_neg.
+Notation Z_modulo_2 := Z_modulo_2.
+Notation Zsplit2 := Zsplit2.
+Notation Zminus_Zplus_compatible := Zminus_Zplus_compatible.
+Notation Zcompare_egal_dec := Zcompare_egal_dec.
+Notation Zcompare_elim := Zcompare_elim.
+Notation Zcompare_x_x := Zcompare_x_x.
+Notation Zlt_not_eq := Zlt_not_eq.
+Notation Zcompare_eq_case := Zcompare_eq_case.
+Notation Zle_Zcompare := Zle_Zcompare.
+Notation Zlt_Zcompare := Zlt_Zcompare.
+Notation Zge_Zcompare := Zge_Zcompare.
+Notation Zgt_Zcompare := Zgt_Zcompare.
+Notation Zmin_plus := Zmin_plus.
+Notation absolu_lt := absolu_lt.
+Notation Zle_bool_imp_le := Zle_bool_imp_le.
+Notation Zle_imp_le_bool := Zle_imp_le_bool.
+Notation Zle_bool_refl := Zle_bool_refl.
+Notation Zle_bool_antisym := Zle_bool_antisym.
+Notation Zle_bool_trans := Zle_bool_trans.
+Notation Zle_bool_plus_mono := Zle_bool_plus_mono.
+Notation Zone_pos := Zone_pos.
+Notation Zone_min_pos := Zone_min_pos.
+Notation Zle_is_le_bool := Zle_is_le_bool.
+Notation Zge_is_le_bool := Zge_is_le_bool.
+Notation Zlt_is_le_bool := Zlt_is_le_bool.
+Notation Zgt_is_le_bool := Zgt_is_le_bool.
+Notation Zle_plus_swap := Zle_plus_swap.
+Notation Zge_iff_le := Zge_iff_le.
+Notation Zlt_plus_swap := Zlt_plus_swap.
+Notation Zgt_iff_lt := Zgt_iff_lt.
+Notation Zeq_plus_swap := Zeq_plus_swap.
+(* Definitions *)
+Notation entier_of_Z := entier_of_Z.
+Notation Z_of_entier := Z_of_entier.
+Notation Zle_bool := Zle_bool.
+Notation Zge_bool := Zge_bool.
+Notation Zlt_bool := Zlt_bool.
+Notation Zgt_bool := Zgt_bool.
+Notation Zeq_bool := Zeq_bool.
+Notation Zneq_bool := Zneq_bool.
+Notation Zeven := Zeven.
+Notation Zodd := Zodd.
+Notation Zeven_bool := Zeven_bool.
+Notation Zodd_bool := Zodd_bool.
+Notation Zeven_odd_dec := Zeven_odd_dec.
+Notation Zeven_dec := Zeven_dec.
+Notation Zodd_dec := Zodd_dec.
+Notation Zdiv2_pos := Zdiv2_pos.
+Notation Zdiv2 := Zdiv2.
+Notation Zle_bool_total := Zle_bool_total.
+Export Zbool.
+Export Zeven.
+Export Zabs.
+Export Zmin.
+Export Zorder.
+Export Zcompare.
+].
diff --git a/theories7/ZArith/Znat.v b/theories7/ZArith/Znat.v
new file mode 100644
index 00000000..99d1422f
--- /dev/null
+++ b/theories7/ZArith/Znat.v
@@ -0,0 +1,138 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Znat.v,v 1.1.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+
+Require Export Arith.
+Require BinPos.
+Require BinInt.
+Require Zcompare.
+Require Zorder.
+Require Decidable.
+Require Peano_dec.
+Require Export Compare_dec.
+
+Open Local Scope Z_scope.
+
+Definition neq := [x,y:nat] ~(x=y).
+
+(**********************************************************************)
+(** Properties of the injection from nat into Z *)
+
+Theorem inj_S : (y:nat) (inject_nat (S y)) = (Zs (inject_nat y)).
+Proof.
+Intro y; NewInduction y as [|n H]; [
+  Unfold Zs ; Simpl; Trivial with arith
+| Change (POS (add_un (anti_convert n)))=(Zs (inject_nat (S n)));
+  Rewrite add_un_Zs; Trivial with arith].
+Qed.
+ 
+Theorem inj_plus : 
+  (x,y:nat) (inject_nat (plus x y)) = (Zplus (inject_nat x) (inject_nat y)).
+Proof.
+Intro x; NewInduction x as [|n H]; Intro y; NewDestruct y as [|m]; [
+  Simpl; Trivial with arith
+| Simpl; Trivial with arith
+| Simpl; Rewrite <- plus_n_O; Trivial with arith
+| Change (inject_nat (S (plus n (S m))))=
+                        (Zplus (inject_nat (S n)) (inject_nat (S m)));
+  Rewrite inj_S; Rewrite H; Do 2 Rewrite inj_S; Rewrite Zplus_S_n; Trivial with arith].
+Qed.
+ 
+Theorem inj_mult : 
+  (x,y:nat) (inject_nat (mult x y)) = (Zmult (inject_nat x) (inject_nat y)).
+Proof.
+Intro x; NewInduction x as [|n H]; [
+  Simpl; Trivial with arith
+| Intro y; Rewrite -> inj_S; Rewrite <- Zmult_Sm_n;
+    Rewrite <- H;Rewrite <- inj_plus; Simpl; Rewrite plus_sym; Trivial with arith].
+Qed.
+
+Theorem inj_neq:
+  (x,y:nat) (neq x y) -> (Zne (inject_nat x) (inject_nat y)).
+Proof.
+Unfold neq Zne not ; 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 <- bij1; Intros E; Rewrite E; Auto with arith].
+Qed. 
+
+Theorem inj_le:
+  (x,y:nat) (le x y) -> (Zle (inject_nat x) (inject_nat y)).
+Proof.
+Intros x y; Intros H; Elim H; [
+  Unfold Zle ; Elim (Zcompare_EGAL (inject_nat x) (inject_nat x));
+  Intros H1 H2; Rewrite H2; [ Discriminate | Trivial with arith]
+| Intros m H1 H2; Apply Zle_trans with (inject_nat m); 
+    [Assumption | Rewrite inj_S; Apply Zle_n_Sn]].
+Qed.
+
+Theorem inj_lt: (x,y:nat) (lt x y) -> (Zlt (inject_nat x) (inject_nat y)).
+Proof.
+Intros x y H; Apply Zgt_lt; Apply Zle_S_gt; Rewrite <- inj_S; Apply inj_le;
+Exact H.
+Qed.
+
+Theorem inj_gt: (x,y:nat) (gt x y) -> (Zgt (inject_nat x) (inject_nat y)).
+Proof.
+Intros x y H; Apply Zlt_gt; Apply inj_lt; Exact H.
+Qed.
+
+Theorem inj_ge: (x,y:nat) (ge x y) -> (Zge (inject_nat x) (inject_nat y)).
+Proof.
+Intros x y H; Apply Zle_ge; Apply inj_le; Apply H.
+Qed.
+
+Theorem inj_eq: (x,y:nat) x=y -> (inject_nat x) = (inject_nat y).
+Proof.
+Intros x y H; Rewrite H; Trivial with arith.
+Qed.
+
+Theorem intro_Z : 
+  (x:nat) (EX y:Z | (inject_nat x)=y /\ 
+      	  (Zle ZERO (Zplus (Zmult y (POS xH)) ZERO))).
+Proof.
+Intros x; Exists (inject_nat x); Split; [
+  Trivial with arith
+| Rewrite Zmult_sym; Rewrite Zmult_one; Rewrite Zero_right; 
+  Unfold Zle ; Elim x; Intros;Simpl; Discriminate ].
+Qed.
+
+Theorem inj_minus1 :
+  (x,y:nat) (le y x) -> 
+    (inject_nat (minus x y)) = (Zminus (inject_nat x) (inject_nat y)).
+Proof.
+Intros x y H; Apply (Zsimpl_plus_l (inject_nat y)); Unfold Zminus ;
+Rewrite Zplus_permute; Rewrite Zplus_inverse_r; Rewrite <- inj_plus;
+Rewrite <- (le_plus_minus y x H);Rewrite Zero_right; Trivial with arith.
+Qed.
+ 
+Theorem inj_minus2: (x,y:nat) (gt y x) -> (inject_nat (minus x y)) = ZERO.
+Proof.
+Intros x y H; Rewrite inj_minus_aux; [ Trivial with arith | Apply gt_not_le; Assumption].
+Qed.
+
+V7only [ (* From Zdivides *) ].
+Theorem POS_inject: (x : positive) (POS x) = (inject_nat (convert x)).
+Proof.
+Intros x; Elim x; Simpl; Auto.
+Intros p H; Rewrite ZL6.
+Apply f_equal with f := POS.
+Apply convert_intro.
+Rewrite bij1; Unfold convert; Simpl.
+Rewrite ZL6; Auto.
+Intros p H; Unfold convert; Simpl.
+Rewrite ZL6; Simpl.
+Rewrite inj_plus; Repeat Rewrite <- H.
+Rewrite POS_xO; Simpl; Rewrite add_x_x; Reflexivity.
+Qed.
+
diff --git a/theories7/ZArith/Znumtheory.v b/theories7/ZArith/Znumtheory.v
new file mode 100644
index 00000000..b8e5f300
--- /dev/null
+++ b/theories7/ZArith/Znumtheory.v
@@ -0,0 +1,629 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Znumtheory.v,v 1.3.2.1 2004/07/16 19:31:43 herbelin Exp $ i*)
+
+Require ZArith_base.
+Require ZArithRing.
+Require Zcomplements.
+Require Zdiv.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+(** This file contains some notions of number theory upon Z numbers: 
+     - a divisibility predicate [Zdivide]
+     - a gcd predicate [gcd]
+     - Euclid algorithm [euclid]
+     - an efficient [Zgcd] function 
+     - a relatively prime predicate [rel_prime]
+     - a prime predicate [prime]
+*)
+
+(** * Divisibility *)
+
+Inductive Zdivide [a,b:Z] : Prop := 
+  Zdivide_intro : (q:Z) `b = q * a` -> (Zdivide a b).
+
+(** Syntax for divisibility *)
+
+Notation "( a | b )" := (Zdivide a b) 
+ (at level 0, a,b at level 10) : Z_scope
+ V8only "( a | b )" (at level 0).
+
+(** Results concerning divisibility*)
+
+Lemma Zdivide_refl : (a:Z) (a|a).
+Proof.
+Intros; Apply Zdivide_intro with `1`; Ring.
+Save.
+
+Lemma Zone_divide : (a:Z) (1|a).
+Proof.
+Intros; Apply Zdivide_intro with `a`; Ring.
+Save.
+
+Lemma Zdivide_0 : (a:Z) (a|0).
+Proof.
+Intros; Apply Zdivide_intro with `0`; Ring.
+Save.
+
+Hints Resolve Zdivide_refl Zone_divide Zdivide_0 : zarith.
+
+Lemma Zdivide_mult_left : (a,b,c:Z) (a|b) -> (`c*a`|`c*b`).
+Proof.
+Induction 1; Intros; Apply Zdivide_intro with q.
+Rewrite H0; Ring.
+Save.
+
+Lemma Zdivide_mult_right : (a,b,c:Z) (a|b) -> (`a*c`|`b*c`).
+Proof.
+Intros a b c; Rewrite (Zmult_sym a c); Rewrite (Zmult_sym b c).
+Apply Zdivide_mult_left; Trivial.
+Save.
+
+Hints Resolve Zdivide_mult_left Zdivide_mult_right : zarith.
+
+Lemma Zdivide_plus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b+c`).
+Proof.
+Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
+Apply Zdivide_intro with `q+q'`.
+Rewrite Hq; Rewrite Hq'; Ring.
+Save.
+
+Lemma Zdivide_opp : (a,b:Z) (a|b) -> (a|`-b`).
+Proof.
+Induction 1; Intros; Apply Zdivide_intro with `-q`.
+Rewrite H0; Ring.
+Save.
+
+Lemma Zdivide_opp_rev : (a,b:Z) (a|`-b`) -> (a| b).
+Proof.
+Intros; Replace b with `-(-b)`. Apply Zdivide_opp; Trivial. Ring.
+Save.
+
+Lemma Zdivide_opp_left : (a,b:Z) (a|b) -> (`-a`|b).
+Proof.
+Induction 1; Intros; Apply Zdivide_intro with `-q`.
+Rewrite H0; Ring.
+Save.
+
+Lemma Zdivide_opp_left_rev : (a,b:Z) (`-a`|b) -> (a|b).
+Proof.
+Intros; Replace a with `-(-a)`. Apply Zdivide_opp_left; Trivial. Ring.
+Save.
+
+Lemma Zdivide_minus : (a,b,c:Z) (a|b) -> (a|c) -> (a|`b-c`).
+Proof.
+Induction 1; Intros q Hq; Induction 1; Intros q' Hq'.
+Apply Zdivide_intro with `q-q'`.
+Rewrite Hq; Rewrite Hq'; Ring.
+Save.
+
+Lemma Zdivide_left : (a,b,c:Z) (a|b) -> (a|`b*c`).
+Proof.
+Induction 1; Intros q Hq; Apply Zdivide_intro with `q*c`.
+Rewrite Hq; Ring.
+Save.
+
+Lemma Zdivide_right : (a,b,c:Z) (a|c) -> (a|`b*c`).
+Proof.
+Induction 1; Intros q Hq; Apply Zdivide_intro with `q*b`.
+Rewrite Hq; Ring.
+Save.
+
+Lemma Zdivide_a_ab : (a,b:Z) (a|`a*b`).
+Proof.
+Intros; Apply Zdivide_intro with b; Ring.
+Save.
+
+Lemma Zdivide_a_ba : (a,b:Z) (a|`b*a`).
+Proof.
+Intros; Apply Zdivide_intro with b; Ring.
+Save.
+
+Hints Resolve Zdivide_plus Zdivide_opp Zdivide_opp_rev
+              Zdivide_opp_left Zdivide_opp_left_rev
+              Zdivide_minus Zdivide_left Zdivide_right
+              Zdivide_a_ab Zdivide_a_ba : zarith.
+
+(** Auxiliary result. *)
+
+Lemma Zmult_one : 
+ (x,y:Z) `x>=0` -> `x*y=1` -> `x=1`.
+Proof.
+Intros x y H H0; NewDestruct (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 NEG_lt_ZERO.
+Save.
+
+(** Only [1] and [-1] divide [1]. *)
+
+Lemma Zdivide_1 : (x:Z) (x|1) -> `x=1` \/ `x=-1`.
+Proof.
+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.
+Save.
+
+(** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
+
+Lemma Zdivide_antisym : (a,b:Z) (a|b) -> (b|a) -> `a=b` \/ `a=-b`.
+Proof.
+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_left with a.
+Assumption.
+Ring.
+Pattern 2 a; 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.
+Save.
+
+(** If [a] divides [b] and [b<>0] then [|a| <= |b|]. *)
+
+Lemma Zdivide_bounds : (a,b:Z) (a|b) -> `b<>0` -> `|a| <= |b|`.
+Proof.
+Induction 1; Intros.
+Assert `|b|=|q|*|a|`.
+ Subst; Apply Zabs_Zmult.
+Rewrite H2.
+Assert H3 := (Zabs_pos q).
+Assert H4 := (Zabs_pos a).
+Assert `|q|*|a|>=1*|a|`; Auto with zarith.
+Apply Zge_Zmult_pos_compat; Auto with zarith.
+Elim (Z_lt_ge_dec `|q|` `1`); [ Intros | Auto with zarith ].
+Assert `|q|=0`.
+ Omega.
+Assert `q=0`.
+ Rewrite <- (Zabs_Zsgn q).
+Rewrite H5; Auto with zarith.
+Subst q; Omega.
+Save.
+
+(** * 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.) *)
+
+Inductive gcd [a,b,d:Z] : Prop :=
+  gcd_intro : 
+    (d|a) -> (d|b) -> ((x:Z) (x|a) -> (x|b) -> (x|d)) -> (gcd a b d).
+
+(** Trivial properties of [gcd] *)
+
+Lemma gcd_sym : (a,b,d:Z)(gcd a b d) -> (gcd b a d).
+Proof.
+Induction 1; Constructor; Intuition.
+Save.
+
+Lemma gcd_0 : (a:Z)(gcd a `0` a).
+Proof.
+Constructor; Auto with zarith.
+Save.
+
+Lemma gcd_minus :(a,b,d:Z)(gcd a `-b` d) -> (gcd b a d).
+Proof.
+Induction 1; Constructor; Intuition.
+Save.
+
+Lemma gcd_opp :(a,b,d:Z)(gcd a b d) -> (gcd b a `-d`).
+Proof.
+Induction 1; Constructor; Intuition.
+Save.
+
+Hints Resolve gcd_sym gcd_0 gcd_minus gcd_opp : zarith.
+
+(** * Extended Euclid algorithm. *)
+
+(** Euclid's algorithm to compute the [gcd] mainly relies on
+    the following property. *)
+
+Lemma gcd_for_euclid :
+  (a,b,d,q:Z) (gcd b `a-q*b` d) -> (gcd a b d).
+Proof.
+Induction 1; Constructor; Intuition.
+Replace a with `a-q*b+q*b`. Auto with zarith. Ring.
+Save.
+
+Lemma gcd_for_euclid2 :
+  (b,d,q,r:Z) (gcd r b d) -> (gcd b `b*q+r` d).
+Proof.
+Induction 1; Constructor; Intuition.
+Apply H2; Auto.
+Replace r with `b*q+r-b*q`. Auto with zarith. Ring.
+Save.
+
+(** We implement the extended version of Euclid's algorithm,
+    i.e. the one computing Bezout's coefficients as it computes
+    the [gcd]. We follow the algorithm given in Knuth's
+    "Art of Computer Programming", vol 2, page 325. *)
+
+Section extended_euclid_algorithm.
+
+Variable a,b : Z.
+
+(** The specification of Euclid's algorithm is the existence of
+    [u], [v] and [d] such that [ua+vb=d] and [(gcd a b d)]. *)
+
+Inductive Euclid : Set :=
+  Euclid_intro : 
+    (u,v,d:Z) `u*a+v*b=d` -> (gcd a b d) -> Euclid.
+
+(** 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)]. 
+    *)
+
+Lemma euclid_rec :
+  (v3:Z) `0 <= v3` -> (u1,u2,u3,v1,v2:Z) `u1*a+u2*b=u3` -> `v1*a+v2*b=v3` -> 
+  ((d:Z)(gcd u3 v3 d) -> (gcd a b d)) -> Euclid.
+Proof.
+Intros v3 Hv3; Generalize Hv3; Pattern v3.
+Apply Z_lt_rec.
+Clear v3 Hv3; Intros.
+Elim (Z_zerop x); Intro.
+Apply Euclid_intro with u:=u1 v:=u2 d:=u3.
+Assumption.
+Apply H2.
+Rewrite a0; Auto with zarith.
+LetTac q := (Zdiv u3 x).
+Assert Hq: `0 <= u3-q*x < x`.
+Replace `u3-q*x` with `u3%x`.
+Apply Z_mod_lt; Omega.
+Assert xpos : `x > 0`. Omega.
+Generalize (Z_div_mod_eq u3 x xpos). 
+Unfold q. 
+Intro eq; Pattern 2 u3; 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 `(u1*a+u2*b)-q*(v1*a+v2*b)`.
+Rewrite H0; Rewrite H1; Trivial.
+Ring.
+Intros; Apply H2.
+Apply gcd_for_euclid with q; Assumption.
+Assumption.
+Save.
+
+(** We get Euclid's algorithm by applying [euclid_rec] on
+    [1,0,a,0,1,b] when [b>=0] and [1,0,a,0,-1,-b] when [b<0]. *)
+
+Lemma euclid : Euclid.
+Proof.
+Case (Z_le_gt_dec `0` b); Intro.
+Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
+                              v1:=`0` v2:=`1` v3:=b;
+Auto with zarith; Ring.
+Intros; Apply euclid_rec with u1:=`1` u2:=`0` u3:=a
+                              v1:=`0` v2:=`-1` v3:=`-b`;
+Auto with zarith; Try Ring.
+Save.
+
+End extended_euclid_algorithm.
+
+Theorem gcd_uniqueness_apart_sign :
+  (a,b,d,d':Z) (gcd a b d) -> (gcd a b d') -> `d = d'` \/ `d = -d'`.
+Proof.
+Induction 1.
+Intros H1 H2 H3; 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).
+Save.
+
+(** * Bezout's coefficients *)
+
+Inductive Bezout [a,b,d:Z] : Prop := 
+  Bezout_intro : (u,v:Z) `u*a + v*b = d` -> (Bezout a b d).
+
+(** Existence of Bezout's coefficients for the [gcd] of [a] and [b] *)
+
+Lemma gcd_bezout : (a,b,d:Z) (gcd a b d) -> (Bezout a b d).
+Proof.
+Intros a b d Hgcd.
+Elim (euclid a b); Intros u v d0 e g.
+Generalize (gcd_uniqueness_apart_sign a b d d0 Hgcd g).
+Intro H; Elim H; Clear H; Intros.
+Apply Bezout_intro with u v.
+Rewrite H; Assumption.
+Apply Bezout_intro with `-u` `-v`.
+Rewrite H; Rewrite <- e; Ring.
+Save.
+
+(** gcd of [ca] and [cb] is [c gcd(a,b)]. *)
+
+Lemma gcd_mult : (a,b,c,d:Z) (gcd a b d) -> (gcd `c*a` `c*b` `c*d`).
+Proof.
+Intros a b c d; Induction 1; Constructor; Intuition.
+Elim (gcd_bezout a b d H); Intros.
+Elim H3; Intros.
+Elim H4; Intros.
+Apply Zdivide_intro with `u*q+v*q0`.
+Rewrite <- H5.
+Replace `c*(u*a+v*b)` with `u*(c*a)+v*(c*b)`.
+Rewrite H6; Rewrite H7; Ring.
+Ring.
+Save.
+
+(** We could obtain a [Zgcd] function via [euclid]. But we propose 
+  here a more direct version of a [Zgcd], with better extraction 
+  (no bezout coeffs). *)
+
+Definition Zgcd_pos : (a:Z)`0<=a` -> (b:Z) 
+ { g:Z | `0<=a` -> (gcd a b g) /\ `g>=0` }.
+Proof.
+Intros a Ha.
+Apply (Z_lt_rec [a:Z](b:Z) { g:Z | `0<=a` -> (gcd a b g) /\`g>=0` }); Try Assumption.
+Intro x; Case x.
+Intros _ b; Exists (Zabs b).
+  Elim (Z_le_lt_eq_dec ? ? (Zabs_pos b)).
+    Intros H0; Split.
+    Apply Zabs_ind.
+    Intros; Apply gcd_sym; Apply gcd_0; Auto.
+    Intros; Apply gcd_opp; Apply gcd_0; Auto.
+    Auto with zarith.
+    
+    Intros H0;  Rewrite <- H0.
+    Rewrite <- (Zabs_Zsgn b); Rewrite <- H0; Simpl.
+    Split; [Apply gcd_0|Idtac];Auto with zarith.
+  
+Intros p Hrec b.
+Generalize (Z_div_mod b (POS p)).
+Case (Zdiv_eucl b (POS p)); Intros q r Hqr.
+Elim Hqr; Clear Hqr; Intros; Auto with zarith.
+Elim (Hrec r H0 (POS p)); Intros g Hgkl.
+Inversion_clear H0.
+Elim (Hgkl H1); Clear Hgkl; Intros H3 H4.
+Exists g; Intros.
+Split; Auto.
+Rewrite H.
+Apply gcd_for_euclid2; Auto.
+
+Intros p Hrec b.
+Exists `0`; Intros.
+Elim H; Auto.
+Defined.
+
+Definition Zgcd_spec : (a,b:Z){ g : Z | (gcd a b g) /\ `g>=0` }.
+Proof.
+Intros a; Case (Z_gt_le_dec `0` a).
+Intros; Assert `0 <= -a`.
+Omega.
+Elim (Zgcd_pos `-a` H b); Intros g Hgkl.
+Exists g.
+Intuition.
+Intros Ha b; Elim (Zgcd_pos a Ha b); Intros g; Exists g; Intuition.
+Defined.
+
+Definition Zgcd := [a,b:Z](let (g,_) = (Zgcd_spec a b) in g).
+
+Lemma Zgcd_is_pos : (a,b:Z)`(Zgcd a b) >=0`.
+Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
+Qed.
+
+Lemma Zgcd_is_gcd : (a,b:Z)(gcd a b (Zgcd a b)).
+Intros a b; Unfold Zgcd; Case (Zgcd_spec a b); Tauto.
+Qed.
+
+(** * Relative primality *)
+
+Definition rel_prime [a,b:Z] : Prop := (gcd a b `1`).
+
+(** Bezout's theorem: [a] and [b] are relatively prime if and
+    only if there exist [u] and [v] such that [ua+vb = 1]. *)
+
+Lemma rel_prime_bezout : 
+  (a,b:Z) (rel_prime a b) -> (Bezout a b `1`).
+Proof.
+Intros a b; Exact (gcd_bezout a b `1`).
+Save.
+
+Lemma bezout_rel_prime :
+  (a,b:Z) (Bezout a b `1`) -> (rel_prime a b).
+Proof.
+Induction 1; Constructor; Auto with zarith.
+Intros. Rewrite <- H0; Auto with zarith.
+Save.
+
+(** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are
+    relatively prime, then [a] divides [c]. *)
+
+Theorem Gauss : (a,b,c:Z) (a |`b*c`) -> (rel_prime a b) -> (a | c).
+Proof.
+Intros. Elim (rel_prime_bezout a b H0); Intros.
+Replace c with `c*1`; [ Idtac | Ring ].
+Rewrite <- H1.
+Replace `c*(u*a+v*b)` with `(c*u)*a + v*(b*c)`; [ EAuto with zarith | Ring ].
+Save.
+
+(** If [a] is relatively prime to [b] and [c], then it is to [bc] *)
+
+Lemma rel_prime_mult : 
+  (a,b,c:Z) (rel_prime a b) -> (rel_prime a c) -> (rel_prime a `b*c`).
+Proof.
+Intros a b c Hb Hc.
+Elim (rel_prime_bezout a b Hb); Intros.
+Elim (rel_prime_bezout a c Hc); Intros.
+Apply bezout_rel_prime.
+Apply Bezout_intro with u:=`u*u0*a+v0*c*u+u0*v*b` v:=`v*v0`.
+Rewrite <- H.
+Replace `u*a+v*b` with `(u*a+v*b) * 1`; [ Idtac | Ring ].
+Rewrite <- H0.
+Ring.
+Save.
+
+Lemma rel_prime_cross_prod :
+  (a,b,c,d:Z) (rel_prime a b) -> (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).
+Split; Auto with zarith.
+Rewrite H4 in H3.
+Rewrite Zmult_sym in H3.
+Apply Zmult_reg_left with d; Auto with zarith.
+Intros; Omega.
+Apply Gauss with a.
+Rewrite H3.
+Auto with zarith.
+Red; Auto with zarith.
+Apply Gauss with c.
+Rewrite Zmult_sym.
+Rewrite <- H3.
+Auto with zarith.
+Red; Auto with zarith.
+Save.
+
+(** After factorization by a gcd, the original numbers are relatively prime. *)
+
+Lemma gcd_rel_prime : 
+ (a,b,g:Z)`b>0` -> `g>=0`-> (gcd a b g) -> (rel_prime `a/g` `b/g`).
+Intros a b g; Intros.
+Assert `g <> 0`.
+ Intro.
+ Elim H1; Intros. 
+ Elim H4; Intros.
+ Rewrite H2 in H6; Subst b; Omega.
+Unfold rel_prime.
+Elim (Zgcd_spec `a/g` `b/g`); Intros g' (H3,H4).
+Assert H5 := (gcd_mult ? ? g ? H3).
+Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
+Rewrite <- Z_div_exact_2 in H5; Auto with zarith.
+Elim (gcd_uniqueness_apart_sign ? ? ? ? H1 H5).
+Intros; Rewrite (!Zmult_reg_left `1` g' g); Auto with zarith.
+Intros; Rewrite (!Zmult_reg_left `1` `-g'` g); Auto with zarith.
+Pattern 1 g; Rewrite H6; Ring.
+
+Elim H1; Intros.
+Elim H7; Intros.
+Rewrite H9.
+Replace `q*g` with `0+q*g`.
+Rewrite Z_mod_plus.
+Compute; Auto.
+Omega.
+Ring.
+
+Elim H1; Intros.
+Elim H6; Intros.
+Rewrite H9.
+Replace `q*g` with `0+q*g`.
+Rewrite Z_mod_plus.
+Compute; Auto.
+Omega.
+Ring.
+Save.
+
+(** * Primality *)
+
+Inductive prime [p:Z] : Prop := 
+  prime_intro : 
+   `1 < p` -> ((n:Z) `1 <= n < p` -> (rel_prime n p)) -> (prime p).
+
+(** The sole divisors of a prime number [p] are [-1], [1], [p] and [-p]. *)
+
+Lemma prime_divisors : 
+  (p:Z) (prime p) -> 
+  (a:Z) (a|p) -> `a = -1` \/ `a = 1` \/ a = p \/ `a = -p`.
+Proof.
+Induction 1; Intros.
+Assert `a = (-p)`\/`-p<a< -1`\/`a = -1`\/`a=0`\/`a = 1`\/`1<a<p`\/`a = p`.
+Assert `|a| <= |p|`. Apply Zdivide_bounds; [ Assumption | Omega ].
+Generalize H3. 
+Pattern `|a|`; Apply Zabs_ind; Pattern `|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.
+(* a = 0 *)
+Inversion H2. 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.
+Save.
+
+(** A prime number is relatively prime with any number it does not divide *)
+
+Lemma prime_rel_prime : 
+  (p:Z) (prime p) -> (a:Z) ~ (p|a) -> (rel_prime p a).
+Proof.
+Induction 1; Intros.
+Constructor; Intuition.
+Elim (prime_divisors p H x H3); Intuition; Subst; Auto with zarith.
+Absurd (p | a); Auto with zarith.
+Absurd (p | a); Intuition.
+Save.
+
+Hints Resolve prime_rel_prime : zarith.
+
+(** [Zdivide] can be expressed using [Zmod]. *)
+
+Lemma Zmod_Zdivide : (a,b:Z) `b>0` -> `a%b = 0` -> (b|a).
+Intros a b H H0.
+Apply Zdivide_intro with `(a/b)`.
+Pattern 1 a; Rewrite (Z_div_mod_eq a b H).
+Rewrite H0; Ring.
+Save.
+
+Lemma Zdivide_Zmod : (a,b:Z) `b>0` -> (b|a) -> `a%b = 0`.
+Intros a b; Destruct 2; Intros; Subst.
+Change `q*b` with `0+q*b`.
+Rewrite Z_mod_plus; Auto.
+Save.
+
+(** [Zdivide] is hence decidable *)
+
+Lemma Zdivide_dec : (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%(-a)` `0`).
+Left; Apply Zdivide_opp_left_rev; Apply Zmod_Zdivide; Auto with zarith.
+Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; 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%a` `0`).
+Left; Apply Zmod_Zdivide; Auto with zarith.
+Intro H1; Right; Intro; Elim H1; Apply Zdivide_Zmod; Auto with zarith.
+Save.
+
+(** If a prime [p] divides [ab] then it divides either [a] or [b] *)
+
+Lemma prime_mult : 
+  (p:Z) (prime p) -> (a,b:Z) (p | `a*b`) -> (p | a) \/ (p | b).
+Proof.
+Intro p; Induction 1; Intros.
+Case (Zdivide_dec p a); Intuition.
+Right; Apply Gauss with a; Auto with zarith.
+Save.
+
+
diff --git a/theories7/ZArith/Zorder.v b/theories7/ZArith/Zorder.v
new file mode 100644
index 00000000..d49a0800
--- /dev/null
+++ b/theories7/ZArith/Zorder.v
@@ -0,0 +1,969 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: Zorder.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+(** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
+
+Require BinPos.
+Require BinInt.
+Require Arith.
+Require Decidable.
+Require Zsyntax.
+Require Zcompare.
+
+V7only [Import nat_scope.].
+Open Local Scope Z_scope.
+
+Implicit Variable Type x,y,z:Z.
+
+(**********************************************************************)
+(** Properties of the order relations on binary integers *)
+
+(** Trichotomy *)
+
+Theorem Ztrichotomy_inf : (m,n:Z) {`m<n`} + {m=n} + {`m>n`}.
+Proof.
+Unfold Zgt Zlt; Intros m n; Assert H:=(refl_equal ? (Zcompare m n)).
+  LetTac x := (Zcompare m n) in 2 H Goal.
+  NewDestruct x; 
+    [Left; Right;Rewrite Zcompare_EGAL_eq with 1:=H 
+    | Left; Left
+    | Right ]; Reflexivity.
+Qed.
+
+Theorem Ztrichotomy : (m,n:Z) `m<n` \/ m=n \/ `m>n`.
+Proof.
+  Intros m n; NewDestruct (Ztrichotomy_inf m n) as [[Hlt|Heq]|Hgt];
+    [Left | Right; Left |Right; Right]; Assumption.
+Qed.
+
+(**********************************************************************)
+(** Decidability of equality and order on Z *)
+
+Theorem dec_eq: (x,y:Z) (decidable (x=y)).
+Proof.
+Intros x y; Unfold decidable ; Elim (Zcompare_EGAL x y);
+Intros H1 H2; Elim (Dcompare (Zcompare x y)); [
+    Tauto
+  | Intros H3; Right; Unfold not ; Intros H4;
+    Elim H3; Rewrite (H2 H4); Intros H5; Discriminate H5].
+Qed. 
+
+Theorem dec_Zne: (x,y:Z) (decidable (Zne x y)).
+Proof.
+Intros x y; Unfold decidable Zne ; Elim (Zcompare_EGAL x y).
+Intros H1 H2; Elim (Dcompare (Zcompare x y)); 
+  [ Right; Rewrite H1; Auto
+  | Left; Unfold not; Intro; Absurd (Zcompare x y)=EGAL; 
+    [ Elim H; Intros HR; Rewrite HR; Discriminate 
+    | Auto]].
+Qed.
+
+Theorem dec_Zle: (x,y:Z) (decidable `x<=y`).
+Proof.
+Intros x y; Unfold decidable Zle ; Elim (Zcompare x y); [
+    Left; Discriminate
+  | Left; Discriminate
+  | Right; Unfold not ; Intros H; Apply H; Trivial with arith].
+Qed.
+
+Theorem dec_Zgt: (x,y:Z) (decidable `x>y`).
+Proof.
+Intros x y; Unfold decidable Zgt ; Elim (Zcompare x y);
+  [ Right; Discriminate | Right; Discriminate | Auto with arith].
+Qed.
+
+Theorem dec_Zge: (x,y:Z) (decidable `x>=y`).
+Proof.
+Intros x y; Unfold decidable Zge ; Elim (Zcompare x y); [
+  Left; Discriminate
+| Right; Unfold not ; Intros H; Apply H; Trivial with arith
+| Left; Discriminate]. 
+Qed.
+
+Theorem dec_Zlt: (x,y:Z) (decidable `x<y`).
+Proof.
+Intros x y; Unfold decidable Zlt ; Elim (Zcompare x y);
+  [ Right; Discriminate | Auto with arith | Right; Discriminate].
+Qed.
+
+Theorem not_Zeq : (x,y:Z) ~ x=y -> `x<y` \/ `y<x`.
+Proof.
+Intros x y; Elim (Dcompare (Zcompare x y)); [
+  Intros H1 H2; Absurd x=y; [ Assumption | Elim (Zcompare_EGAL x y); Auto with arith]
+| Unfold Zlt ; Intros H; Elim H; Intros H1; 
+    [Auto with arith | Right; Elim (Zcompare_ANTISYM x y); Auto with arith]].
+Qed. 
+
+(** Relating strict and large orders *)
+
+Lemma Zgt_lt : (m,n:Z) `m>n` -> `n<m`.
+Proof.
+Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM m n); Auto with arith.
+Qed.
+
+Lemma Zlt_gt : (m,n:Z) `m<n` -> `n>m`.
+Proof.
+Unfold Zgt Zlt ;Intros m n H; Elim (Zcompare_ANTISYM n m); Auto with arith.
+Qed.
+
+Lemma Zge_le : (m,n:Z) `m>=n` -> `n<=m`.
+Proof.
+Intros m n; Change ~`m<n`-> ~`n>m`;
+Unfold not; Intros H1 H2; Apply H1; Apply Zgt_lt; Assumption.
+Qed.
+
+Lemma Zle_ge : (m,n:Z) `m<=n` -> `n>=m`.
+Proof.
+Intros m n; Change ~`m>n`-> ~`n<m`;
+Unfold not; Intros H1 H2; Apply H1; Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zle_not_gt     : (n,m:Z)`n<=m` -> ~`n>m`.
+Proof.
+Trivial.
+Qed.
+
+Lemma Zgt_not_le     : (n,m:Z)`n>m` -> ~`n<=m`.
+Proof.
+Intros n m H1 H2; Apply H2; Assumption.
+Qed.
+
+Lemma Zle_not_lt : (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 : (n,m:Z)`n<m` -> ~`m<=n`.
+Proof.
+Intros n m H1 H2.
+Apply Zle_not_lt with m n; Assumption.
+Qed.
+
+Lemma not_Zge : (x,y:Z) ~`x>=y` -> `x<y`.
+Proof.
+Unfold Zge Zlt ; Intros x y H; Apply dec_not_not;
+  [ Exact (dec_Zlt x y) | Assumption].
+Qed.
+ 
+Lemma not_Zlt : (x,y:Z) ~`x<y` -> `x>=y`.
+Proof.
+Unfold Zlt Zge; Auto with arith.
+Qed.
+
+Lemma not_Zgt : (x,y:Z)~`x>y` -> `x<=y`.
+Proof.
+Trivial.
+Qed.
+
+Lemma not_Zle : (x,y:Z) ~`x<=y` -> `x>y`.
+Proof.
+Unfold Zle Zgt ; Intros x y H; Apply dec_not_not;
+  [ Exact (dec_Zgt x y) | Assumption].
+Qed.
+
+Lemma Zge_iff_le : (x,y:Z) `x>=y` <-> `y<=x`.
+Proof.
+    Intros x y; Intros. Split. Intro. Apply Zge_le. Assumption.
+    Intro. Apply Zle_ge. Assumption.
+Qed.
+
+Lemma Zgt_iff_lt : (x,y:Z) `x>y` <-> `y<x`.
+Proof.
+    Intros x y. Split. Intro. Apply Zgt_lt. Assumption.
+    Intro. Apply Zlt_gt. Assumption.
+Qed.
+ 
+(** Reflexivity *)
+
+Lemma Zle_n : (n:Z) (Zle n n).
+Proof.
+Intros n; Unfold Zle; Rewrite (Zcompare_x_x n); Discriminate.
+Qed. 
+
+Lemma Zle_refl : (n,m:Z) n=m -> `n<=m`.
+Proof.
+Intros; Rewrite H; Apply Zle_n.
+Qed.
+
+Hints Resolve Zle_n : zarith.
+
+(** Antisymmetry *)
+
+Lemma Zle_antisym : (n,m:Z)`n<=m`->`m<=n`->n=m.
+Proof.
+Intros n m H1 H2; NewDestruct (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.
+
+(** Asymmetry *)
+
+Lemma Zgt_not_sym    : (n,m:Z)`n>m` -> ~`m>n`.
+Proof.
+Unfold Zgt ;Intros n m H; Elim (Zcompare_ANTISYM n m); Intros H1 H2;
+Rewrite -> H1; [ Discriminate | Assumption ].
+Qed.
+
+Lemma Zlt_not_sym : (n,m:Z)`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_not_sym with m n; Assumption.
+Qed.
+
+(** Irreflexivity *)
+
+Lemma Zgt_antirefl   : (n:Z)~`n>n`.
+Proof.
+Intros n H; Apply (Zgt_not_sym n n H H).
+Qed.
+
+Lemma Zlt_n_n : (n:Z)~`n<n`.
+Proof.
+Intros n H; Apply (Zlt_not_sym n n H H).
+Qed.
+
+Lemma Zlt_not_eq : (x,y:Z)`x<y` -> ~x=y.
+Proof.
+Unfold not; Intros x y H H0.
+Rewrite H0 in H.
+Apply (Zlt_n_n ? H).
+Qed.
+
+(** Large = strict or equal *)
+
+Lemma Zlt_le_weak : (n,m:Z)`n<m`->`n<=m`.
+Proof.
+Intros n m Hlt; Apply not_Zgt; Apply Zgt_not_sym; Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zle_lt_or_eq : (n,m:Z)`n<=m`->(`n<m` \/ n=m).
+Proof.
+Intros n m H; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
+  Left; Assumption
+| Right; Assumption
+| Absurd `n>m`; [Apply Zle_not_gt|Idtac]; Assumption ].
+Qed.
+
+(** Dichotomy *)
+
+Lemma Zle_or_lt : (n,m:Z)`n<=m`\/`m<n`.
+Proof.
+Intros n m; NewDestruct (Ztrichotomy n m) as [Hlt|[Heq|Hgt]]; [
+  Left; Apply not_Zgt; Intro Hgt; Assert Hgt':=(Zlt_gt ? ? Hlt);
+     Apply Zgt_not_sym with m n; Assumption
+| Left; Rewrite Heq; Apply Zle_n
+| Right; Apply Zgt_lt; Assumption ].
+Qed.
+
+(** Transitivity of strict orders *)
+
+Lemma Zgt_trans      : (n,m,p:Z)`n>m`->`m>p`->`n>p`.
+Proof.
+Exact Zcompare_trans_SUPERIEUR.
+Qed.
+
+Lemma Zlt_trans : (n,m,p:Z)`n<m`->`m<p`->`n<p`.
+Proof.
+Intros n m p H1 H2; Apply Zgt_lt; Apply Zgt_trans with m:= m; 
+Apply Zlt_gt; Assumption.
+Qed.
+
+(** Mixed transitivity *)
+
+Lemma Zle_gt_trans : (n,m,p:Z)`m<=n`->`m>p`->`n>p`.
+Proof.
+Intros n m p H1 H2; NewDestruct (Zle_lt_or_eq m n H1) as [Hlt|Heq]; [
+  Apply Zgt_trans with m; [Apply Zlt_gt; Assumption | Assumption ]
+| Rewrite <- Heq; Assumption ].
+Qed.
+
+Lemma Zgt_le_trans : (n,m,p:Z)`n>m`->`p<=m`->`n>p`.
+Proof.
+Intros n m p H1 H2; NewDestruct (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 : (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 ].
+Qed.
+
+Lemma Zle_lt_trans : (n,m,p:Z)`n<=m`->`m<p`->`n<p`.
+Proof.
+Intros n m p H1 H2;Apply Zgt_lt;Apply Zgt_le_trans with m:=m; 
+  [ Apply Zlt_gt;Assumption | Assumption ].
+Qed.
+
+(** Transitivity of large orders *)
+
+Lemma Zle_trans : (n,m,p:Z)`n<=m`->`m<=p`->`n<=p`.
+Proof.
+Intros n m p H1 H2; Apply not_Zgt.
+Intro Hgt; Apply Zle_not_gt with n m. Assumption.
+Exact (Zgt_le_trans n p m Hgt H2).
+Qed.
+
+Lemma Zge_trans : (n, m, p : Z) `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.
+Qed.
+
+Hints Resolve Zle_trans : zarith.
+
+(** Compatibility of successor wrt to order *)
+
+Lemma Zle_n_S : (n,m:Z) `m<=n` -> `(Zs m)<=(Zs n)`.
+Proof.
+Unfold Zle not ;Intros m n H1 H2; Apply H1; 
+Rewrite <- (Zcompare_Zplus_compatible n m (POS xH));
+Do 2 Rewrite (Zplus_sym (POS xH)); Exact H2.
+Qed.
+
+Lemma Zgt_n_S : (n,m:Z)`m>n` -> `(Zs m)>(Zs n)`.
+Proof.
+Unfold Zgt; Intros n m H; Rewrite Zcompare_n_S; Auto with arith.
+Qed.
+
+Lemma Zlt_n_S : (n,m:Z)`n<m`->`(Zs n)<(Zs m)`.
+Proof.
+Intros n m H;Apply Zgt_lt;Apply Zgt_n_S;Apply Zlt_gt; Assumption.
+Qed.
+
+Hints Resolve Zle_n_S : zarith.
+
+(** Simplification of successor wrt to order *)
+
+Lemma Zgt_S_n        : (n,p:Z)`(Zs p)>(Zs n)`->`p>n`.
+Proof.
+Unfold Zs Zgt;Intros n p;Do 2 Rewrite -> [m:Z](Zplus_sym m (POS xH));
+Rewrite -> (Zcompare_Zplus_compatible p n (POS xH));Trivial with arith.
+Qed.
+
+Lemma Zle_S_n     : (n,m:Z) `(Zs m)<=(Zs n)` -> `m<=n`.
+Proof.
+Unfold Zle not ;Intros m n H1 H2;Apply H1;
+Unfold Zs ;Do 2 Rewrite <- (Zplus_sym (POS xH));
+Rewrite -> (Zcompare_Zplus_compatible n m (POS xH));Assumption.
+Qed.
+
+Lemma Zlt_S_n : (n,m:Z)`(Zs n)<(Zs m)`->`n<m`.
+Proof.
+Intros n m H;Apply Zgt_lt;Apply Zgt_S_n;Apply Zlt_gt; Assumption.
+Qed.
+
+(** Compatibility of addition wrt to order *)
+
+Lemma Zgt_reg_l   : (n,m,p:Z)`n>m`->`p+n>p+m`.
+Proof.
+Unfold Zgt; Intros n m p H; Rewrite (Zcompare_Zplus_compatible n m p); 
+Assumption.
+Qed.
+
+Lemma Zgt_reg_r : (n,m,p:Z)`n>m`->`n+p>m+p`.
+Proof.
+Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zgt_reg_l; Trivial.
+Qed.
+
+Lemma Zle_reg_l : (n,m,p:Z)`n<=m`->`p+n<=p+m`.
+Proof.
+Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; 
+Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
+Qed.
+
+Lemma Zle_reg_r : (n,m,p:Z) `n<=m`->`n+p<=m+p`.
+Proof.
+Intros a b c;Do 2 Rewrite [n:Z](Zplus_sym n c); Exact (Zle_reg_l a b c).
+Qed.
+
+Lemma Zlt_reg_l : (n,m,p:Z)`n<m`->`p+n<p+m`.
+Proof.
+Unfold Zlt ;Intros n m p; Rewrite Zcompare_Zplus_compatible;Trivial with arith.
+Qed.
+
+Lemma Zlt_reg_r : (n,m,p:Z)`n<m`->`n+p<m+p`.
+Proof.
+Intros n m p H; Rewrite (Zplus_sym n p); Rewrite (Zplus_sym m p); Apply Zlt_reg_l; Trivial.
+Qed.
+
+Lemma Zlt_le_reg : (a,b,c,d:Z) `a<b`->`c<=d`->`a+c<b+d`.
+Proof.
+Intros a b c d H0 H1.
+Apply Zlt_le_trans with (Zplus b c).
+Apply  Zlt_reg_r; Trivial.
+Apply  Zle_reg_l; Trivial.
+Qed.
+
+Lemma Zle_lt_reg : (a,b,c,d:Z) `a<=b`->`c<d`->`a+c<b+d`.
+Proof.
+Intros a b c d H0 H1.
+Apply Zle_lt_trans with (Zplus b c).
+Apply  Zle_reg_r; Trivial.
+Apply  Zlt_reg_l; Trivial.
+Qed.
+
+Lemma Zle_plus_plus : (n,m,p,q:Z) `n<=m`->(Zle p q)->`n+p<=m+q`.
+Proof.
+Intros n m p q; Intros H1 H2;Apply Zle_trans with m:=(Zplus n q); [
+  Apply Zle_reg_l;Assumption | Apply Zle_reg_r;Assumption ].
+Qed.
+
+V7only [Set Implicit Arguments.].
+
+Lemma Zlt_Zplus : (x1,x2,y1,y2:Z)`x1 < x2` -> `y1 < y2` -> `x1 + y1 < x2 + y2`.
+Intros; Apply Zle_lt_reg. Apply Zlt_le_weak; Assumption. Assumption.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
+(** Compatibility of addition wrt to being positive *)
+
+Lemma Zle_0_plus : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x+y`.
+Proof.
+Intros x y H1 H2;Rewrite <- (Zero_left ZERO); Apply Zle_plus_plus; Assumption.
+Qed.
+
+(** Simplification of addition wrt to order *)
+
+Lemma Zsimpl_gt_plus_l : (n,m,p:Z)`p+n>p+m`->`n>m`.
+Proof.
+Unfold Zgt; Intros n m p H; 
+	Rewrite <- (Zcompare_Zplus_compatible n m p); Assumption.
+Qed.
+
+Lemma Zsimpl_gt_plus_r : (n,m,p:Z)`n+p>m+p`->`n>m`.
+Proof.
+Intros n m p H; Apply Zsimpl_gt_plus_l with p.
+Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+Qed.
+
+Lemma Zsimpl_le_plus_l : (n,m,p:Z)`p+n<=p+m`->`n<=m`.
+Proof.
+Intros n m p; Unfold Zle not ;Intros H1 H2;Apply H1; 
+Rewrite (Zcompare_Zplus_compatible n m p); Assumption.
+Qed.
+ 
+Lemma Zsimpl_le_plus_r : (n,m,p:Z)`n+p<=m+p`->`n<=m`.
+Proof.
+Intros n m p H; Apply Zsimpl_le_plus_l with p.
+Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+Qed.
+
+Lemma Zsimpl_lt_plus_l : (n,m,p:Z)`p+n<p+m`->`n<m`.
+Proof.
+Unfold Zlt ;Intros n m p; 
+	Rewrite Zcompare_Zplus_compatible;Trivial with arith.
+Qed.
+ 
+Lemma Zsimpl_lt_plus_r : (n,m,p:Z)`n+p<m+p`->`n<m`.
+Proof.
+Intros n m p H; Apply Zsimpl_lt_plus_l with p.
+Rewrite (Zplus_sym p n); Rewrite (Zplus_sym p m); Trivial.
+Qed.
+ 
+(** Special base instances of order *)
+
+Lemma Zgt_Sn_n : (n:Z)`(Zs n)>n`.
+Proof.
+Exact Zcompare_Zs_SUPERIEUR.
+Qed.
+
+Lemma Zle_Sn_n : (n:Z)~`(Zs n)<=n`.
+Proof.
+Intros n; Apply Zgt_not_le; Apply Zgt_Sn_n.
+Qed.
+
+Lemma Zlt_n_Sn : (n:Z)`n<(Zs n)`.
+Proof.
+Intro n; Apply Zgt_lt; Apply Zgt_Sn_n.
+Qed.
+
+Lemma Zlt_pred_n_n : (n:Z)`(Zpred n)<n`.
+Proof.
+Intros n; Apply Zlt_S_n; Rewrite <- Zs_pred; Apply Zlt_n_Sn.
+Qed.
+
+(** Relating strict and large order using successor or predecessor *)
+
+Lemma Zgt_le_S       : (n,p:Z)`p>n`->`(Zs n)<=p`.
+Proof.
+Unfold Zgt Zle; Intros n p H; Elim (Zcompare_et_un p n); Intros H1 H2;
+Unfold not ;Intros H3; Unfold not in H1; Apply H1; [
+  Assumption
+| Elim (Zcompare_ANTISYM (Zplus n (POS xH)) p);Intros H4 H5;Apply H4;Exact H3].
+Qed.
+
+Lemma Zle_gt_S       : (n,p:Z)`n<=p`->`(Zs p)>n`.
+Proof.
+Intros n p H; Apply Zgt_le_trans with p.
+  Apply Zgt_Sn_n.
+  Assumption.
+Qed.
+
+Lemma Zle_lt_n_Sm : (n,m:Z)`n<=m`->`n<(Zs m)`.
+Proof.
+Intros n m H; Apply Zgt_lt; Apply Zle_gt_S; Assumption.
+Qed.
+
+Lemma Zlt_le_S : (n,p:Z)`n<p`->`(Zs n)<=p`.
+Proof.
+Intros n p H; Apply Zgt_le_S; Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zgt_S_le       : (n,p:Z)`(Zs p)>n`->`n<=p`.
+Proof.
+Intros n p H;Apply Zle_S_n; Apply Zgt_le_S; Assumption.
+Qed.
+
+Lemma Zlt_n_Sm_le : (n,m:Z)`n<(Zs m)`->`n<=m`.
+Proof.
+Intros n m H; Apply Zgt_S_le; Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zle_S_gt : (n,m:Z) `(Zs n)<=m` -> `m>n`.
+Proof.
+Intros n m H;Apply Zle_gt_trans with m:=(Zs n);
+  [ Assumption | Apply Zgt_Sn_n ].
+Qed.
+
+(** Weakening order *)
+
+Lemma Zle_n_Sn : (n:Z)`n<=(Zs n)`.
+Proof.
+Intros n; Apply Zgt_S_le;Apply Zgt_trans with m:=(Zs n) ;Apply Zgt_Sn_n.
+Qed.
+
+Hints Resolve Zle_n_Sn : zarith.
+
+Lemma Zle_pred_n : (n:Z)`(Zpred n)<=n`.
+Proof.
+Intros n;Pattern 2 n ;Rewrite Zs_pred; Apply Zle_n_Sn.
+Qed.
+
+Lemma Zlt_S : (n,m:Z)`n<m`->`n<(Zs m)`.
+Intros n m H;Apply Zgt_lt; Apply Zgt_trans with m:=m; [
+  Apply Zgt_Sn_n
+| Apply Zlt_gt; Assumption ].
+Qed.
+
+Lemma Zle_le_S : (x,y:Z)`x<=y`->`x<=(Zs y)`.
+Proof.
+Intros x y H.
+Apply Zle_trans with y; Trivial with zarith.
+Qed.
+
+Lemma Zle_trans_S : (n,m:Z)`(Zs n)<=m`->`n<=m`.
+Proof.
+Intros n m H;Apply Zle_trans with m:=(Zs n); [ Apply Zle_n_Sn | Assumption ].
+Qed.
+
+Hints Resolve Zle_le_S : zarith.
+
+(** Relating order wrt successor and order wrt predecessor *)
+
+Lemma Zgt_pred : (n,p:Z)`p>(Zs n)`->`(Zpred p)>n`.
+Proof.
+Unfold Zgt Zs Zpred ;Intros n p H; 
+Rewrite <- [x,y:Z](Zcompare_Zplus_compatible x y (POS xH));
+Rewrite (Zplus_sym p); Rewrite Zplus_assoc; Rewrite [x:Z](Zplus_sym x n);
+Simpl; Assumption.
+Qed.
+
+Lemma Zlt_pred : (n,p:Z)`(Zs n)<p`->`n<(Zpred p)`.
+Proof.
+Intros n p H;Apply Zlt_S_n; Rewrite <- Zs_pred; Assumption.
+Qed.
+
+(** Relating strict order and large order on positive *)
+
+Lemma Zlt_ZERO_pred_le_ZERO : (n:Z) `0<n` -> `0<=(Zpred n)`.
+Intros x H.
+Rewrite (Zs_pred x) in H.
+Apply Zgt_S_le.
+Apply Zlt_gt.
+Assumption.
+Qed.
+
+V7only [Set Implicit Arguments.].
+
+Lemma Zgt0_le_pred : (y:Z) `y > 0` -> `0 <= (Zpred y)`.
+Intros; Apply Zlt_ZERO_pred_le_ZERO; Apply Zgt_lt. Assumption.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
+(** Special cases of ordered integers *)
+
+V7only [ (* Relevance confirmed from Zdivides *) ].
+Lemma Z_O_1: `0<1`.
+Proof.
+Change `0<(Zs 0)`. Apply Zlt_n_Sn.
+Qed.
+
+Lemma Zle_0_1: `0<=1`.
+Proof.
+Change `0<=(Zs 0)`. Apply Zle_n_Sn.
+Qed.
+
+V7only [ (* Relevance confirmed from Zdivides *) ].
+Lemma Zle_NEG_POS: (p,q:positive) `(NEG p)<=(POS q)`.
+Proof.
+Intros p; Red; Simpl; Red; Intros H; Discriminate.
+Qed.
+
+Lemma POS_gt_ZERO : (p:positive) `(POS p)>0`.
+Unfold Zgt; Trivial.
+Qed.
+
+  (* weaker but useful (in [Zpower] for instance) *)
+Lemma ZERO_le_POS : (p:positive) `0<=(POS p)`.
+Intro; Unfold Zle; Discriminate.
+Qed.
+
+Lemma NEG_lt_ZERO : (p:positive)`(NEG p)<0`.
+Unfold Zlt; Trivial.
+Qed.
+
+Lemma ZERO_le_inj :
+  (n:nat) `0 <= (inject_nat n)`.
+Induction n; Simpl; Intros;
+[ Apply Zle_n
+| Unfold Zle; Simpl; Discriminate].
+Qed.
+
+Hints Immediate Zle_refl : zarith.
+
+(** Transitivity using successor *)
+
+Lemma Zgt_trans_S  : (n,m,p:Z)`(Zs n)>m`->`m>p`->`n>p`.
+Proof.
+Intros n m p H1 H2;Apply Zle_gt_trans with m:=m;
+  [ Apply Zgt_S_le; Assumption | Assumption ].
+Qed.
+
+(** Derived lemma *)
+
+Lemma Zgt_S        : (n,m:Z)`(Zs n)>m`->(`n>m`\/(m=n)).
+Proof.
+Intros n m H.
+Assert Hle : `m<=n`.
+  Apply Zgt_S_le; Assumption.
+NewDestruct (Zle_lt_or_eq ? ? Hle) as [Hlt|Heq].
+  Left; Apply Zlt_gt; Assumption.  
+  Right; Assumption.
+Qed.
+
+(** Compatibility of multiplication by a positive wrt to order *)
+
+V7only [Set Implicit Arguments.].
+
+Lemma Zle_Zmult_pos_right : (a,b,c : Z) `a<=b` -> `0<=c` -> `a*c<=b*c`.
+Proof.
+Intros a b c H H0; NewDestruct c.
+  Do 2 Rewrite Zero_mult_right; Assumption.
+  Rewrite (Zmult_sym a); Rewrite (Zmult_sym b).
+    Unfold Zle; Rewrite Zcompare_Zmult_compatible; Assumption.
+  Unfold Zle in H0; Contradiction H0; Reflexivity.
+Qed.
+
+Lemma Zle_Zmult_pos_left : (a,b,c : Z) `a<=b` -> `0<=c` -> `c*a<=c*b`.
+Proof.
+Intros a b c H1 H2; Rewrite (Zmult_sym c a);Rewrite (Zmult_sym c b).
+Apply  Zle_Zmult_pos_right; Trivial.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_compat_r : (x,y,z:Z)`0<z` -> `x < y` -> `x*z < y*z`.
+Proof.
+Intros x y z H H0; NewDestruct z.
+  Contradiction (Zlt_n_n `0`).
+  Rewrite (Zmult_sym x); Rewrite (Zmult_sym y).
+    Unfold Zlt; Rewrite Zcompare_Zmult_compatible; Assumption.
+  Discriminate H.
+Save.
+
+Lemma Zgt_Zmult_right : (x,y,z:Z)`z>0` -> `x > y` -> `x*z > y*z`.
+Proof.
+Intros x y z; Intros; Apply Zlt_gt; Apply Zmult_lt_compat_r; 
+  Apply Zgt_lt; Assumption.
+Qed.
+
+Lemma Zlt_Zmult_right : (x,y,z:Z)`z>0` -> `x < y` -> `x*z < y*z`.
+Proof.
+Intros x y z; Intros; Apply Zmult_lt_compat_r; 
+  [Apply Zgt_lt; Assumption | Assumption].
+Qed.
+
+Lemma Zle_Zmult_right : (x,y,z:Z)`z>0` -> `x <= y` -> `x*z <= y*z`.
+Proof.
+Intros x y z Hz Hxy.
+Elim (Zle_lt_or_eq x y Hxy).
+Intros; Apply Zlt_le_weak.
+Apply Zlt_Zmult_right; Trivial.
+Intros; Apply Zle_refl.
+Rewrite H; Trivial.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_0_le_compat_r : (x,y,z:Z)`0 < z`->`x <= y`->`x*z <= y*z`.
+Proof.
+Intros x y z; Intros; Apply Zle_Zmult_right; Try Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zlt_Zmult_left : (x,y,z:Z)`z>0` -> `x < y` -> `z*x < z*y`.
+Proof.
+Intros x y z; Intros.
+Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
+Apply Zlt_Zmult_right; Assumption.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_compat_l : (x,y,z:Z)`0<z` -> `x < y` -> `z*x < z*y`.
+Proof.
+Intros x y z; Intros.
+Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
+Apply Zlt_Zmult_right; Try Apply Zlt_gt; Assumption.
+Save.
+
+Lemma Zgt_Zmult_left : (x,y,z:Z)`z>0` -> `x > y` -> `z*x > z*y`.
+Proof.
+Intros x y z; Intros;
+Rewrite (Zmult_sym z x); Rewrite (Zmult_sym z y);
+Apply Zgt_Zmult_right; Assumption.
+Qed.
+
+Lemma Zge_Zmult_pos_right : (a,b,c : Z) `a>=b` -> `c>=0` -> `a*c>=b*c`.
+Proof.
+Intros a b c H1 H2; Apply Zle_ge.
+Apply Zle_Zmult_pos_right; Apply Zge_le; Trivial.
+Qed.
+
+Lemma Zge_Zmult_pos_left : (a,b,c : Z) 	`a>=b` -> `c>=0` -> `c*a>=c*b`.
+Proof.
+Intros a b c H1 H2; Apply Zle_ge.
+Apply Zle_Zmult_pos_left; Apply Zge_le; Trivial.
+Qed.
+
+Lemma Zge_Zmult_pos_compat : 
+  (a,b,c,d : Z) `a>=c` -> `b>=d` -> `c>=0` -> `d>=0` -> `a*b>=c*d`.
+Proof.
+Intros a b c d H0 H1 H2 H3.
+Apply Zge_trans with (Zmult a d).
+Apply Zge_Zmult_pos_left; Trivial.
+Apply Zge_trans with c; Trivial. 
+Apply Zge_Zmult_pos_right; Trivial.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_le_compat: (a, b, c, d : Z)
+ `a<=c` -> `b<=d` -> `0<=a` -> `0<=b` -> `a*b<=c*d`.
+Proof.
+Intros a b c d H0 H1 H2 H3.
+Apply Zle_trans with (Zmult c b).
+Apply Zle_Zmult_pos_right; Assumption.
+Apply Zle_Zmult_pos_left.
+Assumption.
+Apply Zle_trans with a; Assumption.
+Qed.
+
+(** Simplification of multiplication by a positive wrt to being positive *)
+
+Lemma Zlt_Zmult_right2 : (x,y,z:Z)`z>0`  -> `x*z < y*z` -> `x < y`.
+Proof.
+Intros x y z; Intros; NewDestruct z.
+  Contradiction (Zgt_antirefl `0`).
+  Rewrite (Zmult_sym x) in H0; Rewrite (Zmult_sym y) in H0.
+    Unfold Zlt in H0; Rewrite Zcompare_Zmult_compatible in H0; Assumption.
+  Discriminate H.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_reg_r : (a, b, c : Z) `0<c` -> `a*c<b*c` -> `a<b`.
+Proof.
+Intros a b c H0 H1.
+Apply Zlt_Zmult_right2 with c; Try Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zle_mult_simpl : (a,b,c:Z)`c>0`->`a*c<=b*c`->`a<=b`.
+Proof.
+Intros x y z Hz Hxy.
+Elim (Zle_lt_or_eq `x*z` `y*z` Hxy).
+Intros; Apply Zlt_le_weak.
+Apply Zlt_Zmult_right2 with z; Trivial.
+Intros; Apply Zle_refl.
+Apply Zmult_reg_right with z.
+  Intro. Rewrite H0 in Hz. Contradiction (Zgt_antirefl `0`).
+Assumption.
+Qed.
+V7only [Notation Zle_Zmult_right2 := Zle_mult_simpl.
+(* Zle_Zmult_right2 :  (x,y,z:Z)`z>0` -> `x*z <= y*z` -> `x <= y`. *)
+].
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_0_le_reg_r: (x,y,z:Z)`0 <z`->`x*z <= y*z`->`x <= y`.
+Intros x y z; Intros ; Apply Zle_mult_simpl with z.
+Try Apply Zlt_gt; Assumption.
+Assumption.
+Qed.
+
+V7only [Unset Implicit Arguments.].
+
+Lemma Zge_mult_simpl : (a,b,c:Z) `c>0`->`a*c>=b*c`->`a>=b`.
+Intros a b c H1 H2; Apply Zle_ge; Apply Zle_mult_simpl with c; Trivial.
+Apply Zge_le; Trivial.
+Qed.
+
+Lemma Zgt_mult_simpl : (a,b,c:Z) `c>0`->`a*c>b*c`->`a>b`.
+Intros a b c H1 H2; Apply Zlt_gt; Apply Zlt_Zmult_right2 with c; Trivial.
+Apply Zgt_lt; Trivial.
+Qed.
+
+
+(** Compatibility of multiplication by a positive wrt to being positive *)
+
+Lemma Zle_ZERO_mult : (x,y:Z) `0<=x` -> `0<=y` -> `0<=x*y`.
+Proof.
+Intros x y; Case x.
+Intros; Rewrite Zero_mult_left; Trivial.
+Intros p H1; Unfold Zle.
+  Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
+  Rewrite  Zcompare_Zmult_compatible; Trivial.
+Intros p H1 H2; Absurd (Zgt ZERO (NEG p)); Trivial.
+Unfold Zgt; Simpl; Auto with zarith.
+Qed.
+
+Lemma Zgt_ZERO_mult: (a,b:Z) `a>0`->`b>0`->`a*b>0`.
+Proof.
+Intros x y; Case x.
+Intros H; Discriminate H.
+Intros p H1; Unfold Zgt; 
+Pattern 2 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
+  Rewrite  Zcompare_Zmult_compatible; Trivial.
+Intros p H; Discriminate H.
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_O_compat : (a, b : Z) `0<a` -> `0<b` -> `0<a*b`.
+Intros a b apos bpos.
+Apply Zgt_lt.
+Apply Zgt_ZERO_mult; Try Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zle_mult: (x,y:Z) `x>0` -> `0<=y` -> `0<=(Zmult y x)`.
+Proof.
+Intros x y H1 H2; Apply Zle_ZERO_mult; Trivial.
+Apply Zlt_le_weak; Apply Zgt_lt; Trivial.
+Qed.
+
+(** Simplification of multiplication by a positive wrt to being positive *)
+
+Lemma Zmult_le: (x,y:Z) `x>0` -> `0<=(Zmult y x)` -> `0<=y`.
+Proof.
+Intros x y; Case x; [
+  Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
+| Intros p H1; Unfold Zle; Rewrite -> Zmult_sym;
+  Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
+  Rewrite  Zcompare_Zmult_compatible; Auto with arith
+| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
+Qed.
+
+Lemma Zmult_lt: (x,y:Z) `x>0` -> `0<y*x` -> `0<y`.
+Proof.
+Intros x y; Case x; [
+  Simpl; Unfold Zgt ; Simpl; Intros H; Discriminate H
+| Intros p H1; Unfold Zlt; Rewrite -> Zmult_sym;
+  Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p));
+  Rewrite  Zcompare_Zmult_compatible; Auto with arith
+| Intros p; Unfold Zgt ; Simpl; Intros H; Discriminate H].
+Qed.
+
+V7only [ (* Relevance confirmed from Zextensions *) ].
+Lemma Zmult_lt_0_reg_r : (x,y:Z)`0 < x`->`0 < y*x`->`0 < y`.
+Proof.
+Intros x y; Intros; EApply Zmult_lt with x ; Try Apply Zlt_gt; Assumption.
+Qed.
+
+Lemma Zmult_gt: (x,y:Z) `x>0` -> `x*y>0` -> `y>0`.
+Proof.
+Intros x y; Case x.
+ Intros H; Discriminate H.
+ Intros p H1; Unfold Zgt.
+ Pattern 1 ZERO ; Rewrite <- (Zero_mult_right (POS p)).
+ Rewrite  Zcompare_Zmult_compatible; Trivial.
+Intros p H; Discriminate H.
+Qed.
+
+(** Simplification of square wrt order *)
+
+Lemma Zgt_square_simpl: (x, y : Z) `x>=0` -> `y>=0` -> `x*x>y*y` -> `x>y`.
+Proof.
+Intros x y H0 H1 H2.
+Case (dec_Zlt y x).
+Intro; Apply Zlt_gt; Trivial.
+Intros H3; Cut (Zge y x).
+Intros H.
+Elim Zgt_not_le with 1 := H2.
+Apply Zge_le.
+Apply Zge_Zmult_pos_compat; Auto.
+Apply not_Zlt; Trivial.
+Qed.
+
+Lemma Zlt_square_simpl: (x,y:Z) `0<=x` -> `0<=y` -> `y*y<x*x` -> `y<x`.
+Proof.
+Intros x y H0 H1 H2.
+Apply Zgt_lt.
+Apply Zgt_square_simpl; Try Apply Zle_ge; Try Apply Zlt_gt; Assumption.
+Qed.
+
+(** Equivalence between inequalities *)
+
+Lemma Zle_plus_swap : (x,y,z:Z) `x+z<=y` <-> `x<=y-z`.
+Proof.
+    Intros x y z; Intros. Split. Intro. Rewrite <- (Zero_right x). Rewrite <- (Zplus_inverse_r z).
+    Rewrite Zplus_assoc_l. Exact (Zle_reg_r ? ? ? H).
+    Intro. Rewrite <- (Zero_right y). Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_l.
+    Apply Zle_reg_r. Assumption.
+Qed.
+
+Lemma Zlt_plus_swap : (x,y,z:Z) `x+z<y` <-> `x<y-z`.
+Proof.
+    Intros x y z; Intros. Split. Intro. Unfold Zminus. Rewrite Zplus_sym. Rewrite <- (Zero_left x).
+    Rewrite <- (Zplus_inverse_l z). Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym.
+    Assumption.
+    Intro. Rewrite Zplus_sym. Rewrite <- (Zero_left y). Rewrite <- (Zplus_inverse_r z).
+    Rewrite Zplus_assoc_r. Apply Zlt_reg_l. Rewrite Zplus_sym. Assumption.
+Qed.
+
+Lemma Zeq_plus_swap : (x,y,z:Z)`x+z=y` <-> `x=y-z`.
+Proof.
+Intros x y z; Intros. Split. Intro. Apply Zplus_minus. Symmetry. Rewrite Zplus_sym. 
+  Assumption.
+Intro. Rewrite H. Unfold Zminus. Rewrite Zplus_assoc_r. 
+  Rewrite Zplus_inverse_l. Apply Zero_right.
+Qed.
+
+Lemma Zlt_minus : (n,m:Z)`0<m`->`n-m<n`.
+Proof.
+Intros n m H; Apply Zsimpl_lt_plus_l with p:=m; Rewrite Zle_plus_minus;
+Pattern 1 n ;Rewrite <- (Zero_right n); Rewrite (Zplus_sym m n);
+Apply Zlt_reg_l; Assumption.
+Qed.
+
+Lemma Zlt_O_minus_lt : (n,m:Z)`0<n-m`->`m<n`.
+Proof.
+Intros n m H; Apply Zsimpl_lt_plus_l with p:=(Zopp m); Rewrite Zplus_inverse_l;
+Rewrite Zplus_sym;Exact H.
+Qed.
diff --git a/theories7/ZArith/Zpower.v b/theories7/ZArith/Zpower.v
new file mode 100644
index 00000000..97c2b3c9
--- /dev/null
+++ b/theories7/ZArith/Zpower.v
@@ -0,0 +1,394 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zpower.v,v 1.2.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+Require ZArith_base.
+Require Omega.
+Require Zcomplements.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+Section section1.
+
+(** [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 ([x:Z]` z * x `) `1`).
+
+(** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for
+    [plus : nat->nat] and [Zmult : Z->Z] *)
+
+Lemma Zpower_nat_is_exp : 
+  (n,m:nat)(z:Z)
+  `(Zpower_nat z (plus n m)) = (Zpower_nat z n)*(Zpower_nat z m)`.
+
+Intros; Elim n; 
+[ Simpl; Elim (Zpower_nat z m); Auto with zarith
+| Unfold Zpower_nat; Intros;  Simpl; Rewrite H;
+  Apply Zmult_assoc].
+Qed.
+
+(** [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 ([x:Z]`z * x`) `1`).
+
+(** This theorem shows that powers of unary and binary integers
+   are the same thing, modulo the function convert : [positive -> nat] *)
+
+Theorem Zpower_pos_nat : 
+  (z:Z)(p:positive)(Zpower_pos z p) = (Zpower_nat z (convert p)).
+
+Intros; Unfold Zpower_pos; Unfold Zpower_nat; Apply iter_convert.
+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] *)
+
+Theorem Zpower_pos_is_exp : 
+  (n,m:positive)(z:Z) 
+  ` (Zpower_pos z (add n m)) = (Zpower_pos z n)*(Zpower_pos z m)`.
+
+Intros.
+Rewrite -> (Zpower_pos_nat z n).
+Rewrite -> (Zpower_pos_nat z m).
+Rewrite -> (Zpower_pos_nat z (add n m)).
+Rewrite -> (convert_add n m).
+Apply Zpower_nat_is_exp.
+Qed.
+
+Definition Zpower :=
+  [x,y:Z]Cases y of
+    (POS p) => (Zpower_pos x p)
+  | ZERO => `1`
+  | (NEG p) => `0`
+  end.
+
+V8Infix "^" Zpower : Z_scope.
+
+Hints Immediate Zpower_nat_is_exp : zarith.
+Hints Immediate Zpower_pos_is_exp : zarith.
+Hints Unfold  Zpower_pos : zarith.
+Hints Unfold  Zpower_nat : zarith.
+
+Lemma Zpower_exp : (x:Z)(n,m:Z)
+  `n >= 0` -> `m >= 0` -> `(Zpower x (n+m))=(Zpower x n)*(Zpower x m)`.
+NewDestruct n; NewDestruct m; Auto with zarith.
+Simpl; Intros; Apply Zred_factor0.
+Simpl; Auto with zarith.
+Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
+Intros; Compute in H0; Absurd INFERIEUR=INFERIEUR; Auto with zarith.
+Qed.
+
+End section1.
+
+(* Exporting notation "^" *)
+
+V8Infix "^" Zpower : Z_scope.
+
+Hints Immediate Zpower_nat_is_exp : zarith.
+Hints Immediate Zpower_pos_is_exp : zarith.
+Hints Unfold  Zpower_pos : zarith.
+Hints Unfold  Zpower_nat : zarith.
+
+Section 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 *)
+
+Definition shift_nat := 
+  [n:nat][z:positive](iter_nat n positive xO z). 
+Definition shift_pos :=
+  [n:positive][z:positive](iter_pos n positive xO z). 
+Definition shift :=
+  [n:Z][z:positive]
+  Cases n of
+    ZERO => z
+  | (POS p) => (iter_pos p positive xO z)
+  | (NEG p) => z
+  end.
+
+Definition two_power_nat := [n:nat] (POS (shift_nat n xH)).
+Definition two_power_pos := [x:positive] (POS (shift_pos x xH)).
+
+Lemma two_power_nat_S : 
+  (n:nat)` (two_power_nat (S n)) = 2*(two_power_nat n)`.
+Intro; Simpl; Apply refl_equal.
+Qed.
+
+Lemma shift_nat_plus :
+  (n,m:nat)(x:positive)
+    (shift_nat (plus n m) x)=(shift_nat n (shift_nat m x)).
+
+Intros; Unfold shift_nat; Apply iter_nat_plus.
+Qed.
+
+Theorem shift_nat_correct :
+  (n:nat)(x:positive)(POS (shift_nat n x))=`(Zpower_nat 2 n)*(POS x)`.
+
+Unfold shift_nat; Induction n; 
+[ Simpl; Trivial with zarith
+| Intros; Replace (Zpower_nat `2` (S n0)) with `2 * (Zpower_nat 2 n0)`;
+[ Rewrite <- Zmult_assoc; Rewrite <- (H x); Simpl; Reflexivity
+| Auto with zarith ]
+].
+Qed.
+
+Theorem two_power_nat_correct :
+  (n:nat)(two_power_nat n)=(Zpower_nat `2` n).
+
+Intro n.
+Unfold two_power_nat.
+Rewrite -> (shift_nat_correct n).
+Omega.
+Qed.
+  
+(** Second we show that [two_power_pos] and [two_power_nat] are the same *)
+Lemma shift_pos_nat : (p:positive)(x:positive)
+  (shift_pos p x)=(shift_nat (convert p) x).
+
+Unfold shift_pos.
+Unfold shift_nat.
+Intros; Apply iter_convert.
+Qed.
+
+Lemma two_power_pos_nat : 
+  (p:positive) (two_power_pos p)=(two_power_nat (convert p)).
+
+Intro; Unfold two_power_pos; Unfold two_power_nat.
+Apply f_equal with f:=POS.
+Apply shift_pos_nat.
+Qed.
+
+(** Then we deduce that [two_power_pos] is also correct *)
+
+Theorem shift_pos_correct :
+  (p,x:positive) ` (POS (shift_pos p x)) = (Zpower_pos 2 p) * (POS x)`.
+
+Intros.
+Rewrite -> (shift_pos_nat p x).
+Rewrite -> (Zpower_pos_nat `2` p).
+Apply shift_nat_correct.
+Qed.
+
+Theorem two_power_pos_correct : 
+  (x:positive) (two_power_pos x)=(Zpower_pos `2` x).
+
+Intro.
+Rewrite -> two_power_pos_nat.
+Rewrite -> Zpower_pos_nat.
+Apply two_power_nat_correct.
+Qed.
+
+(** Some consequences *)
+
+Theorem two_power_pos_is_exp :
+  (x,y:positive) (two_power_pos (add x y))
+    =(Zmult (two_power_pos x) (two_power_pos y)).
+Intros.
+Rewrite -> (two_power_pos_correct (add x y)).
+Rewrite -> (two_power_pos_correct x).
+Rewrite -> (two_power_pos_correct y).
+Apply Zpower_pos_is_exp.
+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. *)
+ 
+Definition two_p :=
+  [x:Z]Cases x of
+         ZERO    => `1`
+       | (POS y) => (two_power_pos y)
+       | (NEG y) => `0`
+       end.
+
+Theorem two_p_is_exp :
+  (x,y:Z) ` 0 <= x` -> ` 0 <= y` -> 
+    ` (two_p (x+y)) = (two_p x)*(two_p y)`.
+Induction x; 
+[ Induction y; Simpl; Auto with zarith
+| Induction y; 
+  [ Unfold two_p;  Rewrite -> (Zmult_sym (two_power_pos p) `1`);
+    Rewrite -> (Zmult_one (two_power_pos p)); Auto with zarith
+  | Unfold Zplus; Unfold two_p;
+    Intros; Apply two_power_pos_is_exp
+  | Intros; Unfold Zle in H0; Unfold Zcompare in H0; 
+    Absurd SUPERIEUR=SUPERIEUR; Trivial with zarith
+  ]
+| Induction y; 
+  [ Simpl; Auto with zarith
+  | Intros; Unfold Zle in H; Unfold Zcompare in H;
+    Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
+  | Intros; Unfold Zle in H; Unfold Zcompare in H;
+    Absurd (SUPERIEUR=SUPERIEUR); Trivial with zarith
+  ]
+].
+Qed.
+
+Lemma two_p_gt_ZERO : (x:Z) ` 0 <= x` -> ` (two_p x) > 0`.
+Induction x; Intros;
+[ Simpl; Omega
+| Simpl; Unfold two_power_pos; Apply POS_gt_ZERO
+| Absurd ` 0 <= (NEG p)`;
+  [ Simpl; Unfold Zle; Unfold Zcompare;
+    Do 2 Unfold not; Auto with zarith
+  | Assumption ]
+].
+Qed.
+
+Lemma two_p_S : (x:Z) ` 0 <= x` -> 
+ `(two_p (Zs x)) = 2 * (two_p x)`.
+Intros; Unfold Zs. 
+Rewrite (two_p_is_exp x `1` H (ZERO_le_POS xH)).
+Apply Zmult_sym.
+Qed.
+
+Lemma two_p_pred : 
+  (x:Z)` 0 <= x` -> ` (two_p (Zpred x)) < (two_p x)`.
+Intros; Apply natlike_ind 
+with P:=[x:Z]` (two_p (Zpred x)) < (two_p x)`;
+[ Simpl; Unfold Zlt; Auto with zarith
+| Intros; Elim (Zle_lt_or_eq `0` x0 H0);
+  [ Intros;
+    Replace (two_p (Zpred (Zs x0)))
+    with (two_p (Zs (Zpred x0)));
+    [ Rewrite -> (two_p_S (Zpred x0));
+      [ Rewrite -> (two_p_S x0);
+      	[ Omega
+      	| Assumption]
+      | Apply Zlt_ZERO_pred_le_ZERO; Assumption]
+    | Rewrite <- (Zs_pred x0); Rewrite <- (Zpred_Sn x0); Trivial with zarith]
+  | Intro Hx0; Rewrite <- Hx0; Simpl; Unfold Zlt; Auto with zarith]
+| Assumption].
+Qed. 
+
+Lemma Zlt_lt_double : (x,y:Z) ` 0 <= x < y` -> ` x < 2*y`.
+Intros; Omega. Qed. 
+
+End Powers_of_2.
+
+Hints Resolve two_p_gt_ZERO : zarith.
+Hints Immediate two_p_pred two_p_S : zarith.
+
+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] *)
+
+(** 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
+  (Cases q of
+     ZERO => ` (0, r)`
+   | (POS xH) => ` (0, d + r)`
+   | (POS (xI n)) => ` ((POS n), d + r)`
+   | (POS (xO n)) => ` ((POS n), r)`
+   | (NEG xH) => ` (-1, d + r)`
+   | (NEG (xI n)) => ` ((NEG n) - 1, d + r)`
+   | (NEG (xO n)) => ` ((NEG 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.
+
+Lemma Zdiv_rest_correct1 :
+  (x:Z)(p:positive)
+  let (qr,d)=(iter_pos p ? Zdiv_rest_aux ((x,`0`),`1`)) in d=(two_power_pos p).
+
+Intros x p; 
+Rewrite (iter_convert p ? Zdiv_rest_aux ((x,`0`),`1`));
+Rewrite (two_power_pos_nat p);
+Elim (convert p); Simpl;
+[ Trivial with zarith
+| Intro n; Rewrite (two_power_nat_S n);
+  Unfold 2 Zdiv_rest_aux;
+  Elim (iter_nat n (Z*Z)*Z Zdiv_rest_aux ((x,`0`),`1`));
+  NewDestruct a; Intros; Apply f_equal with f:=[z:Z]`2*z`; Assumption ]. 
+Qed.
+
+Lemma Zdiv_rest_correct2 :
+  (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`.
+
+Intros; Apply iter_pos_invariant with
+  f:=Zdiv_rest_aux
+  Inv:=[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; 
+  Elim q;
+  [ Omega
+  | NewDestruct p0; 
+    [ Rewrite POS_xI; Intro; Elim H; Intros; Split; 
+      [ Rewrite H0; Rewrite Zplus_assoc;
+      	Rewrite Zmult_plus_distr_l;
+      	Rewrite Zmult_1_n; Rewrite Zmult_assoc;
+      	Rewrite (Zmult_sym (POS p0) `2`); Apply refl_equal
+      | Omega ]
+    | Rewrite POS_xO; Intro; Elim H; Intros; Split;
+      [ Rewrite H0;
+      	Rewrite Zmult_assoc; Rewrite (Zmult_sym (POS p0) `2`);
+      	Apply refl_equal  
+      | Omega ]
+    | Omega ]
+  | NewDestruct p0; 
+    [ Rewrite NEG_xI; Unfold Zminus; Intro; Elim H; Intros; Split; 
+      [ Rewrite H0; Rewrite Zplus_assoc;
+      	Apply f_equal with f:=[z:Z]`z+r`;
+      	Do 2 (Rewrite Zmult_plus_distr_l);
+       	Rewrite Zmult_assoc; 
+      	Rewrite (Zmult_sym (NEG p0) `2`);
+      	Rewrite <- Zplus_assoc;
+	Apply f_equal with f:=[z:Z]`2 * (NEG p0) * d + z`; 
+      	Omega
+      | Omega ]
+    | Rewrite NEG_xO; Unfold Zminus; Intro; Elim H; Intros; Split;
+      [ Rewrite H0;
+      	Rewrite Zmult_assoc; Rewrite (Zmult_sym (NEG p0) `2`);
+      	Apply refl_equal  
+      | Omega ]
+    | Omega ] ]
+| Omega].
+Qed.
+
+Inductive Set Zdiv_rest_proofs[x:Z; p:positive] :=
+  Zdiv_rest_proof : (q:Z)(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 :
+  (x:Z)(p:positive)(Zdiv_rest_proofs x p).
+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`)).
+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.
+Qed.
+
+End power_div_with_rest.
diff --git a/theories7/ZArith/Zsqrt.v b/theories7/ZArith/Zsqrt.v
new file mode 100644
index 00000000..72a2e9cf
--- /dev/null
+++ b/theories7/ZArith/Zsqrt.v
@@ -0,0 +1,136 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: Zsqrt.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ *)
+
+Require Omega.
+Require Export ZArith_base.
+Require Export ZArithRing.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Definition and properties of square root on Z *)
+
+(** The following tactic replaces all instances of (POS (xI ...)) by
+    `2*(POS ...)+1` , but only when ... is not made only with xO, XI, or xH. *)
+Tactic Definition compute_POS :=
+  Match Context With
+  | [|- [(POS (xI ?1))]] ->
+    (Match ?1 With
+     | [[xH]] -> Fail
+     | _ -> Rewrite (POS_xI ?1))
+  | [|- [(POS (xO ?1))]] ->
+    (Match ?1 With
+     | [[xH]] -> Fail
+     | _ -> Rewrite (POS_xO ?1)).
+
+Inductive sqrt_data [n : Z] : Set :=
+  c_sqrt: (s, r :Z)`n=s*s+r`->`0<=r<=2*s`->(sqrt_data n) .
+
+Definition sqrtrempos: (p : positive)  (sqrt_data (POS p)).
+Refine (Fix sqrtrempos {
+         sqrtrempos [p : positive] : (sqrt_data (POS p)) :=
+            <[p : ?]  (sqrt_data (POS p))> Cases p of
+                xH => (c_sqrt `1` `1` `0` ? ?)
+               | (xO xH) => (c_sqrt `2` `1` `1` ? ?)
+               | (xI xH) => (c_sqrt `3` `1` `2` ? ?)
+               | (xO (xO p')) =>
+                   Cases (sqrtrempos p') of
+                     (c_sqrt s' r' Heq Hint) =>
+                       Cases (Z_le_gt_dec `4*s'+1` `4*r'`) of
+                         (left Hle) =>
+                           (c_sqrt (POS (xO (xO p'))) `2*s'+1` `4*r'-(4*s'+1)` ? ?)
+                        | (right Hgt) =>
+                            (c_sqrt (POS (xO (xO p'))) `2*s'` `4*r'` ? ?)
+                       end
+                   end
+               | (xO (xI p')) =>
+                   Cases (sqrtrempos p') of
+                     (c_sqrt s' r' Heq Hint) =>
+                       Cases
+                        (Z_le_gt_dec `4*s'+1` `4*r'+2`) of
+                         (left Hle) =>
+                           (c_sqrt 
+			     (POS (xO (xI p'))) `2*s'+1` `4*r'+2-(4*s'+1)` ? ?)
+                        | (right Hgt) =>
+                            (c_sqrt (POS (xO (xI p'))) `2*s'` `4*r'+2` ? ?)
+                       end
+                   end
+               | (xI (xO p')) =>
+                   Cases (sqrtrempos p') of
+                     (c_sqrt s' r' Heq Hint) =>
+                       Cases
+                        (Z_le_gt_dec `4*s'+1` `4*r'+1`) of
+                         (left Hle) =>
+                           (c_sqrt
+                            (POS (xI (xO p'))) `2*s'+1` `4*r'+1-(4*s'+1)` ? ?)
+                        | (right Hgt) =>
+                            (c_sqrt (POS (xI (xO p'))) `2*s'` `4*r'+1` ? ?)
+                       end
+                   end
+               | (xI (xI p')) =>
+                   Cases (sqrtrempos p') of
+                     (c_sqrt s' r' Heq Hint) =>
+                       Cases
+                        (Z_le_gt_dec `4*s'+1` `4*r'+3`) of
+                         (left Hle) =>
+                           (c_sqrt
+                            (POS (xI (xI p'))) `2*s'+1` `4*r'+3-(4*s'+1)` ? ?)
+                        | (right Hgt) =>
+                            (c_sqrt (POS (xI (xI p'))) `2*s'` `4*r'+3` ? ?)
+                       end
+                   end
+            end
+        }); Clear sqrtrempos; Repeat compute_POS;
+ Try (Try Rewrite Heq; Ring; Fail); Try Omega.
+Defined.
+
+(** Define with integer input, but with a strong (readable) specification. *)
+Definition Zsqrt : (x:Z)`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}.
+Refine [x]
+   <[x:Z]`0<=x`->{s:Z & {r:Z | x=`s*s+r` /\ `s*s<=x<(s+1)*(s+1)`}}>Cases x of
+       (POS p) => [h]Cases (sqrtrempos p) of
+                    (c_sqrt s r Heq Hint) =>
+                  (existS ? [s:Z]{r:Z | `(POS p)=s*s+r` /\ 
+		                         `s*s<=(POS p)<(s+1)*(s+1)`}
+		   s
+                    (exist Z [r:Z]((POS p)=`s*s+r` /\ `s*s<=(POS p)<(s+1)*(s+1)`)
+                       r ?))
+                  end
+     | (NEG p) => [h](False_rec 
+		         {s:Z & {r:Z |
+			     (NEG p)=`s*s+r` /\ `s*s<=(NEG p)<(s+1)*(s+1)`}}
+                         (h (refl_equal ? SUPERIEUR)))
+     | ZERO => [h](existS ? [s:Z]{r:Z | `0=s*s+r` /\ `s*s<=0<(s+1)*(s+1)`}
+		     `0` (exist Z [r:Z](`0=0*0+r`/\`0*0<=0<(0+1)*(0+1)`)
+		     `0` ?))
+     end;Try Omega.
+Split;[Omega|Rewrite Heq;Ring `(s+1)*(s+1)`;Omega].
+Defined.
+
+(** Define a function of type Z->Z that computes the integer square root,
+    but only for positive numbers, and 0 for others. *)
+Definition Zsqrt_plain : Z->Z :=
+  [x]Cases x of
+    (POS p)=>Cases (Zsqrt (POS p) (ZERO_le_POS p)) of (existS s _) => s end
+   |(NEG p)=>`0`
+   |ZERO=>`0`
+   end.
+
+(** A basic theorem about Zsqrt_plain *)
+Theorem Zsqrt_interval :(x:Z)`0<=x`->
+  `(Zsqrt_plain x)*(Zsqrt_plain x)<= x < ((Zsqrt_plain x)+1)*((Zsqrt_plain x)+1)`.
+Intros x;Case x.
+Unfold Zsqrt_plain;Omega.
+Intros p;Unfold Zsqrt_plain;Case (Zsqrt (POS p) (ZERO_le_POS p)).
+Intros s (r,(Heq,Hint)) Hle;Assumption.
+Intros p Hle;Elim Hle;Auto.
+Qed.
+
+
diff --git a/theories7/ZArith/Zsyntax.v b/theories7/ZArith/Zsyntax.v
new file mode 100644
index 00000000..3c7f3a57
--- /dev/null
+++ b/theories7/ZArith/Zsyntax.v
@@ -0,0 +1,278 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: Zsyntax.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+Require Export BinInt.
+
+V7only[
+
+Grammar znatural ident :=
+  nat_id [ prim:var($id) ] -> [$id]
+
+with number :=
+
+with negnumber := 
+
+with formula : constr :=
+  form_expr [ expr($p) ] -> [$p]
+(*| form_eq [ expr($p) "=" expr($c) ] -> [ (eq Z $p $c) ]*)
+| form_eq [ expr($p) "=" expr($c) ] -> [ (Coq.Init.Logic.eq ? $p $c) ]
+| form_le [ expr($p) "<=" expr($c) ] -> [ (Zle $p $c) ]
+| form_lt [ expr($p) "<" expr($c) ] -> [ (Zlt $p $c) ]
+| form_ge [ expr($p) ">=" expr($c) ] -> [ (Zge $p $c) ]
+| form_gt [ expr($p) ">" expr($c) ] -> [ (Zgt $p $c) ]
+(*| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
+              -> [ (eq Z $p $c)/\(eq Z $c $c1) ]*)
+| form_eq_eq [ expr($p) "=" expr($c) "=" expr($c1) ]
+              -> [ (Coq.Init.Logic.eq ? $p $c)/\(Coq.Init.Logic.eq ? $c $c1) ]
+| form_le_le [ expr($p) "<=" expr($c) "<=" expr($c1) ]
+              -> [ (Zle $p $c)/\(Zle $c $c1) ]
+| form_le_lt [ expr($p) "<=" expr($c) "<" expr($c1) ]
+              -> [ (Zle $p $c)/\(Zlt $c $c1) ]
+| form_lt_le [ expr($p) "<" expr($c) "<=" expr($c1) ]
+              -> [ (Zlt $p $c)/\(Zle $c $c1) ]
+| form_lt_lt [ expr($p) "<" expr($c) "<" expr($c1) ]
+              -> [ (Zlt $p $c)/\(Zlt $c $c1) ]
+(*| form_neq  [ expr($p) "<>" expr($c) ] -> [  ~(Coq.Init.Logic.eq Z $p $c) ]*)
+| form_neq  [ expr($p) "<>" expr($c) ] -> [  ~(Coq.Init.Logic.eq ? $p $c) ]
+| form_comp [ expr($p) "?=" expr($c) ] -> [ (Zcompare $p $c) ]
+
+with expr : constr :=
+  expr_plus [ expr($p) "+" expr($c) ] -> [ (Zplus $p $c) ]
+| expr_minus [ expr($p) "-" expr($c) ] -> [ (Zminus $p $c) ]
+| expr2 [ expr2($e) ] -> [$e]
+
+with expr2 : constr :=
+  expr_mult [ expr2($p) "*" expr2($c) ] -> [ (Zmult $p $c) ]
+| expr1 [ expr1($e) ] -> [$e]
+
+with expr1 : constr :=
+  expr_abs [ "|" expr($c) "|" ] -> [ (Zabs $c) ]
+| expr0 [ expr0($e) ] -> [$e]
+
+with expr0 : constr :=
+  expr_id [ constr:global($c) ] -> [ $c ]
+| expr_com [ "[" constr:constr($c) "]" ] -> [$c]
+| expr_appl [ "(" application($a) ")" ] -> [$a]
+| expr_num [ number($s) ] -> [$s ]
+| expr_negnum [ "-" negnumber($n) ] -> [ $n ]
+| expr_inv [ "-" expr0($c) ] -> [ (Zopp $c) ] 
+| expr_meta [ zmeta($m) ] -> [ $m ]
+
+with zmeta :=
+| rimpl [ "?" ] -> [ ? ]
+| rmeta0 [ "?" "0" ] -> [ ?0 ]
+| rmeta1 [ "?" "1" ] -> [ ?1 ]
+| rmeta2 [ "?" "2" ] -> [ ?2 ]
+| rmeta3 [ "?" "3" ] -> [ ?3 ]
+| rmeta4 [ "?" "4" ] -> [ ?4 ]
+| rmeta5 [ "?" "5" ] -> [ ?5 ]
+
+with application : constr :=
+  apply [ application($p) expr($c1) ] -> [ ($p $c1) ]
+| apply_inject_nat [ "inject_nat" constr:constr($c1) ] -> [ (inject_nat $c1) ]
+| pair [ expr($p) "," expr($c) ] -> [ ($p, $c) ]
+| appl0 [ expr($a) ] -> [$a]
+.
+
+Grammar constr constr0 :=
+  z_in_com [ "`" znatural:formula($c) "`" ] -> [$c].
+
+Grammar constr pattern :=
+  z_in_pattern [ "`" prim:bigint($c) "`" ] -> [ 'Z: $c ' ].   
+
+(* The symbols "`" "`" must be printed just once at the top of the expressions,
+  to avoid printings like |``x` + `y`` < `45`| 
+  for |x + y < 45|.
+  So when a Z-expression is to be printed, its sub-expresssions are
+  enclosed into an ast (ZEXPR \$subexpr), which is printed like \$subexpr
+  but without symbols "`" "`" around. 
+
+  There is just one problem: NEG and Zopp have the same printing rules.
+  If Zopp is opaque, we may not be able to solve a goal like
+  ` -5 = -5 ` by reflexivity. (In fact, this precise Goal is solved
+  by the Reflexivity tactic, but more complex problems may arise 
+
+  SOLUTION : Print (Zopp 5) for constants and -x for variables *)
+
+Syntax constr
+  level 0:
+    Zle [ (Zle $n1 $n2) ] -> 
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2) "`"]]
+  | Zlt [ (Zlt $n1 $n2) ] -> 
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2) "`" ]]
+  | Zge [ (Zge $n1 $n2) ] -> 
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] ">= " (ZEXPR $n2) "`" ]]
+  | Zgt [ (Zgt $n1 $n2) ] -> 
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "> " (ZEXPR $n2) "`" ]]
+  | Zcompare [<<(Zcompare $n1 $n2)>>] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "?= " (ZEXPR $n2) "`" ]]
+  | Zeq [ (eq Z $n1 $n2) ] -> 
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "= " (ZEXPR $n2)"`"]]
+  | Zneq [ ~(eq Z $n1 $n2) ] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<> " (ZEXPR $n2) "`"]]
+  | Zle_Zle [ (Zle $n1 $n2)/\(Zle $n2 $n3) ] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
+                                [1 0] "<= " (ZEXPR $n3) "`"]]
+  | Zle_Zlt [ (Zle $n1 $n2)/\(Zlt $n2 $n3) ] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "<= " (ZEXPR $n2)
+                                [1 0] "< " (ZEXPR $n3) "`"]]
+  | Zlt_Zle [ (Zlt $n1 $n2)/\(Zle $n2 $n3) ] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
+                                [1 0] "<= " (ZEXPR $n3) "`"]]
+  | Zlt_Zlt [ (Zlt $n1 $n2)/\(Zlt $n2 $n3) ] ->
+      [[<hov 0> "`" (ZEXPR $n1) [1 0] "< " (ZEXPR $n2)
+                                [1 0] "< " (ZEXPR $n3) "`"]]
+  | ZZero_v7 [ ZERO ] -> [ "`0`" ]
+  | ZPos_v7 [ (POS $r) ] -> [$r:"positive_printer":9]
+  | ZNeg_v7 [ (NEG $r) ] -> [$r:"negative_printer":9]
+  ;
+
+  level 7:
+    Zplus [ (Zplus $n1 $n2) ]
+      -> [ [<hov 0> "`" (ZEXPR $n1):E "+"  [0 0] (ZEXPR $n2):L "`"] ]
+  | Zminus [ (Zminus $n1 $n2) ]
+      -> [ [<hov 0> "`" (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L "`"] ]
+  ;
+
+  level 6:
+    Zmult [ (Zmult $n1 $n2) ]
+      -> [ [<hov 0> "`" (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L "`"] ]
+  ;
+
+  level 8:
+    Zopp [ (Zopp $n1) ] -> [ [<hov 0> "`" "-" (ZEXPR $n1):E "`"] ]
+  | Zopp_POS [ (Zopp (POS $r)) ] -> 
+         [ [<hov 0> "`(" "Zopp" [1 0] $r:"positive_printer_inside"  ")`"] ]
+  | Zopp_ZERO [ (Zopp ZERO) ] -> [ [<hov 0> "`(" "Zopp" [1 0] "0" ")`"] ]
+  | Zopp_NEG [ (Zopp (NEG $r)) ] ->  
+         [ [<hov 0> "`(" "Zopp" [1 0] "(" $r:"negative_printer_inside" "))`"] ]
+  ;
+
+  level 4:
+    Zabs [ (Zabs $n1) ] -> [  [<hov 0> "`|" (ZEXPR $n1):E "|`"] ]
+  ;
+
+  level 0:
+    escape_inside [ << (ZEXPR $r) >> ] -> [ "[" $r:E "]" ]
+  ;
+
+  level 4:
+    Zappl_inside [ << (ZEXPR (APPLIST $h ($LIST $t))) >> ]
+      -> [ [<hov 0> "("(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E ")"] ]
+  | Zappl_inject_nat [ << (ZEXPR (APPLIST <<inject_nat>> $n)) >> ]
+      -> [ [<hov 0> "(inject_nat" [1 1] $n:L ")"] ]
+  | Zappl_inside_tail [ << (ZAPPLINSIDETAIL $h ($LIST $t)) >> ]
+      -> [(ZEXPR $h):E [1 0] (ZAPPLINSIDETAIL ($LIST $t)):E] 
+  | Zappl_inside_one [ << (ZAPPLINSIDETAIL $e) >> ] ->[(ZEXPR $e):E]
+  | pair_inside [ << (ZEXPR <<(pair $s1 $s2 $z1 $z2)>>) >> ] 
+      -> [ [<hov 0> "("(ZEXPR $z1):E "," [1 0] (ZEXPR $z2):E ")"] ]
+  ;
+
+ level 3:
+    var_inside [ << (ZEXPR ($VAR $i)) >> ] -> [$i]
+  | secvar_inside [ << (ZEXPR (SECVAR $i)) >> ] -> [(SECVAR $i)]
+  | const_inside [ << (ZEXPR (CONST $c)) >> ] -> [(CONST $c)]
+  | mutind_inside [ << (ZEXPR (MUTIND $i $n)) >> ] 
+      -> [(MUTIND $i $n)]
+  | mutconstruct_inside [ << (ZEXPR (MUTCONSTRUCT $c1 $c2 $c3)) >> ]
+      -> [ (MUTCONSTRUCT $c1 $c2 $c3) ]
+
+  | O_inside [ << (ZEXPR << O >>) >> ] -> [ "O" ] (* To shunt Arith printer *)
+
+  (* Added by JCF, 9/3/98; updated HH, 11/9/01 *)
+  | implicit_head_inside [ << (ZEXPR (APPLISTEXPL ($LIST $c))) >> ]
+      -> [ (APPLIST ($LIST $c)) ]
+  | implicit_arg_inside  [ << (ZEXPR (EXPL "!" $n $c)) >> ] -> [ ]
+
+  ;
+
+  level 7:
+    Zplus_inside
+      [ << (ZEXPR <<(Zplus $n1 $n2)>>) >> ]
+      	 -> [ (ZEXPR $n1):E "+" [0 0] (ZEXPR $n2):L ]
+  | Zminus_inside
+      [ << (ZEXPR <<(Zminus $n1 $n2)>>) >> ]
+      	 -> [ (ZEXPR $n1):E "-" [0 0] (ZEXPR $n2):L ]
+  ;
+
+  level 6:
+    Zmult_inside
+      [ << (ZEXPR <<(Zmult $n1 $n2)>>) >> ]
+      	 -> [ (ZEXPR $n1):E "*" [0 0] (ZEXPR $n2):L ]
+  ;
+
+  level 5:
+    Zopp_inside [ << (ZEXPR <<(Zopp $n1)>>) >> ] -> [ "(-" (ZEXPR $n1):E ")" ]
+  ;  
+
+  level 10:
+    Zopp_POS_inside [ << (ZEXPR <<(Zopp (POS $r))>>) >> ] -> 
+      	 [ [<hov 0> "Zopp" [1 0] $r:"positive_printer_inside" ] ]
+  | Zopp_ZERO_inside [ << (ZEXPR <<(Zopp ZERO)>>) >> ] -> 
+      	 [ [<hov 0> "Zopp" [1 0] "0"] ]
+  | Zopp_NEG_inside [ << (ZEXPR <<(Zopp (NEG $r))>>) >> ] ->  
+      	 [ [<hov 0> "Zopp" [1 0] $r:"negative_printer_inside" ] ]
+  ;
+
+  level 4:
+    Zabs_inside [ << (ZEXPR <<(Zabs $n1)>>) >> ] -> [ "|" (ZEXPR $n1) "|"]
+  ;
+
+  level 0:
+    ZZero_inside [ << (ZEXPR <<ZERO>>) >> ] -> ["0"]
+  | ZPos_inside [ << (ZEXPR <<(POS $p)>>) >>] -> 
+      [$p:"positive_printer_inside":9]
+  | ZNeg_inside [ << (ZEXPR <<(NEG $p)>>) >>] ->
+      [$p:"negative_printer_inside":9]
+.
+].
+
+V7only[
+(* For parsing/printing based on scopes *)
+Module Z_scope.
+
+Infix LEFTA 4 "+" Zplus : Z_scope.
+Infix LEFTA 4 "-" Zminus : Z_scope.
+Infix LEFTA 3 "*" Zmult : Z_scope.
+Notation "- x" := (Zopp x) (at level 0): Z_scope V8only.
+Infix NONA 5 "<=" Zle : Z_scope.
+Infix NONA 5 "<"  Zlt : Z_scope.
+Infix NONA 5 ">=" Zge : Z_scope.
+Infix NONA 5 ">"  Zgt  : Z_scope.
+Infix NONA 5 "?=" Zcompare : Z_scope.
+Notation "x <= y <= z" := (Zle x y)/\(Zle y z)
+  (at level 5, y at level 4):Z_scope
+  V8only (at level 70, y at next level).
+Notation "x <= y < z"  := (Zle x y)/\(Zlt y z)
+  (at level 5, y at level 4):Z_scope
+  V8only (at level 70, y at next level).
+Notation  "x < y < z"  := (Zlt x y)/\(Zlt y z)
+  (at level 5, y at level 4):Z_scope
+  V8only (at level 70, y at next level).
+Notation  "x < y <= z" := (Zlt x y)/\(Zle y z)
+  (at level 5, y at level 4):Z_scope
+  V8only (at level 70, y at next level).
+Notation  "x = y = z" := x=y/\y=z : Z_scope
+  V8only (at level 70, y at next level).
+
+(* Now a polymorphic notation
+Notation "x <> y" := ~(eq Z x y) (at level 5, no associativity) : Z_scope.
+*)
+
+(* Notation "| x |" (Zabs x) : Z_scope.(* "|" conflicts with THENS *)*)
+
+(* Overwrite the printing of "`x = y`" *)
+Syntax constr level 0:
+  Zeq [ (eq Z $n1 $n2) ] -> [[<hov 0> $n1 [1 0] "= " $n2 ]].
+
+Open Scope Z_scope.
+
+End Z_scope.
+].
diff --git a/theories7/ZArith/Zwf.v b/theories7/ZArith/Zwf.v
new file mode 100644
index 00000000..c2e6ca2a
--- /dev/null
+++ b/theories7/ZArith/Zwf.v
@@ -0,0 +1,96 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* $Id: Zwf.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ *)
+
+Require ZArith_base.
+Require Export Wf_nat.
+Require Omega.
+V7only [Import Z_scope.].
+Open Local Scope Z_scope.
+
+(** Well-founded relations on Z. *)
+
+(** We define the following family of relations on [Z x Z]: 
+
+    [x (Zwf c) y]   iff   [x < y & c <= y]
+ *)
+
+Definition Zwf := [c:Z][x,y:Z] `c <= y` /\ `x < y`.
+
+(** and we prove that [(Zwf c)] is well founded *)
+
+Section wf_proof.
+
+Variable c : Z.
+
+(** The proof of well-foundness is classic: we do the proof by induction
+    on a measure in nat, which is here [|x-c|] *)
+
+Local f := [z:Z](absolu (Zminus z c)).
+
+Lemma Zwf_well_founded : (well_founded Z (Zwf c)).
+Red; Intros.
+Assert (n:nat)(a:Z)(lt (f a) n)\/(`a<c`) -> (Acc Z (Zwf c) a).
+Clear a; Induction n; Intros.
+(** n= 0 *)
+Case H; Intros.
+Case (lt_n_O (f a)); Auto.
+Apply Acc_intro; Unfold Zwf; Intros.
+Assert False;Omega Orelse 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.
+Left.
+Red in H0.
+Apply lt_le_trans with (f a); Auto with arith.
+Unfold f.
+Apply absolu_lt; Omega.
+Apply (H (S (f a))); Auto.
+Save.
+
+End wf_proof.
+
+Hints Resolve Zwf_well_founded : datatypes v62.
+
+
+(** We also define the other family of relations:
+
+    [x (Zwf_up c) y]   iff   [y < x <= c]
+ *)
+
+Definition Zwf_up := [c:Z][x,y:Z] `y < x <= c`.
+
+(** and we prove that [(Zwf_up c)] is well founded *)
+
+Section wf_proof_up.
+
+Variable c : Z.
+
+(** The proof of well-foundness is classic: we do the proof by induction
+    on a measure in nat, which is here [|c-x|] *)
+
+Local f := [z:Z](absolu (Zminus c z)).
+
+Lemma Zwf_up_well_founded : (well_founded Z (Zwf_up c)).
+Proof.
+Apply well_founded_lt_compat with f:=f.
+Unfold Zwf_up f.
+Intros.
+Apply absolu_lt.
+Unfold Zminus. Split.
+Apply Zle_left; Intuition.
+Apply Zlt_reg_l; Unfold Zlt; Rewrite <- Zcompare_Zopp; Intuition.
+Save.
+
+End wf_proof_up.
+
+Hints Resolve Zwf_up_well_founded : datatypes v62.
diff --git a/theories7/ZArith/auxiliary.v b/theories7/ZArith/auxiliary.v
new file mode 100644
index 00000000..8db2c852
--- /dev/null
+++ b/theories7/ZArith/auxiliary.v
@@ -0,0 +1,219 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: auxiliary.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+
+Require Export Arith.
+Require BinInt.
+Require Zorder.
+Require Decidable.
+Require Peano_dec.
+Require Export Compare_dec.
+
+Open Local Scope Z_scope.
+
+(**********************************************************************)
+(** Moving terms from one side to the other of an inequality *)
+
+Theorem Zne_left : (x,y:Z) (Zne x y) -> (Zne (Zplus x (Zopp y)) ZERO).
+Proof.
+Intros x y; Unfold Zne; Unfold not; Intros H1 H2; Apply H1;
+Apply Zsimpl_plus_l with (Zopp y); Rewrite Zplus_inverse_l; Rewrite Zplus_sym;
+Trivial with arith.
+Qed.
+
+Theorem Zegal_left : (x,y:Z) (x=y) -> (Zplus x (Zopp y)) = ZERO.
+Proof.
+Intros x y H;
+Apply (Zsimpl_plus_l y);Rewrite -> Zplus_permute;
+Rewrite -> Zplus_inverse_r;Do 2 Rewrite -> Zero_right;Assumption.
+Qed.
+
+Theorem Zle_left : (x,y:Z) (Zle x y) -> (Zle ZERO (Zplus y (Zopp x))).
+Proof.
+Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
+Apply Zle_reg_r; Trivial.
+Apply Zplus_inverse_r.
+Qed.
+
+Theorem Zle_left_rev : (x,y:Z) (Zle ZERO (Zplus y (Zopp x))) 
+	-> (Zle x y).
+Proof.
+Intros x y H; Apply Zsimpl_le_plus_r with (Zopp x).
+Rewrite Zplus_inverse_r; Trivial.
+Qed.
+
+Theorem Zlt_left_rev : (x,y:Z) (Zlt ZERO (Zplus y (Zopp x))) 
+	-> (Zlt x y).
+Proof.
+Intros x y H; Apply Zsimpl_lt_plus_r with (Zopp x).
+Rewrite Zplus_inverse_r; Trivial.
+Qed.
+
+Theorem Zlt_left :
+  (x,y:Z) (Zlt x y) -> (Zle ZERO (Zplus (Zplus y (NEG xH)) (Zopp x))).
+Proof.
+Intros x y H; Apply Zle_left; Apply Zle_S_n; 
+Change (Zle (Zs x) (Zs (Zpred y))); Rewrite <- Zs_pred; Apply Zlt_le_S;
+Assumption.
+Qed.
+
+Theorem Zlt_left_lt :
+  (x,y:Z) (Zlt x y) -> (Zlt ZERO (Zplus y (Zopp x))).
+Proof.
+Intros x y H; Replace ZERO with (Zplus x (Zopp x)).
+Apply Zlt_reg_r; Trivial.
+Apply Zplus_inverse_r.
+Qed.
+
+Theorem Zge_left : (x,y:Z) (Zge x y) -> (Zle ZERO (Zplus x (Zopp y))).
+Proof.
+Intros x y H; Apply Zle_left; Apply Zge_le; Assumption.
+Qed.
+
+Theorem Zgt_left :
+  (x,y:Z) (Zgt x y) -> (Zle ZERO (Zplus (Zplus x (NEG xH)) (Zopp y))).
+Proof.
+Intros x y H; Apply Zlt_left; Apply Zgt_lt; Assumption.
+Qed.
+
+Theorem Zgt_left_gt :
+  (x,y:Z) (Zgt x y) -> (Zgt (Zplus x (Zopp y)) ZERO).
+Proof.
+Intros x y H; Replace ZERO with (Zplus y (Zopp y)).
+Apply Zgt_reg_r; Trivial.
+Apply Zplus_inverse_r.
+Qed.
+
+Theorem Zgt_left_rev : (x,y:Z) (Zgt (Zplus x (Zopp y)) ZERO) 
+	-> (Zgt x y).
+Proof.
+Intros x y H; Apply Zsimpl_gt_plus_r with (Zopp y).
+Rewrite Zplus_inverse_r; Trivial.
+Qed.
+
+(**********************************************************************)
+(** Factorization lemmas *)
+
+Theorem Zred_factor0 : (x:Z) x = (Zmult x (POS xH)).
+Intro x; Rewrite (Zmult_n_1 x); Reflexivity.
+Qed.
+
+Theorem Zred_factor1 : (x:Z) (Zplus x x) = (Zmult x (POS (xO xH))).
+Proof.
+Exact Zplus_Zmult_2.
+Qed.
+
+Theorem Zred_factor2 :
+  (x,y:Z) (Zplus x (Zmult x y)) = (Zmult x (Zplus (POS xH) y)).
+
+Intros x y; Pattern 1 x ; Rewrite <- (Zmult_n_1 x);
+Rewrite <- Zmult_plus_distr_r; Trivial with arith.
+Qed.
+
+Theorem Zred_factor3 :
+  (x,y:Z) (Zplus (Zmult x y) x) = (Zmult x (Zplus (POS xH) y)).
+
+Intros x y; Pattern 2 x ; Rewrite <- (Zmult_n_1 x);
+Rewrite <- Zmult_plus_distr_r; Rewrite Zplus_sym; Trivial with arith.
+Qed.
+Theorem Zred_factor4 :
+  (x,y,z:Z) (Zplus (Zmult x y) (Zmult x z)) = (Zmult x (Zplus y z)).
+Intros x y z; Symmetry; Apply Zmult_plus_distr_r.
+Qed.
+
+Theorem Zred_factor5 : (x,y:Z) (Zplus (Zmult x ZERO) y) = y.
+
+Intros x y; Rewrite <- Zmult_n_O;Auto with arith.
+Qed.
+
+Theorem Zred_factor6 : (x:Z) x = (Zplus x ZERO).
+
+Intro; Rewrite Zero_right; Trivial with arith.
+Qed.
+
+Theorem Zle_mult_approx:
+  (x,y,z:Z) (Zgt x ZERO) -> (Zgt z ZERO) -> (Zle ZERO y) -> 
+    (Zle ZERO (Zplus (Zmult y x) z)).
+
+Intros x y z H1 H2 H3; Apply Zle_trans with m:=(Zmult y x) ; [
+  Apply Zle_mult; Assumption
+| Pattern 1 (Zmult y x) ; Rewrite <- Zero_right; Apply Zle_reg_l;
+  Apply Zlt_le_weak; Apply Zgt_lt; Assumption].
+Qed.
+
+Theorem Zmult_le_approx:
+  (x,y,z:Z) (Zgt x ZERO) -> (Zgt x z) -> 
+    (Zle ZERO (Zplus (Zmult y x) z)) -> (Zle ZERO y).
+
+Intros x y z H1 H2 H3; Apply Zlt_n_Sm_le; Apply Zmult_lt with x; [
+  Assumption
+  | Apply Zle_lt_trans with 1:=H3 ; Rewrite <- Zmult_Sm_n;
+    Apply Zlt_reg_l; Apply Zgt_lt; Assumption].
+
+Qed.
+
+V7only [
+(* Compatibility *)
+Require Znat.
+Require Zcompare.
+Notation neq := neq.
+Notation Zne := Zne.
+Notation OMEGA2 := Zle_0_plus.
+Notation add_un_Zs := add_un_Zs.
+Notation inj_S := inj_S.
+Notation Zplus_S_n := Zplus_S_n.
+Notation inj_plus := inj_plus.
+Notation inj_mult := inj_mult.
+Notation inj_neq := inj_neq.
+Notation inj_le := inj_le.
+Notation inj_lt := inj_lt.
+Notation inj_gt := inj_gt.
+Notation inj_ge := inj_ge.
+Notation inj_eq := inj_eq.
+Notation intro_Z := intro_Z.
+Notation inj_minus1 := inj_minus1.
+Notation inj_minus2 := inj_minus2.
+Notation dec_eq := dec_eq.
+Notation dec_Zne := dec_Zne.
+Notation dec_Zle := dec_Zle.
+Notation dec_Zgt := dec_Zgt.
+Notation dec_Zge := dec_Zge.
+Notation dec_Zlt := dec_Zlt.
+Notation dec_eq_nat := dec_eq_nat.
+Notation not_Zge := not_Zge.
+Notation not_Zlt := not_Zlt.
+Notation not_Zle := not_Zle.
+Notation not_Zgt := not_Zgt.
+Notation not_Zeq := not_Zeq.
+Notation Zopp_one := Zopp_one.
+Notation Zopp_Zmult_r := Zopp_Zmult_r.
+Notation Zmult_Zopp_left := Zmult_Zopp_left.
+Notation Zopp_Zmult_l := Zopp_Zmult_l.
+Notation Zcompare_Zplus_compatible2 := Zcompare_Zplus_compatible2.
+Notation Zcompare_Zmult_compatible := Zcompare_Zmult_compatible.
+Notation Zmult_eq := Zmult_eq.
+Notation Z_eq_mult := Z_eq_mult.
+Notation Zmult_le := Zmult_le.
+Notation Zle_ZERO_mult := Zle_ZERO_mult.
+Notation Zgt_ZERO_mult := Zgt_ZERO_mult.
+Notation Zle_mult := Zle_mult.
+Notation Zmult_lt := Zmult_lt.
+Notation Zmult_gt := Zmult_gt.
+Notation Zle_Zmult_pos_right := Zle_Zmult_pos_right.
+Notation Zle_Zmult_pos_left := Zle_Zmult_pos_left.
+Notation Zge_Zmult_pos_right := Zge_Zmult_pos_right.
+Notation Zge_Zmult_pos_left := Zge_Zmult_pos_left.
+Notation Zge_Zmult_pos_compat := Zge_Zmult_pos_compat.
+Notation Zle_mult_simpl := Zle_mult_simpl.
+Notation Zge_mult_simpl := Zge_mult_simpl.
+Notation Zgt_mult_simpl := Zgt_mult_simpl.
+Notation Zgt_square_simpl := Zgt_square_simpl.
+].
diff --git a/theories7/ZArith/fast_integer.v b/theories7/ZArith/fast_integer.v
new file mode 100644
index 00000000..7e3fe306
--- /dev/null
+++ b/theories7/ZArith/fast_integer.v
@@ -0,0 +1,191 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(*i $Id: fast_integer.v,v 1.1.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+(***********************************************************)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(***********************************************************)
+
+Require BinPos.
+Require BinNat.
+Require BinInt.
+Require Zcompare.
+Require Mult.
+
+V7only [
+(* Defs and ppties on positive, entier and Z, previously in fast_integer *)
+(* For v7 compatibility *)
+Notation positive := positive.
+Notation xO := xO.
+Notation xI := xI.
+Notation xH := xH.
+Notation add_un := add_un.
+Notation add := add.
+Notation convert := convert.
+Notation convert_add_un := convert_add_un.
+Notation cvt_carry := cvt_carry.
+Notation convert_add := convert_add.
+Notation positive_to_nat := positive_to_nat.
+Notation anti_convert := anti_convert.
+Notation double_moins_un := double_moins_un.
+Notation sub_un := sub_un.
+Notation positive_mask := positive_mask.
+Notation Un_suivi_de_mask := Un_suivi_de_mask.
+Notation Zero_suivi_de_mask := Zero_suivi_de_mask.
+Notation double_moins_deux := double_moins_deux.
+Notation sub_pos := sub_pos.
+Notation true_sub := true_sub.
+Notation times := times.
+Notation relation := relation.
+Notation SUPERIEUR := SUPERIEUR.
+Notation INFERIEUR := INFERIEUR.
+Notation EGAL := EGAL.
+Notation Op := Op.
+Notation compare := compare.
+Notation compare_convert1 := compare_convert1.
+Notation compare_convert_EGAL := compare_convert_EGAL.
+Notation ZLSI := ZLSI.
+Notation ZLIS := ZLIS.
+Notation ZLII := ZLII.
+Notation ZLSS := ZLSS.
+Notation Dcompare := Dcompare.
+Notation convert_compare_EGAL := convert_compare_EGAL.
+Notation ZL0 := ZL0.
+Notation ZL11 := ZL11.
+Notation xI_add_un_xO := xI_add_un_xO.
+Notation is_double_moins_un := is_double_moins_un.
+Notation double_moins_un_add_un_xI := double_moins_un_add_un_xI.
+Notation ZL1 := ZL1.
+Notation add_un_not_un := add_un_not_un.
+Notation sub_add_one := sub_add_one.
+Notation add_sub_one := add_sub_one.
+Notation add_un_inj := add_un_inj.
+Notation ZL12 := ZL12.
+Notation ZL12bis := ZL12bis.
+Notation ZL13 := ZL13.
+Notation add_sym := add_sym.
+Notation ZL14 := ZL14.
+Notation ZL14bis := ZL14bis.
+Notation ZL15 := ZL15.
+Notation add_no_neutral := add_no_neutral.
+Notation add_carry_not_add_un := add_carry_not_add_un.
+Notation add_carry_add := add_carry_add.
+Notation simpl_add_r := simpl_add_r.
+Notation simpl_add_carry_r := simpl_add_carry_r.
+Notation simpl_add_l := simpl_add_l.
+Notation simpl_add_carry_l := simpl_add_carry_l.
+Notation add_assoc := add_assoc.
+Notation add_xI_double_moins_un := add_xI_double_moins_un.
+Notation add_x_x := add_x_x.
+Notation ZS := ZS.
+Notation US := US.
+Notation USH := USH.
+Notation ZSH := ZSH.
+Notation sub_pos_x_x := sub_pos_x_x.
+Notation ZL10 := ZL10.
+Notation sub_pos_SUPERIEUR := sub_pos_SUPERIEUR.
+Notation sub_add := sub_add.
+Notation convert_add_carry := convert_add_carry.
+Notation add_verif := add_verif.
+Notation ZL2 := ZL2.
+Notation ZL6 := ZL6.
+Notation positive_to_nat_mult := positive_to_nat_mult.
+Notation times_convert := times_convert.
+Notation compare_positive_to_nat_O := compare_positive_to_nat_O.
+Notation compare_convert_O := compare_convert_O.
+Notation convert_xH := convert_xH.
+Notation convert_xO := convert_xO.
+Notation convert_xI := convert_xI.
+Notation bij1 := bij1.
+Notation ZL3 := ZL3.
+Notation ZL4 := ZL4.
+Notation ZL5 := ZL5.
+Notation bij2 := bij2.
+Notation bij3 := bij3.
+Notation ZL7 := ZL7.
+Notation ZL8 := ZL8.
+Notation compare_convert_INFERIEUR := compare_convert_INFERIEUR.
+Notation compare_convert_SUPERIEUR := compare_convert_SUPERIEUR.
+Notation convert_compare_INFERIEUR := convert_compare_INFERIEUR.
+Notation convert_compare_SUPERIEUR := convert_compare_SUPERIEUR.
+Notation ZC1 := ZC1.
+Notation ZC2 := ZC2.
+Notation ZC3 := ZC3.
+Notation ZC4 := ZC4.
+Notation true_sub_convert := true_sub_convert.
+Notation convert_intro := convert_intro.
+Notation ZL16 := ZL16.
+Notation ZL17 := ZL17.
+Notation compare_true_sub_right := compare_true_sub_right.
+Notation compare_true_sub_left := compare_true_sub_left.
+Notation times_x_ := times_x_1.
+Notation times_x_double := times_x_double.
+Notation times_x_double_plus_one := times_x_double_plus_one.
+Notation times_sym := times_sym.
+Notation times_add_distr := times_add_distr.
+Notation times_add_distr_l := times_add_distr_l.
+Notation times_assoc := times_assoc.
+Notation times_true_sub_distr := times_true_sub_distr.
+Notation times_discr_xO_xI := times_discr_xO_xI.
+Notation times_discr_xO := times_discr_xO.
+Notation simpl_times_r := simpl_times_r.
+Notation simpl_times_l := simpl_times_l.
+Notation iterate_add := iterate_add.
+Notation entier := entier.
+Notation Nul := Nul.
+Notation Pos := Pos.
+Notation Un_suivi_de := Un_suivi_de.
+Notation Zero_suivi_de := Zero_suivi_de.
+Notation times1 :=
+    [x:positive;_:positive->positive;y:positive](times x y).
+Notation times1_convert :=
+    [x,y:positive;_:positive->positive](times_convert x y).
+
+Notation Z := Z.
+Notation POS := POS.
+Notation NEG := NEG.
+Notation ZERO := ZERO.
+Notation Zero_left := Zero_left.
+Notation Zopp_Zopp := Zopp_Zopp.
+Notation Zero_right := Zero_right.
+Notation Zplus_inverse_r := Zplus_inverse_r.
+Notation Zopp_Zplus := Zopp_Zplus.
+Notation Zplus_sym := Zplus_sym.
+Notation Zplus_inverse_l := Zplus_inverse_l.
+Notation Zopp_intro := Zopp_intro.
+Notation Zopp_NEG := Zopp_NEG.
+Notation weak_assoc := weak_assoc.
+Notation Zplus_assoc := Zplus_assoc.
+Notation Zplus_simpl := Zplus_simpl.
+Notation Zmult_sym := Zmult_sym.
+Notation Zmult_assoc := Zmult_assoc.
+Notation Zmult_one := Zmult_one.
+Notation lt_mult_left := lt_mult_left. (* Mult*)
+Notation Zero_mult_left := Zero_mult_left.
+Notation Zero_mult_right := Zero_mult_right.
+Notation Zopp_Zmult := Zopp_Zmult.
+Notation Zmult_Zopp_Zopp := Zmult_Zopp_Zopp.
+Notation weak_Zmult_plus_distr_r := weak_Zmult_plus_distr_r.
+Notation Zmult_plus_distr_r := Zmult_plus_distr_r.
+Notation Zcompare_EGAL := Zcompare_EGAL.
+Notation Zcompare_ANTISYM := Zcompare_ANTISYM.
+Notation le_minus := le_minus.
+Notation Zcompare_Zopp := Zcompare_Zopp.
+Notation weaken_Zcompare_Zplus_compatible := weaken_Zcompare_Zplus_compatible.
+Notation weak_Zcompare_Zplus_compatible := weak_Zcompare_Zplus_compatible.
+Notation Zcompare_Zplus_compatible := Zcompare_Zplus_compatible.
+Notation Zcompare_trans_SUPERIEUR := Zcompare_trans_SUPERIEUR.
+Notation SUPERIEUR_POS := SUPERIEUR_POS.
+Export Datatypes.
+Export BinPos.
+Export BinNat.
+Export BinInt.
+Export Zcompare.
+Export Mult.
+].
diff --git a/theories7/ZArith/zarith_aux.v b/theories7/ZArith/zarith_aux.v
new file mode 100644
index 00000000..cd67d46b
--- /dev/null
+++ b/theories7/ZArith/zarith_aux.v
@@ -0,0 +1,163 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+(*i $Id: zarith_aux.v,v 1.2.2.1 2004/07/16 19:31:44 herbelin Exp $ i*)
+
+Require Export BinInt.
+Require Export Zcompare.
+Require Export Zorder.
+Require Export Zmin.
+Require Export Zabs.
+
+V7only [
+Notation Zlt := Zlt.
+Notation Zgt := Zgt.
+Notation Zle := Zle.
+Notation Zge := Zge.
+Notation Zsgn := Zsgn.
+Notation absolu := absolu.
+Notation Zabs := Zabs.
+Notation Zabs_eq := Zabs_eq.
+Notation Zabs_non_eq := Zabs_non_eq.
+Notation Zabs_dec := Zabs_dec.
+Notation Zabs_pos := Zabs_pos.
+Notation Zsgn_Zabs := Zsgn_Zabs.
+Notation Zabs_Zsgn := Zabs_Zsgn.
+Notation inject_nat := inject_nat.
+Notation Zs := Zs.
+Notation Zpred := Zpred.
+Notation Zgt_Sn_n := Zgt_Sn_n.
+Notation Zle_gt_trans := Zle_gt_trans.
+Notation Zgt_le_trans := Zgt_le_trans.
+Notation Zle_S_gt := Zle_S_gt.
+Notation Zcompare_n_S := Zcompare_n_S.
+Notation Zgt_n_S := Zgt_n_S.
+Notation Zle_not_gt := Zle_not_gt.
+Notation Zgt_antirefl := Zgt_antirefl.
+Notation Zgt_not_sym := Zgt_not_sym.
+Notation Zgt_not_le := Zgt_not_le.
+Notation Zgt_trans := Zgt_trans.
+Notation Zle_gt_S := Zle_gt_S.
+Notation Zgt_pred := Zgt_pred.       
+Notation Zsimpl_gt_plus_l := Zsimpl_gt_plus_l. 
+Notation Zsimpl_gt_plus_r := Zsimpl_gt_plus_r.
+Notation Zgt_reg_l := Zgt_reg_l.      
+Notation Zgt_reg_r := Zgt_reg_r.
+Notation Zcompare_et_un := Zcompare_et_un.
+Notation Zgt_S_n := Zgt_S_n.
+Notation Zle_S_n := Zle_S_n.
+Notation Zgt_le_S := Zgt_le_S.
+Notation Zgt_S_le := Zgt_S_le.
+Notation Zgt_S := Zgt_S.
+Notation Zgt_trans_S := Zgt_trans_S.
+Notation Zeq_S := Zeq_S.
+Notation Zpred_Sn := Zpred_Sn.
+Notation Zeq_add_S := Zeq_add_S.
+Notation Znot_eq_S := Znot_eq_S.
+Notation Zsimpl_plus_l := Zsimpl_plus_l.
+Notation Zn_Sn := Zn_Sn.
+Notation Zplus_n_O := Zplus_n_O.
+Notation Zplus_unit_left := Zplus_unit_left.
+Notation Zplus_unit_right := Zplus_unit_right.
+Notation Zplus_n_Sm := Zplus_n_Sm.
+Notation Zmult_n_O := Zmult_n_O.
+Notation Zmult_n_Sm := Zmult_n_Sm.
+Notation Zle_n := Zle_n.
+Notation Zle_refl := Zle_refl.
+Notation Zle_trans := Zle_trans.
+Notation Zle_n_Sn := Zle_n_Sn.
+Notation Zle_n_S := Zle_n_S.
+Notation Zs_pred := Zs_pred. (* BinInt *)
+Notation Zle_pred_n := Zle_pred_n.
+Notation Zle_trans_S := Zle_trans_S.
+Notation Zle_Sn_n := Zle_Sn_n.
+Notation Zle_antisym := Zle_antisym.
+Notation Zgt_lt := Zgt_lt.
+Notation Zlt_gt := Zlt_gt.
+Notation Zge_le := Zge_le.
+Notation Zle_ge := Zle_ge.
+Notation Zge_trans := Zge_trans.
+Notation Zlt_n_Sn := Zlt_n_Sn.
+Notation Zlt_S := Zlt_S.
+Notation Zlt_n_S := Zlt_n_S.
+Notation Zlt_S_n := Zlt_S_n.
+Notation Zlt_n_n := Zlt_n_n.
+Notation Zlt_pred := Zlt_pred.
+Notation Zlt_pred_n_n := Zlt_pred_n_n.
+Notation Zlt_le_S := Zlt_le_S.
+Notation Zlt_n_Sm_le := Zlt_n_Sm_le.
+Notation Zle_lt_n_Sm := Zle_lt_n_Sm.
+Notation Zlt_le_weak := Zlt_le_weak.
+Notation Zlt_trans := Zlt_trans.
+Notation Zlt_le_trans := Zlt_le_trans.
+Notation Zle_lt_trans := Zle_lt_trans.
+Notation Zle_lt_or_eq := Zle_lt_or_eq.
+Notation Zle_or_lt := Zle_or_lt.
+Notation Zle_not_lt := Zle_not_lt.
+Notation Zlt_not_le := Zlt_not_le.
+Notation Zlt_not_sym := Zlt_not_sym.
+Notation Zle_le_S := Zle_le_S.
+Notation Zmin := Zmin.
+Notation Zmin_SS := Zmin_SS.
+Notation Zle_min_l := Zle_min_l.
+Notation Zle_min_r := Zle_min_r.
+Notation Zmin_case := Zmin_case.
+Notation Zmin_or := Zmin_or.
+Notation Zmin_n_n := Zmin_n_n.
+Notation Zplus_assoc_l := Zplus_assoc_l.
+Notation Zplus_assoc_r := Zplus_assoc_r.
+Notation Zplus_permute := Zplus_permute.
+Notation Zsimpl_le_plus_l := Zsimpl_le_plus_l.
+Notation "'Zsimpl_le_plus_l' c" := [a,b:Z](Zsimpl_le_plus_l a b c)
+  (at level 10, c at next level).
+Notation "'Zsimpl_le_plus_l' c a" := [b:Z](Zsimpl_le_plus_l a b c)
+  (at level 10, a, c at next level).
+Notation "'Zsimpl_le_plus_l' c a b" := (Zsimpl_le_plus_l a b c)
+  (at level 10, a, b, c at next level).
+Notation Zsimpl_le_plus_r := Zsimpl_le_plus_r.
+Notation "'Zsimpl_le_plus_r' c" := [a,b:Z](Zsimpl_le_plus_r a b c)
+  (at level 10, c at next level).
+Notation "'Zsimpl_le_plus_r' c a" := [b:Z](Zsimpl_le_plus_r a b c)
+  (at level 10, a, c at next level).
+Notation "'Zsimpl_le_plus_r' c a b" := (Zsimpl_le_plus_r a b c)
+  (at level 10, a, b, c at next level).
+Notation Zle_reg_l := Zle_reg_l.
+Notation Zle_reg_r := Zle_reg_r.
+Notation Zle_plus_plus := Zle_plus_plus.
+Notation Zplus_Snm_nSm := Zplus_Snm_nSm.
+Notation Zsimpl_lt_plus_l := Zsimpl_lt_plus_l. 
+Notation Zsimpl_lt_plus_r := Zsimpl_lt_plus_r.
+Notation Zlt_reg_l := Zlt_reg_l.
+Notation Zlt_reg_r := Zlt_reg_r.
+Notation Zlt_le_reg := Zlt_le_reg.
+Notation Zle_lt_reg := Zle_lt_reg.
+Notation Zminus := Zminus.
+Notation Zminus_plus_simpl := Zminus_plus_simpl.
+Notation Zminus_n_O := Zminus_n_O.
+Notation Zminus_n_n := Zminus_n_n.
+Notation Zplus_minus := Zplus_minus.
+Notation Zminus_plus := Zminus_plus.
+Notation Zle_plus_minus := Zle_plus_minus.
+Notation Zminus_Sn_m := Zminus_Sn_m.
+Notation Zlt_minus := Zlt_minus.
+Notation Zlt_O_minus_lt := Zlt_O_minus_lt.
+Notation Zmult_plus_distr_l := Zmult_plus_distr_l.
+Notation Zmult_plus_distr := BinInt.Zmult_plus_distr_l.
+Notation Zmult_minus_distr := Zmult_minus_distr.
+Notation Zmult_assoc_r := Zmult_assoc_r.
+Notation Zmult_assoc_l := Zmult_assoc_l.
+Notation Zmult_permute := Zmult_permute.
+Notation Zmult_1_n := Zmult_1_n.
+Notation Zmult_n_1 := Zmult_n_1.
+Notation Zmult_Sm_n := Zmult_Sm_n.
+Notation Zmult_Zplus_distr := Zmult_plus_distr_r.
+Export BinInt.
+Export Zorder.
+Export Zmin.
+Export Zabs.
+Export Zcompare.
+].