Imported Upstream version 8.1~gammaupstream/8.1.gamma

512 files changed, 60224 insertions, 45879 deletions

diff --git a/.depend b/.depend
index f762207f..6c36e157 100644
--- a/.depend
+++ b/.depend
@@ -77,10 +77,11 @@ kernel/term_typing.cmi: kernel/univ.cmi kernel/typeops.cmi kernel/term.cmi \
     kernel/entries.cmi kernel/declarations.cmi kernel/cooking.cmi 
 kernel/type_errors.cmi: kernel/term.cmi kernel/names.cmi kernel/environ.cmi 
 kernel/typeops.cmi: kernel/univ.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/names.cmi kernel/environ.cmi kernel/entries.cmi 
+    kernel/names.cmi kernel/environ.cmi kernel/entries.cmi \
+    kernel/declarations.cmi 
 kernel/univ.cmi: lib/pp.cmi kernel/names.cmi 
-kernel/vconv.cmi: kernel/vm.cmi kernel/term.cmi kernel/reduction.cmi \
-    kernel/names.cmi kernel/environ.cmi 
+kernel/vconv.cmi: kernel/term.cmi kernel/reduction.cmi kernel/names.cmi \
+    kernel/environ.cmi 
 kernel/vm.cmi: kernel/term.cmi kernel/names.cmi kernel/cemitcodes.cmi \
     kernel/cbytecodes.cmi 
 lib/bigint.cmi: lib/pp.cmi 
@@ -129,11 +130,12 @@ parsing/lexer.cmi: lib/util.cmi lib/pp.cmi
 parsing/pcoq.cmi: toplevel/vernacexpr.cmo lib/util.cmi interp/topconstr.cmi \
     proofs/tacexpr.cmo pretyping/rawterm.cmi kernel/names.cmi \
     library/libnames.cmi interp/genarg.cmi parsing/extend.cmi \
-    library/decl_kinds.cmo lib/bigint.cmi 
+    library/decl_kinds.cmo proofs/decl_expr.cmi lib/bigint.cmi 
 parsing/ppconstr.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
     proofs/tacexpr.cmo pretyping/rawterm.cmi interp/ppextend.cmi lib/pp.cmi \
     parsing/pcoq.cmi kernel/names.cmi library/libnames.cmi interp/genarg.cmi \
     kernel/environ.cmi 
+parsing/ppdecl_proof.cmi: lib/pp.cmi kernel/environ.cmi proofs/decl_expr.cmi 
 parsing/pptactic.cmi: interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi proofs/proof_type.cmi pretyping/pretyping.cmi \
     interp/ppextend.cmi lib/pp.cmi library/libnames.cmi interp/genarg.cmi \
@@ -183,7 +185,7 @@ pretyping/evarutil.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
     kernel/names.cmi pretyping/evd.cmi kernel/environ.cmi 
 pretyping/evd.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
     kernel/reduction.cmi lib/pp.cmi kernel/names.cmi kernel/mod_subst.cmi \
-    library/libnames.cmi kernel/environ.cmi 
+    library/libnames.cmi kernel/environ.cmi lib/dyn.cmi 
 pretyping/indrec.cmi: kernel/term.cmi kernel/names.cmi \
     pretyping/inductiveops.cmi pretyping/evd.cmi kernel/environ.cmi \
     kernel/declarations.cmi 
@@ -222,9 +224,17 @@ pretyping/termops.cmi: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
 pretyping/typing.cmi: kernel/term.cmi pretyping/evd.cmi kernel/environ.cmi 
 pretyping/unification.cmi: kernel/term.cmi pretyping/evd.cmi \
     kernel/environ.cmi 
+pretyping/vnorm.cmi: kernel/term.cmi kernel/reduction.cmi kernel/names.cmi \
+    kernel/environ.cmi 
 proofs/clenvtac.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
     proofs/proof_type.cmi kernel/names.cmi pretyping/evd.cmi \
     pretyping/clenv.cmi 
+proofs/decl_expr.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
+    proofs/tacexpr.cmo pretyping/rawterm.cmi kernel/names.cmi \
+    interp/genarg.cmi 
+proofs/decl_mode.cmi: kernel/term.cmi proofs/tacmach.cmi \
+    proofs/proof_type.cmi kernel/names.cmi pretyping/evd.cmi lib/dyn.cmi \
+    proofs/decl_expr.cmi 
 proofs/evar_refiner.cmi: interp/topconstr.cmi kernel/term.cmi \
     proofs/refiner.cmi pretyping/rawterm.cmi kernel/names.cmi \
     pretyping/evd.cmi kernel/environ.cmi 
@@ -236,11 +246,11 @@ proofs/pfedit.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
     library/decl_kinds.cmo 
 proofs/proof_trees.cmi: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
     proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi pretyping/evd.cmi \
-    kernel/environ.cmi 
+    kernel/environ.cmi lib/dyn.cmi 
 proofs/proof_type.cmi: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \
     kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \
-    kernel/environ.cmi 
+    kernel/environ.cmi proofs/decl_expr.cmi 
 proofs/redexpr.cmi: kernel/term.cmi pretyping/reductionops.cmi \
     pretyping/rawterm.cmi kernel/names.cmi kernel/closure.cmi 
 proofs/refiner.cmi: pretyping/termops.cmi kernel/term.cmi proofs/tacexpr.cmo \
@@ -260,11 +270,18 @@ tactics/auto.cmi: toplevel/vernacexpr.cmo lib/util.cmi kernel/term.cmi \
     pretyping/pattern.cmi kernel/names.cmi kernel/mod_subst.cmi \
     library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi \
     pretyping/clenv.cmi tactics/btermdn.cmi 
-tactics/autorewrite.cmi: kernel/term.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo kernel/names.cmi 
+tactics/autorewrite.cmi: kernel/term.cmi tactics/tacticals.cmi \
+    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/names.cmi 
 tactics/btermdn.cmi: kernel/term.cmi pretyping/pattern.cmi 
 tactics/contradiction.cmi: kernel/term.cmi pretyping/rawterm.cmi \
     proofs/proof_type.cmi kernel/names.cmi 
+tactics/decl_interp.cmi: tactics/tacinterp.cmi kernel/mod_subst.cmi \
+    pretyping/evd.cmi kernel/environ.cmi proofs/decl_mode.cmi \
+    proofs/decl_expr.cmi 
+tactics/decl_proof_instr.cmi: kernel/term.cmi proofs/tacmach.cmi \
+    proofs/refiner.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
+    kernel/names.cmi kernel/environ.cmi proofs/decl_mode.cmi \
+    proofs/decl_expr.cmi 
 tactics/dhyp.cmi: toplevel/vernacexpr.cmo interp/topconstr.cmi \
     proofs/tacmach.cmi proofs/tacexpr.cmo kernel/names.cmi 
 tactics/eauto.cmi: interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \
@@ -276,15 +293,16 @@ tactics/equality.cmi: kernel/term.cmi tactics/tactics.cmi \
     tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
     kernel/sign.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
     pretyping/pattern.cmi kernel/names.cmi tactics/hipattern.cmi \
-    pretyping/evd.cmi kernel/environ.cmi 
+    interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi 
 tactics/evar_tactics.cmi: kernel/term.cmi proofs/tacmach.cmi \
     proofs/tacexpr.cmo pretyping/rawterm.cmi kernel/names.cmi 
 tactics/extraargs.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tacexpr.cmo tactics/setoid_replace.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi parsing/pcoq.cmi kernel/names.cmi 
+    tactics/tacticals.cmi proofs/tacexpr.cmo tactics/setoid_replace.cmi \
+    pretyping/rawterm.cmi proofs/proof_type.cmi parsing/pcoq.cmi \
+    kernel/names.cmi 
 tactics/extratactics.cmi: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
     proofs/tacexpr.cmo pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/pcoq.cmi kernel/names.cmi interp/genarg.cmi 
+    kernel/names.cmi interp/genarg.cmi 
 tactics/hiddentac.cmi: kernel/term.cmi tactics/tacticals.cmi \
     proofs/tacmach.cmi proofs/tacexpr.cmo proofs/redexpr.cmi \
     pretyping/rawterm.cmi proofs/proof_type.cmi kernel/names.cmi \
@@ -358,7 +376,8 @@ toplevel/whelp.cmi: interp/topconstr.cmi kernel/term.cmi kernel/names.cmi \
     kernel/environ.cmi 
 contrib/cc/ccalgo.cmi: lib/util.cmi kernel/term.cmi lib/pp.cmi \
     kernel/names.cmi 
-contrib/cc/ccproof.cmi: kernel/names.cmi contrib/cc/ccalgo.cmi 
+contrib/cc/ccproof.cmi: kernel/term.cmi kernel/names.cmi \
+    contrib/cc/ccalgo.cmi 
 contrib/cc/cctac.cmi: kernel/term.cmi proofs/proof_type.cmi 
 contrib/correctness/past.cmi: lib/util.cmi interp/topconstr.cmi \
     kernel/term.cmi kernel/names.cmi 
@@ -483,14 +502,15 @@ contrib/subtac/subtac_errors.cmi: lib/util.cmi lib/pp.cmi
 contrib/subtac/subtac_interp_fixpoint.cmi: lib/util.cmi interp/topconstr.cmi \
     lib/pp.cmi kernel/names.cmi library/libnames.cmi 
 contrib/subtac/subtac.cmi: toplevel/vernacexpr.cmo lib/util.cmi 
+contrib/subtac/subtac_obligations.cmi: kernel/term.cmi kernel/names.cmi 
 contrib/subtac/subtac_pretyping.cmi: interp/topconstr.cmi kernel/term.cmi \
     kernel/sign.cmi pretyping/pretyping.cmi kernel/names.cmi \
     library/global.cmi pretyping/evd.cmi kernel/environ.cmi 
 contrib/subtac/subtac_utils.cmi: lib/util.cmi interp/topconstr.cmi \
-    kernel/term.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \
-    proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi library/libnames.cmi \
-    pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \
-    library/decl_kinds.cmo interp/coqlib.cmi 
+    kernel/term.cmi proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi \
+    pretyping/rawterm.cmi proofs/proof_type.cmi lib/pp.cmi kernel/names.cmi \
+    library/libnames.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
+    kernel/environ.cmi library/decl_kinds.cmo interp/coqlib.cmi 
 contrib/xml/doubleTypeInference.cmi: kernel/term.cmi kernel/names.cmi \
     pretyping/evd.cmi kernel/environ.cmi contrib/xml/acic.cmo 
 contrib/xml/xmlcommand.cmi: contrib/xml/xml.cmi kernel/term.cmi \
@@ -541,13 +561,13 @@ ide/config_parser.cmx: lib/util.cmx ide/config_parser.cmi
 ide/coqide.cmo: toplevel/vernacexpr.cmo lib/util.cmi ide/undo.cmi \
     lib/system.cmi ide/preferences.cmi lib/pp.cmi proofs/pfedit.cmi \
     ide/ideutils.cmi ide/highlight.cmo ide/find_phrase.cmo \
-    config/coq_config.cmi ide/coq_commands.cmo ide/coq.cmi \
-    ide/command_windows.cmi ide/blaster_window.cmo ide/coqide.cmi 
+    proofs/decl_mode.cmi config/coq_config.cmi ide/coq_commands.cmo \
+    ide/coq.cmi ide/command_windows.cmi ide/blaster_window.cmo ide/coqide.cmi 
 ide/coqide.cmx: toplevel/vernacexpr.cmx lib/util.cmx ide/undo.cmx \
     lib/system.cmx ide/preferences.cmx lib/pp.cmx proofs/pfedit.cmx \
     ide/ideutils.cmx ide/highlight.cmx ide/find_phrase.cmx \
-    config/coq_config.cmx ide/coq_commands.cmx ide/coq.cmx \
-    ide/command_windows.cmx ide/blaster_window.cmx ide/coqide.cmi 
+    proofs/decl_mode.cmx config/coq_config.cmx ide/coq_commands.cmx \
+    ide/coq.cmx ide/command_windows.cmx ide/blaster_window.cmx ide/coqide.cmi 
 ide/coq.cmo: toplevel/vernacexpr.cmo toplevel/vernacentries.cmi \
     toplevel/vernac.cmi lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     proofs/tacmach.cmi tactics/tacinterp.cmi lib/system.cmi \
@@ -555,10 +575,10 @@ ide/coq.cmo: toplevel/vernacexpr.cmo toplevel/vernacentries.cmi \
     parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \
     lib/options.cmi library/nametab.cmi kernel/names.cmi toplevel/mltop.cmi \
     library/library.cmi library/libnames.cmi library/lib.cmi ide/ideutils.cmi \
-    tactics/hipattern.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi kernel/declarations.cmi \
-    toplevel/coqtop.cmi config/coq_config.cmi toplevel/cerrors.cmi \
-    ide/coq.cmi 
+    tactics/hipattern.cmi library/goptions.cmi library/global.cmi \
+    pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \
+    kernel/declarations.cmi proofs/decl_mode.cmi toplevel/coqtop.cmi \
+    config/coq_config.cmi toplevel/cerrors.cmi ide/coq.cmi 
 ide/coq.cmx: toplevel/vernacexpr.cmx toplevel/vernacentries.cmx \
     toplevel/vernac.cmx lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     proofs/tacmach.cmx tactics/tacinterp.cmx lib/system.cmx \
@@ -566,14 +586,14 @@ ide/coq.cmx: toplevel/vernacexpr.cmx toplevel/vernacentries.cmx \
     parsing/printer.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \
     lib/options.cmx library/nametab.cmx kernel/names.cmx toplevel/mltop.cmx \
     library/library.cmx library/libnames.cmx library/lib.cmx ide/ideutils.cmx \
-    tactics/hipattern.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/environ.cmx kernel/declarations.cmx \
-    toplevel/coqtop.cmx config/coq_config.cmx toplevel/cerrors.cmx \
-    ide/coq.cmi 
+    tactics/hipattern.cmx library/goptions.cmx library/global.cmx \
+    pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \
+    kernel/declarations.cmx proofs/decl_mode.cmx toplevel/coqtop.cmx \
+    config/coq_config.cmx toplevel/cerrors.cmx ide/coq.cmi 
 ide/coq_tactics.cmo: ide/coq_tactics.cmi 
 ide/coq_tactics.cmx: ide/coq_tactics.cmi 
-ide/find_phrase.cmo: ide/ideutils.cmi 
-ide/find_phrase.cmx: ide/ideutils.cmx 
+ide/find_phrase.cmo: ide/preferences.cmi ide/ideutils.cmi 
+ide/find_phrase.cmx: ide/preferences.cmx ide/ideutils.cmx 
 ide/highlight.cmo: ide/ideutils.cmi 
 ide/highlight.cmx: ide/ideutils.cmx 
 ide/ideutils.cmo: ide/utf8_convert.cmo lib/system.cmi ide/preferences.cmi \
@@ -677,13 +697,13 @@ interp/syntax_def.cmx: lib/util.cmx interp/topconstr.cmx library/summary.cmx \
     kernel/names.cmx library/nameops.cmx library/libobject.cmx \
     library/libnames.cmx library/lib.cmx interp/syntax_def.cmi 
 interp/topconstr.cmo: lib/util.cmi kernel/term.cmi pretyping/rawterm.cmi \
-    lib/pp.cmi kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \
-    library/libnames.cmi pretyping/evd.cmi lib/dyn.cmi pretyping/detyping.cmi \
-    lib/bigint.cmi interp/topconstr.cmi 
+    lib/pp.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
+    kernel/mod_subst.cmi library/libnames.cmi pretyping/evd.cmi lib/dyn.cmi \
+    pretyping/detyping.cmi lib/bigint.cmi interp/topconstr.cmi 
 interp/topconstr.cmx: lib/util.cmx kernel/term.cmx pretyping/rawterm.cmx \
-    lib/pp.cmx kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \
-    library/libnames.cmx pretyping/evd.cmx lib/dyn.cmx pretyping/detyping.cmx \
-    lib/bigint.cmx interp/topconstr.cmi 
+    lib/pp.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
+    kernel/mod_subst.cmx library/libnames.cmx pretyping/evd.cmx lib/dyn.cmx \
+    pretyping/detyping.cmx lib/bigint.cmx interp/topconstr.cmi 
 kernel/cbytecodes.cmo: kernel/term.cmi kernel/names.cmi kernel/cbytecodes.cmi 
 kernel/cbytecodes.cmx: kernel/term.cmx kernel/names.cmx kernel/cbytecodes.cmi 
 kernel/cbytegen.cmo: lib/util.cmi kernel/term.cmi kernel/pre_env.cmi \
@@ -704,12 +724,14 @@ kernel/closure.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx lib/pp.cmx \
     kernel/declarations.cmx kernel/closure.cmi 
 kernel/conv_oracle.cmo: kernel/names.cmi kernel/conv_oracle.cmi 
 kernel/conv_oracle.cmx: kernel/names.cmx kernel/conv_oracle.cmi 
-kernel/cooking.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
-    kernel/reduction.cmi lib/pp.cmi kernel/names.cmi kernel/environ.cmi \
-    kernel/declarations.cmi kernel/cemitcodes.cmi kernel/cooking.cmi 
-kernel/cooking.cmx: lib/util.cmx kernel/term.cmx kernel/sign.cmx \
-    kernel/reduction.cmx lib/pp.cmx kernel/names.cmx kernel/environ.cmx \
-    kernel/declarations.cmx kernel/cemitcodes.cmx kernel/cooking.cmi 
+kernel/cooking.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \
+    kernel/sign.cmi kernel/reduction.cmi lib/pp.cmi kernel/names.cmi \
+    kernel/environ.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \
+    kernel/cooking.cmi 
+kernel/cooking.cmx: lib/util.cmx kernel/typeops.cmx kernel/term.cmx \
+    kernel/sign.cmx kernel/reduction.cmx lib/pp.cmx kernel/names.cmx \
+    kernel/environ.cmx kernel/declarations.cmx kernel/cemitcodes.cmx \
+    kernel/cooking.cmi 
 kernel/csymtable.cmo: kernel/vm.cmi kernel/term.cmi kernel/pre_env.cmi \
     kernel/names.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \
     kernel/cbytegen.cmi kernel/cbytecodes.cmi kernel/csymtable.cmi 
@@ -746,10 +768,12 @@ kernel/indtypes.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
     kernel/entries.cmx kernel/declarations.cmx kernel/indtypes.cmi 
 kernel/inductive.cmo: lib/util.cmi kernel/univ.cmi kernel/type_errors.cmi \
     kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi kernel/names.cmi \
-    kernel/environ.cmi kernel/declarations.cmi kernel/inductive.cmi 
+    kernel/environ.cmi kernel/declarations.cmi kernel/closure.cmi \
+    kernel/inductive.cmi 
 kernel/inductive.cmx: lib/util.cmx kernel/univ.cmx kernel/type_errors.cmx \
     kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx kernel/names.cmx \
-    kernel/environ.cmx kernel/declarations.cmx kernel/inductive.cmi 
+    kernel/environ.cmx kernel/declarations.cmx kernel/closure.cmx \
+    kernel/inductive.cmi 
 kernel/modops.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \
     kernel/names.cmi kernel/mod_subst.cmi kernel/environ.cmi \
     kernel/entries.cmi kernel/declarations.cmi kernel/cemitcodes.cmi \
@@ -808,12 +832,12 @@ kernel/sign.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \
     kernel/sign.cmi 
 kernel/sign.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \
     kernel/sign.cmi 
-kernel/subtyping.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/reduction.cmi kernel/names.cmi kernel/modops.cmi \
+kernel/subtyping.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
+    kernel/term.cmi kernel/reduction.cmi kernel/names.cmi kernel/modops.cmi \
     kernel/mod_subst.cmi kernel/inductive.cmi kernel/environ.cmi \
     kernel/entries.cmi kernel/declarations.cmi kernel/subtyping.cmi 
-kernel/subtyping.cmx: lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/reduction.cmx kernel/names.cmx kernel/modops.cmx \
+kernel/subtyping.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
+    kernel/term.cmx kernel/reduction.cmx kernel/names.cmx kernel/modops.cmx \
     kernel/mod_subst.cmx kernel/inductive.cmx kernel/environ.cmx \
     kernel/entries.cmx kernel/declarations.cmx kernel/subtyping.cmi 
 kernel/term.cmo: lib/util.cmi kernel/univ.cmi lib/pp.cmi kernel/names.cmi \
@@ -848,14 +872,14 @@ kernel/univ.cmo: lib/util.cmi lib/pp.cmi kernel/names.cmi lib/hashcons.cmi \
     kernel/univ.cmi 
 kernel/univ.cmx: lib/util.cmx lib/pp.cmx kernel/names.cmx lib/hashcons.cmx \
     kernel/univ.cmi 
-kernel/vconv.cmo: kernel/vm.cmi lib/util.cmi kernel/univ.cmi kernel/term.cmi \
-    kernel/reduction.cmi kernel/names.cmi kernel/inductive.cmi \
-    kernel/environ.cmi kernel/declarations.cmi kernel/csymtable.cmi \
-    kernel/conv_oracle.cmi kernel/closure.cmi kernel/vconv.cmi 
-kernel/vconv.cmx: kernel/vm.cmx lib/util.cmx kernel/univ.cmx kernel/term.cmx \
-    kernel/reduction.cmx kernel/names.cmx kernel/inductive.cmx \
-    kernel/environ.cmx kernel/declarations.cmx kernel/csymtable.cmx \
-    kernel/conv_oracle.cmx kernel/closure.cmx kernel/vconv.cmi 
+kernel/vconv.cmo: kernel/vm.cmi kernel/univ.cmi kernel/term.cmi \
+    kernel/reduction.cmi kernel/names.cmi kernel/environ.cmi \
+    kernel/declarations.cmi kernel/csymtable.cmi kernel/conv_oracle.cmi \
+    kernel/closure.cmi kernel/vconv.cmi 
+kernel/vconv.cmx: kernel/vm.cmx kernel/univ.cmx kernel/term.cmx \
+    kernel/reduction.cmx kernel/names.cmx kernel/environ.cmx \
+    kernel/declarations.cmx kernel/csymtable.cmx kernel/conv_oracle.cmx \
+    kernel/closure.cmx kernel/vconv.cmi 
 kernel/vm.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \
     kernel/conv_oracle.cmi kernel/cbytecodes.cmi kernel/vm.cmi 
 kernel/vm.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \
@@ -934,14 +958,14 @@ library/dischargedhypsmap.cmx: lib/util.cmx kernel/term.cmx \
     kernel/names.cmx library/libobject.cmx library/libnames.cmx \
     library/lib.cmx kernel/inductive.cmx kernel/environ.cmx \
     kernel/declarations.cmx library/dischargedhypsmap.cmi 
-library/global.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \
-    kernel/sign.cmi kernel/safe_typing.cmi kernel/names.cmi \
-    library/libnames.cmi kernel/inductive.cmi kernel/environ.cmi \
-    library/global.cmi 
-library/global.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \
-    kernel/sign.cmx kernel/safe_typing.cmx kernel/names.cmx \
-    library/libnames.cmx kernel/inductive.cmx kernel/environ.cmx \
-    library/global.cmi 
+library/global.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \
+    library/summary.cmi kernel/sign.cmi kernel/safe_typing.cmi \
+    kernel/names.cmi library/libnames.cmi kernel/inductive.cmi \
+    kernel/environ.cmi library/global.cmi 
+library/global.cmx: lib/util.cmx kernel/typeops.cmx kernel/term.cmx \
+    library/summary.cmx kernel/sign.cmx kernel/safe_typing.cmx \
+    kernel/names.cmx library/libnames.cmx kernel/inductive.cmx \
+    kernel/environ.cmx library/global.cmi 
 library/goptions.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \
     lib/pp.cmi library/nametab.cmi kernel/names.cmi kernel/mod_subst.cmi \
     library/libobject.cmi library/libnames.cmi library/lib.cmi \
@@ -950,18 +974,18 @@ library/goptions.cmx: lib/util.cmx kernel/term.cmx library/summary.cmx \
     lib/pp.cmx library/nametab.cmx kernel/names.cmx kernel/mod_subst.cmx \
     library/libobject.cmx library/libnames.cmx library/lib.cmx \
     library/goptions.cmi 
-library/impargs.cmo: lib/util.cmi interp/topconstr.cmi pretyping/termops.cmi \
-    kernel/term.cmi library/summary.cmi kernel/reduction.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi library/libobject.cmi \
-    library/libnames.cmi library/lib.cmi kernel/inductive.cmi \
-    library/global.cmi kernel/environ.cmi kernel/declarations.cmi \
-    library/impargs.cmi 
-library/impargs.cmx: lib/util.cmx interp/topconstr.cmx pretyping/termops.cmx \
-    kernel/term.cmx library/summary.cmx kernel/reduction.cmx lib/pp.cmx \
-    library/nametab.cmx kernel/names.cmx library/libobject.cmx \
-    library/libnames.cmx library/lib.cmx kernel/inductive.cmx \
-    library/global.cmx kernel/environ.cmx kernel/declarations.cmx \
-    library/impargs.cmi 
+library/impargs.cmo: lib/util.cmi kernel/typeops.cmi interp/topconstr.cmi \
+    pretyping/termops.cmi kernel/term.cmi library/summary.cmi \
+    kernel/reduction.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
+    library/libobject.cmi library/libnames.cmi library/lib.cmi \
+    kernel/inductive.cmi library/global.cmi kernel/environ.cmi \
+    kernel/declarations.cmi library/impargs.cmi 
+library/impargs.cmx: lib/util.cmx kernel/typeops.cmx interp/topconstr.cmx \
+    pretyping/termops.cmx kernel/term.cmx library/summary.cmx \
+    kernel/reduction.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \
+    library/libobject.cmx library/libnames.cmx library/lib.cmx \
+    kernel/inductive.cmx library/global.cmx kernel/environ.cmx \
+    kernel/declarations.cmx library/impargs.cmi 
 library/lib.cmo: lib/util.cmi kernel/term.cmi library/summary.cmi \
     kernel/sign.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
     kernel/names.cmi library/nameops.cmi library/libobject.cmi \
@@ -1008,8 +1032,6 @@ library/summary.cmo: lib/util.cmi lib/pp.cmi lib/dyn.cmi library/summary.cmi
 library/summary.cmx: lib/util.cmx lib/pp.cmx lib/dyn.cmx library/summary.cmi 
 lib/rtree.cmo: lib/util.cmi lib/pp.cmi lib/rtree.cmi 
 lib/rtree.cmx: lib/util.cmx lib/pp.cmx lib/rtree.cmi 
-lib/stamps.cmo: lib/stamps.cmi 
-lib/stamps.cmx: lib/stamps.cmi 
 lib/system.cmo: lib/util.cmi lib/pp.cmi config/coq_config.cmi lib/system.cmi 
 lib/system.cmx: lib/util.cmx lib/pp.cmx config/coq_config.cmx lib/system.cmi 
 lib/tlm.cmo: lib/gset.cmi lib/gmap.cmi lib/tlm.cmi 
@@ -1048,6 +1070,12 @@ parsing/g_constr.cmo: lib/util.cmi interp/topconstr.cmi kernel/term.cmi \
 parsing/g_constr.cmx: lib/util.cmx interp/topconstr.cmx kernel/term.cmx \
     pretyping/rawterm.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \
     library/libnames.cmx parsing/lexer.cmx lib/bigint.cmx 
+parsing/g_decl_mode.cmo: interp/topconstr.cmi kernel/term.cmi \
+    parsing/pcoq.cmi kernel/names.cmi library/libnames.cmi interp/genarg.cmi \
+    proofs/decl_expr.cmi 
+parsing/g_decl_mode.cmx: interp/topconstr.cmx kernel/term.cmx \
+    parsing/pcoq.cmx kernel/names.cmx library/libnames.cmx interp/genarg.cmx \
+    proofs/decl_expr.cmi 
 parsing/g_ltac.cmo: toplevel/vernacexpr.cmo lib/util.cmi interp/topconstr.cmi \
     proofs/tacexpr.cmo pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi \
     kernel/names.cmi 
@@ -1107,13 +1135,13 @@ parsing/g_vernac.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     lib/pp.cmi parsing/pcoq.cmi lib/options.cmi kernel/names.cmi \
     library/nameops.cmi parsing/lexer.cmi library/goptions.cmi \
     interp/genarg.cmi parsing/g_constr.cmo parsing/extend.cmi \
-    library/decl_kinds.cmo toplevel/class.cmi 
+    proofs/decl_mode.cmi library/decl_kinds.cmo toplevel/class.cmi 
 parsing/g_vernac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     interp/topconstr.cmx pretyping/recordops.cmx interp/ppextend.cmx \
     lib/pp.cmx parsing/pcoq.cmx lib/options.cmx kernel/names.cmx \
     library/nameops.cmx parsing/lexer.cmx library/goptions.cmx \
     interp/genarg.cmx parsing/g_constr.cmx parsing/extend.cmx \
-    library/decl_kinds.cmx toplevel/class.cmx 
+    proofs/decl_mode.cmx library/decl_kinds.cmx toplevel/class.cmx 
 parsing/g_xml.cmo: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi lib/pp.cmi parsing/pcoq.cmi library/nametab.cmi \
     kernel/names.cmi library/libnames.cmi pretyping/inductiveops.cmi \
@@ -1156,6 +1184,14 @@ parsing/ppconstr.cmx: lib/util.cmx kernel/univ.cmx interp/topconstr.cmx \
     library/nameops.cmx library/libnames.cmx interp/genarg.cmx \
     pretyping/evd.cmx interp/constrextern.cmx lib/bigint.cmx \
     parsing/ppconstr.cmi 
+parsing/ppdecl_proof.cmo: lib/util.cmi kernel/term.cmi parsing/printer.cmi \
+    parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi kernel/names.cmi \
+    library/nameops.cmi kernel/environ.cmi proofs/decl_expr.cmi \
+    parsing/ppdecl_proof.cmi 
+parsing/ppdecl_proof.cmx: lib/util.cmx kernel/term.cmx parsing/printer.cmx \
+    parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx kernel/names.cmx \
+    library/nameops.cmx kernel/environ.cmx proofs/decl_expr.cmi \
+    parsing/ppdecl_proof.cmi 
 parsing/pptactic.cmo: lib/util.cmi interp/topconstr.cmi pretyping/termops.cmi \
     kernel/term.cmi proofs/tactic_debug.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi parsing/printer.cmi interp/ppextend.cmi \
@@ -1214,14 +1250,14 @@ parsing/printer.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     library/libnames.cmi library/global.cmi pretyping/evd.cmi \
     pretyping/evarutil.cmi kernel/environ.cmi library/declare.cmi \
-    interp/constrextern.cmi parsing/printer.cmi 
+    proofs/decl_mode.cmi interp/constrextern.cmi parsing/printer.cmi 
 parsing/printer.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     kernel/sign.cmx proofs/refiner.cmx proofs/proof_type.cmx \
     parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \
     library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     library/libnames.cmx library/global.cmx pretyping/evd.cmx \
     pretyping/evarutil.cmx kernel/environ.cmx library/declare.cmx \
-    interp/constrextern.cmx parsing/printer.cmi 
+    proofs/decl_mode.cmx interp/constrextern.cmx parsing/printer.cmi 
 parsing/printmod.cmo: lib/util.cmi lib/pp.cmi library/nametab.cmi \
     kernel/names.cmi library/nameops.cmi library/libnames.cmi \
     library/global.cmi kernel/declarations.cmi parsing/printmod.cmi 
@@ -1242,22 +1278,22 @@ parsing/q_util.cmo: toplevel/vernacexpr.cmo lib/util.cmi parsing/pcoq.cmi \
     interp/genarg.cmi parsing/q_util.cmi 
 parsing/q_util.cmx: toplevel/vernacexpr.cmx lib/util.cmx parsing/pcoq.cmx \
     interp/genarg.cmx parsing/q_util.cmi 
-parsing/search.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
-    kernel/term.cmi pretyping/rawterm.cmi parsing/printer.cmi lib/pp.cmi \
-    pretyping/pattern.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi pretyping/matching.cmi library/libobject.cmi \
-    library/libnames.cmi pretyping/inductiveops.cmi library/global.cmi \
-    pretyping/evd.cmi kernel/environ.cmi library/declaremods.cmi \
-    library/declare.cmi kernel/declarations.cmi interp/coqlib.cmi \
-    parsing/search.cmi 
-parsing/search.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
-    kernel/term.cmx pretyping/rawterm.cmx parsing/printer.cmx lib/pp.cmx \
-    pretyping/pattern.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx pretyping/matching.cmx library/libobject.cmx \
-    library/libnames.cmx pretyping/inductiveops.cmx library/global.cmx \
-    pretyping/evd.cmx kernel/environ.cmx library/declaremods.cmx \
-    library/declare.cmx kernel/declarations.cmx interp/coqlib.cmx \
-    parsing/search.cmi 
+parsing/search.cmo: lib/util.cmi pretyping/typing.cmi kernel/typeops.cmi \
+    pretyping/termops.cmi kernel/term.cmi pretyping/rawterm.cmi \
+    parsing/printer.cmi lib/pp.cmi pretyping/pattern.cmi library/nametab.cmi \
+    kernel/names.cmi library/nameops.cmi pretyping/matching.cmi \
+    library/libobject.cmi library/libnames.cmi pretyping/inductiveops.cmi \
+    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
+    library/declaremods.cmi library/declare.cmi kernel/declarations.cmi \
+    interp/coqlib.cmi parsing/search.cmi 
+parsing/search.cmx: lib/util.cmx pretyping/typing.cmx kernel/typeops.cmx \
+    pretyping/termops.cmx kernel/term.cmx pretyping/rawterm.cmx \
+    parsing/printer.cmx lib/pp.cmx pretyping/pattern.cmx library/nametab.cmx \
+    kernel/names.cmx library/nameops.cmx pretyping/matching.cmx \
+    library/libobject.cmx library/libnames.cmx pretyping/inductiveops.cmx \
+    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
+    library/declaremods.cmx library/declare.cmx kernel/declarations.cmx \
+    interp/coqlib.cmx parsing/search.cmi 
 parsing/tacextend.cmo: lib/util.cmi parsing/q_util.cmi parsing/q_coqast.cmo \
     lib/pp_control.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \
     parsing/argextend.cmo 
@@ -1266,14 +1302,14 @@ parsing/tacextend.cmx: lib/util.cmx parsing/q_util.cmx parsing/q_coqast.cmx \
     parsing/argextend.cmx 
 parsing/tactic_printer.cmo: lib/util.cmi proofs/tacexpr.cmo kernel/sign.cmi \
     proofs/refiner.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi proofs/logic.cmi \
-    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
-    parsing/tactic_printer.cmi 
+    parsing/printer.cmi parsing/pptactic.cmi parsing/ppdecl_proof.cmi \
+    lib/pp.cmi proofs/logic.cmi library/global.cmi pretyping/evd.cmi \
+    kernel/environ.cmi proofs/decl_expr.cmi parsing/tactic_printer.cmi 
 parsing/tactic_printer.cmx: lib/util.cmx proofs/tacexpr.cmx kernel/sign.cmx \
     proofs/refiner.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx proofs/logic.cmx \
-    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
-    parsing/tactic_printer.cmi 
+    parsing/printer.cmx parsing/pptactic.cmx parsing/ppdecl_proof.cmx \
+    lib/pp.cmx proofs/logic.cmx library/global.cmx pretyping/evd.cmx \
+    kernel/environ.cmx proofs/decl_expr.cmi parsing/tactic_printer.cmi 
 parsing/vernacextend.cmo: lib/util.cmi parsing/q_util.cmi \
     parsing/q_coqast.cmo lib/pp_control.cmi lib/pp.cmi interp/genarg.cmi \
     parsing/argextend.cmo 
@@ -1287,7 +1323,7 @@ pretyping/cases.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \
     library/nameops.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
     library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
     pretyping/evarconv.cmi kernel/environ.cmi kernel/declarations.cmi \
-    pretyping/coercion.cmi pretyping/cases.cmi 
+    pretyping/coercion.cmi kernel/closure.cmi pretyping/cases.cmi 
 pretyping/cases.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \
     pretyping/termops.cmx kernel/term.cmx kernel/sign.cmx \
     pretyping/retyping.cmx pretyping/reductionops.cmx pretyping/rawterm.cmx \
@@ -1295,7 +1331,7 @@ pretyping/cases.cmx: lib/util.cmx kernel/typeops.cmx kernel/type_errors.cmx \
     library/nameops.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
     library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
     pretyping/evarconv.cmx kernel/environ.cmx kernel/declarations.cmx \
-    pretyping/coercion.cmx pretyping/cases.cmi 
+    pretyping/coercion.cmx kernel/closure.cmx pretyping/cases.cmi 
 pretyping/cbv.cmo: lib/util.cmi kernel/univ.cmi kernel/term.cmi lib/pp.cmi \
     kernel/names.cmi pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \
     kernel/conv_oracle.cmi kernel/closure.cmi pretyping/cbv.cmi 
@@ -1307,15 +1343,17 @@ pretyping/classops.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     pretyping/rawterm.cmi lib/pp.cmi lib/options.cmi library/nametab.cmi \
     kernel/names.cmi kernel/mod_subst.cmi library/library.cmi \
     library/libobject.cmi library/libnames.cmi library/lib.cmi \
-    library/goptions.cmi lib/gmap.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi library/decl_kinds.cmo pretyping/classops.cmi 
+    pretyping/inductiveops.cmi library/goptions.cmi lib/gmap.cmi \
+    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
+    library/decl_kinds.cmo pretyping/classops.cmi 
 pretyping/classops.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     pretyping/tacred.cmx library/summary.cmx pretyping/reductionops.cmx \
     pretyping/rawterm.cmx lib/pp.cmx lib/options.cmx library/nametab.cmx \
     kernel/names.cmx kernel/mod_subst.cmx library/library.cmx \
     library/libobject.cmx library/libnames.cmx library/lib.cmx \
-    library/goptions.cmx lib/gmap.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx library/decl_kinds.cmx pretyping/classops.cmi 
+    pretyping/inductiveops.cmx library/goptions.cmx lib/gmap.cmx \
+    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
+    library/decl_kinds.cmx pretyping/classops.cmi 
 pretyping/clenv.cmo: lib/util.cmi pretyping/unification.cmi \
     pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
     pretyping/tacred.cmi proofs/tacexpr.cmo kernel/sign.cmi \
@@ -1334,18 +1372,18 @@ pretyping/clenv.cmx: lib/util.cmx pretyping/unification.cmx \
     kernel/mod_subst.cmx library/global.cmx pretyping/evd.cmx \
     pretyping/evarutil.cmx kernel/environ.cmx pretyping/coercion.cmx \
     pretyping/clenv.cmi 
-pretyping/coercion.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    pretyping/recordops.cmi pretyping/rawterm.cmi \
-    pretyping/pretype_errors.cmi lib/pp.cmi kernel/names.cmi \
-    pretyping/evd.cmi pretyping/evarutil.cmi pretyping/evarconv.cmi \
-    kernel/environ.cmi pretyping/classops.cmi pretyping/coercion.cmi 
-pretyping/coercion.cmx: lib/util.cmx kernel/typeops.cmx kernel/term.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    pretyping/recordops.cmx pretyping/rawterm.cmx \
-    pretyping/pretype_errors.cmx lib/pp.cmx kernel/names.cmx \
-    pretyping/evd.cmx pretyping/evarutil.cmx pretyping/evarconv.cmx \
-    kernel/environ.cmx pretyping/classops.cmx pretyping/coercion.cmi 
+pretyping/coercion.cmo: lib/util.cmi kernel/typeops.cmi pretyping/termops.cmi \
+    kernel/term.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
+    kernel/reduction.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \
+    pretyping/pretype_errors.cmi kernel/names.cmi pretyping/evd.cmi \
+    pretyping/evarutil.cmi pretyping/evarconv.cmi kernel/environ.cmi \
+    pretyping/classops.cmi pretyping/coercion.cmi 
+pretyping/coercion.cmx: lib/util.cmx kernel/typeops.cmx pretyping/termops.cmx \
+    kernel/term.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \
+    kernel/reduction.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \
+    pretyping/pretype_errors.cmx kernel/names.cmx pretyping/evd.cmx \
+    pretyping/evarutil.cmx pretyping/evarconv.cmx kernel/environ.cmx \
+    pretyping/classops.cmx pretyping/coercion.cmi 
 pretyping/detyping.cmo: lib/util.cmi kernel/univ.cmi pretyping/termops.cmi \
     kernel/term.cmi kernel/sign.cmi pretyping/rawterm.cmi lib/pp.cmi \
     lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
@@ -1360,16 +1398,18 @@ pretyping/detyping.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \
     kernel/inductive.cmx library/goptions.cmx library/global.cmx \
     pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \
     pretyping/detyping.cmi 
-pretyping/evarconv.cmo: lib/util.cmi pretyping/typing.cmi kernel/term.cmi \
-    pretyping/reductionops.cmi kernel/reduction.cmi pretyping/recordops.cmi \
-    kernel/names.cmi library/libnames.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi kernel/closure.cmi \
-    pretyping/classops.cmi pretyping/evarconv.cmi 
-pretyping/evarconv.cmx: lib/util.cmx pretyping/typing.cmx kernel/term.cmx \
-    pretyping/reductionops.cmx kernel/reduction.cmx pretyping/recordops.cmx \
-    kernel/names.cmx library/libnames.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/environ.cmx kernel/closure.cmx \
-    pretyping/classops.cmx pretyping/evarconv.cmi 
+pretyping/evarconv.cmo: lib/util.cmi pretyping/typing.cmi \
+    pretyping/termops.cmi kernel/term.cmi pretyping/reductionops.cmi \
+    kernel/reduction.cmi pretyping/recordops.cmi lib/pp.cmi kernel/names.cmi \
+    library/libnames.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
+    kernel/environ.cmi kernel/closure.cmi pretyping/classops.cmi \
+    pretyping/evarconv.cmi 
+pretyping/evarconv.cmx: lib/util.cmx pretyping/typing.cmx \
+    pretyping/termops.cmx kernel/term.cmx pretyping/reductionops.cmx \
+    kernel/reduction.cmx pretyping/recordops.cmx lib/pp.cmx kernel/names.cmx \
+    library/libnames.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
+    kernel/environ.cmx kernel/closure.cmx pretyping/classops.cmx \
+    pretyping/evarconv.cmi 
 pretyping/evarutil.cmo: lib/util.cmi kernel/univ.cmi pretyping/typing.cmi \
     kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
     pretyping/reductionops.cmi kernel/reduction.cmi \
@@ -1385,12 +1425,12 @@ pretyping/evarutil.cmx: lib/util.cmx kernel/univ.cmx pretyping/typing.cmx \
 pretyping/evd.cmo: lib/util.cmi kernel/univ.cmi pretyping/termops.cmi \
     kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi lib/pp.cmi \
     kernel/names.cmi library/nameops.cmi kernel/mod_subst.cmi \
-    library/libnames.cmi library/global.cmi kernel/environ.cmi \
+    library/libnames.cmi library/global.cmi kernel/environ.cmi lib/dyn.cmi \
     pretyping/evd.cmi 
 pretyping/evd.cmx: lib/util.cmx kernel/univ.cmx pretyping/termops.cmx \
     kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx lib/pp.cmx \
     kernel/names.cmx library/nameops.cmx kernel/mod_subst.cmx \
-    library/libnames.cmx library/global.cmx kernel/environ.cmx \
+    library/libnames.cmx library/global.cmx kernel/environ.cmx lib/dyn.cmx \
     pretyping/evd.cmi 
 pretyping/indrec.cmo: lib/util.cmi kernel/typeops.cmi kernel/type_errors.cmi \
     pretyping/termops.cmi kernel/term.cmi kernel/sign.cmi \
@@ -1497,13 +1537,15 @@ pretyping/reductionops.cmx: lib/util.cmx kernel/univ.cmx \
     kernel/esubst.cmx kernel/environ.cmx kernel/declarations.cmx \
     kernel/closure.cmx pretyping/reductionops.cmi 
 pretyping/retyping.cmo: lib/util.cmi kernel/univ.cmi kernel/typeops.cmi \
-    kernel/term.cmi pretyping/reductionops.cmi kernel/names.cmi \
-    pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \
-    kernel/environ.cmi kernel/declarations.cmi pretyping/retyping.cmi 
+    pretyping/termops.cmi kernel/term.cmi pretyping/reductionops.cmi \
+    kernel/names.cmi pretyping/inductiveops.cmi kernel/inductive.cmi \
+    pretyping/evd.cmi kernel/environ.cmi kernel/declarations.cmi \
+    pretyping/retyping.cmi 
 pretyping/retyping.cmx: lib/util.cmx kernel/univ.cmx kernel/typeops.cmx \
-    kernel/term.cmx pretyping/reductionops.cmx kernel/names.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \
-    kernel/environ.cmx kernel/declarations.cmx pretyping/retyping.cmi 
+    pretyping/termops.cmx kernel/term.cmx pretyping/reductionops.cmx \
+    kernel/names.cmx pretyping/inductiveops.cmx kernel/inductive.cmx \
+    pretyping/evd.cmx kernel/environ.cmx kernel/declarations.cmx \
+    pretyping/retyping.cmi 
 pretyping/tacred.cmo: lib/util.cmi pretyping/typing.cmi \
     kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \
     library/summary.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
@@ -1550,6 +1592,14 @@ pretyping/unification.cmx: lib/util.cmx pretyping/typing.cmx \
     pretyping/pattern.cmx kernel/names.cmx library/nameops.cmx \
     library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
     kernel/environ.cmx pretyping/unification.cmi 
+pretyping/vnorm.cmo: kernel/vm.cmi kernel/vconv.cmi lib/util.cmi \
+    kernel/typeops.cmi kernel/term.cmi kernel/reduction.cmi kernel/names.cmi \
+    kernel/inductive.cmi kernel/environ.cmi kernel/declarations.cmi \
+    pretyping/vnorm.cmi 
+pretyping/vnorm.cmx: kernel/vm.cmx kernel/vconv.cmx lib/util.cmx \
+    kernel/typeops.cmx kernel/term.cmx kernel/reduction.cmx kernel/names.cmx \
+    kernel/inductive.cmx kernel/environ.cmx kernel/declarations.cmx \
+    pretyping/vnorm.cmi 
 proofs/clenvtac.cmo: lib/util.cmi pretyping/unification.cmi \
     pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
     proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
@@ -1568,6 +1618,12 @@ proofs/clenvtac.cmx: lib/util.cmx pretyping/unification.cmx \
     proofs/logic.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
     proofs/evar_refiner.cmx kernel/environ.cmx pretyping/clenv.cmx \
     proofs/clenvtac.cmi 
+proofs/decl_mode.cmo: lib/util.cmi kernel/term.cmi proofs/refiner.cmi \
+    proofs/proof_trees.cmi proofs/pfedit.cmi kernel/names.cmi \
+    pretyping/evd.cmi lib/dyn.cmi proofs/decl_expr.cmi proofs/decl_mode.cmi 
+proofs/decl_mode.cmx: lib/util.cmx kernel/term.cmx proofs/refiner.cmx \
+    proofs/proof_trees.cmx proofs/pfedit.cmx kernel/names.cmx \
+    pretyping/evd.cmx lib/dyn.cmx proofs/decl_expr.cmi proofs/decl_mode.cmi 
 proofs/evar_refiner.cmo: lib/util.cmi kernel/term.cmi kernel/sign.cmi \
     proofs/refiner.cmi proofs/proof_trees.cmi pretyping/pretyping.cmi \
     kernel/names.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
@@ -1611,29 +1667,31 @@ proofs/proof_trees.cmo: lib/util.cmi pretyping/typing.cmi \
     kernel/sign.cmi proofs/proof_type.cmi lib/pp.cmi library/nametab.cmi \
     kernel/names.cmi library/nameops.cmi library/libnames.cmi \
     pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \
-    pretyping/detyping.cmi kernel/closure.cmi proofs/proof_trees.cmi 
+    pretyping/detyping.cmi proofs/decl_expr.cmi kernel/closure.cmi \
+    proofs/proof_trees.cmi 
 proofs/proof_trees.cmx: lib/util.cmx pretyping/typing.cmx \
     pretyping/termops.cmx kernel/term.cmx pretyping/tacred.cmx \
     kernel/sign.cmx proofs/proof_type.cmx lib/pp.cmx library/nametab.cmx \
     kernel/names.cmx library/nameops.cmx library/libnames.cmx \
     pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \
-    pretyping/detyping.cmx kernel/closure.cmx proofs/proof_trees.cmi 
+    pretyping/detyping.cmx proofs/decl_expr.cmi kernel/closure.cmx \
+    proofs/proof_trees.cmi 
 proofs/proof_type.cmo: lib/util.cmi kernel/term.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi pretyping/pattern.cmi library/nametab.cmi \
     kernel/names.cmi library/libnames.cmi interp/genarg.cmi pretyping/evd.cmi \
-    kernel/environ.cmi proofs/proof_type.cmi 
+    kernel/environ.cmi proofs/decl_expr.cmi proofs/proof_type.cmi 
 proofs/proof_type.cmx: lib/util.cmx kernel/term.cmx proofs/tacexpr.cmx \
     pretyping/rawterm.cmx pretyping/pattern.cmx library/nametab.cmx \
     kernel/names.cmx library/libnames.cmx interp/genarg.cmx pretyping/evd.cmx \
-    kernel/environ.cmx proofs/proof_type.cmi 
-proofs/redexpr.cmo: kernel/vconv.cmi lib/util.cmi kernel/typeops.cmi \
+    kernel/environ.cmx proofs/decl_expr.cmi proofs/proof_type.cmi 
+proofs/redexpr.cmo: pretyping/vnorm.cmi lib/util.cmi kernel/typeops.cmi \
     kernel/term.cmi pretyping/tacred.cmi library/summary.cmi \
     pretyping/reductionops.cmi pretyping/rawterm.cmi lib/pp.cmi \
     library/nametab.cmi kernel/names.cmi library/libnames.cmi \
     library/global.cmi kernel/environ.cmi kernel/declarations.cmi \
     kernel/csymtable.cmi kernel/conv_oracle.cmi kernel/closure.cmi \
     proofs/redexpr.cmi 
-proofs/redexpr.cmx: kernel/vconv.cmx lib/util.cmx kernel/typeops.cmx \
+proofs/redexpr.cmx: pretyping/vnorm.cmx lib/util.cmx kernel/typeops.cmx \
     kernel/term.cmx pretyping/tacred.cmx library/summary.cmx \
     pretyping/reductionops.cmx pretyping/rawterm.cmx lib/pp.cmx \
     library/nametab.cmx kernel/names.cmx library/libnames.cmx \
@@ -1715,31 +1773,75 @@ tactics/auto.cmx: toplevel/vernacexpr.cmx lib/util.cmx pretyping/typing.cmx \
 tactics/autorewrite.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
     pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \
     tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo library/summary.cmi proofs/proof_type.cmi \
-    parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi kernel/names.cmi \
-    kernel/mod_subst.cmi library/libobject.cmi library/lib.cmi \
-    tactics/hipattern.cmi library/global.cmi pretyping/evd.cmi \
-    tactics/equality.cmi kernel/environ.cmi tactics/autorewrite.cmi 
+    proofs/tacexpr.cmo library/summary.cmi proofs/refiner.cmi \
+    proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi \
+    kernel/names.cmi kernel/mod_subst.cmi library/libobject.cmi \
+    library/lib.cmi tactics/hipattern.cmi library/global.cmi \
+    pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \
+    tactics/autorewrite.cmi 
 tactics/autorewrite.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
     pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \
     tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx library/summary.cmx proofs/proof_type.cmx \
-    parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx kernel/names.cmx \
-    kernel/mod_subst.cmx library/libobject.cmx library/lib.cmx \
-    tactics/hipattern.cmx library/global.cmx pretyping/evd.cmx \
-    tactics/equality.cmx kernel/environ.cmx tactics/autorewrite.cmi 
+    proofs/tacexpr.cmx library/summary.cmx proofs/refiner.cmx \
+    proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx \
+    kernel/names.cmx kernel/mod_subst.cmx library/libobject.cmx \
+    library/lib.cmx tactics/hipattern.cmx library/global.cmx \
+    pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \
+    tactics/autorewrite.cmi 
 tactics/btermdn.cmo: tactics/termdn.cmi kernel/term.cmi pretyping/pattern.cmi \
     library/libnames.cmi tactics/dn.cmi tactics/btermdn.cmi 
 tactics/btermdn.cmx: tactics/termdn.cmx kernel/term.cmx pretyping/pattern.cmx \
     library/libnames.cmx tactics/dn.cmx tactics/btermdn.cmi 
 tactics/contradiction.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi tactics/hipattern.cmi \
-    interp/coqlib.cmi tactics/contradiction.cmi 
+    tactics/tacticals.cmi proofs/tacmach.cmi pretyping/retyping.cmi \
+    pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
+    tactics/hipattern.cmi pretyping/evd.cmi kernel/environ.cmi \
+    interp/coqlib.cmi pretyping/coercion.cmi tactics/contradiction.cmi 
 tactics/contradiction.cmx: lib/util.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx pretyping/reductionops.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx tactics/hipattern.cmx \
-    interp/coqlib.cmx tactics/contradiction.cmi 
+    tactics/tacticals.cmx proofs/tacmach.cmx pretyping/retyping.cmx \
+    pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
+    tactics/hipattern.cmx pretyping/evd.cmx kernel/environ.cmx \
+    interp/coqlib.cmx pretyping/coercion.cmx tactics/contradiction.cmi 
+tactics/decl_interp.cmo: lib/util.cmi interp/topconstr.cmi \
+    pretyping/termops.cmi kernel/term.cmi proofs/tacmach.cmi \
+    tactics/tacinterp.cmi pretyping/rawterm.cmi pretyping/pretyping.cmi \
+    lib/pp.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \
+    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
+    pretyping/detyping.cmi kernel/declarations.cmi proofs/decl_mode.cmi \
+    proofs/decl_expr.cmi interp/coqlib.cmi interp/constrintern.cmi \
+    kernel/closure.cmi tactics/decl_interp.cmi 
+tactics/decl_interp.cmx: lib/util.cmx interp/topconstr.cmx \
+    pretyping/termops.cmx kernel/term.cmx proofs/tacmach.cmx \
+    tactics/tacinterp.cmx pretyping/rawterm.cmx pretyping/pretyping.cmx \
+    lib/pp.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \
+    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
+    pretyping/detyping.cmx kernel/declarations.cmx proofs/decl_mode.cmx \
+    proofs/decl_expr.cmi interp/coqlib.cmx interp/constrintern.cmx \
+    kernel/closure.cmx tactics/decl_interp.cmi 
+tactics/decl_proof_instr.cmo: lib/util.cmi pretyping/unification.cmi \
+    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
+    tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
+    proofs/tacexpr.cmo proofs/refiner.cmi pretyping/reductionops.cmi \
+    kernel/reduction.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
+    proofs/proof_trees.cmi parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi \
+    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
+    pretyping/inductiveops.cmi kernel/inductive.cmi library/goptions.cmi \
+    library/global.cmi interp/genarg.cmi pretyping/evd.cmi kernel/environ.cmi \
+    kernel/declarations.cmi proofs/decl_mode.cmi tactics/decl_interp.cmi \
+    proofs/decl_expr.cmi interp/coqlib.cmi kernel/closure.cmi \
+    tactics/decl_proof_instr.cmi 
+tactics/decl_proof_instr.cmx: lib/util.cmx pretyping/unification.cmx \
+    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
+    tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
+    proofs/tacexpr.cmx proofs/refiner.cmx pretyping/reductionops.cmx \
+    kernel/reduction.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
+    proofs/proof_trees.cmx parsing/printer.cmx lib/pp.cmx proofs/pfedit.cmx \
+    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
+    pretyping/inductiveops.cmx kernel/inductive.cmx library/goptions.cmx \
+    library/global.cmx interp/genarg.cmx pretyping/evd.cmx kernel/environ.cmx \
+    kernel/declarations.cmx proofs/decl_mode.cmx tactics/decl_interp.cmx \
+    proofs/decl_expr.cmi interp/coqlib.cmx kernel/closure.cmx \
+    tactics/decl_proof_instr.cmi 
 tactics/dhyp.cmo: lib/util.cmi kernel/term.cmi tactics/tactics.cmi \
     tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
     library/summary.cmi proofs/refiner.cmi kernel/reduction.cmi \
@@ -1850,24 +1952,25 @@ tactics/evar_tactics.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     proofs/refiner.cmx proofs/proof_type.cmx pretyping/evd.cmx \
     pretyping/evarutil.cmx proofs/evar_refiner.cmx kernel/environ.cmx \
     tactics/evar_tactics.cmi 
-tactics/extraargs.cmo: lib/util.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
-    tactics/setoid_replace.cmi parsing/printer.cmi parsing/pptactic.cmi \
-    lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi library/nameops.cmi \
-    toplevel/metasyntax.cmi parsing/lexer.cmi interp/genarg.cmi \
-    tactics/extraargs.cmi 
-tactics/extraargs.cmx: lib/util.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
-    tactics/setoid_replace.cmx parsing/printer.cmx parsing/pptactic.cmx \
-    lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx library/nameops.cmx \
-    toplevel/metasyntax.cmx parsing/lexer.cmx interp/genarg.cmx \
-    tactics/extraargs.cmi 
+tactics/extraargs.cmo: lib/util.cmi tactics/tacticals.cmi \
+    tactics/tacinterp.cmi proofs/tacexpr.cmo tactics/setoid_replace.cmi \
+    parsing/printer.cmi parsing/pptactic.cmi interp/ppextend.cmi \
+    parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \
+    library/nameops.cmi toplevel/metasyntax.cmi parsing/lexer.cmi \
+    interp/genarg.cmi tactics/extraargs.cmi 
+tactics/extraargs.cmx: lib/util.cmx tactics/tacticals.cmx \
+    tactics/tacinterp.cmx proofs/tacexpr.cmx tactics/setoid_replace.cmx \
+    parsing/printer.cmx parsing/pptactic.cmx interp/ppextend.cmx \
+    parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \
+    library/nameops.cmx toplevel/metasyntax.cmx parsing/lexer.cmx \
+    interp/genarg.cmx tactics/extraargs.cmi 
 tactics/extratactics.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
     kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
     tactics/tacinterp.cmi proofs/tacexpr.cmo library/summary.cmi \
     tactics/setoid_replace.cmi proofs/refiner.cmi tactics/refine.cmi \
-    pretyping/rawterm.cmi parsing/pptactic.cmi interp/ppextend.cmi lib/pp.cmi \
-    parsing/pcoq.cmi kernel/names.cmi library/nameops.cmi \
-    kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi parsing/lexer.cmi tactics/leminv.cmi tactics/inv.cmi \
+    pretyping/rawterm.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \
+    kernel/names.cmi kernel/mod_subst.cmi library/libobject.cmi \
+    library/libnames.cmi library/lib.cmi tactics/leminv.cmi tactics/inv.cmi \
     library/global.cmi interp/genarg.cmi tactics/extraargs.cmi \
     pretyping/evd.cmi tactics/evar_tactics.cmi tactics/equality.cmi \
     parsing/egrammar.cmi tactics/contradiction.cmi interp/constrintern.cmi \
@@ -1876,10 +1979,9 @@ tactics/extratactics.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
     kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
     tactics/tacinterp.cmx proofs/tacexpr.cmx library/summary.cmx \
     tactics/setoid_replace.cmx proofs/refiner.cmx tactics/refine.cmx \
-    pretyping/rawterm.cmx parsing/pptactic.cmx interp/ppextend.cmx lib/pp.cmx \
-    parsing/pcoq.cmx kernel/names.cmx library/nameops.cmx \
-    kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx parsing/lexer.cmx tactics/leminv.cmx tactics/inv.cmx \
+    pretyping/rawterm.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \
+    kernel/names.cmx kernel/mod_subst.cmx library/libobject.cmx \
+    library/libnames.cmx library/lib.cmx tactics/leminv.cmx tactics/inv.cmx \
     library/global.cmx interp/genarg.cmx tactics/extraargs.cmx \
     pretyping/evd.cmx tactics/evar_tactics.cmx tactics/equality.cmx \
     parsing/egrammar.cmx tactics/contradiction.cmx interp/constrintern.cmx \
@@ -2058,9 +2160,9 @@ tactics/tacticals.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     pretyping/evd.cmx proofs/evar_refiner.cmx kernel/environ.cmx \
     kernel/declarations.cmx proofs/clenvtac.cmx pretyping/clenv.cmx \
     tactics/tacticals.cmi 
-tactics/tactics.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tacticals.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
-    proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
+tactics/tactics.cmo: lib/util.cmi pretyping/typing.cmi pretyping/termops.cmi \
+    kernel/term.cmi tactics/tacticals.cmi pretyping/tacred.cmi \
+    proofs/tacmach.cmi proofs/tacexpr.cmo kernel/sign.cmi proofs/refiner.cmi \
     pretyping/reductionops.cmi kernel/reduction.cmi proofs/redexpr.cmi \
     pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
     pretyping/pretype_errors.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \
@@ -2072,9 +2174,9 @@ tactics/tactics.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \
     interp/coqlib.cmi interp/constrintern.cmi proofs/clenvtac.cmi \
     pretyping/clenv.cmi tactics/tactics.cmi 
-tactics/tactics.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tacticals.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
-    proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \
+tactics/tactics.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
+    kernel/term.cmx tactics/tacticals.cmx pretyping/tacred.cmx \
+    proofs/tacmach.cmx proofs/tacexpr.cmx kernel/sign.cmx proofs/refiner.cmx \
     pretyping/reductionops.cmx kernel/reduction.cmx proofs/redexpr.cmx \
     pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
     pretyping/pretype_errors.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \
@@ -2141,33 +2243,35 @@ toplevel/class.cmx: lib/util.cmx pretyping/typing.cmx pretyping/termops.cmx \
 toplevel/command.cmo: toplevel/vernacexpr.cmo lib/util.cmi kernel/typeops.cmi \
     interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
     proofs/tacmach.cmi interp/syntax_def.cmi library/states.cmi \
-    kernel/safe_typing.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
-    kernel/reduction.cmi proofs/redexpr.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \
+    kernel/sign.cmi kernel/safe_typing.cmi pretyping/retyping.cmi \
+    pretyping/reductionops.cmi kernel/reduction.cmi proofs/redexpr.cmi \
+    pretyping/rawterm.cmi proofs/proof_type.cmi pretyping/pretyping.cmi \
     lib/pp.cmi proofs/pfedit.cmi lib/options.cmi interp/notation.cmi \
     library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     toplevel/metasyntax.cmi proofs/logic.cmi library/library.cmi \
     library/libobject.cmi library/libnames.cmi library/lib.cmi \
     kernel/inductive.cmi kernel/indtypes.cmi pretyping/indrec.cmi \
     library/impargs.cmi library/global.cmi pretyping/evd.cmi \
-    kernel/environ.cmi kernel/entries.cmi library/declare.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo interp/constrintern.cmi \
-    interp/constrextern.cmi toplevel/class.cmi toplevel/command.cmi 
+    pretyping/evarutil.cmi pretyping/evarconv.cmi kernel/environ.cmi \
+    kernel/entries.cmi library/declare.cmi kernel/declarations.cmi \
+    library/decl_kinds.cmo interp/constrintern.cmi interp/constrextern.cmi \
+    toplevel/class.cmi toplevel/command.cmi 
 toplevel/command.cmx: toplevel/vernacexpr.cmx lib/util.cmx kernel/typeops.cmx \
     interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
     proofs/tacmach.cmx interp/syntax_def.cmx library/states.cmx \
-    kernel/safe_typing.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \
-    kernel/reduction.cmx proofs/redexpr.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \
+    kernel/sign.cmx kernel/safe_typing.cmx pretyping/retyping.cmx \
+    pretyping/reductionops.cmx kernel/reduction.cmx proofs/redexpr.cmx \
+    pretyping/rawterm.cmx proofs/proof_type.cmx pretyping/pretyping.cmx \
     lib/pp.cmx proofs/pfedit.cmx lib/options.cmx interp/notation.cmx \
     library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     toplevel/metasyntax.cmx proofs/logic.cmx library/library.cmx \
     library/libobject.cmx library/libnames.cmx library/lib.cmx \
     kernel/inductive.cmx kernel/indtypes.cmx pretyping/indrec.cmx \
     library/impargs.cmx library/global.cmx pretyping/evd.cmx \
-    kernel/environ.cmx kernel/entries.cmx library/declare.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx interp/constrintern.cmx \
-    interp/constrextern.cmx toplevel/class.cmx toplevel/command.cmi 
+    pretyping/evarutil.cmx pretyping/evarconv.cmx kernel/environ.cmx \
+    kernel/entries.cmx library/declare.cmx kernel/declarations.cmx \
+    library/decl_kinds.cmx interp/constrintern.cmx interp/constrextern.cmx \
+    toplevel/class.cmx toplevel/command.cmi 
 toplevel/coqinit.cmo: toplevel/vernac.cmi toplevel/toplevel.cmi \
     lib/system.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
     library/nameops.cmi toplevel/mltop.cmi config/coq_config.cmi \
@@ -2193,11 +2297,13 @@ toplevel/coqtop.cmx: kernel/vm.cmx toplevel/vernac.cmx kernel/vconv.cmx \
     toplevel/coqinit.cmx config/coq_config.cmx interp/constrintern.cmx \
     toplevel/cerrors.cmx toplevel/coqtop.cmi 
 toplevel/discharge.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    kernel/sign.cmi kernel/names.cmi kernel/inductive.cmi kernel/entries.cmi \
-    kernel/declarations.cmi kernel/cooking.cmi toplevel/discharge.cmi 
+    kernel/sign.cmi kernel/names.cmi kernel/inductive.cmi library/global.cmi \
+    kernel/entries.cmi kernel/declarations.cmi kernel/cooking.cmi \
+    toplevel/discharge.cmi 
 toplevel/discharge.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    kernel/sign.cmx kernel/names.cmx kernel/inductive.cmx kernel/entries.cmx \
-    kernel/declarations.cmx kernel/cooking.cmx toplevel/discharge.cmi 
+    kernel/sign.cmx kernel/names.cmx kernel/inductive.cmx library/global.cmx \
+    kernel/entries.cmx kernel/declarations.cmx kernel/cooking.cmx \
+    toplevel/discharge.cmi 
 toplevel/fhimsg.cmo: lib/util.cmi kernel/type_errors.cmi kernel/term.cmi \
     kernel/sign.cmi kernel/reduction.cmi lib/pp.cmi kernel/names.cmi \
     parsing/g_minicoq.cmi kernel/environ.cmi toplevel/fhimsg.cmi 
@@ -2298,19 +2404,20 @@ toplevel/vernacentries.cmo: kernel/vm.cmi toplevel/vernacinterp.cmi \
     kernel/term.cmi tactics/tactics.cmi parsing/tactic_printer.cmi \
     proofs/tactic_debug.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
     proofs/tacexpr.cmo lib/system.cmi interp/syntax_def.cmi \
-    library/states.cmi tactics/setoid_replace.cmi parsing/search.cmi \
-    kernel/safe_typing.cmi interp/reserve.cmi pretyping/reductionops.cmi \
-    proofs/redexpr.cmi pretyping/recordops.cmi toplevel/record.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    parsing/printmod.cmi parsing/printer.cmi pretyping/pretyping.cmi \
-    parsing/prettyp.cmi lib/pp_control.cmi lib/pp.cmi proofs/pfedit.cmi \
-    lib/options.cmi interp/notation.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi interp/modintern.cmi toplevel/mltop.cmi \
-    toplevel/metasyntax.cmi library/library.cmi library/libnames.cmi \
-    library/lib.cmi pretyping/inductiveops.cmi library/impargs.cmi \
-    library/goptions.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi kernel/entries.cmi \
-    pretyping/detyping.cmi library/declaremods.cmi kernel/declarations.cmi \
+    library/states.cmi kernel/sign.cmi tactics/setoid_replace.cmi \
+    parsing/search.cmi kernel/safe_typing.cmi interp/reserve.cmi \
+    pretyping/reductionops.cmi proofs/redexpr.cmi pretyping/recordops.cmi \
+    toplevel/record.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
+    proofs/proof_trees.cmi parsing/printmod.cmi parsing/printer.cmi \
+    pretyping/pretyping.cmi parsing/prettyp.cmi lib/pp_control.cmi lib/pp.cmi \
+    proofs/pfedit.cmi lib/options.cmi interp/notation.cmi library/nametab.cmi \
+    kernel/names.cmi library/nameops.cmi interp/modintern.cmi \
+    toplevel/mltop.cmi toplevel/metasyntax.cmi library/library.cmi \
+    library/libnames.cmi library/lib.cmi pretyping/inductiveops.cmi \
+    library/impargs.cmi library/goptions.cmi library/global.cmi \
+    pretyping/evd.cmi pretyping/evarutil.cmi kernel/environ.cmi \
+    kernel/entries.cmi pretyping/detyping.cmi library/declaremods.cmi \
+    kernel/declarations.cmi tactics/decl_proof_instr.cmi proofs/decl_mode.cmi \
     library/decl_kinds.cmo interp/constrintern.cmi interp/constrextern.cmi \
     toplevel/command.cmi pretyping/classops.cmi toplevel/class.cmi \
     tactics/autorewrite.cmi tactics/auto.cmi toplevel/vernacentries.cmi 
@@ -2320,30 +2427,33 @@ toplevel/vernacentries.cmx: kernel/vm.cmx toplevel/vernacinterp.cmx \
     kernel/term.cmx tactics/tactics.cmx parsing/tactic_printer.cmx \
     proofs/tactic_debug.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
     proofs/tacexpr.cmx lib/system.cmx interp/syntax_def.cmx \
-    library/states.cmx tactics/setoid_replace.cmx parsing/search.cmx \
-    kernel/safe_typing.cmx interp/reserve.cmx pretyping/reductionops.cmx \
-    proofs/redexpr.cmx pretyping/recordops.cmx toplevel/record.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    parsing/printmod.cmx parsing/printer.cmx pretyping/pretyping.cmx \
-    parsing/prettyp.cmx lib/pp_control.cmx lib/pp.cmx proofs/pfedit.cmx \
-    lib/options.cmx interp/notation.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx interp/modintern.cmx toplevel/mltop.cmx \
-    toplevel/metasyntax.cmx library/library.cmx library/libnames.cmx \
-    library/lib.cmx pretyping/inductiveops.cmx library/impargs.cmx \
-    library/goptions.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/environ.cmx kernel/entries.cmx \
-    pretyping/detyping.cmx library/declaremods.cmx kernel/declarations.cmx \
+    library/states.cmx kernel/sign.cmx tactics/setoid_replace.cmx \
+    parsing/search.cmx kernel/safe_typing.cmx interp/reserve.cmx \
+    pretyping/reductionops.cmx proofs/redexpr.cmx pretyping/recordops.cmx \
+    toplevel/record.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
+    proofs/proof_trees.cmx parsing/printmod.cmx parsing/printer.cmx \
+    pretyping/pretyping.cmx parsing/prettyp.cmx lib/pp_control.cmx lib/pp.cmx \
+    proofs/pfedit.cmx lib/options.cmx interp/notation.cmx library/nametab.cmx \
+    kernel/names.cmx library/nameops.cmx interp/modintern.cmx \
+    toplevel/mltop.cmx toplevel/metasyntax.cmx library/library.cmx \
+    library/libnames.cmx library/lib.cmx pretyping/inductiveops.cmx \
+    library/impargs.cmx library/goptions.cmx library/global.cmx \
+    pretyping/evd.cmx pretyping/evarutil.cmx kernel/environ.cmx \
+    kernel/entries.cmx pretyping/detyping.cmx library/declaremods.cmx \
+    kernel/declarations.cmx tactics/decl_proof_instr.cmx proofs/decl_mode.cmx \
     library/decl_kinds.cmx interp/constrintern.cmx interp/constrextern.cmx \
     toplevel/command.cmx pretyping/classops.cmx toplevel/class.cmx \
     tactics/autorewrite.cmx tactics/auto.cmx toplevel/vernacentries.cmi 
 toplevel/vernacexpr.cmo: lib/util.cmi interp/topconstr.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi interp/ppextend.cmi library/nametab.cmi \
     kernel/names.cmi library/libnames.cmi library/goptions.cmi \
-    interp/genarg.cmi parsing/extend.cmi library/decl_kinds.cmo 
+    interp/genarg.cmi parsing/extend.cmi library/decl_kinds.cmo \
+    proofs/decl_expr.cmi 
 toplevel/vernacexpr.cmx: lib/util.cmx interp/topconstr.cmx proofs/tacexpr.cmx \
     pretyping/rawterm.cmx interp/ppextend.cmx library/nametab.cmx \
     kernel/names.cmx library/libnames.cmx library/goptions.cmx \
-    interp/genarg.cmx parsing/extend.cmx library/decl_kinds.cmx 
+    interp/genarg.cmx parsing/extend.cmx library/decl_kinds.cmx \
+    proofs/decl_expr.cmi 
 toplevel/vernacinterp.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     tactics/tacinterp.cmi proofs/tacexpr.cmo proofs/proof_type.cmi lib/pp.cmi \
     lib/options.cmi kernel/names.cmi library/libnames.cmi toplevel/himsg.cmi \
@@ -2382,10 +2492,10 @@ contrib/cc/ccalgo.cmo: lib/util.cmi kernel/term.cmi lib/pp.cmi \
     kernel/names.cmi library/goptions.cmi contrib/cc/ccalgo.cmi 
 contrib/cc/ccalgo.cmx: lib/util.cmx kernel/term.cmx lib/pp.cmx \
     kernel/names.cmx library/goptions.cmx contrib/cc/ccalgo.cmi 
-contrib/cc/ccproof.cmo: lib/util.cmi kernel/names.cmi contrib/cc/ccalgo.cmi \
-    contrib/cc/ccproof.cmi 
-contrib/cc/ccproof.cmx: lib/util.cmx kernel/names.cmx contrib/cc/ccalgo.cmx \
-    contrib/cc/ccproof.cmi 
+contrib/cc/ccproof.cmo: lib/util.cmi kernel/term.cmi kernel/names.cmi \
+    contrib/cc/ccalgo.cmi contrib/cc/ccproof.cmi 
+contrib/cc/ccproof.cmx: lib/util.cmx kernel/term.cmx kernel/names.cmx \
+    contrib/cc/ccalgo.cmx contrib/cc/ccproof.cmi 
 contrib/cc/cctac.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
     tactics/tacinterp.cmi kernel/sign.cmi proofs/proof_type.cmi lib/pp.cmi \
@@ -2404,14 +2514,12 @@ contrib/cc/cctac.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
     contrib/cc/cctac.cmi 
 contrib/cc/g_congruence.cmo: lib/util.cmi tactics/tactics.cmi \
     tactics/tacticals.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
-    proofs/refiner.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \
-    interp/genarg.cmi parsing/egrammar.cmi toplevel/cerrors.cmi \
-    contrib/cc/cctac.cmi 
+    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \
+    parsing/egrammar.cmi toplevel/cerrors.cmi contrib/cc/cctac.cmi 
 contrib/cc/g_congruence.cmx: lib/util.cmx tactics/tactics.cmx \
     tactics/tacticals.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
-    proofs/refiner.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \
-    interp/genarg.cmx parsing/egrammar.cmx toplevel/cerrors.cmx \
-    contrib/cc/cctac.cmx 
+    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \
+    parsing/egrammar.cmx toplevel/cerrors.cmx contrib/cc/cctac.cmx 
 contrib/correctness/pcicenv.cmo: kernel/univ.cmi kernel/term.cmi \
     kernel/sign.cmi kernel/names.cmi library/global.cmi \
     contrib/correctness/pcicenv.cmi 
@@ -2608,36 +2716,36 @@ contrib/extraction/common.cmx: lib/util.cmx kernel/term.cmx \
     library/libnames.cmx kernel/inductive.cmx contrib/extraction/haskell.cmx \
     lib/gset.cmx library/global.cmx contrib/extraction/extraction.cmx \
     kernel/declarations.cmx contrib/extraction/common.cmi 
-contrib/extraction/extract_env.cmo: lib/util.cmi kernel/term.cmi \
-    contrib/extraction/table.cmi kernel/reduction.cmi lib/pp.cmi \
-    library/nametab.cmi kernel/names.cmi contrib/extraction/modutil.cmi \
-    kernel/modops.cmi kernel/mod_subst.cmi contrib/extraction/miniml.cmi \
-    library/library.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi library/global.cmi contrib/extraction/extraction.cmi \
-    kernel/declarations.cmi contrib/extraction/common.cmi \
-    contrib/extraction/extract_env.cmi 
-contrib/extraction/extract_env.cmx: lib/util.cmx kernel/term.cmx \
-    contrib/extraction/table.cmx kernel/reduction.cmx lib/pp.cmx \
-    library/nametab.cmx kernel/names.cmx contrib/extraction/modutil.cmx \
-    kernel/modops.cmx kernel/mod_subst.cmx contrib/extraction/miniml.cmi \
-    library/library.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx library/global.cmx contrib/extraction/extraction.cmx \
-    kernel/declarations.cmx contrib/extraction/common.cmx \
-    contrib/extraction/extract_env.cmi 
-contrib/extraction/extraction.cmo: lib/util.cmi pretyping/termops.cmi \
-    kernel/term.cmi contrib/extraction/table.cmi library/summary.cmi \
-    pretyping/retyping.cmi pretyping/reductionops.cmi kernel/reduction.cmi \
-    pretyping/recordops.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi contrib/extraction/mlutil.cmi \
+contrib/extraction/extract_env.cmo: lib/util.cmi kernel/typeops.cmi \
+    kernel/term.cmi contrib/extraction/table.cmi kernel/reduction.cmi \
+    lib/pp.cmi library/nametab.cmi kernel/names.cmi \
+    contrib/extraction/modutil.cmi kernel/modops.cmi kernel/mod_subst.cmi \
+    contrib/extraction/miniml.cmi library/library.cmi library/libobject.cmi \
+    library/libnames.cmi library/lib.cmi library/global.cmi \
+    contrib/extraction/extraction.cmi kernel/declarations.cmi \
+    contrib/extraction/common.cmi contrib/extraction/extract_env.cmi 
+contrib/extraction/extract_env.cmx: lib/util.cmx kernel/typeops.cmx \
+    kernel/term.cmx contrib/extraction/table.cmx kernel/reduction.cmx \
+    lib/pp.cmx library/nametab.cmx kernel/names.cmx \
+    contrib/extraction/modutil.cmx kernel/modops.cmx kernel/mod_subst.cmx \
+    contrib/extraction/miniml.cmi library/library.cmx library/libobject.cmx \
+    library/libnames.cmx library/lib.cmx library/global.cmx \
+    contrib/extraction/extraction.cmx kernel/declarations.cmx \
+    contrib/extraction/common.cmx contrib/extraction/extract_env.cmi 
+contrib/extraction/extraction.cmo: lib/util.cmi kernel/typeops.cmi \
+    pretyping/termops.cmi kernel/term.cmi contrib/extraction/table.cmi \
+    library/summary.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
+    kernel/reduction.cmi pretyping/recordops.cmi library/nametab.cmi \
+    kernel/names.cmi library/nameops.cmi contrib/extraction/mlutil.cmi \
     contrib/extraction/miniml.cmi library/libnames.cmi \
     pretyping/inductiveops.cmi kernel/inductive.cmi pretyping/evd.cmi \
     kernel/environ.cmi kernel/declarations.cmi \
     contrib/extraction/extraction.cmi 
-contrib/extraction/extraction.cmx: lib/util.cmx pretyping/termops.cmx \
-    kernel/term.cmx contrib/extraction/table.cmx library/summary.cmx \
-    pretyping/retyping.cmx pretyping/reductionops.cmx kernel/reduction.cmx \
-    pretyping/recordops.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx contrib/extraction/mlutil.cmx \
+contrib/extraction/extraction.cmx: lib/util.cmx kernel/typeops.cmx \
+    pretyping/termops.cmx kernel/term.cmx contrib/extraction/table.cmx \
+    library/summary.cmx pretyping/retyping.cmx pretyping/reductionops.cmx \
+    kernel/reduction.cmx pretyping/recordops.cmx library/nametab.cmx \
+    kernel/names.cmx library/nameops.cmx contrib/extraction/mlutil.cmx \
     contrib/extraction/miniml.cmi library/libnames.cmx \
     pretyping/inductiveops.cmx kernel/inductive.cmx pretyping/evd.cmx \
     kernel/environ.cmx kernel/declarations.cmx \
@@ -2702,13 +2810,13 @@ contrib/extraction/scheme.cmx: lib/util.cmx contrib/extraction/table.cmx \
     library/nameops.cmx contrib/extraction/mlutil.cmx \
     contrib/extraction/miniml.cmi library/libnames.cmx \
     contrib/extraction/scheme.cmi 
-contrib/extraction/table.cmo: lib/util.cmi kernel/term.cmi \
+contrib/extraction/table.cmo: lib/util.cmi kernel/typeops.cmi kernel/term.cmi \
     library/summary.cmi kernel/reduction.cmi parsing/printer.cmi lib/pp.cmi \
     lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     contrib/extraction/miniml.cmi library/libobject.cmi library/libnames.cmi \
     library/lib.cmi library/goptions.cmi library/global.cmi \
     kernel/environ.cmi kernel/declarations.cmi contrib/extraction/table.cmi 
-contrib/extraction/table.cmx: lib/util.cmx kernel/term.cmx \
+contrib/extraction/table.cmx: lib/util.cmx kernel/typeops.cmx kernel/term.cmx \
     library/summary.cmx kernel/reduction.cmx parsing/printer.cmx lib/pp.cmx \
     lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     contrib/extraction/miniml.cmi library/libobject.cmx library/libnames.cmx \
@@ -2718,24 +2826,24 @@ contrib/field/field.cmo: toplevel/vernacinterp.cmi toplevel/vernacexpr.cmo \
     lib/util.cmi pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \
     tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
     proofs/tacexpr.cmo library/summary.cmi contrib/ring/ring.cmo \
-    proofs/refiner.cmi pretyping/reductionops.cmi contrib/ring/quote.cmo \
-    proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi \
-    parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \
-    kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi parsing/lexer.cmi tactics/hipattern.cmi lib/gmap.cmi \
-    library/global.cmi interp/genarg.cmi parsing/extend.cmi pretyping/evd.cmi \
+    pretyping/reductionops.cmi contrib/ring/quote.cmo proofs/proof_type.cmi \
+    parsing/printer.cmi parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi \
+    parsing/pcoq.cmi kernel/names.cmi kernel/mod_subst.cmi \
+    library/libobject.cmi library/libnames.cmi library/lib.cmi \
+    parsing/lexer.cmi tactics/hipattern.cmi lib/gmap.cmi library/global.cmi \
+    interp/genarg.cmi parsing/extend.cmi pretyping/evd.cmi \
     parsing/egrammar.cmi interp/coqlib.cmi interp/constrintern.cmi \
     toplevel/cerrors.cmi 
 contrib/field/field.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
     lib/util.cmx pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \
     tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
     proofs/tacexpr.cmx library/summary.cmx contrib/ring/ring.cmx \
-    proofs/refiner.cmx pretyping/reductionops.cmx contrib/ring/quote.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx \
-    parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \
-    kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx parsing/lexer.cmx tactics/hipattern.cmx lib/gmap.cmx \
-    library/global.cmx interp/genarg.cmx parsing/extend.cmx pretyping/evd.cmx \
+    pretyping/reductionops.cmx contrib/ring/quote.cmx proofs/proof_type.cmx \
+    parsing/printer.cmx parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx \
+    parsing/pcoq.cmx kernel/names.cmx kernel/mod_subst.cmx \
+    library/libobject.cmx library/libnames.cmx library/lib.cmx \
+    parsing/lexer.cmx tactics/hipattern.cmx lib/gmap.cmx library/global.cmx \
+    interp/genarg.cmx parsing/extend.cmx pretyping/evd.cmx \
     parsing/egrammar.cmx interp/coqlib.cmx interp/constrintern.cmx \
     toplevel/cerrors.cmx 
 contrib/first-order/formula.cmo: lib/util.cmi pretyping/termops.cmi \
@@ -2756,14 +2864,16 @@ contrib/first-order/g_ground.cmo: lib/util.cmi kernel/term.cmi \
     parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi kernel/names.cmi \
     library/libnames.cmi contrib/first-order/ground.cmi library/goptions.cmi \
     interp/genarg.cmi contrib/first-order/formula.cmi parsing/egrammar.cmi \
-    toplevel/cerrors.cmi tactics/auto.cmi 
+    tactics/decl_proof_instr.cmi toplevel/cerrors.cmi contrib/cc/cctac.cmi \
+    tactics/auto.cmi 
 contrib/first-order/g_ground.cmx: lib/util.cmx kernel/term.cmx \
     tactics/tactics.cmx tactics/tacticals.cmx tactics/tacinterp.cmx \
     proofs/tacexpr.cmx contrib/first-order/sequent.cmx proofs/refiner.cmx \
     parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx kernel/names.cmx \
     library/libnames.cmx contrib/first-order/ground.cmx library/goptions.cmx \
     interp/genarg.cmx contrib/first-order/formula.cmx parsing/egrammar.cmx \
-    toplevel/cerrors.cmx tactics/auto.cmx 
+    tactics/decl_proof_instr.cmx toplevel/cerrors.cmx contrib/cc/cctac.cmx \
+    tactics/auto.cmx 
 contrib/first-order/ground.cmo: kernel/term.cmi tactics/tactics.cmi \
     tactics/tacticals.cmi proofs/tactic_debug.cmi proofs/tacmach.cmi \
     tactics/tacinterp.cmi contrib/first-order/sequent.cmi \
@@ -2847,8 +2957,8 @@ contrib/fourier/g_fourier.cmx: lib/util.cmx tactics/tacinterp.cmx \
     parsing/pcoq.cmx contrib/fourier/fourierR.cmx parsing/egrammar.cmx \
     toplevel/cerrors.cmx 
 contrib/funind/functional_principles_proofs.cmo: lib/util.cmi \
-    pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tactic_debug.cmi \
+    pretyping/typing.cmi kernel/typeops.cmi pretyping/termops.cmi \
+    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
     pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
     kernel/sign.cmi pretyping/reductionops.cmi contrib/recdef/recdef.cmo \
     pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \
@@ -2861,8 +2971,8 @@ contrib/funind/functional_principles_proofs.cmo: lib/util.cmi \
     toplevel/command.cmi kernel/closure.cmi toplevel/cerrors.cmi \
     contrib/funind/functional_principles_proofs.cmi 
 contrib/funind/functional_principles_proofs.cmx: lib/util.cmx \
-    pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tactic_debug.cmx \
+    pretyping/typing.cmx kernel/typeops.cmx pretyping/termops.cmx \
+    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
     pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
     kernel/sign.cmx pretyping/reductionops.cmx contrib/recdef/recdef.cmx \
     pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \
@@ -2906,47 +3016,53 @@ contrib/funind/indfun_common.cmo: lib/util.cmi pretyping/termops.cmi \
     parsing/printer.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \
     library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     kernel/mod_subst.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/entries.cmi library/declare.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo interp/coqlib.cmi \
-    kernel/closure.cmi contrib/funind/indfun_common.cmi 
+    library/lib.cmi library/impargs.cmi library/goptions.cmi \
+    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
+    kernel/entries.cmi library/declare.cmi kernel/declarations.cmi \
+    library/decl_kinds.cmo interp/coqlib.cmi kernel/closure.cmi \
+    contrib/funind/indfun_common.cmi 
 contrib/funind/indfun_common.cmx: lib/util.cmx pretyping/termops.cmx \
     kernel/term.cmx library/summary.cmx proofs/refiner.cmx \
     pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
     parsing/printer.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \
     library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     kernel/mod_subst.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/entries.cmx library/declare.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx interp/coqlib.cmx \
-    kernel/closure.cmx contrib/funind/indfun_common.cmi 
+    library/lib.cmx library/impargs.cmx library/goptions.cmx \
+    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
+    kernel/entries.cmx library/declare.cmx kernel/declarations.cmx \
+    library/decl_kinds.cmx interp/coqlib.cmx kernel/closure.cmx \
+    contrib/funind/indfun_common.cmi 
 contrib/funind/indfun_main.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
     interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo proofs/refiner.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi parsing/pptactic.cmi \
-    parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi library/nametab.cmi \
-    kernel/names.cmi library/nameops.cmi parsing/lexer.cmi \
-    contrib/funind/invfun.cmo contrib/funind/indfun_common.cmi \
-    contrib/funind/indfun.cmo interp/genarg.cmi \
-    contrib/funind/functional_principles_types.cmi parsing/egrammar.cmi \
+    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
+    tactics/tacinterp.cmi proofs/tacexpr.cmo proofs/refiner.cmi \
+    pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \
+    parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi \
+    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
+    contrib/funind/merge.cmo parsing/lexer.cmi contrib/funind/invfun.cmo \
+    contrib/funind/indfun_common.cmi contrib/funind/indfun.cmo \
+    library/global.cmi interp/genarg.cmi \
+    contrib/funind/functional_principles_types.cmi pretyping/evd.cmi \
+    parsing/egrammar.cmi interp/coqlib.cmi interp/constrintern.cmi \
     toplevel/cerrors.cmi 
 contrib/funind/indfun_main.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
     interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx proofs/refiner.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx parsing/pptactic.cmx \
-    parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx library/nametab.cmx \
-    kernel/names.cmx library/nameops.cmx parsing/lexer.cmx \
-    contrib/funind/invfun.cmx contrib/funind/indfun_common.cmx \
-    contrib/funind/indfun.cmx interp/genarg.cmx \
-    contrib/funind/functional_principles_types.cmx parsing/egrammar.cmx \
+    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
+    tactics/tacinterp.cmx proofs/tacexpr.cmx proofs/refiner.cmx \
+    pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \
+    parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx \
+    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
+    contrib/funind/merge.cmx parsing/lexer.cmx contrib/funind/invfun.cmx \
+    contrib/funind/indfun_common.cmx contrib/funind/indfun.cmx \
+    library/global.cmx interp/genarg.cmx \
+    contrib/funind/functional_principles_types.cmx pretyping/evd.cmx \
+    parsing/egrammar.cmx interp/coqlib.cmx interp/constrintern.cmx \
     toplevel/cerrors.cmx 
 contrib/funind/indfun.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
-    tactics/tacinterp.cmi proofs/tacexpr.cmo library/states.cmi \
-    kernel/sign.cmi contrib/recdef/recdef.cmo \
+    kernel/typeops.cmi interp/topconstr.cmi pretyping/termops.cmi \
+    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
+    proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
+    library/states.cmi kernel/sign.cmi contrib/recdef/recdef.cmo \
     contrib/funind/rawterm_to_relation.cmi pretyping/rawterm.cmi \
     parsing/printer.cmi parsing/ppconstr.cmi lib/pp.cmi lib/options.cmi \
     interp/notation.cmi kernel/names.cmi library/nameops.cmi \
@@ -2959,10 +3075,10 @@ contrib/funind/indfun.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     library/decl_kinds.cmo interp/constrintern.cmi interp/constrextern.cmi \
     toplevel/command.cmi toplevel/cerrors.cmi 
 contrib/funind/indfun.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx library/states.cmx \
-    kernel/sign.cmx contrib/recdef/recdef.cmx \
+    kernel/typeops.cmx interp/topconstr.cmx pretyping/termops.cmx \
+    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
+    proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
+    library/states.cmx kernel/sign.cmx contrib/recdef/recdef.cmx \
     contrib/funind/rawterm_to_relation.cmx pretyping/rawterm.cmx \
     parsing/printer.cmx parsing/ppconstr.cmx lib/pp.cmx lib/options.cmx \
     interp/notation.cmx kernel/names.cmx library/nameops.cmx \
@@ -2977,63 +3093,79 @@ contrib/funind/indfun.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
 contrib/funind/invfun.cmo: toplevel/vernacentries.cmi lib/util.cmi \
     pretyping/typing.cmi pretyping/termops.cmi kernel/term.cmi \
     tactics/tauto.cmo tactics/tactics.cmi tactics/tacticals.cmi \
-    proofs/tactic_debug.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo kernel/sign.cmi lib/rtree.cmi \
-    pretyping/reductionops.cmi pretyping/rawterm.cmi parsing/printer.cmi \
-    parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi tactics/inv.cmi \
-    kernel/inductive.cmi pretyping/indrec.cmi \
-    contrib/funind/indfun_common.cmi tactics/hiddentac.cmi library/global.cmi \
-    interp/genarg.cmi pretyping/evd.cmi tactics/equality.cmi \
-    kernel/environ.cmi kernel/entries.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo interp/coqlib.cmi toplevel/command.cmi \
-    kernel/closure.cmi toplevel/cerrors.cmi 
+    proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
+    kernel/sign.cmi lib/rtree.cmi pretyping/reductionops.cmi \
+    pretyping/rawterm.cmi parsing/printer.cmi parsing/ppconstr.cmi lib/pp.cmi \
+    proofs/pfedit.cmi kernel/names.cmi library/nameops.cmi \
+    library/libnames.cmi tactics/inv.cmi kernel/inductive.cmi \
+    pretyping/indrec.cmi contrib/funind/indfun_common.cmi \
+    tactics/hiddentac.cmi library/global.cmi interp/genarg.cmi \
+    pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \
+    kernel/entries.cmi kernel/declarations.cmi library/decl_kinds.cmo \
+    interp/coqlib.cmi toplevel/command.cmi kernel/closure.cmi \
+    toplevel/cerrors.cmi 
 contrib/funind/invfun.cmx: toplevel/vernacentries.cmx lib/util.cmx \
     pretyping/typing.cmx pretyping/termops.cmx kernel/term.cmx \
     tactics/tauto.cmx tactics/tactics.cmx tactics/tacticals.cmx \
-    proofs/tactic_debug.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx kernel/sign.cmx lib/rtree.cmx \
-    pretyping/reductionops.cmx pretyping/rawterm.cmx parsing/printer.cmx \
-    parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx tactics/inv.cmx \
-    kernel/inductive.cmx pretyping/indrec.cmx \
-    contrib/funind/indfun_common.cmx tactics/hiddentac.cmx library/global.cmx \
-    interp/genarg.cmx pretyping/evd.cmx tactics/equality.cmx \
-    kernel/environ.cmx kernel/entries.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx interp/coqlib.cmx toplevel/command.cmx \
-    kernel/closure.cmx toplevel/cerrors.cmx 
-contrib/funind/rawtermops.cmo: lib/util.cmi proofs/tactic_debug.cmi \
-    tactics/tacinterp.cmi pretyping/rawterm.cmi parsing/printer.cmi \
-    parsing/ppconstr.cmi lib/pp.cmi kernel/names.cmi library/nameops.cmi \
-    library/libnames.cmi pretyping/inductiveops.cmi \
-    contrib/funind/indfun_common.cmi library/global.cmi pretyping/evd.cmi \
-    interp/coqlib.cmi contrib/funind/rawtermops.cmi 
-contrib/funind/rawtermops.cmx: lib/util.cmx proofs/tactic_debug.cmx \
-    tactics/tacinterp.cmx pretyping/rawterm.cmx parsing/printer.cmx \
-    parsing/ppconstr.cmx lib/pp.cmx kernel/names.cmx library/nameops.cmx \
-    library/libnames.cmx pretyping/inductiveops.cmx \
-    contrib/funind/indfun_common.cmx library/global.cmx pretyping/evd.cmx \
-    interp/coqlib.cmx contrib/funind/rawtermops.cmi 
+    proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
+    kernel/sign.cmx lib/rtree.cmx pretyping/reductionops.cmx \
+    pretyping/rawterm.cmx parsing/printer.cmx parsing/ppconstr.cmx lib/pp.cmx \
+    proofs/pfedit.cmx kernel/names.cmx library/nameops.cmx \
+    library/libnames.cmx tactics/inv.cmx kernel/inductive.cmx \
+    pretyping/indrec.cmx contrib/funind/indfun_common.cmx \
+    tactics/hiddentac.cmx library/global.cmx interp/genarg.cmx \
+    pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \
+    kernel/entries.cmx kernel/declarations.cmx library/decl_kinds.cmx \
+    interp/coqlib.cmx toplevel/command.cmx kernel/closure.cmx \
+    toplevel/cerrors.cmx 
+contrib/funind/merge.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
+    interp/topconstr.cmi kernel/term.cmi tactics/tacinterp.cmi \
+    contrib/funind/rawtermops.cmi pretyping/rawterm.cmi parsing/printer.cmi \
+    pretyping/pretyping.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
+    library/nameops.cmi library/libnames.cmi pretyping/inductiveops.cmi \
+    kernel/inductive.cmi library/global.cmi pretyping/evd.cmi \
+    kernel/environ.cmi pretyping/detyping.cmi kernel/declarations.cmi \
+    interp/constrintern.cmi interp/constrextern.cmi toplevel/command.cmi 
+contrib/funind/merge.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
+    interp/topconstr.cmx kernel/term.cmx tactics/tacinterp.cmx \
+    contrib/funind/rawtermops.cmx pretyping/rawterm.cmx parsing/printer.cmx \
+    pretyping/pretyping.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
+    library/nameops.cmx library/libnames.cmx pretyping/inductiveops.cmx \
+    kernel/inductive.cmx library/global.cmx pretyping/evd.cmx \
+    kernel/environ.cmx pretyping/detyping.cmx kernel/declarations.cmx \
+    interp/constrintern.cmx interp/constrextern.cmx toplevel/command.cmx 
+contrib/funind/rawtermops.cmo: lib/util.cmi pretyping/rawterm.cmi lib/pp.cmi \
+    kernel/names.cmi library/nameops.cmi library/libnames.cmi \
+    pretyping/inductiveops.cmi contrib/funind/indfun_common.cmi \
+    library/global.cmi pretyping/evd.cmi interp/coqlib.cmi \
+    contrib/funind/rawtermops.cmi 
+contrib/funind/rawtermops.cmx: lib/util.cmx pretyping/rawterm.cmx lib/pp.cmx \
+    kernel/names.cmx library/nameops.cmx library/libnames.cmx \
+    pretyping/inductiveops.cmx contrib/funind/indfun_common.cmx \
+    library/global.cmx pretyping/evd.cmx interp/coqlib.cmx \
+    contrib/funind/rawtermops.cmi 
 contrib/funind/rawterm_to_relation.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \
-    proofs/tactic_debug.cmi tactics/tacinterp.cmi lib/system.cmi \
+    pretyping/typing.cmi interp/topconstr.cmi pretyping/termops.cmi \
+    kernel/term.cmi tactics/tacinterp.cmi lib/system.cmi kernel/sign.cmi \
     kernel/reduction.cmi contrib/funind/rawtermops.cmi pretyping/rawterm.cmi \
-    parsing/printer.cmi parsing/ppvernac.cmi parsing/ppconstr.cmi lib/pp.cmi \
-    lib/options.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \
-    pretyping/inductiveops.cmi kernel/inductive.cmi \
-    contrib/funind/indfun_common.cmi library/impargs.cmi library/global.cmi \
-    pretyping/evd.cmi kernel/declarations.cmi interp/coqlib.cmi \
+    parsing/printer.cmi pretyping/pretyping.cmi parsing/ppvernac.cmi \
+    parsing/ppconstr.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
+    library/nameops.cmi library/libnames.cmi pretyping/inductiveops.cmi \
+    kernel/inductive.cmi contrib/funind/indfun_common.cmi library/impargs.cmi \
+    library/global.cmi pretyping/evd.cmi kernel/environ.cmi \
+    pretyping/detyping.cmi kernel/declarations.cmi interp/coqlib.cmi \
     interp/constrextern.cmi toplevel/command.cmi toplevel/cerrors.cmi \
     contrib/funind/rawterm_to_relation.cmi 
 contrib/funind/rawterm_to_relation.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \
-    proofs/tactic_debug.cmx tactics/tacinterp.cmx lib/system.cmx \
+    pretyping/typing.cmx interp/topconstr.cmx pretyping/termops.cmx \
+    kernel/term.cmx tactics/tacinterp.cmx lib/system.cmx kernel/sign.cmx \
     kernel/reduction.cmx contrib/funind/rawtermops.cmx pretyping/rawterm.cmx \
-    parsing/printer.cmx parsing/ppvernac.cmx parsing/ppconstr.cmx lib/pp.cmx \
-    lib/options.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \
-    pretyping/inductiveops.cmx kernel/inductive.cmx \
-    contrib/funind/indfun_common.cmx library/impargs.cmx library/global.cmx \
-    pretyping/evd.cmx kernel/declarations.cmx interp/coqlib.cmx \
+    parsing/printer.cmx pretyping/pretyping.cmx parsing/ppvernac.cmx \
+    parsing/ppconstr.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
+    library/nameops.cmx library/libnames.cmx pretyping/inductiveops.cmx \
+    kernel/inductive.cmx contrib/funind/indfun_common.cmx library/impargs.cmx \
+    library/global.cmx pretyping/evd.cmx kernel/environ.cmx \
+    pretyping/detyping.cmx kernel/declarations.cmx interp/coqlib.cmx \
     interp/constrextern.cmx toplevel/command.cmx toplevel/cerrors.cmx \
     contrib/funind/rawterm_to_relation.cmi 
 contrib/funind/tacinv.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
@@ -3074,42 +3206,42 @@ contrib/funind/tacinvutils.cmx: lib/util.cmx pretyping/termops.cmx \
     contrib/funind/tacinvutils.cmi 
 contrib/interface/blast.cmo: toplevel/vernacinterp.cmi \
     toplevel/vernacentries.cmi lib/util.cmi pretyping/typing.cmi \
-    pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi parsing/tactic_printer.cmi pretyping/tacred.cmi \
-    proofs/tacmach.cmi tactics/tacinterp.cmi kernel/sign.cmi \
-    proofs/refiner.cmi kernel/reduction.cmi pretyping/rawterm.cmi \
-    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
-    parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \
-    contrib/interface/pbp.cmi pretyping/pattern.cmi kernel/names.cmi \
-    library/nameops.cmi proofs/logic.cmi kernel/inductive.cmi \
-    tactics/hipattern.cmi library/global.cmi lib/explore.cmi \
-    pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \
+    kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi \
+    tactics/tactics.cmi tactics/tacticals.cmi parsing/tactic_printer.cmi \
+    pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
+    kernel/sign.cmi proofs/refiner.cmi kernel/reduction.cmi \
+    pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
+    parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi \
+    parsing/pcoq.cmi contrib/interface/pbp.cmi pretyping/pattern.cmi \
+    kernel/names.cmi library/nameops.cmi proofs/logic.cmi \
+    kernel/inductive.cmi tactics/hipattern.cmi library/global.cmi \
+    lib/explore.cmi pretyping/evd.cmi tactics/equality.cmi kernel/environ.cmi \
     tactics/eauto.cmi library/declare.cmi kernel/declarations.cmi \
     toplevel/command.cmi pretyping/clenv.cmi tactics/auto.cmi \
     contrib/interface/blast.cmi 
 contrib/interface/blast.cmx: toplevel/vernacinterp.cmx \
     toplevel/vernacentries.cmx lib/util.cmx pretyping/typing.cmx \
-    pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx parsing/tactic_printer.cmx pretyping/tacred.cmx \
-    proofs/tacmach.cmx tactics/tacinterp.cmx kernel/sign.cmx \
-    proofs/refiner.cmx kernel/reduction.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \
-    parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \
-    contrib/interface/pbp.cmx pretyping/pattern.cmx kernel/names.cmx \
-    library/nameops.cmx proofs/logic.cmx kernel/inductive.cmx \
-    tactics/hipattern.cmx library/global.cmx lib/explore.cmx \
-    pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \
+    kernel/typeops.cmx pretyping/termops.cmx kernel/term.cmx \
+    tactics/tactics.cmx tactics/tacticals.cmx parsing/tactic_printer.cmx \
+    pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
+    kernel/sign.cmx proofs/refiner.cmx kernel/reduction.cmx \
+    pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
+    parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx \
+    parsing/pcoq.cmx contrib/interface/pbp.cmx pretyping/pattern.cmx \
+    kernel/names.cmx library/nameops.cmx proofs/logic.cmx \
+    kernel/inductive.cmx tactics/hipattern.cmx library/global.cmx \
+    lib/explore.cmx pretyping/evd.cmx tactics/equality.cmx kernel/environ.cmx \
     tactics/eauto.cmx library/declare.cmx kernel/declarations.cmx \
     toplevel/command.cmx pretyping/clenv.cmx tactics/auto.cmx \
     contrib/interface/blast.cmi 
 contrib/interface/centaur.cmo: contrib/interface/xlate.cmi \
     contrib/interface/vtp.cmi toplevel/vernacinterp.cmi \
     toplevel/vernacexpr.cmo toplevel/vernacentries.cmi toplevel/vernac.cmi \
-    lib/util.cmi contrib/interface/translate.cmi kernel/term.cmi \
-    proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
-    contrib/interface/showproof_ct.cmo contrib/interface/showproof.cmi \
-    parsing/search.cmi proofs/refiner.cmi kernel/reduction.cmi \
-    pretyping/rawterm.cmi toplevel/protectedtoplevel.cmi \
+    lib/util.cmi kernel/typeops.cmi contrib/interface/translate.cmi \
+    kernel/term.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
+    proofs/tacexpr.cmo contrib/interface/showproof_ct.cmo \
+    contrib/interface/showproof.cmi parsing/search.cmi proofs/refiner.cmi \
+    kernel/reduction.cmi pretyping/rawterm.cmi toplevel/protectedtoplevel.cmi \
     proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
     pretyping/pretyping.cmi parsing/pptactic.cmi lib/pp.cmi proofs/pfedit.cmi \
     parsing/pcoq.cmi contrib/interface/pbp.cmi library/nametab.cmi \
@@ -3125,11 +3257,11 @@ contrib/interface/centaur.cmo: contrib/interface/xlate.cmi \
 contrib/interface/centaur.cmx: contrib/interface/xlate.cmx \
     contrib/interface/vtp.cmx toplevel/vernacinterp.cmx \
     toplevel/vernacexpr.cmx toplevel/vernacentries.cmx toplevel/vernac.cmx \
-    lib/util.cmx contrib/interface/translate.cmx kernel/term.cmx \
-    proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
-    contrib/interface/showproof_ct.cmx contrib/interface/showproof.cmx \
-    parsing/search.cmx proofs/refiner.cmx kernel/reduction.cmx \
-    pretyping/rawterm.cmx toplevel/protectedtoplevel.cmx \
+    lib/util.cmx kernel/typeops.cmx contrib/interface/translate.cmx \
+    kernel/term.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
+    proofs/tacexpr.cmx contrib/interface/showproof_ct.cmx \
+    contrib/interface/showproof.cmx parsing/search.cmx proofs/refiner.cmx \
+    kernel/reduction.cmx pretyping/rawterm.cmx toplevel/protectedtoplevel.cmx \
     proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \
     pretyping/pretyping.cmx parsing/pptactic.cmx lib/pp.cmx proofs/pfedit.cmx \
     parsing/pcoq.cmx contrib/interface/pbp.cmx library/nametab.cmx \
@@ -3164,16 +3296,14 @@ contrib/interface/dad.cmx: toplevel/vernacinterp.cmx toplevel/vernacexpr.cmx \
     interp/constrextern.cmx contrib/interface/dad.cmi 
 contrib/interface/debug_tac.cmo: lib/util.cmi tactics/tacticals.cmi \
     proofs/tacmach.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
-    proofs/refiner.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
-    parsing/printer.cmi parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi \
-    library/global.cmi interp/genarg.cmi toplevel/cerrors.cmi \
-    contrib/interface/debug_tac.cmi 
+    proofs/proof_type.cmi proofs/proof_trees.cmi parsing/printer.cmi \
+    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi library/global.cmi \
+    interp/genarg.cmi toplevel/cerrors.cmi contrib/interface/debug_tac.cmi 
 contrib/interface/debug_tac.cmx: lib/util.cmx tactics/tacticals.cmx \
     proofs/tacmach.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
-    proofs/refiner.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
-    parsing/printer.cmx parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx \
-    library/global.cmx interp/genarg.cmx toplevel/cerrors.cmx \
-    contrib/interface/debug_tac.cmi 
+    proofs/proof_type.cmx proofs/proof_trees.cmx parsing/printer.cmx \
+    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx library/global.cmx \
+    interp/genarg.cmx toplevel/cerrors.cmx contrib/interface/debug_tac.cmi 
 contrib/interface/history.cmo: contrib/interface/paths.cmi \
     contrib/interface/history.cmi 
 contrib/interface/history.cmx: contrib/interface/paths.cmx \
@@ -3181,21 +3311,23 @@ contrib/interface/history.cmx: contrib/interface/paths.cmx \
 contrib/interface/line_parser.cmo: contrib/interface/line_parser.cmi 
 contrib/interface/line_parser.cmx: contrib/interface/line_parser.cmi 
 contrib/interface/name_to_ast.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
-    interp/topconstr.cmi kernel/term.cmi kernel/sign.cmi kernel/reduction.cmi \
-    parsing/prettyp.cmi lib/pp.cmi library/nametab.cmi kernel/names.cmi \
-    library/nameops.cmi library/libobject.cmi library/libnames.cmi \
-    library/lib.cmi kernel/inductive.cmi library/impargs.cmi \
-    library/global.cmi kernel/environ.cmi library/declare.cmi \
-    kernel/declarations.cmi library/decl_kinds.cmo interp/constrextern.cmi \
-    pretyping/classops.cmi contrib/interface/name_to_ast.cmi 
+    kernel/typeops.cmi interp/topconstr.cmi kernel/term.cmi kernel/sign.cmi \
+    kernel/reduction.cmi parsing/prettyp.cmi lib/pp.cmi library/nametab.cmi \
+    kernel/names.cmi library/nameops.cmi library/libobject.cmi \
+    library/libnames.cmi library/lib.cmi kernel/inductive.cmi \
+    library/impargs.cmi library/global.cmi kernel/environ.cmi \
+    library/declare.cmi kernel/declarations.cmi library/decl_kinds.cmo \
+    interp/constrextern.cmi pretyping/classops.cmi \
+    contrib/interface/name_to_ast.cmi 
 contrib/interface/name_to_ast.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
-    interp/topconstr.cmx kernel/term.cmx kernel/sign.cmx kernel/reduction.cmx \
-    parsing/prettyp.cmx lib/pp.cmx library/nametab.cmx kernel/names.cmx \
-    library/nameops.cmx library/libobject.cmx library/libnames.cmx \
-    library/lib.cmx kernel/inductive.cmx library/impargs.cmx \
-    library/global.cmx kernel/environ.cmx library/declare.cmx \
-    kernel/declarations.cmx library/decl_kinds.cmx interp/constrextern.cmx \
-    pretyping/classops.cmx contrib/interface/name_to_ast.cmi 
+    kernel/typeops.cmx interp/topconstr.cmx kernel/term.cmx kernel/sign.cmx \
+    kernel/reduction.cmx parsing/prettyp.cmx lib/pp.cmx library/nametab.cmx \
+    kernel/names.cmx library/nameops.cmx library/libobject.cmx \
+    library/libnames.cmx library/lib.cmx kernel/inductive.cmx \
+    library/impargs.cmx library/global.cmx kernel/environ.cmx \
+    library/declare.cmx kernel/declarations.cmx library/decl_kinds.cmx \
+    interp/constrextern.cmx pretyping/classops.cmx \
+    contrib/interface/name_to_ast.cmi 
 contrib/interface/parse.cmo: contrib/interface/xlate.cmi \
     contrib/interface/vtp.cmi toplevel/vernacexpr.cmo \
     toplevel/vernacentries.cmi lib/util.cmi lib/system.cmi lib/pp.cmi \
@@ -3241,7 +3373,7 @@ contrib/interface/showproof_ct.cmx: contrib/interface/xlate.cmx \
     parsing/printer.cmx lib/pp.cmx toplevel/metasyntax.cmx library/global.cmx \
     contrib/interface/ascent.cmi 
 contrib/interface/showproof.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    pretyping/typing.cmi contrib/interface/translate.cmi \
+    pretyping/typing.cmi kernel/typeops.cmi contrib/interface/translate.cmi \
     pretyping/termops.cmi kernel/term.cmi proofs/tacmach.cmi \
     proofs/tacexpr.cmo kernel/sign.cmi contrib/interface/showproof_ct.cmo \
     pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
@@ -3252,7 +3384,7 @@ contrib/interface/showproof.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
     kernel/declarations.cmi interp/constrintern.cmi pretyping/clenv.cmi \
     contrib/interface/showproof.cmi 
 contrib/interface/showproof.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    pretyping/typing.cmx contrib/interface/translate.cmx \
+    pretyping/typing.cmx kernel/typeops.cmx contrib/interface/translate.cmx \
     pretyping/termops.cmx kernel/term.cmx proofs/tacmach.cmx \
     proofs/tacexpr.cmx kernel/sign.cmx contrib/interface/showproof_ct.cmx \
     pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
@@ -3284,18 +3416,16 @@ contrib/interface/xlate.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \
     pretyping/rawterm.cmi parsing/ppconstr.cmi parsing/pcoq.cmi \
     kernel/names.cmi library/libnames.cmi library/goptions.cmi \
-    interp/genarg.cmi contrib/field/field.cmo tactics/extratactics.cmi \
-    tactics/extraargs.cmi parsing/extend.cmi tactics/eauto.cmi \
-    library/decl_kinds.cmo lib/bigint.cmi contrib/interface/ascent.cmi \
-    contrib/interface/xlate.cmi 
+    interp/genarg.cmi tactics/extraargs.cmi parsing/extend.cmi \
+    tactics/eauto.cmi library/decl_kinds.cmo lib/bigint.cmi \
+    contrib/interface/ascent.cmi contrib/interface/xlate.cmi 
 contrib/interface/xlate.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     interp/topconstr.cmx kernel/term.cmx proofs/tacexpr.cmx \
     pretyping/rawterm.cmx parsing/ppconstr.cmx parsing/pcoq.cmx \
     kernel/names.cmx library/libnames.cmx library/goptions.cmx \
-    interp/genarg.cmx contrib/field/field.cmx tactics/extratactics.cmx \
-    tactics/extraargs.cmx parsing/extend.cmx tactics/eauto.cmx \
-    library/decl_kinds.cmx lib/bigint.cmx contrib/interface/ascent.cmi \
-    contrib/interface/xlate.cmi 
+    interp/genarg.cmx tactics/extraargs.cmx parsing/extend.cmx \
+    tactics/eauto.cmx library/decl_kinds.cmx lib/bigint.cmx \
+    contrib/interface/ascent.cmi contrib/interface/xlate.cmi 
 contrib/jprover/jall.cmo: lib/pp.cmi contrib/jprover/opname.cmi \
     contrib/jprover/jtunify.cmi contrib/jprover/jterm.cmi \
     contrib/jprover/jlogic.cmi contrib/jprover/jall.cmi 
@@ -3368,13 +3498,13 @@ contrib/omega/omega.cmo: lib/util.cmi kernel/names.cmi
 contrib/omega/omega.cmx: lib/util.cmx kernel/names.cmx 
 contrib/recdef/recdef.cmo: toplevel/vernacinterp.cmi \
     toplevel/vernacentries.cmi lib/util.cmi pretyping/typing.cmi \
-    interp/topconstr.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tactic_debug.cmi \
-    pretyping/tacred.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    kernel/safe_typing.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
-    parsing/printer.cmi pretyping/pretyping.cmi parsing/ppconstr.cmi \
-    lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi lib/options.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
+    kernel/typeops.cmi interp/topconstr.cmi pretyping/termops.cmi \
+    kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
+    proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
+    tactics/tacinterp.cmi kernel/safe_typing.cmi pretyping/rawterm.cmi \
+    proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \
+    parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi parsing/pcoq.cmi \
+    lib/options.cmi library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     library/libnames.cmi library/lib.cmi tactics/hiddentac.cmi \
     library/global.cmi interp/genarg.cmi pretyping/evd.cmi \
     tactics/equality.cmi kernel/environ.cmi kernel/entries.cmi \
@@ -3384,13 +3514,13 @@ contrib/recdef/recdef.cmo: toplevel/vernacinterp.cmi \
     kernel/closure.cmi toplevel/cerrors.cmi tactics/auto.cmi 
 contrib/recdef/recdef.cmx: toplevel/vernacinterp.cmx \
     toplevel/vernacentries.cmx lib/util.cmx pretyping/typing.cmx \
-    interp/topconstr.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tactic_debug.cmx \
-    pretyping/tacred.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    kernel/safe_typing.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
-    parsing/printer.cmx pretyping/pretyping.cmx parsing/ppconstr.cmx \
-    lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx lib/options.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
+    kernel/typeops.cmx interp/topconstr.cmx pretyping/termops.cmx \
+    kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
+    proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
+    tactics/tacinterp.cmx kernel/safe_typing.cmx pretyping/rawterm.cmx \
+    proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \
+    parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx parsing/pcoq.cmx \
+    lib/options.cmx library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     library/libnames.cmx library/lib.cmx tactics/hiddentac.cmx \
     library/global.cmx interp/genarg.cmx pretyping/evd.cmx \
     tactics/equality.cmx kernel/environ.cmx kernel/entries.cmx \
@@ -3399,23 +3529,23 @@ contrib/recdef/recdef.cmx: toplevel/vernacinterp.cmx \
     interp/coqlib.cmx interp/constrintern.cmx toplevel/command.cmx \
     kernel/closure.cmx toplevel/cerrors.cmx tactics/auto.cmx 
 contrib/ring/g_quote.cmo: lib/util.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo proofs/refiner.cmi contrib/ring/quote.cmo \
-    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \
-    parsing/egrammar.cmi toplevel/cerrors.cmi 
-contrib/ring/g_quote.cmx: lib/util.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx proofs/refiner.cmx contrib/ring/quote.cmx \
-    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \
-    parsing/egrammar.cmx toplevel/cerrors.cmx 
-contrib/ring/g_ring.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    tactics/tacinterp.cmi proofs/tacexpr.cmo contrib/ring/ring.cmo \
-    proofs/refiner.cmi contrib/ring/quote.cmo parsing/pptactic.cmi lib/pp.cmi \
+    proofs/tacexpr.cmo contrib/ring/quote.cmo parsing/pptactic.cmi lib/pp.cmi \
     parsing/pcoq.cmi interp/genarg.cmi parsing/egrammar.cmi \
     toplevel/cerrors.cmi 
-contrib/ring/g_ring.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    tactics/tacinterp.cmx proofs/tacexpr.cmx contrib/ring/ring.cmx \
-    proofs/refiner.cmx contrib/ring/quote.cmx parsing/pptactic.cmx lib/pp.cmx \
+contrib/ring/g_quote.cmx: lib/util.cmx tactics/tacinterp.cmx \
+    proofs/tacexpr.cmx contrib/ring/quote.cmx parsing/pptactic.cmx lib/pp.cmx \
     parsing/pcoq.cmx interp/genarg.cmx parsing/egrammar.cmx \
     toplevel/cerrors.cmx 
+contrib/ring/g_ring.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
+    tactics/tacticals.cmi tactics/tacinterp.cmi proofs/tacexpr.cmo \
+    contrib/ring/ring.cmo proofs/refiner.cmi contrib/ring/quote.cmo \
+    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi interp/genarg.cmi \
+    parsing/egrammar.cmi toplevel/cerrors.cmi 
+contrib/ring/g_ring.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
+    tactics/tacticals.cmx tactics/tacinterp.cmx proofs/tacexpr.cmx \
+    contrib/ring/ring.cmx proofs/refiner.cmx contrib/ring/quote.cmx \
+    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx interp/genarg.cmx \
+    parsing/egrammar.cmx toplevel/cerrors.cmx 
 contrib/ring/quote.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
     tactics/tactics.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
     proofs/proof_trees.cmi lib/pp.cmi pretyping/pattern.cmi kernel/names.cmi \
@@ -3499,43 +3629,47 @@ contrib/rtauto/refl_tauto.cmx: lib/util.cmx pretyping/termops.cmx \
     kernel/environ.cmx interp/coqlib.cmx kernel/closure.cmx \
     contrib/rtauto/refl_tauto.cmi 
 contrib/setoid_ring/newring.cmo: toplevel/vernacinterp.cmi lib/util.cmi \
-    pretyping/typing.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacmach.cmi tactics/tacinterp.cmi \
-    proofs/tacexpr.cmo library/summary.cmi tactics/setoid_replace.cmi \
-    pretyping/retyping.cmi proofs/refiner.cmi pretyping/rawterm.cmi \
+    pretyping/typing.cmi interp/topconstr.cmi kernel/term.cmi \
+    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
+    tactics/tacinterp.cmi proofs/tacexpr.cmo library/summary.cmi \
+    tactics/setoid_replace.cmi pretyping/retyping.cmi proofs/refiner.cmi \
+    pretyping/reductionops.cmi pretyping/rawterm.cmi contrib/ring/quote.cmo \
     proofs/proof_type.cmi parsing/printer.cmi pretyping/pretyping.cmi \
-    parsing/pptactic.cmi parsing/ppconstr.cmi lib/pp.cmi parsing/pcoq.cmi \
+    parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi library/nametab.cmi \
     kernel/names.cmi kernel/mod_subst.cmi library/libobject.cmi \
-    library/lib.cmi parsing/lexer.cmi library/global.cmi interp/genarg.cmi \
-    pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \
-    parsing/egrammar.cmi interp/coqlib.cmi interp/constrintern.cmi \
+    library/libnames.cmi library/lib.cmi parsing/lexer.cmi library/global.cmi \
+    interp/genarg.cmi pretyping/evd.cmi kernel/esubst.cmi kernel/environ.cmi \
+    kernel/entries.cmi parsing/egrammar.cmi library/declare.cmi \
+    library/decl_kinds.cmo interp/coqlib.cmi interp/constrintern.cmi \
     kernel/closure.cmi toplevel/cerrors.cmi 
 contrib/setoid_ring/newring.cmx: toplevel/vernacinterp.cmx lib/util.cmx \
-    pretyping/typing.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacmach.cmx tactics/tacinterp.cmx \
-    proofs/tacexpr.cmx library/summary.cmx tactics/setoid_replace.cmx \
-    pretyping/retyping.cmx proofs/refiner.cmx pretyping/rawterm.cmx \
+    pretyping/typing.cmx interp/topconstr.cmx kernel/term.cmx \
+    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
+    tactics/tacinterp.cmx proofs/tacexpr.cmx library/summary.cmx \
+    tactics/setoid_replace.cmx pretyping/retyping.cmx proofs/refiner.cmx \
+    pretyping/reductionops.cmx pretyping/rawterm.cmx contrib/ring/quote.cmx \
     proofs/proof_type.cmx parsing/printer.cmx pretyping/pretyping.cmx \
-    parsing/pptactic.cmx parsing/ppconstr.cmx lib/pp.cmx parsing/pcoq.cmx \
+    parsing/pptactic.cmx lib/pp.cmx parsing/pcoq.cmx library/nametab.cmx \
     kernel/names.cmx kernel/mod_subst.cmx library/libobject.cmx \
-    library/lib.cmx parsing/lexer.cmx library/global.cmx interp/genarg.cmx \
-    pretyping/evd.cmx kernel/esubst.cmx kernel/environ.cmx \
-    parsing/egrammar.cmx interp/coqlib.cmx interp/constrintern.cmx \
+    library/libnames.cmx library/lib.cmx parsing/lexer.cmx library/global.cmx \
+    interp/genarg.cmx pretyping/evd.cmx kernel/esubst.cmx kernel/environ.cmx \
+    kernel/entries.cmx parsing/egrammar.cmx library/declare.cmx \
+    library/decl_kinds.cmx interp/coqlib.cmx interp/constrintern.cmx \
     kernel/closure.cmx toplevel/cerrors.cmx 
 contrib/subtac/context.cmo: kernel/term.cmi kernel/names.cmi \
     contrib/subtac/context.cmi 
 contrib/subtac/context.cmx: kernel/term.cmx kernel/names.cmx \
     contrib/subtac/context.cmi 
 contrib/subtac/eterm.cmo: lib/util.cmi pretyping/termops.cmi kernel/term.cmi \
-    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi lib/pp.cmi \
-    lib/options.cmi kernel/names.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi kernel/environ.cmi library/declare.cmi \
-    library/decl_kinds.cmo contrib/subtac/eterm.cmi 
+    tactics/tactics.cmi tactics/tacticals.cmi proofs/tacmach.cmi \
+    parsing/printer.cmi lib/pp.cmi lib/options.cmi kernel/names.cmi \
+    library/global.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
+    kernel/environ.cmi contrib/subtac/eterm.cmi 
 contrib/subtac/eterm.cmx: lib/util.cmx pretyping/termops.cmx kernel/term.cmx \
-    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx lib/pp.cmx \
-    lib/options.cmx kernel/names.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx kernel/environ.cmx library/declare.cmx \
-    library/decl_kinds.cmx contrib/subtac/eterm.cmi 
+    tactics/tactics.cmx tactics/tacticals.cmx proofs/tacmach.cmx \
+    parsing/printer.cmx lib/pp.cmx lib/options.cmx kernel/names.cmx \
+    library/global.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
+    kernel/environ.cmx contrib/subtac/eterm.cmi 
 contrib/subtac/g_eterm.cmo: lib/util.cmi proofs/tacmach.cmi \
     tactics/tacinterp.cmi proofs/tacexpr.cmo proofs/refiner.cmi \
     parsing/pptactic.cmi lib/pp.cmi parsing/pcoq.cmi contrib/subtac/eterm.cmi \
@@ -3547,75 +3681,79 @@ contrib/subtac/g_eterm.cmx: lib/util.cmx proofs/tacmach.cmx \
 contrib/subtac/g_subtac.cmo: toplevel/vernacinterp.cmi \
     toplevel/vernacexpr.cmo toplevel/vernacentries.cmi lib/util.cmi \
     interp/topconstr.cmi kernel/term.cmi proofs/tacexpr.cmo \
-    contrib/subtac/subtac.cmi kernel/reduction.cmi proofs/proof_type.cmi \
-    lib/pp.cmi parsing/pcoq.cmi lib/options.cmi kernel/names.cmi \
-    library/nameops.cmi library/libnames.cmi interp/genarg.cmi \
-    parsing/egrammar.cmi toplevel/cerrors.cmi 
+    contrib/subtac/subtac_obligations.cmi contrib/subtac/subtac.cmi \
+    kernel/reduction.cmi proofs/proof_type.cmi lib/pp.cmi parsing/pcoq.cmi \
+    lib/options.cmi kernel/names.cmi library/nameops.cmi library/libnames.cmi \
+    interp/genarg.cmi parsing/egrammar.cmi toplevel/cerrors.cmi 
 contrib/subtac/g_subtac.cmx: toplevel/vernacinterp.cmx \
     toplevel/vernacexpr.cmx toplevel/vernacentries.cmx lib/util.cmx \
     interp/topconstr.cmx kernel/term.cmx proofs/tacexpr.cmx \
-    contrib/subtac/subtac.cmx kernel/reduction.cmx proofs/proof_type.cmx \
-    lib/pp.cmx parsing/pcoq.cmx lib/options.cmx kernel/names.cmx \
-    library/nameops.cmx library/libnames.cmx interp/genarg.cmx \
-    parsing/egrammar.cmx toplevel/cerrors.cmx 
+    contrib/subtac/subtac_obligations.cmx contrib/subtac/subtac.cmx \
+    kernel/reduction.cmx proofs/proof_type.cmx lib/pp.cmx parsing/pcoq.cmx \
+    lib/options.cmx kernel/names.cmx library/nameops.cmx library/libnames.cmx \
+    interp/genarg.cmx parsing/egrammar.cmx toplevel/cerrors.cmx 
 contrib/subtac/subtac_coercion.cmo: lib/util.cmi kernel/typeops.cmi \
     pretyping/termops.cmi kernel/term.cmi contrib/subtac/subtac_utils.cmi \
     contrib/subtac/subtac_errors.cmi pretyping/retyping.cmi \
     pretyping/reductionops.cmi kernel/reduction.cmi pretyping/recordops.cmi \
     pretyping/rawterm.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \
-    lib/pp.cmi kernel/names.cmi library/global.cmi pretyping/evd.cmi \
-    pretyping/evarutil.cmi pretyping/evarconv.cmi contrib/subtac/eterm.cmi \
-    kernel/environ.cmi interp/coqlib.cmi contrib/subtac/context.cmi \
-    pretyping/classops.cmi contrib/subtac/subtac_coercion.cmi 
+    lib/pp.cmi kernel/names.cmi library/nameops.cmi library/global.cmi \
+    pretyping/evd.cmi pretyping/evarutil.cmi pretyping/evarconv.cmi \
+    contrib/subtac/eterm.cmi kernel/environ.cmi interp/coqlib.cmi \
+    contrib/subtac/context.cmi pretyping/classops.cmi \
+    contrib/subtac/subtac_coercion.cmi 
 contrib/subtac/subtac_coercion.cmx: lib/util.cmx kernel/typeops.cmx \
     pretyping/termops.cmx kernel/term.cmx contrib/subtac/subtac_utils.cmx \
     contrib/subtac/subtac_errors.cmx pretyping/retyping.cmx \
     pretyping/reductionops.cmx kernel/reduction.cmx pretyping/recordops.cmx \
     pretyping/rawterm.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \
-    lib/pp.cmx kernel/names.cmx library/global.cmx pretyping/evd.cmx \
-    pretyping/evarutil.cmx pretyping/evarconv.cmx contrib/subtac/eterm.cmx \
-    kernel/environ.cmx interp/coqlib.cmx contrib/subtac/context.cmx \
-    pretyping/classops.cmx contrib/subtac/subtac_coercion.cmi 
+    lib/pp.cmx kernel/names.cmx library/nameops.cmx library/global.cmx \
+    pretyping/evd.cmx pretyping/evarutil.cmx pretyping/evarconv.cmx \
+    contrib/subtac/eterm.cmx kernel/environ.cmx interp/coqlib.cmx \
+    contrib/subtac/context.cmx pretyping/classops.cmx \
+    contrib/subtac/subtac_coercion.cmi 
 contrib/subtac/subtac_command.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     pretyping/typing.cmi interp/topconstr.cmi pretyping/termops.cmi \
     kernel/term.cmi tactics/tactics.cmi tactics/tacticals.cmi \
     proofs/tactic_debug.cmi pretyping/tacred.cmi proofs/tacmach.cmi \
     tactics/tacinterp.cmi proofs/tacexpr.cmo interp/syntax_def.cmi \
     contrib/subtac/subtac_utils.cmi contrib/subtac/subtac_pretyping.cmi \
-    library/states.cmi kernel/sign.cmi kernel/safe_typing.cmi \
-    interp/reserve.cmi proofs/refiner.cmi pretyping/reductionops.cmi \
-    pretyping/rawterm.cmi proofs/proof_type.cmi parsing/printer.cmi \
-    pretyping/pretyping.cmi parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi \
-    pretyping/pattern.cmi lib/options.cmi interp/notation.cmi \
-    library/nametab.cmi kernel/names.cmi library/nameops.cmi \
-    kernel/mod_subst.cmi toplevel/metasyntax.cmi pretyping/matching.cmi \
-    library/libobject.cmi library/libnames.cmi pretyping/inductiveops.cmi \
-    library/impargs.cmi tactics/hiddentac.cmi library/global.cmi \
-    interp/genarg.cmi pretyping/evd.cmi pretyping/evarutil.cmi \
-    contrib/subtac/eterm.cmi kernel/environ.cmi kernel/entries.cmi \
-    lib/dyn.cmi library/declare.cmi kernel/declarations.cmi \
-    library/decl_kinds.cmo interp/coqlib.cmi interp/constrintern.cmi \
-    toplevel/command.cmi kernel/closure.cmi contrib/subtac/subtac_command.cmi 
+    contrib/subtac/subtac_obligations.cmi library/states.cmi kernel/sign.cmi \
+    kernel/safe_typing.cmi interp/reserve.cmi proofs/refiner.cmi \
+    pretyping/reductionops.cmi pretyping/rawterm.cmi proofs/proof_type.cmi \
+    parsing/printer.cmi pretyping/pretyping.cmi parsing/ppconstr.cmi \
+    lib/pp.cmi proofs/pfedit.cmi pretyping/pattern.cmi lib/options.cmi \
+    interp/notation.cmi library/nametab.cmi kernel/names.cmi \
+    library/nameops.cmi kernel/mod_subst.cmi toplevel/metasyntax.cmi \
+    pretyping/matching.cmi library/libobject.cmi library/libnames.cmi \
+    pretyping/inductiveops.cmi library/impargs.cmi tactics/hiddentac.cmi \
+    library/global.cmi interp/genarg.cmi pretyping/evd.cmi \
+    pretyping/evarutil.cmi contrib/subtac/eterm.cmi kernel/environ.cmi \
+    kernel/entries.cmi lib/dyn.cmi library/declare.cmi \
+    kernel/declarations.cmi library/decl_kinds.cmo interp/coqlib.cmi \
+    interp/constrintern.cmi toplevel/command.cmi kernel/closure.cmi \
+    contrib/subtac/subtac_command.cmi 
 contrib/subtac/subtac_command.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     pretyping/typing.cmx interp/topconstr.cmx pretyping/termops.cmx \
     kernel/term.cmx tactics/tactics.cmx tactics/tacticals.cmx \
     proofs/tactic_debug.cmx pretyping/tacred.cmx proofs/tacmach.cmx \
     tactics/tacinterp.cmx proofs/tacexpr.cmx interp/syntax_def.cmx \
     contrib/subtac/subtac_utils.cmx contrib/subtac/subtac_pretyping.cmx \
-    library/states.cmx kernel/sign.cmx kernel/safe_typing.cmx \
-    interp/reserve.cmx proofs/refiner.cmx pretyping/reductionops.cmx \
-    pretyping/rawterm.cmx proofs/proof_type.cmx parsing/printer.cmx \
-    pretyping/pretyping.cmx parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx \
-    pretyping/pattern.cmx lib/options.cmx interp/notation.cmx \
-    library/nametab.cmx kernel/names.cmx library/nameops.cmx \
-    kernel/mod_subst.cmx toplevel/metasyntax.cmx pretyping/matching.cmx \
-    library/libobject.cmx library/libnames.cmx pretyping/inductiveops.cmx \
-    library/impargs.cmx tactics/hiddentac.cmx library/global.cmx \
-    interp/genarg.cmx pretyping/evd.cmx pretyping/evarutil.cmx \
-    contrib/subtac/eterm.cmx kernel/environ.cmx kernel/entries.cmx \
-    lib/dyn.cmx library/declare.cmx kernel/declarations.cmx \
-    library/decl_kinds.cmx interp/coqlib.cmx interp/constrintern.cmx \
-    toplevel/command.cmx kernel/closure.cmx contrib/subtac/subtac_command.cmi 
+    contrib/subtac/subtac_obligations.cmx library/states.cmx kernel/sign.cmx \
+    kernel/safe_typing.cmx interp/reserve.cmx proofs/refiner.cmx \
+    pretyping/reductionops.cmx pretyping/rawterm.cmx proofs/proof_type.cmx \
+    parsing/printer.cmx pretyping/pretyping.cmx parsing/ppconstr.cmx \
+    lib/pp.cmx proofs/pfedit.cmx pretyping/pattern.cmx lib/options.cmx \
+    interp/notation.cmx library/nametab.cmx kernel/names.cmx \
+    library/nameops.cmx kernel/mod_subst.cmx toplevel/metasyntax.cmx \
+    pretyping/matching.cmx library/libobject.cmx library/libnames.cmx \
+    pretyping/inductiveops.cmx library/impargs.cmx tactics/hiddentac.cmx \
+    library/global.cmx interp/genarg.cmx pretyping/evd.cmx \
+    pretyping/evarutil.cmx contrib/subtac/eterm.cmx kernel/environ.cmx \
+    kernel/entries.cmx lib/dyn.cmx library/declare.cmx \
+    kernel/declarations.cmx library/decl_kinds.cmx interp/coqlib.cmx \
+    interp/constrintern.cmx toplevel/command.cmx kernel/closure.cmx \
+    contrib/subtac/subtac_command.cmi 
 contrib/subtac/subtac_errors.cmo: lib/util.cmi parsing/printer.cmi lib/pp.cmi \
     contrib/subtac/subtac_errors.cmi 
 contrib/subtac/subtac_errors.cmx: lib/util.cmx parsing/printer.cmx lib/pp.cmx \
@@ -3674,6 +3812,20 @@ contrib/subtac/subtac.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     lib/dyn.cmx library/decl_kinds.cmx interp/coqlib.cmx \
     contrib/subtac/context.cmx toplevel/command.cmx pretyping/classops.cmx \
     toplevel/cerrors.cmx contrib/subtac/subtac.cmi 
+contrib/subtac/subtac_obligations.cmo: lib/util.cmi kernel/term.cmi \
+    library/summary.cmi contrib/subtac/subtac_utils.cmi lib/pp.cmi \
+    lib/options.cmi kernel/names.cmi library/libobject.cmi \
+    library/libnames.cmi pretyping/evd.cmi kernel/environ.cmi \
+    kernel/entries.cmi library/declare.cmi library/decl_kinds.cmo \
+    toplevel/command.cmi tactics/auto.cmi \
+    contrib/subtac/subtac_obligations.cmi 
+contrib/subtac/subtac_obligations.cmx: lib/util.cmx kernel/term.cmx \
+    library/summary.cmx contrib/subtac/subtac_utils.cmx lib/pp.cmx \
+    lib/options.cmx kernel/names.cmx library/libobject.cmx \
+    library/libnames.cmx pretyping/evd.cmx kernel/environ.cmx \
+    kernel/entries.cmx library/declare.cmx library/decl_kinds.cmx \
+    toplevel/command.cmx tactics/auto.cmx \
+    contrib/subtac/subtac_obligations.cmi 
 contrib/subtac/subtac_pretyping_F.cmo: lib/util.cmi kernel/typeops.cmi \
     kernel/type_errors.cmi pretyping/termops.cmi kernel/term.cmi \
     kernel/sign.cmi pretyping/retyping.cmi pretyping/reductionops.cmi \
@@ -3697,7 +3849,8 @@ contrib/subtac/subtac_pretyping_F.cmx: lib/util.cmx kernel/typeops.cmx \
 contrib/subtac/subtac_pretyping.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
     kernel/typeops.cmi kernel/type_errors.cmi interp/topconstr.cmi \
     pretyping/termops.cmi kernel/term.cmi contrib/subtac/subtac_utils.cmi \
-    contrib/subtac/subtac_pretyping_F.cmo contrib/subtac/subtac_errors.cmi \
+    contrib/subtac/subtac_pretyping_F.cmo \
+    contrib/subtac/subtac_obligations.cmi contrib/subtac/subtac_errors.cmi \
     contrib/subtac/subtac_coercion.cmi kernel/sign.cmi \
     pretyping/reductionops.cmi pretyping/recordops.cmi pretyping/rawterm.cmi \
     parsing/printer.cmi pretyping/pretype_errors.cmi lib/pp.cmi \
@@ -3710,7 +3863,8 @@ contrib/subtac/subtac_pretyping.cmo: toplevel/vernacexpr.cmo lib/util.cmi \
 contrib/subtac/subtac_pretyping.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     kernel/typeops.cmx kernel/type_errors.cmx interp/topconstr.cmx \
     pretyping/termops.cmx kernel/term.cmx contrib/subtac/subtac_utils.cmx \
-    contrib/subtac/subtac_pretyping_F.cmx contrib/subtac/subtac_errors.cmx \
+    contrib/subtac/subtac_pretyping_F.cmx \
+    contrib/subtac/subtac_obligations.cmx contrib/subtac/subtac_errors.cmx \
     contrib/subtac/subtac_coercion.cmx kernel/sign.cmx \
     pretyping/reductionops.cmx pretyping/recordops.cmx pretyping/rawterm.cmx \
     parsing/printer.cmx pretyping/pretype_errors.cmx lib/pp.cmx \
@@ -3722,21 +3876,23 @@ contrib/subtac/subtac_pretyping.cmx: toplevel/vernacexpr.cmx lib/util.cmx \
     contrib/subtac/subtac_pretyping.cmi 
 contrib/subtac/subtac_utils.cmo: lib/util.cmi interp/topconstr.cmi \
     pretyping/termops.cmi kernel/term.cmi tactics/tactics.cmi \
-    tactics/tacticals.cmi proofs/tacexpr.cmo pretyping/rawterm.cmi \
-    proofs/proof_type.cmi parsing/printer.cmi pretyping/pretype_errors.cmi \
-    parsing/ppconstr.cmi lib/pp.cmi proofs/pfedit.cmi lib/options.cmi \
-    kernel/names.cmi library/libnames.cmi library/global.cmi \
-    pretyping/evd.cmi pretyping/evarutil.cmi library/decl_kinds.cmo \
-    interp/coqlib.cmi interp/constrextern.cmi toplevel/command.cmi \
+    tactics/tacticals.cmi proofs/tacmach.cmi proofs/tacexpr.cmo \
+    pretyping/rawterm.cmi proofs/proof_type.cmi proofs/proof_trees.cmi \
+    parsing/printer.cmi pretyping/pretype_errors.cmi parsing/ppconstr.cmi \
+    lib/pp.cmi proofs/pfedit.cmi lib/options.cmi kernel/names.cmi \
+    library/libnames.cmi library/global.cmi pretyping/evd.cmi \
+    pretyping/evarutil.cmi library/decl_kinds.cmo interp/coqlib.cmi \
+    interp/constrextern.cmi toplevel/command.cmi \
     contrib/subtac/subtac_utils.cmi 
 contrib/subtac/subtac_utils.cmx: lib/util.cmx interp/topconstr.cmx \
     pretyping/termops.cmx kernel/term.cmx tactics/tactics.cmx \
-    tactics/tacticals.cmx proofs/tacexpr.cmx pretyping/rawterm.cmx \
-    proofs/proof_type.cmx parsing/printer.cmx pretyping/pretype_errors.cmx \
-    parsing/ppconstr.cmx lib/pp.cmx proofs/pfedit.cmx lib/options.cmx \
-    kernel/names.cmx library/libnames.cmx library/global.cmx \
-    pretyping/evd.cmx pretyping/evarutil.cmx library/decl_kinds.cmx \
-    interp/coqlib.cmx interp/constrextern.cmx toplevel/command.cmx \
+    tactics/tacticals.cmx proofs/tacmach.cmx proofs/tacexpr.cmx \
+    pretyping/rawterm.cmx proofs/proof_type.cmx proofs/proof_trees.cmx \
+    parsing/printer.cmx pretyping/pretype_errors.cmx parsing/ppconstr.cmx \
+    lib/pp.cmx proofs/pfedit.cmx lib/options.cmx kernel/names.cmx \
+    library/libnames.cmx library/global.cmx pretyping/evd.cmx \
+    pretyping/evarutil.cmx library/decl_kinds.cmx interp/coqlib.cmx \
+    interp/constrextern.cmx toplevel/command.cmx \
     contrib/subtac/subtac_utils.cmi 
 contrib/xml/acic2Xml.cmo: contrib/xml/xml.cmi lib/util.cmi kernel/term.cmi \
     kernel/names.cmi contrib/xml/cic2acic.cmo contrib/xml/acic.cmo 
@@ -3745,7 +3901,7 @@ contrib/xml/acic2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx kernel/term.cmx \
 contrib/xml/acic.cmo: kernel/term.cmi kernel/names.cmi 
 contrib/xml/acic.cmx: kernel/term.cmx kernel/names.cmx 
 contrib/xml/cic2acic.cmo: lib/util.cmi contrib/xml/unshare.cmi \
-    kernel/univ.cmi pretyping/termops.cmi kernel/term.cmi \
+    kernel/univ.cmi kernel/typeops.cmi pretyping/termops.cmi kernel/term.cmi \
     pretyping/reductionops.cmi parsing/printer.cmi lib/pp.cmi \
     library/nametab.cmi kernel/names.cmi library/nameops.cmi \
     library/library.cmi library/libnames.cmi library/lib.cmi \
@@ -3754,7 +3910,7 @@ contrib/xml/cic2acic.cmo: lib/util.cmi contrib/xml/unshare.cmi \
     library/dischargedhypsmap.cmi library/declare.cmi kernel/declarations.cmi \
     contrib/xml/acic.cmo 
 contrib/xml/cic2acic.cmx: lib/util.cmx contrib/xml/unshare.cmx \
-    kernel/univ.cmx pretyping/termops.cmx kernel/term.cmx \
+    kernel/univ.cmx kernel/typeops.cmx pretyping/termops.cmx kernel/term.cmx \
     pretyping/reductionops.cmx parsing/printer.cmx lib/pp.cmx \
     library/nametab.cmx kernel/names.cmx library/nameops.cmx \
     library/library.cmx library/libnames.cmx library/lib.cmx \
@@ -3809,8 +3965,8 @@ contrib/xml/proofTree2Xml.cmx: contrib/xml/xml.cmx lib/util.cmx \
 contrib/xml/unshare.cmo: contrib/xml/unshare.cmi 
 contrib/xml/unshare.cmx: contrib/xml/unshare.cmi 
 contrib/xml/xmlcommand.cmo: contrib/xml/xml.cmi toplevel/vernac.cmi \
-    lib/util.cmi contrib/xml/unshare.cmi kernel/term.cmi proofs/tacmach.cmi \
-    pretyping/recordops.cmi proofs/proof_trees.cmi \
+    lib/util.cmi contrib/xml/unshare.cmi kernel/typeops.cmi kernel/term.cmi \
+    proofs/tacmach.cmi pretyping/recordops.cmi proofs/proof_trees.cmi \
     contrib/xml/proof2aproof.cmo proofs/pfedit.cmi library/nametab.cmi \
     kernel/names.cmi library/library.cmi library/libobject.cmi \
     library/libnames.cmi library/lib.cmi parsing/lexer.cmi \
@@ -3820,8 +3976,8 @@ contrib/xml/xmlcommand.cmo: contrib/xml/xml.cmi toplevel/vernac.cmi \
     config/coq_config.cmi contrib/xml/cic2acic.cmo contrib/xml/acic2Xml.cmo \
     contrib/xml/acic.cmo contrib/xml/xmlcommand.cmi 
 contrib/xml/xmlcommand.cmx: contrib/xml/xml.cmx toplevel/vernac.cmx \
-    lib/util.cmx contrib/xml/unshare.cmx kernel/term.cmx proofs/tacmach.cmx \
-    pretyping/recordops.cmx proofs/proof_trees.cmx \
+    lib/util.cmx contrib/xml/unshare.cmx kernel/typeops.cmx kernel/term.cmx \
+    proofs/tacmach.cmx pretyping/recordops.cmx proofs/proof_trees.cmx \
     contrib/xml/proof2aproof.cmx proofs/pfedit.cmx library/nametab.cmx \
     kernel/names.cmx library/library.cmx library/libobject.cmx \
     library/libnames.cmx library/lib.cmx parsing/lexer.cmx \
@@ -3972,6 +4128,8 @@ parsing/vernacextend.cmo:
 parsing/vernacextend.cmx: 
 parsing/q_constr.cmo: 
 parsing/q_constr.cmx: 
+parsing/g_decl_mode.cmo: parsing/grammar.cma
+parsing/g_decl_mode.cmx: parsing/grammar.cma
 toplevel/mltop.cmo: 
 toplevel/mltop.cmx: 
 lib/pp.cmo: 
@@ -3991,96 +4149,66 @@ tools/coq_makefile.cmx:
 tools/coq-tex.cmo: 
 tools/coq-tex.cmx: 
 coq_fix_code.o: kernel/byterun/coq_fix_code.c \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h \
-  kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h
 coq_interp.o: kernel/byterun/coq_interp.c kernel/byterun/coq_gc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/alloc.h /usr/lib/ocaml/caml/mlvalues.h \
   kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
+  kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
   kernel/byterun/coq_jumptbl.h
 coq_memory.o: kernel/byterun/coq_memory.c kernel/byterun/coq_gc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/alloc.h /usr/lib/ocaml/caml/mlvalues.h \
   kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h
+  kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h
 coq_values.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h kernel/byterun/coq_instruct.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/fail.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
+  /usr/lib/ocaml/caml/alloc.h
 coq_fix_code.d.o: kernel/byterun/coq_fix_code.c \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h \
-  kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/misc.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_instruct.h \
+  kernel/byterun/coq_fix_code.h
 coq_interp.d.o: kernel/byterun/coq_interp.c kernel/byterun/coq_gc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/alloc.h /usr/lib/ocaml/caml/mlvalues.h \
   kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
+  kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
   kernel/byterun/coq_jumptbl.h
 coq_memory.d.o: kernel/byterun/coq_memory.c kernel/byterun/coq_gc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/alloc.h /usr/lib/ocaml/caml/mlvalues.h \
   kernel/byterun/coq_instruct.h kernel/byterun/coq_fix_code.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h
+  kernel/byterun/coq_memory.h /usr/lib/ocaml/caml/config.h \
+  /usr/lib/ocaml/caml/fail.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h
 coq_values.d.o: kernel/byterun/coq_values.c kernel/byterun/coq_fix_code.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/compatibility.h \
-  /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h kernel/byterun/coq_instruct.h \
-  kernel/byterun/coq_memory.h /user/jforest/home//lib/ocaml/caml/config.h \
-  /user/jforest/home//lib/ocaml/caml/fail.h \
-  /user/jforest/home//lib/ocaml/caml/mlvalues.h \
-  /user/jforest/home//lib/ocaml/caml/misc.h \
-  /user/jforest/home//lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
-  /user/jforest/home//lib/ocaml/caml/alloc.h
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/compatibility.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/misc.h \
+  kernel/byterun/coq_instruct.h kernel/byterun/coq_memory.h \
+  /usr/lib/ocaml/caml/config.h /usr/lib/ocaml/caml/fail.h \
+  /usr/lib/ocaml/caml/mlvalues.h /usr/lib/ocaml/caml/misc.h \
+  /usr/lib/ocaml/caml/memory.h kernel/byterun/coq_values.h \
+  /usr/lib/ocaml/caml/alloc.h
diff --git a/.depend.camlp4 b/.depend.camlp4
index e1a671bc..895c7857 100644
--- a/.depend.camlp4
+++ b/.depend.camlp4
@@ -42,6 +42,7 @@ parsing/argextend.ml:
 parsing/tacextend.ml: 
 parsing/vernacextend.ml: 
 parsing/q_constr.ml: 
+parsing/g_decl_mode.ml: parsing/grammar.cma
 toplevel/mltop.ml: 
 lib/pp.ml: 
 lib/compat.ml: 
diff --git a/.depend.coq b/.depend.coq
index 17de70f7..430003c5 100644
--- a/.depend.coq
+++ b/.depend.coq
@@ -12,7 +12,7 @@ theories/FSets/FSetWeakProperties.vo: theories/FSets/FSetWeakProperties.v theori
 theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/Logic/DecidableType.vo
 theories/FSets/FSetWeakList.vo: theories/FSets/FSetWeakList.v theories/FSets/FSetWeakInterface.vo
 theories/FSets/FSetWeakFacts.vo: theories/FSets/FSetWeakFacts.v theories/FSets/FSetWeakInterface.vo
-theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetProperties.vo theories/FSets/FSetWeakList.vo
+theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakFacts.vo theories/FSets/FSetWeakProperties.vo theories/FSets/FSetWeakList.vo
 theories/FSets/FMapInterface.vo: theories/FSets/FMapInterface.v theories/FSets/FSetInterface.vo
 theories/FSets/FMapList.vo: theories/FSets/FMapList.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo
 theories/FSets/FMaps.vo: theories/FSets/FMaps.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/FSets/FMapPositive.vo theories/FSets/FMapIntMap.vo theories/FSets/FMapFacts.vo
@@ -21,23 +21,24 @@ theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bo
 theories/FSets/FMapWeakInterface.vo: theories/FSets/FMapWeakInterface.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo
 theories/FSets/FMapWeakList.vo: theories/FSets/FMapWeakList.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FMapWeakInterface.vo
 theories/FSets/FMapWeak.vo: theories/FSets/FMapWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo theories/FSets/FMapWeakFacts.vo
-theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo
+theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/Bool/Bool.vo theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo
 theories/FSets/FMapIntMap.vo: theories/FSets/FMapIntMap.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/NArith/Nnat.vo theories/IntMap/Allmaps.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo
 theories/FSets/FSetToFiniteSet.vo: theories/FSets/FSetToFiniteSet.v theories/Sets/Ensembles.vo theories/Sets/Finite_sets.vo theories/FSets/FSetInterface.vo theories/FSets/FSetProperties.vo theories/FSets/OrderedTypeEx.vo
 theories/FSets/FMapAVL.vo: theories/FSets/FMapAVL.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo
 theories/FSets/FSetAVL.vo: theories/FSets/FSetAVL.v theories/FSets/FSetInterface.vo theories/FSets/FSetList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo
 theories/Reals/Rdefinitions.vo: theories/Reals/Rdefinitions.v theories/ZArith/ZArith_base.vo
 theories/Reals/Raxioms.vo: theories/Reals/Raxioms.v theories/ZArith/ZArith_base.vo theories/Reals/Rdefinitions.vo
-theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/ring/ZArithRing.vo contrib/omega/Omega.vo contrib/field/Field.vo
+theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/setoid_ring/ZArithRing.vo contrib/omega/Omega.vo contrib/setoid_ring/RealField.vo
 theories/Reals/DiscrR.vo: theories/Reals/DiscrR.v theories/Reals/RIneq.vo contrib/omega/Omega.vo
 theories/Reals/Rbase.vo: theories/Reals/Rbase.v theories/Reals/Rdefinitions.vo theories/Reals/Raxioms.vo theories/Reals/RIneq.vo theories/Reals/DiscrR.vo
+theories/Reals/LegacyRfield.vo: theories/Reals/LegacyRfield.v theories/Reals/Raxioms.vo contrib/field/LegacyField.vo
 theories/Reals/R_Ifp.vo: theories/Reals/R_Ifp.v theories/Reals/Rbase.vo contrib/omega/Omega.vo
 theories/Reals/Rbasic_fun.vo: theories/Reals/Rbasic_fun.v theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo contrib/fourier/Fourier.vo
 theories/Reals/R_sqr.vo: theories/Reals/R_sqr.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo
 theories/Reals/SplitAbsolu.vo: theories/Reals/SplitAbsolu.v theories/Reals/Rbasic_fun.vo
 theories/Reals/SplitRmult.vo: theories/Reals/SplitRmult.v theories/Reals/Rbase.vo
-theories/Reals/ArithProp.vo: theories/Reals/ArithProp.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo theories/Arith/Even.vo theories/Arith/Div2.vo
-theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo theories/Reals/Rbasic_fun.vo theories/Reals/R_sqr.vo theories/Reals/SplitAbsolu.vo theories/Reals/SplitRmult.vo theories/Reals/ArithProp.vo contrib/omega/Omega.vo theories/ZArith/Zpower.vo
+theories/Reals/ArithProp.vo: theories/Reals/ArithProp.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo theories/Arith/Even.vo theories/Arith/Div2.vo contrib/setoid_ring/ArithRing.vo
+theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v contrib/ring/LegacyArithRing.vo contrib/setoid_ring/ArithRing.vo theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo theories/Reals/Rbasic_fun.vo theories/Reals/R_sqr.vo theories/Reals/SplitAbsolu.vo theories/Reals/SplitRmult.vo theories/Reals/ArithProp.vo contrib/omega/Omega.vo theories/ZArith/Zpower.vo
 theories/Reals/Rseries.vo: theories/Reals/Rseries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Logic/Classical.vo theories/Arith/Compare.vo
 theories/Reals/SeqProp.vo: theories/Reals/SeqProp.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Logic/Classical.vo theories/Arith/Max.vo
 theories/Reals/Rcomplete.vo: theories/Reals/Rcomplete.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Arith/Max.vo
@@ -121,14 +122,14 @@ theories/Logic/ClassicalEpsilon.vo: theories/Logic/ClassicalEpsilon.v theories/L
 theories/Logic/ClassicalUniqueChoice.vo: theories/Logic/ClassicalUniqueChoice.v theories/Logic/Classical.vo theories/Setoids/Setoid.vo
 theories/Logic/DecidableType.vo: theories/Logic/DecidableType.v theories/Lists/SetoidList.vo
 theories/Logic/DecidableTypeEx.vo: theories/Logic/DecidableTypeEx.v theories/Logic/DecidableType.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo
-theories/Arith/Arith.vo: theories/Arith/Arith.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Plus.vo theories/Arith/Gt.vo theories/Arith/Minus.vo theories/Arith/Mult.vo theories/Arith/Between.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo theories/Arith/Factorial.vo
+theories/Arith/Arith.vo: theories/Arith/Arith.v theories/Arith/Arith_base.vo contrib/setoid_ring/ArithRing.vo
 theories/Arith/Gt.vo: theories/Arith/Gt.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Plus.vo
 theories/Arith/Between.vo: theories/Arith/Between.v theories/Arith/Le.vo theories/Arith/Lt.vo
 theories/Arith/Le.vo: theories/Arith/Le.v
-theories/Arith/Compare.vo: theories/Arith/Compare.v theories/Arith/Arith.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo theories/Arith/Wf_nat.vo theories/Arith/Min.vo
+theories/Arith/Compare.vo: theories/Arith/Compare.v theories/Arith/Arith_base.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo theories/Arith/Wf_nat.vo theories/Arith/Min.vo
 theories/Arith/Lt.vo: theories/Arith/Lt.v theories/Arith/Le.vo
 theories/Arith/Compare_dec.vo: theories/Arith/Compare_dec.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Gt.vo theories/Logic/Decidable.vo
-theories/Arith/Min.vo: theories/Arith/Min.v theories/Arith/Arith.vo
+theories/Arith/Min.vo: theories/Arith/Min.v theories/Arith/Le.vo
 theories/Arith/Div2.vo: theories/Arith/Div2.v theories/Arith/Lt.vo theories/Arith/Plus.vo theories/Arith/Compare_dec.vo theories/Arith/Even.vo
 theories/Arith/Minus.vo: theories/Arith/Minus.v theories/Arith/Lt.vo theories/Arith/Le.vo
 theories/Arith/Mult.vo: theories/Arith/Mult.v theories/Arith/Plus.vo theories/Arith/Minus.vo theories/Arith/Lt.vo theories/Arith/Le.vo
@@ -141,6 +142,7 @@ theories/Arith/Wf_nat.vo: theories/Arith/Wf_nat.v theories/Arith/Lt.vo
 theories/Arith/Max.vo: theories/Arith/Max.v theories/Arith/Arith.vo
 theories/Arith/Bool_nat.vo: theories/Arith/Bool_nat.v theories/Arith/Compare_dec.vo theories/Arith/Peano_dec.vo theories/Bool/Sumbool.vo
 theories/Arith/Factorial.vo: theories/Arith/Factorial.v theories/Arith/Plus.vo theories/Arith/Mult.vo theories/Arith/Lt.vo
+theories/Arith/Arith_base.vo: theories/Arith/Arith_base.v theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Plus.vo theories/Arith/Gt.vo theories/Arith/Minus.vo theories/Arith/Mult.vo theories/Arith/Between.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo theories/Arith/Factorial.vo
 theories/Bool/Bool.vo: theories/Bool/Bool.v
 theories/Bool/IfProp.vo: theories/Bool/IfProp.v theories/Bool/Bool.vo
 theories/Bool/Zerob.vo: theories/Bool/Zerob.v theories/Arith/Arith.vo theories/Bool/Bool.vo
@@ -151,7 +153,7 @@ theories/Bool/Bvector.vo: theories/Bool/Bvector.v theories/Bool/Bool.vo theories
 theories/NArith/BinPos.vo: theories/NArith/BinPos.v
 theories/NArith/Pnat.vo: theories/NArith/Pnat.v theories/NArith/BinPos.vo theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Gt.vo theories/Arith/Plus.vo theories/Arith/Mult.vo theories/Arith/Minus.vo
 theories/NArith/BinNat.vo: theories/NArith/BinNat.v theories/NArith/BinPos.vo
-theories/NArith/NArith.vo: theories/NArith/NArith.v theories/NArith/BinPos.vo theories/NArith/BinNat.vo
+theories/NArith/NArith.vo: theories/NArith/NArith.v theories/NArith/BinPos.vo theories/NArith/BinNat.vo contrib/setoid_ring/NArithRing.vo
 theories/NArith/Nnat.vo: theories/NArith/Nnat.v theories/Arith/Arith.vo theories/Arith/Compare_dec.vo theories/Bool/Sumbool.vo theories/Arith/Div2.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/NArith/Pnat.vo
 theories/NArith/Ndigits.vo: theories/NArith/Ndigits.v theories/Bool/Bool.vo theories/Bool/Bvector.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo
 theories/NArith/Ndec.vo: theories/NArith/Ndec.v theories/Bool/Bool.vo theories/Bool/Sumbool.vo theories/Arith/Arith.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/NArith/Pnat.vo theories/NArith/Nnat.vo theories/NArith/Ndigits.vo
@@ -160,27 +162,27 @@ theories/ZArith/BinInt.vo: theories/ZArith/BinInt.v theories/NArith/BinPos.vo th
 theories/ZArith/Wf_Z.vo: theories/ZArith/Wf_Z.v theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/ZArith/Znat.vo theories/ZArith/Zmisc.vo theories/Arith/Wf_nat.vo
 theories/ZArith/ZArith.vo: theories/ZArith/ZArith.v theories/ZArith/ZArith_base.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zsqrt.vo theories/ZArith/Zpower.vo theories/ZArith/Zdiv.vo theories/ZArith/Zlogarithm.vo
 theories/ZArith/ZArith_dec.vo: theories/ZArith/ZArith_dec.v theories/Bool/Sumbool.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/Zcompare.vo
-theories/ZArith/auxiliary.vo: theories/ZArith/auxiliary.v theories/Arith/Arith.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/Logic/Decidable.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo
+theories/ZArith/auxiliary.vo: theories/ZArith/auxiliary.v theories/Arith/Arith_base.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/Logic/Decidable.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo
 theories/ZArith/Zmisc.vo: theories/ZArith/Zmisc.v theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/Bool/Bool.vo
 theories/ZArith/Zcompare.vo: theories/ZArith/Zcompare.v theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/Arith/Lt.vo theories/Arith/Gt.vo theories/Arith/Plus.vo theories/Arith/Mult.vo
-theories/ZArith/Znat.vo: theories/ZArith/Znat.v theories/Arith/Arith.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/Logic/Decidable.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo
-theories/ZArith/Zorder.vo: theories/ZArith/Zorder.v theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/Arith/Arith.vo theories/Logic/Decidable.vo theories/ZArith/Zcompare.vo
-theories/ZArith/Zabs.vo: theories/ZArith/Zabs.v theories/Arith/Arith.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/ZArith_dec.vo
-theories/ZArith/Zmin.vo: theories/ZArith/Zmin.v theories/Arith/Arith.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo
-theories/ZArith/Zmax.vo: theories/ZArith/Zmax.v theories/Arith/Arith.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo
+theories/ZArith/Znat.vo: theories/ZArith/Znat.v theories/Arith/Arith_base.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/Logic/Decidable.vo theories/Arith/Peano_dec.vo theories/Arith/Compare_dec.vo
+theories/ZArith/Zorder.vo: theories/ZArith/Zorder.v theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/Arith/Arith_base.vo theories/Logic/Decidable.vo theories/ZArith/Zcompare.vo
+theories/ZArith/Zabs.vo: theories/ZArith/Zabs.v theories/Arith/Arith_base.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/ZArith_dec.vo
+theories/ZArith/Zmin.vo: theories/ZArith/Zmin.v theories/Arith/Arith_base.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo
+theories/ZArith/Zmax.vo: theories/ZArith/Zmax.v theories/Arith/Arith_base.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo
 theories/ZArith/Zminmax.vo: theories/ZArith/Zminmax.v theories/ZArith/Zmin.vo theories/ZArith/Zmax.vo theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo
 theories/ZArith/Zeven.vo: theories/ZArith/Zeven.v theories/ZArith/BinInt.vo
 theories/ZArith/Zhints.vo: theories/ZArith/Zhints.v theories/ZArith/BinInt.vo theories/ZArith/Zorder.vo theories/ZArith/Zmin.vo theories/ZArith/Zabs.vo theories/ZArith/Zcompare.vo theories/ZArith/Znat.vo theories/ZArith/auxiliary.vo theories/ZArith/Zmisc.vo theories/ZArith/Wf_Z.vo
 theories/ZArith/Zlogarithm.vo: theories/ZArith/Zlogarithm.v theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zpower.vo
 theories/ZArith/Zpower.vo: theories/ZArith/Zpower.v theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/ZArith/Zcomplements.vo
-theories/ZArith/Zcomplements.vo: theories/ZArith/Zcomplements.v contrib/ring/ZArithRing.vo theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/Arith/Wf_nat.vo theories/Lists/List.vo
-theories/ZArith/Zdiv.vo: theories/ZArith/Zdiv.v theories/ZArith/ZArith_base.vo theories/ZArith/Zbool.vo contrib/omega/Omega.vo contrib/ring/ZArithRing.vo theories/ZArith/Zcomplements.vo
-theories/ZArith/Zsqrt.vo: theories/ZArith/Zsqrt.v contrib/omega/Omega.vo theories/ZArith/ZArith_base.vo contrib/ring/ZArithRing.vo
+theories/ZArith/Zcomplements.vo: theories/ZArith/Zcomplements.v contrib/setoid_ring/ZArithRing.vo theories/ZArith/ZArith_base.vo contrib/omega/Omega.vo theories/Arith/Wf_nat.vo theories/Lists/List.vo
+theories/ZArith/Zdiv.vo: theories/ZArith/Zdiv.v theories/ZArith/ZArith_base.vo theories/ZArith/Zbool.vo contrib/omega/Omega.vo contrib/setoid_ring/ZArithRing.vo theories/ZArith/Zcomplements.vo
+theories/ZArith/Zsqrt.vo: theories/ZArith/Zsqrt.v contrib/setoid_ring/ZArithRing.vo contrib/omega/Omega.vo theories/ZArith/ZArith_base.vo
 theories/ZArith/Zwf.vo: theories/ZArith/Zwf.v theories/ZArith/ZArith_base.vo theories/Arith/Wf_nat.vo contrib/omega/Omega.vo
 theories/ZArith/ZArith_base.vo: theories/ZArith/ZArith_base.v theories/NArith/BinPos.vo theories/NArith/BinNat.vo theories/ZArith/BinInt.vo theories/ZArith/Zcompare.vo theories/ZArith/Zorder.vo theories/ZArith/Zeven.vo theories/ZArith/Zmin.vo theories/ZArith/Zmax.vo theories/ZArith/Zminmax.vo theories/ZArith/Zabs.vo theories/ZArith/Znat.vo theories/ZArith/auxiliary.vo theories/ZArith/ZArith_dec.vo theories/ZArith/Zbool.vo theories/ZArith/Zmisc.vo theories/ZArith/Wf_Z.vo theories/ZArith/Zhints.vo
 theories/ZArith/Zbool.vo: theories/ZArith/Zbool.v theories/ZArith/BinInt.vo theories/ZArith/Zeven.vo theories/ZArith/Zorder.vo theories/ZArith/Zcompare.vo theories/ZArith/ZArith_dec.vo theories/Bool/Sumbool.vo
 theories/ZArith/Zbinary.vo: theories/ZArith/Zbinary.v theories/Bool/Bvector.vo theories/ZArith/ZArith.vo theories/ZArith/Zpower.vo contrib/omega/Omega.vo
-theories/ZArith/Znumtheory.vo: theories/ZArith/Znumtheory.v theories/ZArith/ZArith_base.vo contrib/ring/ZArithRing.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zdiv.vo theories/NArith/Ndigits.vo theories/Arith/Wf_nat.vo
+theories/ZArith/Znumtheory.vo: theories/ZArith/Znumtheory.v theories/ZArith/ZArith_base.vo contrib/setoid_ring/ZArithRing.vo theories/ZArith/Zcomplements.vo theories/ZArith/Zdiv.vo theories/NArith/Ndigits.vo theories/Arith/Wf_nat.vo
 theories/ZArith/Int.vo: theories/ZArith/Int.v theories/ZArith/ZArith.vo contrib/romega/ROmega.vo
 theories/Setoids/Setoid.vo: theories/Setoids/Setoid.v theories/Relations/Relation_Definitions.vo
 theories/Lists/MonoList.vo: theories/Lists/MonoList.v theories/Arith/Le.vo
@@ -189,6 +191,7 @@ theories/Lists/Streams.vo: theories/Lists/Streams.v
 theories/Lists/TheoryList.vo: theories/Lists/TheoryList.v theories/Lists/List.vo theories/Arith/Le.vo theories/Arith/Lt.vo theories/Arith/Minus.vo theories/Bool/DecBool.vo
 theories/Lists/List.vo: theories/Lists/List.v theories/Arith/Le.vo theories/Arith/Gt.vo theories/Arith/Minus.vo theories/Arith/Min.vo theories/Bool/Bool.vo theories/Setoids/Setoid.vo
 theories/Lists/SetoidList.vo: theories/Lists/SetoidList.v theories/Lists/List.vo theories/Sorting/Sorting.vo theories/Setoids/Setoid.vo
+theories/Lists/ListTactics.vo: theories/Lists/ListTactics.v theories/NArith/BinPos.vo theories/Lists/List.vo
 theories/Strings/Ascii.vo: theories/Strings/Ascii.v theories/Bool/Bool.vo theories/NArith/BinPos.vo
 theories/Strings/String.vo: theories/Strings/String.v theories/Arith/Arith.vo theories/Strings/Ascii.vo
 theories/Sets/Classical_sets.vo: theories/Sets/Classical_sets.v theories/Sets/Ensembles.vo theories/Sets/Constructive_sets.vo theories/Logic/Classical_Type.vo
@@ -227,7 +230,7 @@ theories/FSets/FSetWeakProperties.vo: theories/FSets/FSetWeakProperties.v theori
 theories/FSets/FSetWeakInterface.vo: theories/FSets/FSetWeakInterface.v theories/Bool/Bool.vo theories/Logic/DecidableType.vo
 theories/FSets/FSetWeakList.vo: theories/FSets/FSetWeakList.v theories/FSets/FSetWeakInterface.vo
 theories/FSets/FSetWeakFacts.vo: theories/FSets/FSetWeakFacts.v theories/FSets/FSetWeakInterface.vo
-theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetFacts.vo theories/FSets/FSetProperties.vo theories/FSets/FSetWeakList.vo
+theories/FSets/FSetWeak.vo: theories/FSets/FSetWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FSetWeakFacts.vo theories/FSets/FSetWeakProperties.vo theories/FSets/FSetWeakList.vo
 theories/FSets/FMapInterface.vo: theories/FSets/FMapInterface.v theories/FSets/FSetInterface.vo
 theories/FSets/FMapList.vo: theories/FSets/FMapList.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo
 theories/FSets/FMaps.vo: theories/FSets/FMaps.v theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/OrderedTypeAlt.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/FSets/FMapPositive.vo theories/FSets/FMapIntMap.vo theories/FSets/FMapFacts.vo
@@ -236,7 +239,7 @@ theories/FSets/FMapWeakFacts.vo: theories/FSets/FMapWeakFacts.v theories/Bool/Bo
 theories/FSets/FMapWeakInterface.vo: theories/FSets/FMapWeakInterface.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo
 theories/FSets/FMapWeakList.vo: theories/FSets/FMapWeakList.v theories/FSets/FSetInterface.vo theories/FSets/FSetWeakInterface.vo theories/FSets/FMapWeakInterface.vo
 theories/FSets/FMapWeak.vo: theories/FSets/FMapWeak.v theories/Logic/DecidableType.vo theories/Logic/DecidableTypeEx.vo theories/FSets/FMapWeakInterface.vo theories/FSets/FMapWeakList.vo theories/FSets/FMapWeakFacts.vo
-theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo
+theories/FSets/FMapPositive.vo: theories/FSets/FMapPositive.v theories/Bool/Bool.vo theories/ZArith/ZArith.vo theories/FSets/OrderedType.vo theories/FSets/FMapInterface.vo
 theories/FSets/FMapIntMap.vo: theories/FSets/FMapIntMap.v theories/Bool/Bool.vo theories/NArith/NArith.vo theories/NArith/Ndigits.vo theories/NArith/Ndec.vo theories/NArith/Nnat.vo theories/IntMap/Allmaps.vo theories/FSets/OrderedType.vo theories/FSets/OrderedTypeEx.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo
 theories/FSets/FSetToFiniteSet.vo: theories/FSets/FSetToFiniteSet.v theories/Sets/Ensembles.vo theories/Sets/Finite_sets.vo theories/FSets/FSetInterface.vo theories/FSets/FSetProperties.vo theories/FSets/OrderedTypeEx.vo
 theories/FSets/FMapAVL.vo: theories/FSets/FMapAVL.v theories/FSets/FSetInterface.vo theories/FSets/FMapInterface.vo theories/FSets/FMapList.vo theories/ZArith/ZArith.vo theories/ZArith/Int.vo
@@ -271,48 +274,107 @@ theories/Wellfounded/Well_Ordering.vo: theories/Wellfounded/Well_Ordering.v theo
 theories/Wellfounded/Lexicographic_Product.vo: theories/Wellfounded/Lexicographic_Product.v theories/Logic/Eqdep.vo theories/Relations/Relation_Operators.vo theories/Wellfounded/Transitive_Closure.vo
 theories/Reals/Rdefinitions.vo: theories/Reals/Rdefinitions.v theories/ZArith/ZArith_base.vo
 theories/Reals/Raxioms.vo: theories/Reals/Raxioms.v theories/ZArith/ZArith_base.vo theories/Reals/Rdefinitions.vo
-theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/ring/ZArithRing.vo contrib/omega/Omega.vo contrib/field/Field.vo
+theories/Reals/RIneq.vo: theories/Reals/RIneq.v theories/Reals/Raxioms.vo contrib/setoid_ring/ZArithRing.vo contrib/omega/Omega.vo contrib/setoid_ring/RealField.vo
 theories/Reals/DiscrR.vo: theories/Reals/DiscrR.v theories/Reals/RIneq.vo contrib/omega/Omega.vo
 theories/Reals/Rbase.vo: theories/Reals/Rbase.v theories/Reals/Rdefinitions.vo theories/Reals/Raxioms.vo theories/Reals/RIneq.vo theories/Reals/DiscrR.vo
+theories/Reals/LegacyRfield.vo: theories/Reals/LegacyRfield.v theories/Reals/Raxioms.vo contrib/field/LegacyField.vo
+theories/Reals/R_Ifp.vo: theories/Reals/R_Ifp.v theories/Reals/Rbase.vo contrib/omega/Omega.vo
+theories/Reals/Rbasic_fun.vo: theories/Reals/Rbasic_fun.v theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo contrib/fourier/Fourier.vo
+theories/Reals/R_sqr.vo: theories/Reals/R_sqr.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo
+theories/Reals/SplitAbsolu.vo: theories/Reals/SplitAbsolu.v theories/Reals/Rbasic_fun.vo
+theories/Reals/SplitRmult.vo: theories/Reals/SplitRmult.v theories/Reals/Rbase.vo
+theories/Reals/ArithProp.vo: theories/Reals/ArithProp.v theories/Reals/Rbase.vo theories/Reals/Rbasic_fun.vo theories/Arith/Even.vo theories/Arith/Div2.vo contrib/setoid_ring/ArithRing.vo
+theories/Reals/Rfunctions.vo: theories/Reals/Rfunctions.v contrib/ring/LegacyArithRing.vo contrib/setoid_ring/ArithRing.vo theories/Reals/Rbase.vo theories/Reals/R_Ifp.vo theories/Reals/Rbasic_fun.vo theories/Reals/R_sqr.vo theories/Reals/SplitAbsolu.vo theories/Reals/SplitRmult.vo theories/Reals/ArithProp.vo contrib/omega/Omega.vo theories/ZArith/Zpower.vo
+theories/Reals/Rseries.vo: theories/Reals/Rseries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Logic/Classical.vo theories/Arith/Compare.vo
+theories/Reals/SeqProp.vo: theories/Reals/SeqProp.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Logic/Classical.vo theories/Arith/Max.vo
+theories/Reals/Rcomplete.vo: theories/Reals/Rcomplete.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Arith/Max.vo
+theories/Reals/PartSum.vo: theories/Reals/PartSum.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/Rcomplete.vo theories/Arith/Max.vo
+theories/Reals/AltSeries.vo: theories/Reals/AltSeries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/PartSum.vo theories/Arith/Max.vo
+theories/Reals/Binomial.vo: theories/Reals/Binomial.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/PartSum.vo
+theories/Reals/Rsigma.vo: theories/Reals/Rsigma.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo
+theories/Reals/Rprod.vo: theories/Reals/Rprod.v theories/Arith/Compare.vo theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo theories/Reals/Binomial.vo
+theories/Reals/Cauchy_prod.vo: theories/Reals/Cauchy_prod.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/PartSum.vo
+theories/Reals/Alembert.vo: theories/Reals/Alembert.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/PartSum.vo theories/Arith/Max.vo
+theories/Reals/SeqSeries.vo: theories/Reals/SeqSeries.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Arith/Max.vo theories/Reals/Rseries.vo theories/Reals/SeqProp.vo theories/Reals/Rcomplete.vo theories/Reals/PartSum.vo theories/Reals/AltSeries.vo theories/Reals/Binomial.vo theories/Reals/Rsigma.vo theories/Reals/Rprod.vo theories/Reals/Cauchy_prod.vo theories/Reals/Alembert.vo
+theories/Reals/Rtrigo_fun.vo: theories/Reals/Rtrigo_fun.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo
+theories/Reals/Rtrigo_def.vo: theories/Reals/Rtrigo_def.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_fun.vo theories/Arith/Max.vo
+theories/Reals/Rtrigo_alt.vo: theories/Reals/Rtrigo_alt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo
+theories/Reals/Cos_rel.vo: theories/Reals/Cos_rel.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo
+theories/Reals/Cos_plus.vo: theories/Reals/Cos_plus.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_def.vo theories/Reals/Cos_rel.vo theories/Arith/Max.vo
+theories/Reals/Rtrigo.vo: theories/Reals/Rtrigo.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo_fun.vo theories/Reals/Rtrigo_def.vo theories/Reals/Rtrigo_alt.vo theories/Reals/Cos_rel.vo theories/Reals/Cos_plus.vo theories/ZArith/ZArith_base.vo theories/ZArith/Zcomplements.vo theories/Logic/Classical_Prop.vo
+theories/Reals/Rlimit.vo: theories/Reals/Rlimit.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Logic/Classical_Prop.vo contrib/fourier/Fourier.vo
+theories/Reals/Rderiv.vo: theories/Reals/Rderiv.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rlimit.vo contrib/fourier/Fourier.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo contrib/omega/Omega.vo
+theories/Reals/RList.vo: theories/Reals/RList.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo
+theories/Reals/Ranalysis1.vo: theories/Reals/Ranalysis1.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rlimit.vo theories/Reals/Rderiv.vo
+theories/Reals/Ranalysis2.vo: theories/Reals/Ranalysis2.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo
+theories/Reals/Ranalysis3.vo: theories/Reals/Ranalysis3.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis2.vo
+theories/Reals/Rtopology.vo: theories/Reals/Rtopology.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/RList.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo
+theories/Reals/MVT.vo: theories/Reals/MVT.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/Rtopology.vo
+theories/Reals/PSeries_reg.vo: theories/Reals/PSeries_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo theories/Arith/Max.vo theories/Arith/Even.vo
+theories/Reals/Exp_prop.vo: theories/Reals/Exp_prop.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/PSeries_reg.vo theories/Arith/Div2.vo theories/Arith/Even.vo theories/Arith/Max.vo
+theories/Reals/Rtrigo_reg.vo: theories/Reals/Rtrigo_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/PSeries_reg.vo
+theories/Reals/Rsqrt_def.vo: theories/Reals/Rsqrt_def.v theories/Bool/Sumbool.vo theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo
+theories/Reals/R_sqrt.vo: theories/Reals/R_sqrt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rsqrt_def.vo
+theories/Reals/Rtrigo_calc.vo: theories/Reals/Rtrigo_calc.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/R_sqrt.vo
+theories/Reals/Rgeom.vo: theories/Reals/Rgeom.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/R_sqrt.vo
+theories/Reals/Sqrt_reg.vo: theories/Reals/Sqrt_reg.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis1.vo theories/Reals/R_sqrt.vo
+theories/Reals/Ranalysis4.vo: theories/Reals/Ranalysis4.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis3.vo theories/Reals/Exp_prop.vo
+theories/Reals/Rpower.vo: theories/Reals/Rpower.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis1.vo theories/Reals/Exp_prop.vo theories/Reals/Rsqrt_def.vo theories/Reals/R_sqrt.vo theories/Reals/MVT.vo theories/Reals/Ranalysis4.vo
+theories/Reals/Ranalysis.vo: theories/Reals/Ranalysis.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Rtrigo.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis1.vo theories/Reals/Ranalysis2.vo theories/Reals/Ranalysis3.vo theories/Reals/Rtopology.vo theories/Reals/MVT.vo theories/Reals/PSeries_reg.vo theories/Reals/Exp_prop.vo theories/Reals/Rtrigo_reg.vo theories/Reals/Rsqrt_def.vo theories/Reals/R_sqrt.vo theories/Reals/Rtrigo_calc.vo theories/Reals/Rgeom.vo theories/Reals/RList.vo theories/Reals/Sqrt_reg.vo theories/Reals/Ranalysis4.vo theories/Reals/Rpower.vo
+theories/Reals/NewtonInt.vo: theories/Reals/NewtonInt.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis.vo
+theories/Reals/RiemannInt_SF.vo: theories/Reals/RiemannInt_SF.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/Ranalysis.vo theories/Logic/Classical_Prop.vo
+theories/Reals/RiemannInt.vo: theories/Reals/RiemannInt.v theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Ranalysis.vo theories/Reals/Rbase.vo theories/Reals/RiemannInt_SF.vo theories/Logic/Classical_Prop.vo theories/Logic/Classical_Pred_Type.vo theories/Arith/Max.vo
+theories/Reals/Integration.vo: theories/Reals/Integration.v theories/Reals/NewtonInt.vo theories/Reals/RiemannInt_SF.vo theories/Reals/RiemannInt.vo
+theories/Reals/Reals.vo: theories/Reals/Reals.v theories/Reals/Rbase.vo theories/Reals/Rfunctions.vo theories/Reals/SeqSeries.vo theories/Reals/Rtrigo.vo theories/Reals/Ranalysis.vo theories/Reals/Integration.vo
 theories/Sorting/Heap.vo: theories/Sorting/Heap.v theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Relations/Relations.vo theories/Sorting/Sorting.vo
 theories/Sorting/Permutation.vo: theories/Sorting/Permutation.v theories/Relations/Relations.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Arith/Arith.vo
 theories/Sorting/Sorting.vo: theories/Sorting/Sorting.v theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Relations/Relations.vo
 theories/Sorting/PermutSetoid.vo: theories/Sorting/PermutSetoid.v contrib/omega/Omega.vo theories/Relations/Relations.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo theories/Lists/SetoidList.vo
 theories/Sorting/PermutEq.vo: theories/Sorting/PermutEq.v contrib/omega/Omega.vo theories/Relations/Relations.vo theories/Setoids/Setoid.vo theories/Lists/List.vo theories/Sets/Multiset.vo theories/Sorting/Permutation.vo
-theories/QArith/QArith_base.vo: theories/QArith/QArith_base.v theories/ZArith/ZArith.vo contrib/ring/ZArithRing.vo theories/Setoids/Setoid.vo
+theories/QArith/QArith_base.vo: theories/QArith/QArith_base.v theories/ZArith/ZArith.vo contrib/setoid_ring/ZArithRing.vo theories/Setoids/Setoid.vo
 theories/QArith/Qreduction.vo: theories/QArith/Qreduction.v theories/QArith/QArith_base.vo theories/ZArith/Znumtheory.vo
-theories/QArith/Qring.vo: theories/QArith/Qring.v contrib/ring/Ring.vo contrib/ring/Setoid_ring.vo theories/QArith/QArith_base.vo
+theories/QArith/Qring.vo: theories/QArith/Qring.v contrib/setoid_ring/Ring.vo theories/QArith/QArith_base.vo
 theories/QArith/Qreals.vo: theories/QArith/Qreals.v theories/Reals/Rbase.vo theories/QArith/QArith_base.vo
 theories/QArith/QArith.vo: theories/QArith/QArith.v theories/QArith/QArith_base.vo theories/QArith/Qring.vo theories/QArith/Qreduction.vo
-theories/QArith/Qcanon.vo: theories/QArith/Qcanon.v theories/QArith/QArith.vo theories/Logic/Eqdep_dec.vo contrib/field/Field.vo
+theories/QArith/Qcanon.vo: theories/QArith/Qcanon.v contrib/setoid_ring/Field.vo theories/QArith/QArith.vo theories/ZArith/Znumtheory.vo theories/Logic/Eqdep_dec.vo
 contrib/omega/OmegaLemmas.vo: contrib/omega/OmegaLemmas.v theories/ZArith/ZArith_base.vo
 contrib/omega/Omega.vo: contrib/omega/Omega.v theories/ZArith/ZArith_base.vo contrib/omega/OmegaLemmas.vo theories/ZArith/Zhints.vo
 contrib/romega/ReflOmegaCore.vo: contrib/romega/ReflOmegaCore.v theories/Arith/Arith.vo theories/Lists/List.vo theories/Bool/Bool.vo theories/ZArith/ZArith_base.vo contrib/omega/OmegaLemmas.vo theories/Logic/Decidable.vo
 contrib/romega/ROmega.vo: contrib/romega/ROmega.v contrib/romega/ReflOmegaCore.vo
-contrib/ring/ArithRing.vo: contrib/ring/ArithRing.v contrib/ring/Ring.vo theories/Arith/Arith.vo theories/Logic/Eqdep_dec.vo
-contrib/ring/Ring_normalize.vo: contrib/ring/Ring_normalize.v contrib/ring/Ring_theory.vo contrib/ring/Quote.vo
-contrib/ring/Ring_theory.vo: contrib/ring/Ring_theory.v theories/Bool/Bool.vo
-contrib/ring/Ring.vo: contrib/ring/Ring.v theories/Bool/Bool.vo contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo contrib/ring/Ring_abstract.vo
-contrib/ring/NArithRing.vo: contrib/ring/NArithRing.v contrib/ring/Ring.vo theories/ZArith/ZArith_base.vo theories/NArith/NArith.vo theories/Logic/Eqdep_dec.vo
-contrib/ring/ZArithRing.vo: contrib/ring/ZArithRing.v contrib/ring/ArithRing.vo theories/ZArith/ZArith_base.vo theories/Logic/Eqdep_dec.vo
-contrib/ring/Ring_abstract.vo: contrib/ring/Ring_abstract.v contrib/ring/Ring_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo
+contrib/ring/LegacyArithRing.vo: contrib/ring/LegacyArithRing.v theories/Bool/Bool.vo contrib/ring/LegacyRing.vo theories/Arith/Arith.vo theories/Logic/Eqdep_dec.vo
+contrib/ring/Ring_normalize.vo: contrib/ring/Ring_normalize.v contrib/ring/LegacyRing_theory.vo contrib/ring/Quote.vo
+contrib/ring/LegacyRing_theory.vo: contrib/ring/LegacyRing_theory.v theories/Bool/Bool.vo
+contrib/ring/LegacyRing.vo: contrib/ring/LegacyRing.v theories/Bool/Bool.vo contrib/ring/LegacyRing_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo contrib/ring/Ring_abstract.vo
+contrib/ring/LegacyNArithRing.vo: contrib/ring/LegacyNArithRing.v theories/Bool/Bool.vo contrib/ring/LegacyRing.vo theories/ZArith/ZArith_base.vo theories/NArith/NArith.vo theories/Logic/Eqdep_dec.vo
+contrib/ring/LegacyZArithRing.vo: contrib/ring/LegacyZArithRing.v contrib/ring/LegacyArithRing.vo theories/ZArith/ZArith_base.vo theories/Logic/Eqdep_dec.vo contrib/ring/LegacyRing.vo
+contrib/ring/Ring_abstract.vo: contrib/ring/Ring_abstract.v contrib/ring/LegacyRing_theory.vo contrib/ring/Quote.vo contrib/ring/Ring_normalize.vo
 contrib/ring/Quote.vo: contrib/ring/Quote.v
 contrib/ring/Setoid_ring_normalize.vo: contrib/ring/Setoid_ring_normalize.v contrib/ring/Setoid_ring_theory.vo contrib/ring/Quote.vo
 contrib/ring/Setoid_ring.vo: contrib/ring/Setoid_ring.v contrib/ring/Setoid_ring_theory.vo contrib/ring/Quote.vo contrib/ring/Setoid_ring_normalize.vo
 contrib/ring/Setoid_ring_theory.vo: contrib/ring/Setoid_ring_theory.v theories/Bool/Bool.vo theories/Setoids/Setoid.vo
-contrib/field/Field_Compl.vo: contrib/field/Field_Compl.v theories/Lists/List.vo
-contrib/field/Field_Theory.vo: contrib/field/Field_Theory.v theories/Lists/List.vo theories/Arith/Peano_dec.vo contrib/ring/Ring.vo contrib/field/Field_Compl.vo
-contrib/field/Field_Tactic.vo: contrib/field/Field_Tactic.v theories/Lists/List.vo contrib/ring/Ring.vo contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo
-contrib/field/Field.vo: contrib/field/Field.v contrib/field/Field_Compl.vo contrib/field/Field_Theory.vo contrib/field/Field_Tactic.vo
+contrib/field/LegacyField_Compl.vo: contrib/field/LegacyField_Compl.v theories/Lists/List.vo
+contrib/field/LegacyField_Theory.vo: contrib/field/LegacyField_Theory.v theories/Lists/List.vo theories/Arith/Peano_dec.vo contrib/ring/LegacyRing.vo contrib/field/LegacyField_Compl.vo
+contrib/field/LegacyField_Tactic.vo: contrib/field/LegacyField_Tactic.v theories/Lists/List.vo contrib/ring/LegacyRing.vo contrib/field/LegacyField_Compl.vo contrib/field/LegacyField_Theory.vo
+contrib/field/LegacyField.vo: contrib/field/LegacyField.v contrib/field/LegacyField_Compl.vo contrib/field/LegacyField_Theory.vo contrib/field/LegacyField_Tactic.vo
 contrib/fourier/Fourier_util.vo: contrib/fourier/Fourier_util.v theories/Reals/Rbase.vo
-contrib/fourier/Fourier.vo: contrib/fourier/Fourier.v contrib/ring/quote.cmo contrib/ring/ring.cmo contrib/fourier/fourier.cmo contrib/fourier/fourierR.cmo contrib/field/field.cmo contrib/fourier/Fourier_util.vo contrib/field/Field.vo theories/Reals/DiscrR.vo
+contrib/fourier/Fourier.vo: contrib/fourier/Fourier.v contrib/ring/quote.cmo contrib/ring/ring.cmo contrib/fourier/fourier.cmo contrib/fourier/fourierR.cmo contrib/field/field.cmo contrib/fourier/Fourier_util.vo contrib/field/LegacyField.vo theories/Reals/DiscrR.vo
 contrib/subtac/FixSub.vo: contrib/subtac/FixSub.v theories/Init/Wf.vo theories/Arith/Wf_nat.vo theories/Arith/Lt.vo
 contrib/subtac/Utils.vo: contrib/subtac/Utils.v
 contrib/rtauto/Bintree.vo: contrib/rtauto/Bintree.v theories/Lists/List.vo theories/NArith/BinPos.vo
 contrib/rtauto/Rtauto.vo: contrib/rtauto/Rtauto.v theories/Lists/List.vo contrib/rtauto/Bintree.vo theories/Bool/Bool.vo theories/NArith/BinPos.vo
 contrib/recdef/Recdef.vo: contrib/recdef/Recdef.v theories/Arith/Compare_dec.vo theories/Arith/Wf_nat.vo
-contrib/setoid_ring/BinList.vo: contrib/setoid_ring/BinList.v theories/NArith/BinPos.vo
-contrib/setoid_ring/Ring_th.vo: contrib/setoid_ring/Ring_th.v theories/Setoids/Setoid.vo
-contrib/setoid_ring/Pol.vo: contrib/setoid_ring/Pol.v theories/Setoids/Setoid.vo contrib/setoid_ring/BinList.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo contrib/setoid_ring/Ring_th.vo
-contrib/setoid_ring/Ring_tac.vo: contrib/setoid_ring/Ring_tac.v theories/Setoids/Setoid.vo contrib/setoid_ring/BinList.vo theories/NArith/BinPos.vo contrib/setoid_ring/Pol.vo contrib/setoid_ring/newring.cmo
-contrib/setoid_ring/ZRing_th.vo: contrib/setoid_ring/ZRing_th.v contrib/setoid_ring/Ring_th.vo contrib/setoid_ring/Pol.vo contrib/setoid_ring/Ring_tac.vo theories/ZArith/ZArith_base.vo theories/ZArith/BinInt.vo theories/NArith/BinNat.vo theories/Setoids/Setoid.vo
+contrib/setoid_ring/BinList.vo: contrib/setoid_ring/BinList.v theories/NArith/BinPos.vo theories/Lists/List.vo theories/Lists/ListTactics.vo
+contrib/setoid_ring/Ring_theory.vo: contrib/setoid_ring/Ring_theory.v theories/Setoids/Setoid.vo
+contrib/setoid_ring/Ring_polynom.vo: contrib/setoid_ring/Ring_polynom.v theories/Setoids/Setoid.vo contrib/setoid_ring/BinList.vo theories/NArith/BinPos.vo theories/ZArith/BinInt.vo contrib/setoid_ring/Ring_theory.vo
+contrib/setoid_ring/Ring_tac.vo: contrib/setoid_ring/Ring_tac.v theories/Setoids/Setoid.vo theories/NArith/BinPos.vo contrib/setoid_ring/Ring_polynom.vo contrib/setoid_ring/BinList.vo contrib/setoid_ring/newring.cmo
+contrib/setoid_ring/Ring_base.vo: contrib/setoid_ring/Ring_base.v contrib/setoid_ring/newring.cmo contrib/setoid_ring/Ring_theory.vo contrib/setoid_ring/Ring_tac.vo contrib/setoid_ring/InitialRing.vo
+contrib/setoid_ring/InitialRing.vo: contrib/setoid_ring/InitialRing.v theories/ZArith/ZArith_base.vo theories/ZArith/BinInt.vo theories/NArith/BinNat.vo theories/Setoids/Setoid.vo contrib/setoid_ring/Ring_theory.vo contrib/setoid_ring/Ring_tac.vo contrib/setoid_ring/Ring_polynom.vo
+contrib/setoid_ring/Ring_equiv.vo: contrib/setoid_ring/Ring_equiv.v contrib/ring/Setoid_ring_theory.vo contrib/ring/LegacyRing_theory.vo contrib/setoid_ring/Ring_theory.vo
+contrib/setoid_ring/Ring.vo: contrib/setoid_ring/Ring.v theories/Bool/Bool.vo contrib/setoid_ring/Ring_theory.vo contrib/setoid_ring/Ring_base.vo contrib/setoid_ring/Ring_tac.vo
+contrib/setoid_ring/ArithRing.vo: contrib/setoid_ring/ArithRing.v theories/Arith/Mult.vo contrib/setoid_ring/Ring.vo
+contrib/setoid_ring/NArithRing.vo: contrib/setoid_ring/NArithRing.v contrib/setoid_ring/Ring.vo theories/NArith/BinPos.vo theories/NArith/BinNat.vo
+contrib/setoid_ring/ZArithRing.vo: contrib/setoid_ring/ZArithRing.v contrib/setoid_ring/Ring.vo theories/ZArith/ZArith_base.vo
+contrib/setoid_ring/Field_theory.vo: contrib/setoid_ring/Field_theory.v contrib/setoid_ring/Ring.vo theories/ZArith/ZArith_base.vo
+contrib/setoid_ring/Field_tac.vo: contrib/setoid_ring/Field_tac.v contrib/setoid_ring/Ring_tac.vo contrib/setoid_ring/BinList.vo contrib/setoid_ring/Ring_polynom.vo contrib/setoid_ring/InitialRing.vo contrib/setoid_ring/Field_theory.vo
+contrib/setoid_ring/Field.vo: contrib/setoid_ring/Field.v contrib/setoid_ring/Field_theory.vo contrib/setoid_ring/Field_tac.vo
+contrib/setoid_ring/RealField.vo: contrib/setoid_ring/RealField.v theories/Reals/Raxioms.vo theories/Reals/Rdefinitions.vo contrib/setoid_ring/Ring.vo contrib/setoid_ring/Field.vo
diff --git a/CHANGES b/CHANGES
index c1daeecb..e80035ad 100644
--- a/CHANGES
+++ b/CHANGES
@@ -1,5 +1,49 @@
-Changes from V8.0 to V8.1
-=========================
+Changes from V8.1beta to V8.1gamma
+==================================
+
+Syntax
+
+- changed parsing precedence of let/in and fun constructions of Ltac:
+  let x := t in e1; e2 is now parsed as let x := t in (e1;e2).
+
+Language and commands
+
+- Added sort-polymorphism for definitions in Type.
+- Support for implicit arguments in the types of parameters in
+  (co-)fixpoints and (co-)inductive declarations.
+- Improved type inference: use as much of possible general information.
+  before applying irreversible unification heuristics (allow e.g. to
+  infer the predicate in "(exist _ 0 (refl_equal 0) : {n:nat | n=0 })").
+- Support for Miller-Pfenning's patterns unification in type synthesis
+  (e.g. can infer P such that P x y = phi(x,y)).
+- Support for "where" clause in cofixpoint definitions.
+- New option "Set Printing Universes" for making Type levels explicit.
+
+Tactics
+
+- Improved implementation of the ring and field tactics. For compatibility
+  reasons, the previous tactics are renamed as legacy ring and legacy field,
+  but should be considered as deprecated.
+- New declarative mathematical proof language.
+- Support for argument lists of arbitrary length in Tactic Notation.
+- [rewrite ... in H] now fails if [H] is used either in an hypothesis
+  or in the goal.
+- The semantics of [rewrite ... in *] has been slightly modified (see doc). 
+- Support for "as" clause in tactic injection.
+- New forward-reasoning tactic "apply in".
+- Ltac fresh operator now builds names from a concatenation of its arguments.
+- New ltac tactic "remember" to abstract over a subterm and keep an equality
+- Support for Miller-Pfenning's patterns unification in apply/rewrite/...
+  (may lead to few incompatibilities - generally now useless tactic calls).
+
+Bug fixes
+
+- Fix for notations involving basic "match" expressions.
+- Numerous other bugs solved (a few fixes may lead to incompatibilities).
+
+
+Changes from V8.0 to V8.1beta
+=============================
 
 Logic
 
@@ -48,6 +92,10 @@ Tactics
   setoid_symmetry, setoid_transitivity, setoid_reflexivity and autorewite).
   New syntax for declaring relations and morphisms (old syntax still working
   with minor modifications, but deprecated).
+- New implementation (still experimental) of the ring tactic with a built-in
+  notion of coefficients and a better usage of setoids.
+- New conversion tactic "vm_compute": evaluates the goal (or an hypothesis)
+  with a call-by-value strategy, using the compiled version of terms. 
 - When rewriting H where H is not directly a Coq equality, search first H for 
   a registered setoid equality before starting to reduce in H. This is unlikely
   to break any script. Should this happen nonetheless, one can insert manually 
diff --git a/COMPATIBILITY b/COMPATIBILITY
index bb293baa..b5d94d58 100644
--- a/COMPATIBILITY
+++ b/COMPATIBILITY
@@ -3,6 +3,8 @@ Potential sources of incompatibilities between Coq V8.0 and V8.1
 
 (see also file CHANGES)
 
+Language
+
 - Inductive types in Type are now polymorphic over their parameters in
   Type. This may affect the naming of introduction hypotheses if such
   an inductive type in Type is used on small types such as Prop or
@@ -10,6 +12,8 @@ Potential sources of incompatibilities between Coq V8.0 and V8.1
   a matter of fact, it is recommended to systematically name the
   hypotheses that are later refered to in the proof script.
 
+Tactics
+
 - Some bug fixes may lead to incompatibilities. This is e.g. the case
   of inversion on Type which failed to rewrite some hypotheses as it
   did on Prop/Set.
@@ -21,6 +25,28 @@ Potential sources of incompatibilities between Coq V8.0 and V8.1
   premises and the parameters are now interleaved while the whole
   bunch of parameters used to come first.
 
+- The previous implementation of the ring and field tactics are
+  maintained but their name changed : require modules "LegacyRing" or
+  "LegacyField" and globally replace calls to "ring" and "field" by
+  calls to "legacy ring" and "legacy field".
+
+- Users ready to benefit of the power of the new implemetations have
+  to know that
+
+  - most of the time, ring solves goals similarly and often faster;
+  - if not, it may be because the old ring did some automatic unfold;
+    they now have to be done separately (by hand or using ltac);
+  - most of the time, field solvesp goals similarly but much faster but
+    there are usually less side conditions to prove;
+  - to simplify expressions, use now ring_simplify and field_simplify;
+  - simplifications are most of the time different: the new results are
+    more natural but they may require some adaptation of proof scripts;
+  - the Ring library no longer imports the Bool library (you may have
+    to explicitly request a "Require Import Bool");
+  - to declare new rings and fields, see the documentation.
+
+Libraries
+
 - A few changes in the library (as mentioned in the CHANGES file) may
   imply the need for local adaptations.
 
@@ -28,5 +54,5 @@ Potential sources of incompatibilities between Coq V8.0 and V8.1
   match construction: occurrences in the return clause now come after
   the occurrences in the term matched; this was the opposite before.
 
-- For changes in the ML interfaces, see file dev/doc/changes.txt in
-  the main archive.
+For changes in the ML interfaces, see file dev/doc/changes.txt in the
+main archive.
diff --git a/CREDITS b/CREDITS
index eba2a4a4..2e61259f 100644
--- a/CREDITS
+++ b/CREDITS
@@ -38,15 +38,16 @@ contrib/first-order
 contrib/fourier
   developed by Loïc Pottier (INRIA-Lemme, 2001)
 contrib/funind
-  developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2004-2006)
-  and Julien Forest, Benjamin Grégoire and Gilles Barthe (INRIA-Everest, 2006)
+  developed by Pierre Courtieu (INRIA-Lemme, 2003-2004, CNAM, 2004-2006),
+  Julien Forest (INRIA-Everest, 2006) 
+  and Yves Bertot (INRIA-Marelle, 2005-2006).
 contrib/interface
   developed by Yves Bertot with contributions from Loïc Pottier and
   Laurence Rideau as part of the Pcoq project (INRIA-Lemme, 1997-2006)
 contrib/omega
   developed by Pierre Crégut (France Telecom R&D, 1996)
 contrib/recdef
-  developed by Yves Bertot (INRIA-Marelle, 2005)
+  developed by Yves Bertot (INRIA-Marelle, 2005-2006)
 contrib/ring
   developed by Samuel Boutin (INRIA-Coq, 1996) and Patrick 
   Loiseleur (LRI, 1997-1999)
@@ -55,8 +56,9 @@ contrib/romega
 contrib/rtauto
   developed by Pierre Corbineau (LRI, 2005)
 contrib/setoid_ring
-  developed by Benjamin Grégoire, Assia Mahboubi (INRIA-Marelle, 2005-2006)
-  and Bruno Barras (INRIA LogiCal, 2005-2006)
+  developed by Benjamin Grégoire (INRIA-Everest, 2005-2006), 
+  Assia Mahboubi, Laurent Théry (INRIA-Marelle, 2006) 
+  and Bruno Barras (INRIA LogiCal, 2005-2006),
 contrib/subtac
   developed by Matthieu Sozeau (LRI, 2005-2006)
 contrib/xml
@@ -85,7 +87,7 @@ Intensive users suggested improvements of the system :
   Y. Bertot, L. Pottier, L. Théry (INRIA-Lemme projects),
   C. Alvarado, P. Crégut, J.-F. Monin (France Telecom R&D),
   P. Castéran (University Bordeaux 1),
-  The Foundations Group (Radboub University, Nijmegen, The Netherlands),
+  The Foundations Group (Radboud University, Nijmegen, The Netherlands),
   Laboratoire J.-A. Dieudonné (University of Nice-Sophia Antipolis).
 
 The following people have contributed to the development of different versions 
@@ -94,6 +96,7 @@ of the Coq Proof assistant during the indicated time :
   Bruno Barras (INRIA, 1995-now)
   Jacek Chrzaszcz (LRI, 1998-2003)
   Thierry Coquand (INRIA, 1985-1989)
+  Pierre Corbineau (LRI, 2003-now)
   Cristina Cornes (INRIA, 1993-1996)
   Yann Coscoy (INRIA Sophia-Antipolis, 1995-1996)
   David Delahaye (INRIA, 1997-2002)
diff --git a/INSTALL b/INSTALL
index 56c03e2e..1577ba90 100644
--- a/INSTALL
+++ b/INSTALL
@@ -8,7 +8,7 @@ WHAT DO YOU NEED ?
    Coq is designed to work on computers equipped with the Unix operating 
    system. In order to compile Coq V8.1 you need:
 
-     - Objective Caml version 3.06 or later
+     - Objective Caml version 3.07 or later
        (available at http://caml.inria.fr/)
   
    Until now, it has mainly been tested on Sun workstations running Solaris,
@@ -29,7 +29,7 @@ QUICK INSTALLATION PROCEDURE.
 INSTALLATION PROCEDURE IN DETAILS (NORMAL USERS).
 =================================================
 
-1- Check that you have the Objective Caml compiler version 3.06 (or later)
+1- Check that you have the Objective Caml compiler version 3.07 (or later)
    installed on your computer and that "ocamlmktop" and "ocamlc" (or
    its native code version "ocamlc.opt") lie in a directory which is present
    in your $PATH environment variable. 
diff --git a/INSTALL.ide b/INSTALL.ide
index d8f1208b..0ca3d9e0 100644
--- a/INSTALL.ide
+++ b/INSTALL.ide
@@ -9,7 +9,7 @@ DISCLAIMER: CoqIde is ongoing work. Eventhough it should never let you
  	    Do not hesitate to send suggestions/bug reports.
 
 REQUIREMENT:
-	- OCaml >= 3.06 with native thread support.
+	- OCaml >= 3.07 with native thread support.
 	- make world must succeed.
 	- The graphical toolkit Gtk 2.x. See http://www.gtk.org.
 	  The official supported version is at least 2.2.x.
@@ -37,7 +37,7 @@ INSTALLATION
        	http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/lablgtk.html
     The first official release of lablftk2 is here:
 	http://wwwfun.kurims.kyoto-u.ac.jp/soft/olabl/dist/lablgtk-2.2.0.tar.gz
-    Note that even if its README requires ocaml > 3.07, it works ok with 3.06.
+    Note that even if its README requires ocaml > 3.07, it works ok with 3.07.
     If you are in a hurry just run :
     
 cd /tmp && \
diff --git a/INSTALL.macosx b/INSTALL.macosx
index ac9c3e05..84f32670 100644
--- a/INSTALL.macosx
+++ b/INSTALL.macosx
@@ -1,11 +1,11 @@
 INSTALLATION PROCEDURE FOR THE COQ V8.1 SYSTEM UNDER MACOS X
 ------------------------------------------------------------
 
-1) Download archive coq-8.0-macosx.dmg.
+1) Download archive coq-8.1-macosx.dmg.
 
-2) Double-click on its icon; it mounts a disk volume named "Coq V8.0".
+2) Double-click on its icon; it mounts a disk volume named "Coq V8.1".
 
-3) Open volume "Coq 8.0" and double-click on coq-8.0.pkg to launch the
+3) Open volume "Coq 8.1" and double-click on coq-8.1.pkg to launch the
    installer (you'll need administrator permissions).
 
 4) Coq installs in /usr/local/bin, which should be in your PATH, and
diff --git a/Makefile b/Makefile
index 23d7afb4..8ad122da 100644
--- a/Makefile
+++ b/Makefile
@@ -6,7 +6,7 @@
 #         #       GNU Lesser General Public License Version 2.1       #
 #######################################################################
 
-# $Id: Makefile 8989 2006-06-25 22:17:49Z letouzey $ 
+# $Id: Makefile 9347 2006-11-06 16:58:28Z notin $ 
 
 
 # Makefile for Coq
@@ -26,7 +26,11 @@
 
 include config/Makefile
 
-NOARG:
+.PHONY: NOARG
+
+NOARG: world
+
+help:
 	@echo "Please use either"
 	@echo "   ./configure"
 	@echo "   make world"
@@ -36,8 +40,9 @@ NOARG:
 	@echo
 	@echo "For make to be verbose, add VERBOSE=1"
 
+
 # build and install the three subsystems: coq, coqide, pcoq
-world: coq coqide pcoq
+world: revision coq coqide pcoq
 
 install: install-coq install-coqide install-pcoq
 #install-manpages: install-coq-manpages install-pcoq-manpages
@@ -73,15 +78,17 @@ LOCALINCLUDES=-I config -I tools -I tools/coqdoc \
 
 MLINCLUDES=$(LOCALINCLUDES) -I $(MYCAMLP4LIB)
 
+OCAMLC += $(CAMLFLAGS)
+OCAMLOPT += $(CAMLFLAGS)
+
 BYTEFLAGS=$(MLINCLUDES) $(CAMLDEBUG) $(USERFLAGS)
-OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF) $(USERFLAGS) -noassert
-OCAMLDEP=ocamldep
+OPTFLAGS=$(MLINCLUDES) $(CAMLTIMEPROF) $(INLINEFLAG) $(USERFLAGS)
 DEPFLAGS=$(LOCALINCLUDES)
 
 OCAMLC_P4O=$(OCAMLC) -pp $(CAMLP4O) $(BYTEFLAGS)
 OCAMLOPT_P4O=$(OCAMLOPT) -pp $(CAMLP4O) $(OPTFLAGS)
 CAMLP4EXTENDFLAGS=-I . pa_extend.cmo pa_extend_m.cmo q_MLast.cmo
-CAMLP4DEPS=sed -n -e 's|^(\*.*camlp4deps: "\(.*\)".*\*)$$|\1|p'
+CAMLP4DEPS=sed -n -e 's|^(\*.*camlp4deps: "\(.*\)".*\*)|\1|p'
 
 COQINCLUDES=          # coqtop includes itself the needed paths
 GLOB=           # is "-dump-glob file" when making the doc
@@ -91,8 +98,7 @@ UNBOXEDVALUES=  # is "-unboxed-values" to use unboxed values
 COQOPTS=$(GLOB) $(COQ_XML) $(VM) $(UNBOXEDVALUES)
 TIME=           # is "'time -p'" to get compilation time of .v 
 
-BOOTCOQTOP= $(TIME) $(BESTCOQTOP) -boot $(COQOPTS)
-
+BOOTCOQTOP= $(TIME) $(BESTCOQTOP) -boot $(COQOPTS) 
 
 ###########################################################################
 # Objects files 
@@ -141,7 +147,7 @@ LIBRARY=\
 
 PRETYPING=\
   pretyping/termops.cmo pretyping/evd.cmo \
-  pretyping/reductionops.cmo pretyping/inductiveops.cmo \
+  pretyping/reductionops.cmo pretyping/vnorm.cmo pretyping/inductiveops.cmo \
   pretyping/retyping.cmo pretyping/cbv.cmo \
   pretyping/pretype_errors.cmo pretyping/recordops.cmo pretyping/typing.cmo \
   pretyping/tacred.cmo \
@@ -164,20 +170,21 @@ PROOFS=\
   proofs/proof_trees.cmo proofs/logic.cmo \
   proofs/refiner.cmo proofs/evar_refiner.cmo proofs/tacmach.cmo \
   proofs/pfedit.cmo proofs/tactic_debug.cmo \
-  proofs/clenvtac.cmo
+  proofs/clenvtac.cmo proofs/decl_mode.cmo
 
 PARSING=\
   parsing/extend.cmo \
   parsing/pcoq.cmo parsing/egrammar.cmo parsing/g_xml.cmo \
   parsing/ppconstr.cmo parsing/printer.cmo \
-  parsing/pptactic.cmo parsing/tactic_printer.cmo \
+  parsing/pptactic.cmo parsing/ppdecl_proof.cmo parsing/tactic_printer.cmo \
   parsing/printmod.cmo parsing/prettyp.cmo parsing/search.cmo 
 
 HIGHPARSING=\
   parsing/g_constr.cmo parsing/g_vernac.cmo parsing/g_prim.cmo \
   parsing/g_proofs.cmo parsing/g_tactic.cmo parsing/g_ltac.cmo \
   parsing/g_natsyntax.cmo parsing/g_zsyntax.cmo parsing/g_rsyntax.cmo \
-  parsing/g_ascii_syntax.cmo parsing/g_string_syntax.cmo
+  parsing/g_ascii_syntax.cmo parsing/g_string_syntax.cmo \
+  parsing/g_decl_mode.cmo
 
 TACTICS=\
   tactics/dn.cmo tactics/termdn.cmo tactics/btermdn.cmo \
@@ -188,11 +195,12 @@ TACTICS=\
   tactics/dhyp.cmo tactics/auto.cmo \
   tactics/setoid_replace.cmo tactics/equality.cmo \
   tactics/contradiction.cmo tactics/inv.cmo tactics/leminv.cmo \
-  tactics/tacinterp.cmo tactics/autorewrite.cmo
+  tactics/tacinterp.cmo tactics/autorewrite.cmo \
+  tactics/decl_interp.cmo tactics/decl_proof_instr.cmo
 
 TOPLEVEL=\
   toplevel/himsg.cmo toplevel/cerrors.cmo toplevel/class.cmo \
-  toplevel/vernacexpr.cmo  toplevel/metasyntax.cmo \
+  toplevel/vernacexpr.cmo toplevel/metasyntax.cmo \
   toplevel/command.cmo toplevel/record.cmo \
   parsing/ppvernac.cmo \
   toplevel/vernacinterp.cmo toplevel/mltop.cmo \
@@ -280,7 +288,7 @@ FUNINDCMO=\
   contrib/funind/functional_principles_proofs.cmo \
   contrib/funind/functional_principles_types.cmo \
   contrib/funind/invfun.cmo contrib/funind/indfun.cmo \
-  contrib/funind/indfun_main.cmo
+  contrib/funind/merge.cmo contrib/funind/indfun_main.cmo
 
 RECDEFCMO=\
   contrib/recdef/recdef.cmo
@@ -294,19 +302,14 @@ FOCMO=\
 CCCMO=contrib/cc/ccalgo.cmo contrib/cc/ccproof.cmo contrib/cc/cctac.cmo \
   contrib/cc/g_congruence.cmo 
 
-SUBTACCMO=\
-	contrib/subtac/subtac_utils.cmo \
-	contrib/subtac/eterm.cmo \
-	contrib/subtac/g_eterm.cmo \
-	contrib/subtac/context.cmo \
-	contrib/subtac/subtac_errors.cmo \
-	contrib/subtac/subtac_coercion.cmo \
-	contrib/subtac/subtac_pretyping_F.cmo \
-	contrib/subtac/subtac_pretyping.cmo \
-	contrib/subtac/subtac_interp_fixpoint.cmo \
-	contrib/subtac/subtac_command.cmo \
-	contrib/subtac/subtac.cmo \
-	contrib/subtac/g_subtac.cmo
+SUBTACCMO=contrib/subtac/subtac_utils.cmo contrib/subtac/eterm.cmo \
+  contrib/subtac/g_eterm.cmo contrib/subtac/context.cmo \
+  contrib/subtac/subtac_errors.cmo contrib/subtac/subtac_coercion.cmo \
+  contrib/subtac/subtac_obligations.cmo \
+  contrib/subtac/subtac_pretyping_F.cmo contrib/subtac/subtac_pretyping.cmo \
+  contrib/subtac/subtac_interp_fixpoint.cmo \
+  contrib/subtac/subtac_command.cmo contrib/subtac/subtac.cmo \
+  contrib/subtac/g_subtac.cmo
 
 
 RTAUTOCMO=contrib/rtauto/proof_search.cmo contrib/rtauto/refl_tauto.cmo \
@@ -319,10 +322,10 @@ ML4FILES += contrib/jprover/jprover.ml4 contrib/cc/g_congruence.ml4 \
 	contrib/funind/indfun_main.ml4 
 
 
-CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(DPCMO) $(FIELDCMO) \
+CONTRIB=$(OMEGACMO) $(ROMEGACMO) $(RINGCMO) $(NEWRINGCMO) $(DPCMO) $(FIELDCMO) \
 	$(FOURIERCMO) $(EXTRACTIONCMO) $(JPROVERCMO) $(XMLCMO) \
 	$(CCCMO)  $(FOCMO) $(SUBTACCMO) $(RTAUTOCMO) \
-        $(RECDEFCMO) $(FUNINDCMO) $(NEWRINGCMO)
+        $(RECDEFCMO) $(FUNINDCMO)
 
 CMA=$(CLIBS) $(CAMLP4OBJS)
 CMXA=$(CMA:.cma=.cmxa)
@@ -348,10 +351,12 @@ OBJSCMO=$(CONFIG) $(LIBREP) $(KERNEL) $(LIBRARY) $(PRETYPING) $(INTERP) \
 ###########################################################################
 
 CINCLUDES= -I $(CAMLHLIB)
-CC=gcc
-AR=ar
-RANLIB=ranlib
-BYTECCCOMPOPTS=-fno-defer-pop -Wall -Wno-unused
+
+ifeq ($(CAMLVERSION),OCAML307)
+  CFLAGS=-fno-defer-pop -Wall -Wno-unused -DOCAML_307
+else
+  CFLAGS=-fno-defer-pop -Wall -Wno-unused
+endif
 
 # libcoqrun.a 
 
@@ -426,7 +431,7 @@ COQMKTOPCMX=config/coq_config.cmx scripts/tolink.cmx scripts/coqmktop.cmx
 
 $(COQMKTOPBYTE): $(COQMKTOPCMO)
 	$(SHOW)'OCAMLC -o $@'	
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom str.cma unix.cma \
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma \
           $(COQMKTOPCMO) $(OSDEPLIBS)
 
 $(COQMKTOPOPT): $(COQMKTOPCMX)
@@ -454,7 +459,7 @@ COQCCMX=config/coq_config.cmx toplevel/usage.cmx scripts/coqc.cmx
 
 $(COQCBYTE): $(COQCCMO) $(COQTOPBYTE) $(BESTCOQTOP)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom unix.cma $(COQCCMO) $(OSDEPLIBS)
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ unix.cma $(COQCCMO) $(OSDEPLIBS)
 
 $(COQCOPT): $(COQCCMX) $(COQTOPOPT) $(BESTCOQTOP)
 	$(SHOW)'OCAMLOPT -o $@'
@@ -754,14 +759,14 @@ PARSERCODE=contrib/interface/line_parser.cmo contrib/interface/vtp.cmo \
 PARSERCMO=$(PARSERREQUIRES) $(PARSERCODE)
 PARSERCMX= $(PARSERREQUIRESCMX) $(PARSERCODE:.cmo=.cmx)
 
-bin/parser$(EXE): $(PARSERCMO)
+bin/parser$(EXE):$(LIBCOQRUN) $(PARSERCMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) -linkall -custom -cclib -lunix $(BYTEFLAGS) -o $@ \
-	  dynlink.cma $(CMA) $(PARSERCMO)
+	$(HIDE)$(OCAMLC) -custom -linkall $(BYTEFLAGS) -o $@ \
+	  dynlink.cma $(LIBCOQRUN) $(CMA) $(PARSERCMO)
 
-bin/parser.opt$(EXE): $(PARSERCMX)
+bin/parser.opt$(EXE): $(LIBCOQRUN) $(PARSERCMX)
 	$(SHOW)'OCAMLOPT -o $@'
-	$(HIDE)$(OCAMLOPT) -linkall -cclib -lunix $(OPTFLAGS) -o $@ \
+	$(HIDE)$(OCAMLOPT) -linkall $(OPTFLAGS) -o $@ \
 	  $(LIBCOQRUN) $(CMXA) $(PARSERCMX)
 
 INTERFACEVO=
@@ -837,7 +842,7 @@ ARITHVO=\
  theories/Arith/Euclid.vo       theories/Arith/Plus.vo        \
  theories/Arith/Wf_nat.vo  	theories/Arith/Max.vo	      \
  theories/Arith/Bool_nat.vo	theories/Arith/Factorial.vo   \
-# theories/Arith/Div.vo 
+ theories/Arith/Arith_base.vo 
 
 SORTINGVO=\
  theories/Sorting/Heap.vo	theories/Sorting/Permutation.vo \
@@ -880,7 +885,7 @@ LISTSVO=\
  theories/Lists/MonoList.vo \
  theories/Lists/ListSet.vo   	theories/Lists/Streams.vo \
  theories/Lists/TheoryList.vo   theories/Lists/List.vo \
- theories/Lists/SetoidList.vo
+ theories/Lists/SetoidList.vo   theories/Lists/ListTactics.vo
 
 STRINGSVO=\
  theories/Strings/Ascii.vo      theories/Strings/String.vo
@@ -955,6 +960,7 @@ REALSBASEVO=\
  theories/Reals/Rdefinitions.vo \
  theories/Reals/Raxioms.vo      theories/Reals/RIneq.vo \
  theories/Reals/DiscrR.vo       theories/Reals/Rbase.vo \
+ theories/Reals/LegacyRfield.vo
 
 REALS_basic= 
 
@@ -1035,21 +1041,26 @@ ROMEGAVO=\
  contrib/romega/ReflOmegaCore.vo contrib/romega/ROmega.vo 
 
 RINGVO=\
- contrib/ring/ArithRing.vo      contrib/ring/Ring_normalize.vo \
- contrib/ring/Ring_theory.vo    contrib/ring/Ring.vo \
- contrib/ring/NArithRing.vo     \
- contrib/ring/ZArithRing.vo     contrib/ring/Ring_abstract.vo \
- contrib/ring/Quote.vo		contrib/ring/Setoid_ring_normalize.vo \
- contrib/ring/Setoid_ring.vo	contrib/ring/Setoid_ring_theory.vo
-
-NEWRINGVO=\
- contrib/setoid_ring/BinList.vo   contrib/setoid_ring/Ring_th.vo \
- contrib/setoid_ring/Pol.vo       contrib/setoid_ring/Ring_tac.vo \
- contrib/setoid_ring/ZRing_th.vo
+ contrib/ring/LegacyArithRing.vo      	contrib/ring/Ring_normalize.vo \
+ contrib/ring/LegacyRing_theory.vo	contrib/ring/LegacyRing.vo \
+ contrib/ring/LegacyNArithRing.vo     \
+ contrib/ring/LegacyZArithRing.vo	contrib/ring/Ring_abstract.vo \
+ contrib/ring/Quote.vo			contrib/ring/Setoid_ring_normalize.vo \
+ contrib/ring/Setoid_ring.vo		contrib/ring/Setoid_ring_theory.vo
 
 FIELDVO=\
- contrib/field/Field_Compl.vo     contrib/field/Field_Theory.vo \
- contrib/field/Field_Tactic.vo    contrib/field/Field.vo
+ contrib/field/LegacyField_Compl.vo     contrib/field/LegacyField_Theory.vo \
+ contrib/field/LegacyField_Tactic.vo    contrib/field/LegacyField.vo
+
+NEWRINGVO=\
+ contrib/setoid_ring/BinList.vo   	contrib/setoid_ring/Ring_theory.vo \
+ contrib/setoid_ring/Ring_polynom.vo	contrib/setoid_ring/Ring_tac.vo \
+ contrib/setoid_ring/Ring_base.vo 	contrib/setoid_ring/InitialRing.vo \
+ contrib/setoid_ring/Ring_equiv.vo 	contrib/setoid_ring/Ring.vo \
+ contrib/setoid_ring/ArithRing.vo	contrib/setoid_ring/NArithRing.vo \
+ contrib/setoid_ring/ZArithRing.vo \
+ contrib/setoid_ring/Field_theory.vo	contrib/setoid_ring/Field_tac.vo \
+ contrib/setoid_ring/Field.vo		contrib/setoid_ring/RealField.vo
 
 XMLVO= 
 
@@ -1156,7 +1167,7 @@ COQDEPCMO=config/coq_config.cmo tools/coqdep_lexer.cmo tools/coqdep.cmo
 
 $(COQDEP): $(COQDEPCMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ unix.cma $(COQDEPCMO) $(OSDEPLIBS)
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ unix.cma $(COQDEPCMO) $(OSDEPLIBS)
 
 beforedepend:: tools/coqdep_lexer.ml $(COQDEP)
 
@@ -1164,23 +1175,23 @@ GALLINACMO=tools/gallina_lexer.cmo tools/gallina.cmo
 
 $(GALLINA): $(GALLINACMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ $(GALLINACMO)
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(GALLINACMO)
 
 beforedepend:: tools/gallina_lexer.ml
 
 $(COQMAKEFILE): tools/coq_makefile.cmo
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ tools/coq_makefile.cmo
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ tools/coq_makefile.cmo
 
 $(COQTEX): tools/coq-tex.cmo
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ str.cma tools/coq-tex.cmo
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma tools/coq-tex.cmo
 
 beforedepend:: tools/coqwc.ml
 
 $(COQWC): tools/coqwc.cmo
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ tools/coqwc.cmo
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ tools/coqwc.cmo
 
 beforedepend:: tools/coqdoc/pretty.ml tools/coqdoc/index.ml
 
@@ -1190,7 +1201,7 @@ COQDOCCMO=$(CONFIG) tools/coqdoc/cdglobals.cmo tools/coqdoc/alpha.cmo \
 
 $(COQDOC): $(COQDOCCMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -custom -o $@ str.cma unix.cma $(COQDOCCMO)
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ str.cma unix.cma $(COQDOCCMO)
 
 clean::
 	rm -f tools/coqdep_lexer.ml tools/gallina_lexer.ml
@@ -1212,7 +1223,7 @@ MINICOQ=bin/minicoq$(EXE)
 
 $(MINICOQ): $(MINICOQCMO)
 	$(SHOW)'OCAMLC -o $@'
-	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ -custom $(CMA) $(MINICOQCMO) $(OSDEPLIBS)
+	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -o $@ $(CMA) $(MINICOQCMO) $(OSDEPLIBS)
 
 archclean::
 	rm -f $(MINICOQ)
@@ -1248,6 +1259,9 @@ install-opt::
 
 install-tools::
 	$(MKDIR) $(FULLBINDIR)
+	# recopie des fichiers de style pour coqide
+	$(MKDIR) $(FULLCOQLIB)/tools/coqdoc
+	cp tools/coqdoc/coqdoc.css tools/coqdoc/coqdoc.sty $(FULLCOQLIB)/tools/coqdoc
 	cp $(TOOLS) $(FULLBINDIR)
 
 LIBFILES=$(THEORIESVO) $(CONTRIBVO)
@@ -1318,6 +1332,24 @@ clean::
 	rm -f doc/coq.tex
 
 ###########################################################################
+# Documentation of the source code (using ocamldoc)
+###########################################################################
+
+SOURCEDOCDIR=dev/source-doc
+
+.PHONY: source-doc
+
+source-doc:
+	if !(test -d $(SOURCEDOCDIR)); then mkdir $(SOURCEDOCDIR); fi
+	$(OCAMLDOC) -html -rectypes $(LOCALINCLUDES) -d $(SOURCEDOCDIR) `find . -name "*.ml"`
+
+clean::
+	rm -rf $(SOURCEDOCDIR)
+
+
+
+
+###########################################################################
 # Emacs tags
 ###########################################################################
 
@@ -1382,7 +1414,7 @@ GRAMMARNEEDEDCMO=\
   proofs/tacexpr.cmo \
   parsing/lexer.cmo parsing/extend.cmo \
   toplevel/vernacexpr.cmo parsing/pcoq.cmo parsing/q_util.cmo \
-  parsing/q_coqast.cmo
+  parsing/q_coqast.cmo 
 
 CAMLP4EXTENSIONSCMO=\
   parsing/argextend.cmo parsing/tacextend.cmo parsing/vernacextend.cmo 
@@ -1400,9 +1432,9 @@ PRINTERSCMO=\
   kernel/sign.cmo kernel/declarations.cmo kernel/pre_env.cmo \
   kernel/cbytecodes.cmo kernel/cbytegen.cmo kernel/environ.cmo \
   kernel/conv_oracle.cmo kernel/closure.cmo kernel/reduction.cmo	\
-  kernel/cooking.cmo 		\
   kernel/modops.cmo kernel/type_errors.cmo kernel/inductive.cmo		\
-  kernel/subtyping.cmo kernel/typeops.cmo kernel/indtypes.cmo		\
+  kernel/typeops.cmo kernel/subtyping.cmo kernel/indtypes.cmo		\
+  kernel/cooking.cmo 		\
   kernel/term_typing.cmo kernel/mod_typing.cmo kernel/safe_typing.cmo	\
   library/summary.cmo library/global.cmo library/nameops.cmo		\
   library/libnames.cmo library/nametab.cmo library/libobject.cmo	\
@@ -1422,9 +1454,12 @@ PRINTERSCMO=\
   interp/constrextern.cmo interp/syntax_def.cmo interp/constrintern.cmo	\
   proofs/proof_trees.cmo proofs/logic.cmo proofs/refiner.cmo \
   proofs/tacexpr.cmo \
-  proofs/evar_refiner.cmo proofs/pfedit.cmo proofs/tactic_debug.cmo	\
+  proofs/evar_refiner.cmo proofs/pfedit.cmo proofs/tactic_debug.cmo \
+  proofs/decl_mode.cmo \
   parsing/ppconstr.cmo parsing/extend.cmo parsing/pcoq.cmo \
-  parsing/printer.cmo parsing/pptactic.cmo parsing/tactic_printer.cmo \
+  parsing/printer.cmo parsing/pptactic.cmo \
+  parsing/ppdecl_proof.cmo \
+  parsing/tactic_printer.cmo \
   parsing/egrammar.cmo toplevel/himsg.cmo \
   toplevel/cerrors.cmo toplevel/vernacexpr.cmo toplevel/vernacinterp.cmo \
   dev/top_printers.cmo
@@ -1452,7 +1487,9 @@ ML4FILES +=parsing/g_minicoq.ml4 \
 	   parsing/g_xml.ml4 parsing/g_constr.ml4 \
 	   parsing/g_tactic.ml4 parsing/g_ltac.ml4 \
 	   parsing/argextend.ml4 parsing/tacextend.ml4 \
-	   parsing/vernacextend.ml4 parsing/q_constr.ml4
+	   parsing/vernacextend.ml4 parsing/q_constr.ml4 \
+	   parsing/g_decl_mode.ml4
+
 
 # beforedepend:: $(GRAMMARCMO)
 
@@ -1551,6 +1588,19 @@ parsing/lexer.cmo: parsing/lexer.ml4
 	$(SHOW)'OCAMLC4   $<'
 	$(HIDE)$(OCAMLC) $(BYTEFLAGS) -pp "$(CAMLP4O) $(CAMLP4EXTENDFLAGS) `$(CAMLP4DEPS) $<` pr_o.cmo -impl" -c -impl $<
 
+# pretty printing of the revision number when compiling a checked out
+# source tree
+.PHONY: revision
+
+revision:
+ifeq ($(CHECKEDOUT),1)
+	- /bin/rm -f revision
+	sed -ne '/url/s/^.*\/\([^\/]\+\)"$$/\1/p' .svn/entries > revision
+	sed -ne '/revision/s/^.*"\([0-9]\+\)".*$$/r\1/p' .svn/entries >> revision
+endif
+
+archclean::
+	/bin/rm -f revision
 
 
 ###########################################################################
@@ -1576,15 +1626,15 @@ parsing/lexer.cmo: parsing/lexer.ml4
 
 .mll.ml:
 	$(SHOW)'OCAMLLEX  $<'
-	$(HIDE)ocamllex $<
+	$(HIDE)$(OCAMLLEX) $<
 
 .mly.ml:
 	$(SHOW)'OCAMLYACC $<'
-	$(HIDE)ocamlyacc $<
+	$(HIDE)$(OCAMLYACC) $<
 
 .mly.mli:
 	$(SHOW)'OCAMLYACC $<'
-	$(HIDE)ocamlyacc $<
+	$(HIDE)$(OCAMLYACC) $<
 
 .ml4.cmx:
 	$(SHOW)'OCAMLOPT4 $<'
@@ -1630,22 +1680,22 @@ archclean::
 clean:: archclean
 	rm -f *~ */*~ */*/*~
 	rm -f gmon.out core
-	rm -f config/*.cm[ioa]
-	rm -f lib/*.cm[ioa]
-	rm -f kernel/*.cm[ioa]
-	rm -f library/*.cm[ioa]
-	rm -f proofs/*.cm[ioa]
-	rm -f tactics/*.cm[ioa]
-	rm -f interp/*.cm[ioa]
-	rm -f parsing/*.cm[ioa] parsing/*.ppo
-	rm -f pretyping/*.cm[ioa]
-	rm -f toplevel/*.cm[ioa]
-	rm -f ide/*.cm[ioa]
-	rm -f ide/utils/*.cm[ioa]
-	rm -f tools/*.cm[ioa]
-	rm -f tools/*/*.cm[ioa]
-	rm -f scripts/*.cm[ioa]
-	rm -f dev/*.cm[ioa]
+	rm -f config/*.cm[ioa] config/*.annot
+	rm -f lib/*.cm[ioa] lib/*.annot
+	rm -f kernel/*.cm[ioa] kernel/*.annot
+	rm -f library/*.cm[ioa] library/*.annot
+	rm -f proofs/*.cm[ioa] proofs/*.annot
+	rm -f tactics/*.cm[ioa] tactics/*.annot
+	rm -f interp/*.cm[ioa] interp/*.annot
+	rm -f parsing/*.cm[ioa] parsing/*.ppo parsing/*.annot
+	rm -f pretyping/*.cm[ioa] pretyping/*.annot
+	rm -f toplevel/*.cm[ioa] toplevel/*.annot
+	rm -f ide/*.cm[ioa] ide/*.annot
+	rm -f ide/utils/*.cm[ioa] ide/utils/*.annot
+	rm -f tools/*.cm[ioa] tools/*.annot
+	rm -f tools/*/*.cm[ioa] tools/*/*.annot
+	rm -f scripts/*.cm[ioa] scripts/*.annot
+	rm -f dev/*.cm[ioa] dev/*.annot
 	rm -f */*.pp[iox] contrib/*/*.pp[iox]
 
 cleanconfig::
@@ -1703,8 +1753,8 @@ depend: beforedepend dependp4 ml4filesml
 	  echo `$(CAMLP4DEPS) $$f` >> .depend; \
 	done
 # 5.  We express dependencies of .o files
-	gcc -MM $(CINCLUDES) kernel/byterun/*.c >> .depend
-	gcc -MM  $(CINCLUDES) kernel/byterun/*.c | sed -e 's/\.o/.d.o/' >> \
+	$(CC) -MM $(CINCLUDES) kernel/byterun/*.c >> .depend
+	$(CC) -MM  $(CINCLUDES) kernel/byterun/*.c | sed -e 's/\.o/.d.o/' >> \
                     .depend
 # 6. Finally, we erase the generated .ml files
 	rm -f $(ML4FILESML)
@@ -1729,7 +1779,5 @@ devel:
 
 clean::
 	find . -name "\.#*" -exec rm -f {} \;
-	find . -name "*~" -exec rm -f {} \;
-	find . -name "*.annot" -exec rm -f {} \;
 
 ###########################################################################
diff --git a/README.win b/README.win
index d4431ac6..ee64a54d 100644
--- a/README.win
+++ b/README.win
@@ -15,7 +15,7 @@ COMPILATION.
     distribution. If you really need to recompile under Windows, here
     are some indications:
 
-    1- Install ocaml version 3.06 or later, Visual C++ (needed
+    1- Install ocaml version 3.07 or later, Visual C++ (needed
        for the -custom option of ocaml) and MASM (needed if you want
        to produce a native version).
 
diff --git a/config/Makefile.template b/config/Makefile.template
index aa7f2d62..3ea7c7c9 100644
--- a/config/Makefile.template
+++ b/config/Makefile.template
@@ -35,31 +35,41 @@ COQTOP=COQTOPDIRECTORY
 VERSION=COQVERSION
 
 # Directory containing Camlp4 binaries. Can be empty if camlp4 is in the PATH
-CAMLP4BIN=CAMLP4BINDIRECTORY
+CAMLP4BIN="CAMLP4BINDIRECTORY"
 
 # Ocaml version number
 CAMLVERSION=CAMLTAG
 
 # Ocaml .h directory
-CAMLHLIB=CAMLLIBDIRECTORY/caml
+CAMLHLIB="CAMLLIBDIRECTORY"/caml
 
 # Camlp4 library directory (avoid CAMLP4LIB used on Windows)
 CAMLP4O=CAMLP4TOOL
 CAMLP4COMPAT=CAMLP4COMPATFLAGS
-MYCAMLP4LIB=CAMLP4LIBDIRECTORY
+MYCAMLP4LIB="CAMLP4LIBDIRECTORY"
 
 # Objective-Caml compile command 
-OCAMLC=BYTECAMLC
-OCAMLOPT=NATIVECAMLC
+OCAMLC="BYTECAMLC"
+OCAMLOPT="NATIVECAMLC"
+OCAMLDEP="OCAMLDEPEXEC"
+OCAMLDOC="OCAMLDOCEXEC"
+OCAMLLEX="OCAMLLEXEXEC"
+OCAMLYACC="OCAMLYACCEXEC"
 
 # Caml link command and Caml make top command
-CAMLLINK=BYTECAMLC
-CAMLOPTLINK=NATIVECAMLC
-CAMLMKTOP=ocamlmktop
+CAMLLINK="BYTECAMLC"
+CAMLOPTLINK="NATIVECAMLC"
+CAMLMKTOP="CAMLMKTOPEXEC"
+
+# Caml flags
+CAMLFLAGS=CAMLANNOTATEFLAG
 
 # Compilation debug flag
 CAMLDEBUG=COQDEBUGFLAG
 
+# Inlining flag (inlining causes problems with ocaml < 3.09.x)
+INLINEFLAG=COQINLINEFLAG
+
 # User compilation flag
 USERFLAGS=
 
@@ -77,6 +87,11 @@ P4DEP=$(COQTOP)/bin/$(ARCH)/camlp4dep
 # Can be obtain by UNIX command arch
 ARCH=ARCHITECTURE
 
+# Your C compiler and co
+CC="CCEXEC"
+AR="AREXEC"
+RANLIB="RANLIBEXEC"
+
 # Supplementary libs for some systems, currently:
 #  . Sun Solaris: -cclib -lunix -cclib -lnsl -cclib -lsocket
 #  . others     : -cclib -lunix
@@ -93,7 +108,7 @@ EXE=EXECUTEEXTENSION
 MKDIR=mkdir -p
 
 # where to put the coqdoc.sty style file
-COQDOCDIR=COQDOCDIRECTORY
+COQDOCDIR="COQDOCDIRECTORY"
 
 # command to update TeX' kpathsea database
 #MKTEXLSR=MKTEXLSRCOMMAND
@@ -113,5 +128,9 @@ REALS=REALSOPT
 # CoqIde (no/byte/opt)
 HASCOQIDE=COQIDEOPT
 
+# Defining REVISION
+CHECKEDOUT=CHECKEDOUTSOURCETREE
+
 # make or sed are bogus and believe lines not terminating by a return
 # are inexistent
+
diff --git a/config/coq_config.mli b/config/coq_config.mli
index 29ee7f9d..c214344e 100644
--- a/config/coq_config.mli
+++ b/config/coq_config.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coq_config.mli 8932 2006-06-09 09:29:03Z notin $ i*)
+(*i $Id: coq_config.mli 9115 2006-09-01 13:47:00Z notin $ i*)
 
 val local : bool        (* local use (no installation) *)
 
@@ -15,6 +15,7 @@ val coqlib : string     (* where the std library is installed *)
 
 val coqtop : string     (* where are the sources *)
 
+val camldir : string    (* base directory of OCaml binaries *)
 val camllib : string    (* for Dynlink *)
 
 val camlp4lib : string  (* where is the library of Camlp4 *)
diff --git a/configure b/configure
index 71217486..1db98577 100755
--- a/configure
+++ b/configure
@@ -6,8 +6,8 @@
 # 
 ##################################
 
-VERSION=8.1beta
-DATE="Jun 2006"
+VERSION=8.1gamma
+DATE="Nov. 2006"
 
 # a local which command for sh
 which () {
@@ -22,13 +22,75 @@ for i in $PATH; do
 done
 }
 
+usage () {
+    echo -e "Available options for configure are:\n"
+    echo "-help"
+    echo -e "\tDisplays this help page\n"
+    echo "-prefix <dir>"
+    echo -e "\tSet installation directory to <dir>\n"
+    echo "-local"
+    echo -e "\tSet installation directory to the current source tree\n"
+    echo "-src"
+    echo -e "\tSpecifies the source directory\n"
+    echo "-bindir"
+    echo "-libdir"
+    echo "-mandir"
+    echo -e "\tSpecifies where to install bin/lib/man files resp.\n"
+    echo "-emacslib"
+    echo "-emacs"
+    echo -e "\tSpecifies where emacs files are to be installed\n"
+    echo "-coqdocdir"
+    echo -e "\tSpecifies where Coqdoc style files are to be installed\n"
+    echo "-camldir"
+    echo -e "\tTells configure where to look for OCaml files\n"
+    echo "-arch"
+    echo -e "\tSpecifies the architecture\n"
+    echo "-opt"
+    echo -e "\tSpecifies whether or not to generate optimized executables\n"
+    echo "-fsets (all|basic)"
+    echo "-reals (all|basic)"
+    echo -e "Specifies whether or not to compile full FSets/Reals library\n"
+    echo "-coqide (opt|byte|no)"
+    echo -e "\tSpecifies whether or not to compile Coqide\n"
+    echo "-with-geoproof (yes|no)"
+    echo -e "\tSpecifies whether or not to use Geoproof binding\n"
+    echo "-with-cc <file>"
+    echo "-with-ar <file>"
+    echo "-with-ranlib <file>"
+    echo -e "\tTells configure where to find gcc/ar/ranlib executables\n"
+    echo "-byte-only"
+    echo -e "\tCompiles only bytecode version of Coq\n"
+    echo "-debug"
+    echo -e "\tAdd debugging information in the Coq executables\n"
+    echo "-profile"
+    echo -e "\tAdd profiling information in the Coq executables\n"
+    echo "-annotate"
+    echo -e "\tCompiles Coq with -dtypes option"
+}
+
+
+# Default OCaml binaries
 bytecamlc=ocamlc
 nativecamlc=ocamlopt
-camlp4o=camlp4o
+ocamlexec=ocaml
+ocamldepexec=ocamldep
+ocamldocexec=ocamldoc
+ocamllexexec=ocamllex
+ocamlyaccexec=ocamlyacc
+ocamlmktopexec=ocamlmktop
+camlp4oexec=camlp4o
+
+
 coq_debug_flag=
 coq_profile_flag=
+coq_annotate_flag=
+coq_inline_flag=
 best_compiler=opt
 
+gcc_exec=gcc
+ar_exec=ar
+ranlib_exec=ranlib
+
 local=false
 src_spec=no
 prefix_spec=no
@@ -37,6 +99,7 @@ libdir_spec=no
 mandir_spec=no
 emacslib_spec=no
 emacs_spec=no
+camldir_spec=no
 coqdocdir_spec=no
 fsets_opt=no
 fsets=all
@@ -44,16 +107,18 @@ reals_opt=no
 reals=all
 arch_spec=no
 coqide_spec=no
-with_geoproof=true
+with_geoproof=false
 
 # COQTOP=`pwd`
-
+COQSRC=`pwd`
 
 # Parse command-line arguments
 
 while : ; do
   case "$1" in
     "") break;;
+    -help|--help) usage
+	          exit;;
     -prefix|--prefix) prefix_spec=yes
                       prefix="$2"
 		      shift;;
@@ -81,20 +146,32 @@ while : ; do
     -coqdocdir|--coqdocdir) coqdocdir_spec=yes
 	              coqdocdir="$2"
 		      shift;;
+    -camldir|--camldir) camldir_spec=yes
+	                camldir="$2"
+			shift;;
     -arch|--arch) arch_spec=yes
                   arch=$2
 		  shift;;
     -opt|--opt) bytecamlc=ocamlc.opt
-                camlp4o=camlp4o  # can't add .opt since dyn load'll be required
+                camlp4oexec=camlp4o  # can't add .opt since dyn load'll be required
                 nativecamlc=ocamlopt.opt;;
     -fsets|--fsets) fsets_opt=yes
-                    fsets=$2
+                    case "$2" in
+			yes|all) fsets=all;;
+			*) fsets=basic
+		    esac
 		    shift;;
     -reals|--reals) reals_opt=yes
-		    reals=$2
+	            case "$2" in
+			yes|all) reals=all;;
+			*) reals=basic
+		    esac
 		    shift;;
     -coqide|--coqide) coqide_spec=yes
-		      COQIDE=$2
+		      case "$2" in
+			  byte|opt) COQIDE=$2;;
+			  *) COQIDE=no
+		      esac
 		      shift;;
     -with-geoproof|--with-geoproof) 
 	  case $2 in
@@ -102,10 +179,23 @@ while : ; do
 	      no) with_geoproof=false;;
 	  esac
 	  shift;;
+    -with-cc|-with-gcc|--with-cc|--with-gcc) 
+	  gcc_spec=yes
+	  gcc_exec=$2
+	  shift;;
+    -with-ar|--with-ar) 
+	  ar_spec=yes
+	  ar_exec=$2
+	  shift;;
+    -with-ranlib|--with-ranlib) 
+	  ranlib_spec=yes
+	  ranlib_exec=$2
+	  shift;;
     -byte-only|-byteonly|--byteonly|--byte-only) best_compiler=byte;;
     -debug|--debug) coq_debug_flag=-g;;
     -profile|--profile) coq_profile_flag=-p;;
-     *) echo "Unknown option \"$1\"." 1>&2; exit 2;;
+    -annotate|--annotate) coq_annotate_flag=-dtypes;;
+    *) echo "Unknown option \"$1\"." 1>&2; usage; exit 2;;
   esac
   shift
 done
@@ -171,50 +261,71 @@ case $ARCH in
     fi
 esac
 
+# Is the source tree checked out from svn ?
+if test -e .svn/entries ; then 
+    checkedout=1
+else 
+    checkedout=0
+fi
+
 #########################################
 # Objective Caml programs
 
-CAMLC=`which $bytecamlc`
-case "$CAMLC" in
-	"") echo "$bytecamlc is not present in your path !"
-	echo "Give me manually the path to the $bytecamlc executable [/usr/local/bin by default]: "
-	read CAMLC
-	
+case $camldir_spec in
+    no) CAMLC=`which $bytecamlc`
 	case "$CAMLC" in
-		"") CAMLC=/usr/local/bin/$bytecamlc;;
-		*/ocamlc|*/ocamlc.opt) true;;
-		*/) CAMLC="${CAMLC}"$bytecamlc;;
-		*) CAMLC="${CAMLC}"/$bytecamlc;;
+	    "") echo "$bytecamlc is not present in your path !"
+		echo "Give me manually the path to the $bytecamlc executable [/usr/local/bin by default]: "
+		read CAMLC
+		
+		case "$CAMLC" in
+		    "") CAMLC=/usr/local/bin/$bytecamlc;;
+		    */ocamlc|*/ocamlc.opt) true;;
+		    */) CAMLC="${CAMLC}"$bytecamlc;;
+		    *) CAMLC="${CAMLC}"/$bytecamlc;;
+		esac
 	esac
-	bytecamlc="$CAMLC"
-	nativecamlc=`dirname "$CAMLC"`/$nativecamlc;;
+	CAMLBIN=`dirname "$CAMLC"`;;
+    yes) CAMLC=$camldir/$bytecamlc
+        
+         CAMLBIN=`dirname "$CAMLC"`
+	 bytecamlc="$CAMLC"
+	 nativecamlc=$CAMLBIN/$nativecamlc
+	 ocamlexec=$CAMLBIN/ocaml
+	 ocamldepexec=$CAMLBIN/ocamldep
+	 ocamldocexec=$CAMLBIN/ocamldoc
+	 ocamllexexec=$CAMLBIN/ocamllex
+	 ocamlyaccexec=$CAMLBIN/ocamlyacc
+	 camlmktopexec=$CAMLBIN/ocamlmktop
+	 camlp4oexec=$CAMLBIN/camlp4o
 esac
 
 if test ! -f "$CAMLC" ; then
-	echo "I can not find the executable '$CAMLC'! (Have you installed it?)"
-	echo "Configuration script failed!"
-	exit 1
+    echo "I can not find the executable '$CAMLC'! (Have you installed it?)"
+    echo "Configuration script failed!"
+    exit 1
 fi
 
-CAMLBIN=`dirname "$CAMLC"`
-CAMLVERSION=`"$CAMLC" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+
+CAMLVERSION=`"$bytecamlc" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
 
 case $CAMLVERSION in
-  1.*|2.*|3.00|3.01|3.02|3.03|3.03alpha|3.04|3.05beta|3.05|3.08.0)
+    1.*|2.*|3.00|3.01|3.02|3.03|3.03alpha|3.04|3.05beta|3.05|3.08.0)
 	echo "Your version of Objective-Caml is $CAMLVERSION."
 	if [ "$CAMLVERSION" = "3.08.0" ] ; then
-	  echo "You need Objective-Caml 3.06 or later (to the exception of 3.08.0)!"
+	    echo "You need Objective-Caml 3.06 or later (to the exception of 3.08.0)!"
 	else
-	  echo "You need Objective-Caml 3.06 or later!";
+	    echo "You need Objective-Caml 3.06 or later!"
 	fi
 	echo "Configuration script failed!"
 	exit 1;;
-  3.06|3.07*|3.08*)
-	echo "You have Objective-Caml $CAMLVERSION. Good!";;
-  ?*)
+    3.06|3.07*|3.08*)
+	echo "You have Objective-Caml $CAMLVERSION. Good!"
+	coq_inline_flag="-inline 0";;
+    ?*)
 	CAMLP4COMPAT="-loc loc" 
 	echo "You have Objective-Caml $CAMLVERSION. Good!";;
-  *)
+    *)
 	echo "I found the Objective-Caml compiler but cannot find its version number!"
 	echo "Is it installed properly ?"
 	echo "Configuration script failed!"
@@ -226,17 +337,18 @@ CAMLTAG=OCAML`echo $CAMLVERSION | sed -e "s/\([1-9]\)\.\([0-9]*\).*/\1\2/g"`
 # do we have a native compiler: test of ocamlopt and its version
 
 if [ "$best_compiler" = "opt" ] ; then
-  CAMLOPT=`which $nativecamlc`
-  case "$CAMLOPT" in
-    "") best_compiler=byte
-        echo "You have only bytecode compilation.";;
-    *) CAMLOPTVERSION=`"$CAMLOPT" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
-       if [ "$CAMLOPTVERSION" != "$CAMLVERSION" ] ; then \
-         echo "native and bytecode compilers do not have the same version!"; fi
-       echo "You have native-code compilation. Good!"
-  esac
+  if test -e `which "$nativecamlc"` ; then
+      CAMLOPTVERSION=`"$nativecamlc" -v | sed -n -e 's|.*version* *\(.*\)$|\1|p' `
+      if [ "$CAMLOPTVERSION" != "$CAMLVERSION" ] ; then
+	  echo "native and bytecode compilers do not have the same version!"; fi
+      echo "You have native-code compilation. Good!"
+  else
+      best_compiler=byte ;
+      echo "You have only bytecode compilation."
+  fi
 fi
 
+
 # For coqmktop & bytecode compiler
 
 CAMLLIB=`"$CAMLC" -where`
@@ -485,19 +597,20 @@ echo ""
 
 # An escaped version of a variable
 escape_var () {
-ocaml 2>&1 1>/dev/null <<EOF
+"$ocamlexec" 2>&1 1>/dev/null <<EOF
   prerr_endline(String.escaped(Sys.getenv"$VAR"));;
 EOF
 }
 
-export COQTOP BINDIR LIBDIR CAMLLIB
+export COQTOP BINDIR LIBDIR CAMLBIN CAMLLIB
 ESCCOQTOP="`VAR=COQTOP escape_var`"
 ESCBINDIR="`VAR=BINDIR escape_var`"
 ESCLIBDIR="`VAR=LIBDIR escape_var`"
+ESCCAMLDIR="`VAR=CAMLBIN escape_var`"
 ESCCAMLLIB="`VAR=CAMLLIB escape_var`"
 ESCCAMLP4LIB="$ESCCAMLLIB"/camlp4
 
-mlconfig_file=$COQTOP/config/coq_config.ml
+mlconfig_file="$COQSRC/config/coq_config.ml"
 rm -f $mlconfig_file
 cat << END_OF_COQ_CONFIG > $mlconfig_file
 (* DO NOT EDIT THIS FILE: automatically generated by ../configure *)
@@ -506,6 +619,7 @@ let local = $local
 let bindir = "$ESCBINDIR" 
 let coqlib = "$ESCLIBDIR"
 let coqtop = "$ESCCOQTOP"
+let camldir = "$ESCCAMLDIR"
 let camllib = "$ESCCAMLLIB"
 let camlp4lib = "$ESCCAMLP4LIB"
 let best = "$best_compiler"
@@ -525,25 +639,25 @@ PRINTF=`which printf`
 
 # Subdirectories of theories/ added in coq_config.ml
 subdirs () {
-    (cd $1; find * -type d ! -name .svn -exec $PRINTF "\"%s\";\n" {} \; | grep -v extraction/test | grep -v correctness >> $mlconfig_file)
+    (cd $1; find * -type d ! -name .svn -exec $PRINTF "\"%s\";\n" {} \; | grep -v extraction/test | grep -v correctness >> "$mlconfig_file")
 }
 
-echo "let theories_dirs = [" >> $mlconfig_file
+echo "let theories_dirs = [" >> "$mlconfig_file"
 subdirs theories
-echo "]" >> $mlconfig_file
+echo "]" >> "$mlconfig_file"
 
-echo "let contrib_dirs = [" >> $mlconfig_file
+echo "let contrib_dirs = [" >> "$mlconfig_file"
 subdirs contrib
-echo "]" >> $mlconfig_file
+echo "]" >> "$mlconfig_file"
 
-chmod a-w $mlconfig_file
+chmod a-w "$mlconfig_file"
 
 
 ###############################################
 # Building the $COQTOP/config/Makefile file
 ###############################################
 
-rm -f $COQTOP/config/Makefile
+rm -f "$COQSRC/config/Makefile"
 
 # damned backslashes under M$Windows (bis)
 case $ARCH in
@@ -579,25 +693,36 @@ sed -e "s|LOCALINSTALLATION|$local|" \
     -e "s|ARCHITECTURE|$ARCH|" \
     -e "s|OSDEPENDENTLIBS|$OSDEPLIBS|" \
     -e "s|OSDEPENDENTP4OPTFLAGS|$OSDEPP4OPTFLAGS|" \
-    -e "s|CAMLLIBDIRECTORY|$CAMLLIB|" \
+    -e "s|CAMLLIBDIRECTORY|$ESCCAMLLIB|" \
     -e "s|CAMLTAG|$CAMLTAG|" \
     -e "s|CAMLP4BINDIRECTORY|$ESCCAMLP4BIN|" \
     -e "s|CAMLP4LIBDIRECTORY|$CAMLP4LIB|" \
-    -e "s|CAMLP4TOOL|$camlp4o|" \
+    -e "s|CAMLP4TOOL|$camlp4oexec|" \
     -e "s|CAMLP4COMPATFLAGS|$CAMLP4COMPAT|" \
     -e "s|COQDEBUGFLAG|$coq_debug_flag|" \
     -e "s|COQPROFILEFLAG|$coq_profile_flag|" \
+    -e "s|COQINLINEFLAG|$coq_inline_flag|" \
+    -e "s|CAMLANNOTATEFLAG|$coq_annotate_flag|" \
     -e "s|BESTCOMPILER|$best_compiler|" \
     -e "s|EXECUTEEXTENSION|$EXE|" \
     -e "s|BYTECAMLC|$bytecamlc|" \
     -e "s|NATIVECAMLC|$nativecamlc|" \
+    -e "s|OCAMLDEPEXEC|$ocamldepexec|" \
+    -e "s|OCAMLDOCEXEC|$ocamldocexec|" \
+    -e "s|OCAMLLEXEXEC|$ocamllexexec|" \
+    -e "s|OCAMLYACCEXEC|$ocamlyaccexec|" \
+    -e "s|CAMLMKTOPEXEC|$camlmktopexec|" \
+    -e "s|CCEXEC|$gcc_exec|" \
+    -e "s|AREXEC|$ar_exec|" \
+    -e "s|RANLIBEXEC|$ranlib_exec|" \
     -e "s|STRIPCOMMAND|$STRIPCOMMAND|" \
     -e "s|FSETSOPT|$fsets|" \
     -e "s|REALSOPT|$reals|" \
     -e "s|COQIDEOPT|$COQIDE|" \
-      $COQTOP/config/Makefile.template > $COQTOP/config/Makefile
+    -e "s|CHECKEDOUTSOURCETREE|$checkedout|" \
+      "$COQSRC/config/Makefile.template" > "$COQSRC/config/Makefile"
 
-chmod a-w $COQTOP/config/Makefile
+chmod a-w "$COQSRC/config/Makefile"
 
 ##################################################
 # Building the $COQTOP/dev/ocamldebug-coq file
@@ -625,7 +750,7 @@ fi
 ####################################################
 
 if [ "$LABLGTKGE26" = "yes" ] ; then
-  cp -f ide/undo_lablgtk_ge26.mli ide/undo.mli;
+  cp -f ide/undo_lablgtk_ge26.mli ide/undo.mli
 else
   cp -f ide/undo_lablgtk_lt26.mli ide/undo.mli
 fi
@@ -639,4 +764,4 @@ echo
 echo "*Warning* To compile the system for a new architecture"
 echo "          don't forget to do a 'make archclean' before './configure'."
 
-# $Id: configure 8961 2006-06-15 15:22:05Z notin $
+# $Id: configure 9353 2006-11-07 16:18:57Z notin $
diff --git a/contrib/cc/ccalgo.ml b/contrib/cc/ccalgo.ml
index 3e2d11a2..8bdae54b 100644
--- a/contrib/cc/ccalgo.ml
+++ b/contrib/cc/ccalgo.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccalgo.ml 7298 2005-08-17 12:56:38Z corbinea $ *)
+(* $Id: ccalgo.ml 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 (* This file implements the basic congruence-closure algorithm by *)
 (* Downey,Sethi and Tarjan. *)
@@ -55,6 +55,8 @@ module ST=struct
 	Hashtbl.replace st.tosign t sign
 	  
   let query sign st=Hashtbl.find st.toterm sign
+
+  let rev_query term st=Hashtbl.find st.tosign term
 	  
   let delete st t=
     try let sign=Hashtbl.find st.tosign t in
@@ -72,10 +74,22 @@ type pa_constructor=
       arity : int;
       args  : int list}
 
+type pa_fun=
+    {fsym:int;
+     fnargs:int}
+
+type pa_mark=
+    Fmark of pa_fun
+  | Cmark of pa_constructor
+
 module PacMap=Map.Make(struct 
 			 type t=pa_constructor 
 			 let compare=Pervasives.compare end) 
 
+module PafMap=Map.Make(struct 
+			 type t=pa_fun
+			 let compare=Pervasives.compare end)
+
 type cinfo=
     {ci_constr: constructor; (* inductive type *)
      ci_arity: int;     (* # args *)
@@ -87,16 +101,20 @@ type term=
   | Appli of term*term
   | Constructor of cinfo (* constructor arity + nhyps *)
 
+type ccpattern =
+    PApp of term * ccpattern list (* arguments are reversed *)
+  | PVar of int 
+
 type rule=
     Congruence
-  | Axiom of identifier * bool 
+  | Axiom of constr * bool 
   | Injection of int * pa_constructor * int * pa_constructor * int
 
 type from=
     Goal
-  | Hyp of identifier
-  | HeqG of identifier
-  | HeqnH of identifier * identifier
+  | Hyp of constr
+  | HeqG of constr
+  | HeqnH of constr * constr
 
 type 'a eq = {lhs:int;rhs:int;rule:'a}
 
@@ -104,6 +122,15 @@ type equality = rule eq
 
 type disequality = from eq
 
+type quant_eq =
+    {qe_hyp_id: identifier;
+     qe_pol: bool;
+     qe_nvars:int;
+     qe_lhs: ccpattern;
+     qe_lhs_valid:bool;
+     qe_rhs: ccpattern;
+     qe_rhs_valid:bool}
+
 let swap eq : equality =
   let swap_rule=match eq.rule with
       Congruence -> Congruence
@@ -122,6 +149,7 @@ type representative=
      mutable lfathers:Intset.t;
      mutable fathers:Intset.t;
      mutable inductive_status: inductive_status;
+     mutable functions: Intset.t PafMap.t;
      mutable constructors: int PacMap.t} (*pac -> term = app(constr,t) *)
 
 type cl = Rep of representative| Eqto of int*equality
@@ -138,7 +166,7 @@ type forest=
     {mutable max_size:int;
      mutable size:int;
      mutable map: node array;
-     axioms: (identifier,term*term) Hashtbl.t;
+     axioms: (constr,term*term) Hashtbl.t;
      mutable epsilons: pa_constructor list;
      syms:(term,int) Hashtbl.t}
 
@@ -147,9 +175,13 @@ type state =
      sigtable:ST.t;
      mutable terms: Intset.t; 
      combine: equality Queue.t; 
-     marks: (int * pa_constructor) Queue.t;
+     marks: (int * pa_mark) Queue.t;
      mutable diseq: disequality list;
-     mutable pa_classes: Intset.t}
+     mutable quant: quant_eq list;
+     mutable pa_classes: Intset.t;
+     q_history: (constr,unit) Hashtbl.t;
+     mutable rew_depth:int;
+     mutable changed:bool}
 
 let dummy_node =
   {clas=Eqto(min_int,{lhs=min_int;rhs=min_int;rule=Congruence});
@@ -157,7 +189,7 @@ let dummy_node =
    vertex=Leaf;
    term=Symb (mkRel min_int)}
 
-let empty ():state =
+let empty depth:state =
   {uf=
      {max_size=init_size;
       size=0;
@@ -170,7 +202,11 @@ let empty ():state =
   marks=Queue.create ();
   sigtable=ST.empty ();
   diseq=[];
-  pa_classes=Intset.empty}
+  quant=[];
+  pa_classes=Intset.empty;
+  q_history=Hashtbl.create init_size;
+  rew_depth=depth;
+  changed=false}
 
 let forest state = state.uf 
        
@@ -221,11 +257,19 @@ let append_pac t p =
 
 let tail_pac p=
   {p with arity=succ p.arity;args=List.tl p.args}
+
+let fsucc paf =
+  {paf with fnargs=succ paf.fnargs}
     
 let add_pac rep pac t =
   if not (PacMap.mem pac rep.constructors) then
     rep.constructors<-PacMap.add pac t rep.constructors
 
+let add_paf rep paf t =
+  let already = 
+    try PafMap.find paf rep.functions with Not_found -> Intset.empty in
+    rep.functions<- PafMap.add paf (Intset.add t already) rep.functions
+
 let term uf i=uf.map.(i).term
 		
 let subterms uf i=
@@ -256,8 +300,36 @@ let new_representative ()=
    lfathers=Intset.empty;
    fathers=Intset.empty;
    inductive_status=Unknown;
+   functions=PafMap.empty;
    constructors=PacMap.empty}
     
+(* rebuild a constr from an applicative term *)
+    
+let rec constr_of_term = function
+    Symb s->s
+  | Eps -> anomaly "epsilon constant has no value" 
+  | Constructor cinfo -> mkConstruct cinfo.ci_constr 
+  | Appli (s1,s2)->
+      make_app [(constr_of_term s2)] s1
+and make_app l=function
+    Appli (s1,s2)->make_app ((constr_of_term s2)::l) s1    
+  | other -> applistc (constr_of_term other) l 
+
+(* rebuild a term from a pattern and a substitution *)
+
+let build_subst uf subst =
+  Array.map (fun i -> 
+	       try term uf i 
+	       with _ -> anomaly "incomplete matching") subst
+
+let rec inst_pattern subst = function
+    PVar i -> 
+      subst.(pred i) 
+  | PApp (t, args) -> 
+      List.fold_right
+	(fun spat f -> Appli (f,inst_pattern subst spat))
+	   args t  
+
 let rec add_term state t= 
   let uf=state.uf in
     try Hashtbl.find uf.syms t with 
@@ -265,7 +337,16 @@ let rec add_term state t=
 	  let b=next uf in
 	  let new_node=
 	    match t with
-		Symb _ | Eps -> 
+		Symb _ ->
+		  let paf =
+		    {fsym=b;
+		     fnargs=0} in
+		    Queue.add (b,Fmark paf) state.marks;
+		    {clas= Rep (new_representative ());
+		     cpath= -1;
+		     vertex= Leaf;
+		     term= t}
+	      | Eps -> 
 		  {clas= Rep (new_representative ());
 		   cpath= -1;
 		   vertex= Leaf;
@@ -280,11 +361,15 @@ let rec add_term state t=
 		     vertex= Node(i1,i2);
 		     term= t}
 	      | Constructor cinfo ->
+		  let paf =
+		    {fsym=b;
+		     fnargs=0} in
+		    Queue.add (b,Fmark paf) state.marks;
 		  let pac =
 		    {cnode= b;
 		     arity= cinfo.ci_arity;
 		     args=[]} in
-		    Queue.add (b,pac) state.marks;
+		    Queue.add (b,Cmark pac) state.marks;
 		    {clas=Rep (new_representative ());
 		     cpath= -1;
 		     vertex=Leaf;
@@ -294,17 +379,54 @@ let rec add_term state t=
 	    Hashtbl.add uf.syms t b;
 	    b
 
-let add_equality state id s t=
+let add_equality state c s t=
   let i = add_term state s in
   let j = add_term state t in
-    Queue.add {lhs=i;rhs=j;rule=Axiom(id,false)} state.combine;
-    Hashtbl.add state.uf.axioms id (s,t)
+    Queue.add {lhs=i;rhs=j;rule=Axiom(c,false)} state.combine;
+    Hashtbl.add state.uf.axioms c (s,t)
 
 let add_disequality state from s t =
   let i = add_term state s in
   let j = add_term state t in
     state.diseq<-{lhs=i;rhs=j;rule=from}::state.diseq
 
+let add_quant state id pol (nvars,valid1,patt1,valid2,patt2) =
+  state.quant<-
+    {qe_hyp_id= id;
+     qe_pol= pol;
+     qe_nvars=nvars;
+     qe_lhs= patt1;
+     qe_lhs_valid=valid1;
+     qe_rhs= patt2;
+     qe_rhs_valid=valid2}::state.quant
+
+let add_inst state (inst,int_subst) = 
+  if state.rew_depth > 0 then 
+  let subst = build_subst (forest state) int_subst in
+  let prfhead= mkVar inst.qe_hyp_id in
+  let args = Array.map constr_of_term subst in
+  let _ = array_rev args in (* highest deBruijn index first *)
+  let prf= mkApp(prfhead,args) in
+    try Hashtbl.find state.q_history prf
+    with Not_found ->
+      (* this instance is new, we can go on *)
+      let s = inst_pattern subst inst.qe_lhs 
+      and t = inst_pattern subst inst.qe_rhs in
+	state.changed<-true;
+	state.rew_depth<-pred state.rew_depth;
+	if inst.qe_pol then
+	  begin
+	    debug msgnl 
+	      (str "adding new equality, depth="++ int state.rew_depth);
+	    add_equality state prf s t
+	  end
+	else
+	  begin
+	    debug msgnl (str "adding new disequality, depth="++ 
+			   int state.rew_depth);
+	    add_disequality state (Hyp prf) s t 
+	  end
+
 let link uf i j eq = (* links i -> j *)
   let node=uf.map.(i) in 
     node.clas<-Eqto (j,eq);
@@ -336,7 +458,13 @@ let union state i1 i2 eq=
       r2.lfathers<-Intset.union r1.lfathers r2.lfathers;
       ST.delete_set state.sigtable r1.fathers;
       state.terms<-Intset.union state.terms r1.fathers;       
-      PacMap.iter (fun pac b -> Queue.add (b,pac) state.marks) r1.constructors;
+      PacMap.iter 
+	(fun pac b -> Queue.add (b,Cmark pac) state.marks) 
+	r1.constructors;
+      PafMap.iter 
+	(fun paf -> Intset.iter 
+	   (fun b -> Queue.add (b,Fmark paf) state.marks)) 
+	r1.functions;
       match r1.inductive_status,r2.inductive_status with 
 	  Unknown,_ -> ()
 	| Partial pac,Unknown -> 
@@ -351,7 +479,7 @@ let union state i1 i2 eq=
 	    state.pa_classes<-Intset.remove i2 state.pa_classes;
 	    r2.inductive_status<-Partial_applied
 	| Total cpl,Unknown -> r2.inductive_status<-Total cpl;
-	| Total cpl,Total _ -> Queue.add cpl state.marks    
+	| Total (i,pac),Total _ -> Queue.add (i,Cmark pac) state.marks    
 	| _,_ -> () 
             
 let merge eq state = (* merge and no-merge *)
@@ -380,19 +508,22 @@ let update t state = (* update 1 and 2 *)
 	| _ -> ()
     end;
     PacMap.iter 
-      (fun pac _ -> Queue.add (t,append_pac v pac) state.marks) 
+      (fun pac _ -> Queue.add (t,Cmark (append_pac v pac)) state.marks) 
       rep.constructors; 
+    PafMap.iter 
+      (fun paf _ -> Queue.add (t,Fmark (fsucc paf)) state.marks) 
+      rep.functions; 
     try 
       let s = ST.query sign state.sigtable in 
 	Queue.add {lhs=t;rhs=s;rule=Congruence} state.combine
     with 
 	Not_found -> ST.enter t sign state.sigtable
 
-let process_mark t pac state =
-  debug msgnl 
-    (str "Processing mark for term " ++ int t ++ str ".");
-  let i=find state.uf t in
-  let rep=get_representative state.uf i in
+let process_function_mark t rep paf state  =
+  add_paf rep paf t;
+  state.terms<-Intset.union rep.lfathers state.terms
+    
+let process_constructor_mark t i rep pac state =
     match rep.inductive_status with
 	Total (s,opac) ->
 	  if pac.cnode <> opac.cnode then (* Conflict *) 
@@ -424,6 +555,15 @@ let process_mark t pac state =
 	      state.pa_classes<- Intset.add i state.pa_classes
 	    end
 
+let process_mark t m state = 
+  debug msgnl 
+    (str "Processing mark for term " ++ int t ++ str ".");
+  let i=find state.uf t in
+  let rep=get_representative state.uf i in
+    match m with
+	Fmark paf -> process_function_mark t rep paf state
+      | Cmark pac -> process_constructor_mark t i rep pac state
+
 type explanation =
     Discrimination of (int*pa_constructor*int*pa_constructor)
   | Contradiction of disequality
@@ -447,15 +587,21 @@ let check_disequalities state =
 let one_step state =
     try
       let eq = Queue.take state.combine in
-	merge eq state
+	merge eq state;
+	true
     with Queue.Empty -> 
       try 
 	let (t,m) = Queue.take state.marks in
-	  process_mark t m state
+	  process_mark t m state;
+	  true
       with Queue.Empty ->
+	try
 	  let t = Intset.choose state.terms in
 	    state.terms<-Intset.remove t state.terms;
-	    update t state
+	    update t state;
+	    true
+	with Not_found -> false
+	  
 
 let complete_one_class state i=
   match (get_representative state.uf i).inductive_status with
@@ -470,38 +616,162 @@ let complete_one_class state i=
 let complete state =
   Intset.iter (complete_one_class state) state.pa_classes
 
+type matching_problem = 
+{mp_subst : int array;
+ mp_inst : quant_eq;
+ mp_stack : (ccpattern*int) list }
+
+let make_fun_table state =
+  let uf= state.uf in
+  let funtab=ref PafMap.empty in
+  for cl=0 to pred uf.size do 
+    match uf.map.(cl).clas with
+	Rep rep ->
+	  PafMap.iter 
+	    (fun paf _ -> 
+	       let elem = 
+		 try PafMap.find paf !funtab 
+		 with Not_found -> Intset.empty in
+		 funtab:= PafMap.add paf (Intset.add cl elem) !funtab) 
+	    rep.functions
+      | _ -> ()   
+  done;
+    !funtab
+  
+
+let rec do_match state res pb_stack =
+  let mp=Stack.pop pb_stack in
+    match mp.mp_stack with
+	[] -> 
+	  res:= (mp.mp_inst,mp.mp_subst) :: !res
+      | (patt,cl)::remains ->
+	  let uf=state.uf in
+	    match patt with
+		PVar i -> 
+		  if mp.mp_subst.(pred i)<0 then  
+		    begin
+		      mp.mp_subst.(pred i)<- cl; (* no aliasing problem here *)
+		      Stack.push {mp with mp_stack=remains} pb_stack
+		    end
+		  else
+		    if mp.mp_subst.(pred i) = cl then
+		      Stack.push {mp with mp_stack=remains} pb_stack
+	      | PApp (f,[]) ->
+		  begin
+		    try let j=Hashtbl.find uf.syms f in
+		      if find uf j =cl then
+			Stack.push {mp with mp_stack=remains} pb_stack
+		    with Not_found -> ()
+		  end
+	      | PApp(f, ((last_arg::rem_args) as args)) ->
+		  try 
+		    let j=Hashtbl.find uf.syms f in
+		    let paf={fsym=j;fnargs=List.length args} in
+		    let rep=get_representative uf cl in
+		    let good_terms = PafMap.find paf rep.functions in
+		    let aux i = 
+		      let (s,t) = ST.rev_query i state.sigtable in
+			Stack.push 
+			  {mp with 
+			     mp_subst=Array.copy mp.mp_subst;
+			     mp_stack=
+			      (PApp(f,rem_args),s) :: 
+				(last_arg,t) :: remains} pb_stack in
+		      Intset.iter aux good_terms 
+		  with Not_found -> ()
+
+let paf_of_patt syms = function
+    PVar _ -> invalid_arg "paf_of_patt: pattern is trivial"
+  | PApp (f,args) ->
+      {fsym=Hashtbl.find syms f;
+       fnargs=List.length args}
+
+let init_pb_stack state = 
+  let syms= state.uf.syms in
+  let pb_stack = Stack.create () in
+  let funtab = make_fun_table state in
+  let aux inst =
+    begin
+      if inst.qe_lhs_valid then
+	try 
+	  let paf= paf_of_patt syms inst.qe_lhs in
+	  let good_classes = PafMap.find paf funtab in
+	    Intset.iter (fun i -> 
+			 Stack.push 
+			   {mp_subst = Array.make inst.qe_nvars (-1); 
+			    mp_inst=inst;
+			    mp_stack=[inst.qe_lhs,i]} pb_stack) good_classes
+	with Not_found -> ()
+    end;
+    begin 
+      if inst.qe_rhs_valid then
+	try 
+	  let paf= paf_of_patt syms inst.qe_rhs in
+	  let good_classes = PafMap.find paf funtab in
+	    Intset.iter (fun i -> 
+			   Stack.push 
+			     {mp_subst = Array.make inst.qe_nvars (-1); 
+			      mp_inst=inst;
+			      mp_stack=[inst.qe_rhs,i]} pb_stack) good_classes
+	with Not_found -> ()
+    end in
+    List.iter aux state.quant;
+    pb_stack
+
+let find_instances state = 
+  let pb_stack= init_pb_stack state in
+  let res =ref [] in
+  let _ =
+    debug msgnl (str "Running E-matching algorithm ... ");
+    try
+      while true do 
+	do_match state res pb_stack 
+      done;
+      anomaly "get out of here !"
+    with Stack.Empty -> () in
+    !res
+
 let rec execute first_run state =
   debug msgnl (str "Executing ... ");
   try
-    while true do 
-      one_step state
+    while one_step state do ()
     done;
-    anomaly "keep out of here" 
-  with 
-      Discriminable(s,spac,t,tpac) -> 
-	Some
-	begin
-	  if first_run then 
-	    Discrimination (s,spac,t,tpac)
-	  else
-	    Incomplete
-	end
-    | Not_found ->
-	match check_disequalities state with
-	    None -> 
-	      if not(Intset.is_empty state.pa_classes) then
-		begin 
-		  debug msgnl 
-		    (str "First run was incomplete, completing ... ");
-		  complete state;
-		  execute false state
-		end
-	      else None
-	  | Some dis -> Some
-	      begin
-		if first_run then 
-		  Contradiction dis
+    match check_disequalities state with
+	None -> 
+	  if not(Intset.is_empty state.pa_classes) then
+	    begin 
+	      debug msgnl (str "First run was incomplete, completing ... ");
+	      complete state;
+	      execute false state
+	    end
+	  else 
+	    if state.rew_depth>0 then
+	      let l=find_instances state in
+		List.iter (add_inst state) l;
+		if state.changed then 
+		  begin
+		    state.changed <- false;
+		    execute true state
+		  end
 		else
-		  Incomplete
+	      begin 
+		debug msgnl (str "Out of instances ... ");
+		None
+	      end
+	    else 
+	      begin 
+		debug msgnl (str "Out of depth ... ");
+		None
 	      end
+      | Some dis -> Some
+	  begin
+	    if first_run then Contradiction dis
+	    else Incomplete
+	  end
+  with Discriminable(s,spac,t,tpac) -> Some
+    begin
+      if first_run then Discrimination (s,spac,t,tpac)
+      else Incomplete
+    end
+
 
diff --git a/contrib/cc/ccalgo.mli b/contrib/cc/ccalgo.mli
index 74132811..05a5c4d1 100644
--- a/contrib/cc/ccalgo.mli
+++ b/contrib/cc/ccalgo.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccalgo.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
+(* $Id: ccalgo.mli 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 open Util
 open Term
@@ -23,6 +23,10 @@ type term =
   | Appli of term*term
   | Constructor of cinfo (* constructor arity + nhyps *)
 
+type ccpattern =
+    PApp of term * ccpattern list
+  | PVar of int 
+
 type pa_constructor =
     { cnode : int;
       arity : int;
@@ -36,14 +40,14 @@ type state
 
 type rule=
     Congruence
-  | Axiom of identifier * bool 
+  | Axiom of constr * bool 
   | Injection of int * pa_constructor * int * pa_constructor * int
 
 type from=
     Goal
-  | Hyp of identifier
-  | HeqG of identifier
-  | HeqnH of identifier * identifier
+  | Hyp of constr
+  | HeqG of constr
+  | HeqnH of constr*constr 
 
 type 'a eq = {lhs:int;rhs:int;rule:'a}
 
@@ -56,22 +60,28 @@ type explanation =
   | Contradiction of disequality
   | Incomplete
 
+val constr_of_term : term -> constr
+
 val debug : (Pp.std_ppcmds -> unit) -> Pp.std_ppcmds -> unit
 
 val forest : state -> forest
 
-val axioms : forest -> (identifier, term * term) Hashtbl.t
+val axioms : forest -> (constr, term * term) Hashtbl.t
 
 val epsilons : forest -> pa_constructor list
 
-val empty : unit -> state
+val empty : int -> state
 
 val add_term : state -> term -> int
 
-val add_equality : state -> identifier -> term -> term -> unit
+val add_equality : state -> constr -> term -> term -> unit
 
 val add_disequality : state -> from -> term -> term -> unit
 
+val add_quant : state -> identifier -> bool -> 
+  int * bool * ccpattern * bool * ccpattern -> unit
+
+
 val tail_pac : pa_constructor -> pa_constructor
 
 val find : forest -> int -> int
@@ -87,6 +97,35 @@ val subterms : forest -> int -> int * int
 val join_path : forest -> int -> int -> 
   ((int * int) * equality) list * ((int * int) * equality) list
 
+type quant_eq=
+    {qe_hyp_id: identifier;
+     qe_pol: bool;
+     qe_nvars:int;
+     qe_lhs: ccpattern;
+     qe_lhs_valid:bool;
+     qe_rhs: ccpattern;
+     qe_rhs_valid:bool}
+
+
+type pa_fun=
+    {fsym:int;
+     fnargs:int}
+
+type matching_problem
+ 
+module PafMap: Map.S with type key = pa_fun
+
+val make_fun_table : state -> Intset.t PafMap.t 
+
+val do_match :  state ->
+    (quant_eq * int array) list ref -> matching_problem Stack.t -> unit
+
+val init_pb_stack : state -> matching_problem Stack.t
+
+val paf_of_patt : (term, int) Hashtbl.t -> ccpattern -> pa_fun
+
+val find_instances : state -> (quant_eq * int array) list
+
 val execute : bool -> state -> explanation option
 
 
diff --git a/contrib/cc/ccproof.ml b/contrib/cc/ccproof.ml
index 1200dc2e..1ffa347a 100644
--- a/contrib/cc/ccproof.ml
+++ b/contrib/cc/ccproof.ml
@@ -6,18 +6,19 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccproof.ml 7298 2005-08-17 12:56:38Z corbinea $ *)
+(* $Id: ccproof.ml 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 (* This file uses the (non-compressed) union-find structure to generate *) 
 (* proof-trees that will be transformed into proof-terms in cctac.ml4   *)
 
 open Util
 open Names
+open Term
 open Ccalgo
   
 type proof=
-    Ax of identifier
-  | SymAx of identifier
+    Ax of constr
+  | SymAx of constr
   | Refl of term
   | Trans of proof*proof
   | Congr of proof*proof
diff --git a/contrib/cc/ccproof.mli b/contrib/cc/ccproof.mli
index 18c745bf..abdd6fea 100644
--- a/contrib/cc/ccproof.mli
+++ b/contrib/cc/ccproof.mli
@@ -6,14 +6,15 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ccproof.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
+(* $Id: ccproof.mli 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 open Ccalgo
 open Names
+open Term
 
 type proof =
-    Ax of identifier
-  | SymAx of identifier
+    Ax of constr
+  | SymAx of constr
   | Refl of term
   | Trans of proof * proof
   | Congr of proof * proof
@@ -25,6 +26,6 @@ val build_proof :
   | `Prove of int * int ] -> proof
 
 val type_proof :
-  (identifier, (term * term)) Hashtbl.t -> proof -> term * term
+  (constr, (term * term)) Hashtbl.t -> proof -> term * term
 
 
diff --git a/contrib/cc/cctac.ml b/contrib/cc/cctac.ml
index 4a719f38..ea8aceeb 100644
--- a/contrib/cc/cctac.ml
+++ b/contrib/cc/cctac.ml
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: cctac.ml 7909 2006-01-21 11:09:18Z herbelin $ *)
+(* $Id: cctac.ml 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 (* This file is the interface between the c-c algorithm and Coq *)
 
@@ -63,7 +63,7 @@ let rec decompose_term env t=
 	  Constructor {ci_constr=c;
 		       ci_arity=nargs;
 		       ci_nhyps=nargs-oib.mind_nparams}
-    | _ ->(Symb t)
+    | _ ->if closed0 t then (Symb t) else raise Not_found
 	
 (* decompose equality in members and type *)
 	
@@ -79,34 +79,72 @@ let atom_of_constr env term =
 	  else `Other (decompose_term env term)
     | _ -> `Other (decompose_term env term)
 
-let rec litteral_of_constr env term=
+let rec pattern_of_constr env c =
+  match kind_of_term (whd env c) with
+      App (f,args)->
+	let pf = decompose_term env f in
+	let pargs,lrels = List.split 
+	  (array_map_to_list (pattern_of_constr env) args) in
+	  PApp (pf,List.rev pargs),
+	List.fold_left Intset.union Intset.empty lrels 
+    | Rel i -> PVar i,Intset.singleton i
+    | _ -> 
+	let pf = decompose_term env c in
+	  PApp (pf,[]),Intset.empty
+
+let non_trivial = function
+    PVar _ -> false
+  | _ -> true
+
+let patterns_of_constr env nrels term=
+  let f,args= 
+    try destApp (whd_delta env term) with _ -> raise Not_found in
+	if eq_constr f (Lazy.force _eq) && (Array.length args)=3 
+	then 
+	  let patt1,rels1 = pattern_of_constr env args.(1)
+	  and patt2,rels2 = pattern_of_constr env args.(2) in
+	  let valid1 = (Intset.cardinal rels1 = nrels && non_trivial patt1) 
+	  and valid2 = (Intset.cardinal rels2 = nrels && non_trivial patt2) in
+	    if valid1 || valid2 then 
+	      nrels,valid1,patt1,valid2,patt2
+	    else raise Not_found
+	else raise Not_found
+
+let rec quantified_atom_of_constr env nrels term =
   match kind_of_term (whd_delta env term) with
       Prod (_,atom,ff) -> 
 	if eq_constr ff (Lazy.force _False) then
+	  let patts=patterns_of_constr env nrels atom in
+	      `Nrule patts
+	else 
+	  quantified_atom_of_constr env (succ nrels) ff
+    | _ ->  
+	let patts=patterns_of_constr env nrels term in
+	    `Rule patts	  
+
+let litteral_of_constr env term=
+  match kind_of_term (whd_delta env term) with
+    | Prod (_,atom,ff) -> 
+	if eq_constr ff (Lazy.force _False) then
 	  match (atom_of_constr env atom) with
 	      `Eq(t,a,b) -> `Neq(t,a,b)
 	    | `Other(p) -> `Nother(p)
-	else 
-	  `Other (decompose_term env term)
-    | _ -> atom_of_constr env term
+	else
+	  begin
+	    try 
+	      quantified_atom_of_constr env 1 ff  
+	    with Not_found ->
+	      `Other (decompose_term env term)
+	  end
+    | _ -> 
+	atom_of_constr env term
 	
-(* rebuild a term from applicative format *)
-    
-let rec make_term = function
-    Symb s->s
-  | Eps -> anomaly "epsilon constant has no value" 
-  | Constructor cinfo -> mkConstruct cinfo.ci_constr 
-  | Appli (s1,s2)->
-      make_app [(make_term s2)] s1
-and make_app l=function
-    Appli (s1,s2)->make_app ((make_term s2)::l) s1    
-  | other -> applistc (make_term other) l 
 
 (* store all equalities from the context *)
 	
-let rec make_prb gls additionnal_terms =
+let rec make_prb gls depth additionnal_terms =
   let env=pf_env gls in
-  let state = empty () in
+  let state = empty depth in
   let pos_hyps = ref [] in
   let neg_hyps =ref [] in
     List.iter
@@ -116,21 +154,24 @@ let rec make_prb gls additionnal_terms =
     List.iter 
       (fun (id,_,e) ->
 	 begin
+	   let cid=mkVar id in
 	   match litteral_of_constr env e with
-	       `Eq (t,a,b) -> add_equality state id a b
-	     | `Neq (t,a,b) -> add_disequality state (Hyp id) a b
+	       `Eq (t,a,b) -> add_equality state cid a b
+	     | `Neq (t,a,b) -> add_disequality state (Hyp cid) a b
 	     | `Other ph ->
 		 List.iter 
-		   (fun (idn,nh) -> 
-		      add_disequality state (HeqnH (id,idn)) ph nh) 
+		   (fun (cidn,nh) -> 
+		      add_disequality state (HeqnH (cid,cidn)) ph nh) 
 		   !neg_hyps;
-		 pos_hyps:=(id,ph):: !pos_hyps
+		 pos_hyps:=(cid,ph):: !pos_hyps
 	     | `Nother nh ->
 		 List.iter 
-		   (fun (idp,ph) -> 
-		      add_disequality state (HeqnH (idp,id)) ph nh) 
+		   (fun (cidp,ph) -> 
+		      add_disequality state (HeqnH (cidp,cid)) ph nh) 
 		   !pos_hyps;
-		 neg_hyps:=(id,nh):: !neg_hyps
+		 neg_hyps:=(cid,nh):: !neg_hyps
+	     | `Rule patts -> add_quant state id true patts
+	     | `Nrule patts -> add_quant state id false patts
 	 end) (Environ.named_context_of_val gls.it.evar_hyps);
     begin
       match atom_of_constr env gls.it.evar_concl with
@@ -170,18 +211,18 @@ let build_projection intype outtype (cstr:constructor) special default gls=
 (* generate an adhoc tactic following the proof tree  *)
 
 let rec proof_tac axioms=function
-    Ax id->exact_check (mkVar id)
-  | SymAx id->tclTHEN symmetry (exact_check (mkVar id))
-  | Refl t->reflexivity
-  | Trans (p1,p2)->let t=(make_term (snd (type_proof axioms p1))) in
+    Ax c -> exact_check c
+  | SymAx c -> tclTHEN symmetry (exact_check c)
+  | Refl t -> reflexivity
+  | Trans (p1,p2)->let t=(constr_of_term (snd (type_proof axioms p1))) in
       (tclTHENS (transitivity t) 
 	 [(proof_tac axioms p1);(proof_tac axioms p2)])
   | Congr (p1,p2)->
       fun gls->
 	let (f1,f2)=(type_proof axioms p1) 
 	and (x1,x2)=(type_proof axioms p2) in
-        let tf1=make_term f1 and tx1=make_term x1 
-	and tf2=make_term f2 and tx2=make_term x2 in
+        let tf1=constr_of_term f1 and tx1=constr_of_term x1 
+	and tf2=constr_of_term f2 and tx2=constr_of_term x2 in
 	let typf=pf_type_of gls tf1 and typx=pf_type_of gls tx1
 	and typfx=pf_type_of gls (mkApp(tf1,[|tx1|])) in
 	let id=pf_get_new_id (id_of_string "f") gls in
@@ -204,52 +245,52 @@ let rec proof_tac axioms=function
       (fun gls ->
 	 let ti,tj=type_proof axioms prf in
 	 let ai,aj=type_proof axioms gprf in
-	 let cti=make_term ti in
-	 let ctj=make_term tj in
-	 let cai=make_term ai in
+	 let cti=constr_of_term ti in
+	 let ctj=constr_of_term tj in
+	 let cai=constr_of_term ai in
 	 let intype=pf_type_of gls cti in
 	 let outtype=pf_type_of gls cai in
 	 let special=mkRel (1+nargs-argind) in
-	 let default=make_term ai in
+	 let default=constr_of_term ai in
 	 let proj=build_projection intype outtype cstr special default gls in
 	 let injt=
 	   mkApp (Lazy.force _f_equal,[|intype;outtype;proj;cti;ctj|]) in 
 	   tclTHEN (apply injt) (proof_tac axioms prf) gls)
 
-let refute_tac axioms id t1 t2 p gls =      
-  let tt1=make_term t1 and tt2=make_term t2 in
+let refute_tac axioms c t1 t2 p gls =      
+  let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
   let intype=pf_type_of gls tt1 in
   let neweq=
     mkApp(Lazy.force _eq,
 	  [|intype;tt1;tt2|]) in
   let hid=pf_get_new_id (id_of_string "Heq") gls in
-  let false_t=mkApp (mkVar id,[|mkVar hid|]) in
+  let false_t=mkApp (c,[|mkVar hid|]) in
     tclTHENS (true_cut (Name hid) neweq)
       [proof_tac axioms p; simplest_elim false_t] gls
 
-let convert_to_goal_tac axioms id t1 t2 p gls =
-  let tt1=make_term t1 and tt2=make_term t2 in
+let convert_to_goal_tac axioms c t1 t2 p gls =
+  let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
   let sort=pf_type_of gls tt2 in
   let neweq=mkApp(Lazy.force _eq,[|sort;tt1;tt2|]) in 
   let e=pf_get_new_id (id_of_string "e") gls in
   let x=pf_get_new_id (id_of_string "X") gls in
   let identity=mkLambda (Name x,sort,mkRel 1) in 
   let endt=mkApp (Lazy.force _eq_rect,
-		  [|sort;tt1;identity;mkVar id;tt2;mkVar e|]) in
+		  [|sort;tt1;identity;c;tt2;mkVar e|]) in
     tclTHENS (true_cut (Name e) neweq) 
       [proof_tac axioms p;exact_check endt] gls
 
-let convert_to_hyp_tac axioms id1 t1 id2 t2 p gls =
-  let tt2=make_term t2 in
+let convert_to_hyp_tac axioms c1 t1 c2 t2 p gls =
+  let tt2=constr_of_term t2 in
   let h=pf_get_new_id (id_of_string "H") gls in
-  let false_t=mkApp (mkVar id2,[|mkVar h|]) in
+  let false_t=mkApp (c2,[|mkVar h|]) in
     tclTHENS (true_cut (Name h) tt2)
-      [convert_to_goal_tac axioms id1 t1 t2 p;
+      [convert_to_goal_tac axioms c1 t1 t2 p;
        simplest_elim false_t] gls
   
 let discriminate_tac axioms cstr p gls =
   let t1,t2=type_proof axioms p in 
-  let tt1=make_term t1 and tt2=make_term t2 in
+  let tt1=constr_of_term t1 and tt2=constr_of_term t2 in
   let intype=pf_type_of gls tt1 in
   let concl=pf_concl gls in
   let outsort=mkType (new_univ ()) in
@@ -273,15 +314,15 @@ let discriminate_tac axioms cstr p gls =
 	
 let build_term_to_complete uf meta pac =
   let cinfo = get_constructor_info uf pac.cnode in
-  let real_args = List.map (fun i -> make_term (term uf i)) pac.args in
+  let real_args = List.map (fun i -> constr_of_term (term uf i)) pac.args in
   let dummy_args = List.rev (list_tabulate meta pac.arity) in
   let all_args = List.rev_append real_args dummy_args in
     applistc (mkConstruct cinfo.ci_constr) all_args
       
-let cc_tactic additionnal_terms gls=
+let cc_tactic depth additionnal_terms gls=
   Coqlib.check_required_library ["Coq";"Init";"Logic"];
   let _ = debug Pp.msgnl (Pp.str "Reading subgoal ...") in
-  let state = make_prb gls additionnal_terms in
+  let state = make_prb gls depth additionnal_terms in
   let _ = debug Pp.msgnl (Pp.str "Problem built, solving ...") in
   let sol = execute true state in
   let _ = debug Pp.msgnl (Pp.str "Computation completed.") in
@@ -334,3 +375,8 @@ let cc_tactic additionnal_terms gls=
 
 let cc_fail gls =
   errorlabstrm  "Congruence" (Pp.str "congruence failed.")     
+
+let congruence_tac depth l = 
+  tclORELSE 
+    (tclTHEN (tclREPEAT introf) (cc_tactic depth l)) 
+    cc_fail
diff --git a/contrib/cc/cctac.mli b/contrib/cc/cctac.mli
index 6082beb6..97fa4d77 100644
--- a/contrib/cc/cctac.mli
+++ b/contrib/cc/cctac.mli
@@ -6,11 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cctac.mli 7298 2005-08-17 12:56:38Z corbinea $ *)
+(* $Id: cctac.mli 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 open Term 
 open Proof_type
 
-val cc_tactic : constr list -> tactic
+val cc_tactic : int -> constr list -> tactic
 
 val cc_fail : tactic
+
+val congruence_tac : int -> constr list -> tactic
diff --git a/contrib/cc/g_congruence.ml4 b/contrib/cc/g_congruence.ml4
index 0bdf7608..693aebb4 100644
--- a/contrib/cc/g_congruence.ml4
+++ b/contrib/cc/g_congruence.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_congruence.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
+(* $Id: g_congruence.ml4 9151 2006-09-19 13:32:22Z corbinea $ *)
 
 open Cctac
 open Tactics
@@ -17,13 +17,9 @@ open Tacticals
 (* Tactic registration *)
       
 TACTIC EXTEND cc
- [ "congruence" ] -> [ tclORELSE 
-			 (tclTHEN (tclREPEAT introf) (cc_tactic [])) 
-			 cc_fail ]
-END
-      
-TACTIC EXTEND cc_with
- [ "congruence" "with" ne_constr_list(l) ] -> [ tclORELSE 
-			 (tclTHEN (tclREPEAT introf) (cc_tactic l)) 
-			 cc_fail]
+ [ "congruence" ] -> [ congruence_tac 0 [] ]
+ |[ "congruence" integer(n) ] -> [ congruence_tac n [] ]
+ |[ "congruence" "with" ne_constr_list(l) ] -> [ congruence_tac 0 l ]
+ |[ "congruence" integer(n) "with" ne_constr_list(l) ] -> 
+   [ congruence_tac n l ]
 END
diff --git a/contrib/extraction/extract_env.ml b/contrib/extraction/extract_env.ml
index c581c620..2d425e9f 100644
--- a/contrib/extraction/extract_env.ml
+++ b/contrib/extraction/extract_env.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extract_env.ml 6328 2004-11-18 17:31:41Z sacerdot $ i*)
+(*i $Id: extract_env.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 open Term
 open Declarations
@@ -74,7 +74,8 @@ let visit_ref v r =
 exception Impossible
 
 let check_arity env cb = 
-  if Reduction.is_arity env cb.const_type then raise Impossible
+  let t = Typeops.type_of_constant_type env cb.const_type in
+  if Reduction.is_arity env t then raise Impossible
 
 let check_fix env cb i = 
   match cb.const_body with 
diff --git a/contrib/extraction/extraction.ml b/contrib/extraction/extraction.ml
index 2b4b7967..52e7f1dd 100644
--- a/contrib/extraction/extraction.ml
+++ b/contrib/extraction/extraction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extraction.ml 9032 2006-07-07 16:30:34Z herbelin $ i*)
+(*i $Id: extraction.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -225,7 +225,7 @@ let rec extract_type env db j c args =
     | Const kn -> 
 	let r = ConstRef kn in 
 	let cb = lookup_constant kn env in 
-	let typ = cb.const_type in 
+	let typ = Typeops.type_of_constant_type env cb.const_type in 
 	(match flag_of_type env typ with 
 	   | (Info, TypeScheme) -> 
 	       let mlt = extract_type_app env db (r, type_sign env typ) args in 
@@ -321,7 +321,7 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
       Array.map 
 	(fun mip ->
 	   let b = snd (mind_arity mip) <> InProp in
-	   let ar = Inductive.type_of_inductive (mib,mip) in
+	   let ar = Inductive.type_of_inductive env (mib,mip) in
 	   let s,v = if b then type_sign_vl env ar else [],[] in
 	   let t = Array.make (Array.length mip.mind_nf_lc) [] in 
 	   { ip_typename = mip.mind_typename;
@@ -401,7 +401,8 @@ and extract_ind env kn = (* kn is supposed to be in long form *)
 	(* Is this record officially declared with its projections ? *)
 	(* If so, we use this information. *)
 	begin try 
-	  let n = nb_default_params env (Inductive.type_of_inductive(mib,mip0))
+	  let n = nb_default_params env
+            (Inductive.type_of_inductive env (mib,mip0))
 	  in
 	  List.iter 
 	    (option_iter 
@@ -446,7 +447,7 @@ and mlt_env env r = match r with
 	   | _ -> None
        with Not_found -> 
 	 let cb = Environ.lookup_constant kn env in
-	 let typ = cb.const_type in
+	 let typ = Typeops.type_of_constant_type env cb.const_type in 
 	 match cb.const_body with
 	   | None -> None
 	   | Some l_body -> 
@@ -473,7 +474,7 @@ let record_constant_type env kn opt_typ =
     lookup_type kn 
   with Not_found ->
     let typ = match opt_typ with 
-      | None -> constant_type env kn 
+      | None -> Typeops.type_of_constant env kn
       | Some typ -> typ 
     in let mlt = extract_type env [] 1 typ [] 
     in let schema = (type_maxvar mlt, mlt)
@@ -814,7 +815,7 @@ let extract_fixpoint env vkn (fi,ti,ci) =
 		 
 let extract_constant env kn cb = 
   let r = ConstRef kn in 
-  let typ = cb.const_type in
+  let typ = Typeops.type_of_constant_type env cb.const_type in 
   match cb.const_body with
     | None -> (* A logical axiom is risky, an informative one is fatal. *) 
         (match flag_of_type env typ with
@@ -846,7 +847,7 @@ let extract_constant env kn cb =
 
 let extract_constant_spec env kn cb = 
   let r = ConstRef kn in 
-  let typ = cb.const_type in
+  let typ = Typeops.type_of_constant_type env cb.const_type in 
   match flag_of_type env typ with 
     | (Logic, TypeScheme) -> Stype (r, [], Some (Tdummy Ktype))
     | (Logic, Default) -> Sval (r, Tdummy Kother) 
@@ -884,7 +885,7 @@ let extract_declaration env r = match r with
 type kind = Logical | Term | Type 
     
 let constant_kind env cb = 
-  match flag_of_type env cb.const_type with 
+  match flag_of_type env (Typeops.type_of_constant_type env cb.const_type) with 
     | (Logic,_) -> Logical
     | (Info,TypeScheme) -> Type
     | (Info,Default) -> Term
diff --git a/contrib/extraction/table.ml b/contrib/extraction/table.ml
index bd4fe924..b1a3cb31 100644
--- a/contrib/extraction/table.ml
+++ b/contrib/extraction/table.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: table.ml 6555 2005-01-03 19:25:36Z sacerdot $ i*)
+(*i $Id: table.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 open Names
 open Term
@@ -140,16 +140,14 @@ let error_axiom_scheme r i =
        str " type variable(s).") 
 
 let warning_info_ax r =
-  Options.if_verbose msg_warning
-    (str "You must realize axiom " ++
-     pr_global r ++ str " in the extracted code.")
+  msg_warning (str "You must realize axiom " ++
+		  pr_global r ++ str " in the extracted code.")
 
 let warning_log_ax r = 
-  Options.if_verbose msg_warning
-    (str "This extraction depends on logical axiom" ++ spc () ++ 
-     pr_global r ++ str "." ++ spc() ++ 
-     str "Having false logical axiom in the environment when extracting" ++ 
-     spc () ++ str "may lead to incorrect or non-terminating ML terms.")
+  msg_warning (str "This extraction depends on logical axiom" ++ spc () ++ 
+		  pr_global r ++ str "." ++ spc() ++ 
+		  str "Having false logical axiom in the environment when extracting" ++ 
+		  spc () ++ str "may lead to incorrect or non-terminating ML terms.")
 
 let check_inside_module () = 
   try 
@@ -443,7 +441,7 @@ let extract_constant_inline inline r ids s =
   match g with 
     | ConstRef kn -> 
 	let env = Global.env () in 
-	let typ = Environ.constant_type env kn in 
+	let typ = Typeops.type_of_constant env kn in 
 	let typ = Reduction.whd_betadeltaiota env typ in
 	if Reduction.is_arity env typ 
 	  then begin 
diff --git a/contrib/field/LegacyField.v b/contrib/field/LegacyField.v
new file mode 100644
index 00000000..08397d02
--- /dev/null
+++ b/contrib/field/LegacyField.v
@@ -0,0 +1,15 @@
+(************************************************************************)
+(*  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: LegacyField.v 9273 2006-10-25 11:30:36Z barras $ *)
+
+Require Export LegacyField_Compl.
+Require Export LegacyField_Theory.
+Require Export LegacyField_Tactic.
+
+(* Command declarations are moved to the ML side *)
diff --git a/contrib/field/Field_Compl.v b/contrib/field/LegacyField_Compl.v
index f018359e..b37281e9 100644
--- a/contrib/field/Field_Compl.v
+++ b/contrib/field/LegacyField_Compl.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Compl.v 8866 2006-05-28 16:21:04Z herbelin $ *)
+(* $Id: LegacyField_Compl.v 9273 2006-10-25 11:30:36Z barras $ *)
 
 Require Import List.
 
diff --git a/contrib/field/Field_Tactic.v b/contrib/field/LegacyField_Tactic.v
index 8d727536..2b6ff5b4 100644
--- a/contrib/field/Field_Tactic.v
+++ b/contrib/field/LegacyField_Tactic.v
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Tactic.v 8866 2006-05-28 16:21:04Z herbelin $ *)
+(* $Id: LegacyField_Tactic.v 9319 2006-10-30 12:41:21Z barras $ *)
 
 Require Import List.
-Require Import Ring.
-Require Export Field_Compl.
-Require Export Field_Theory.
+Require Import LegacyRing.
+Require Export LegacyField_Compl.
+Require Export LegacyField_Theory.
 
 (**** Interpretation A --> ExprA ****)
 
@@ -184,15 +184,15 @@ Ltac multiply mul :=
   match goal with
   |  |- (interp_ExprA ?FT ?X2 ?X3 = interp_ExprA ?FT ?X2 ?X4) =>
       let AzeroT := get_component Azero FT in
-      (cut (interp_ExprA FT X2 mul <> AzeroT);
-        [ intro; let id := grep_mult in apply (mult_eq FT X3 X4 mul X2 id)
-        | weak_reduce;
-           let AoneT := get_component Aone ltac:(body_of FT)
+      cut (interp_ExprA FT X2 mul <> AzeroT);
+       [ intro; (let id := grep_mult in apply (mult_eq FT X3 X4 mul X2 id))
+       | weak_reduce;
+          (let AoneT := get_component Aone ltac:(body_of FT)
            with AmultT := get_component Amult ltac:(body_of FT) in
-           (try
+           try
              match goal with
              |  |- context [(AmultT _ AoneT)] => rewrite (AmultT_1r FT)
-             end; clear FT X2) ])
+             end; clear FT X2) ]
   end.
 
 Ltac apply_multiply FT lvar trm :=
@@ -279,7 +279,7 @@ Ltac field_gen_aux FT :=
       let lvar := build_varlist FT (AplusT X1 X2) in
       let trm1 := interp_A FT lvar X1 with trm2 := interp_A FT lvar X2 in
       let mul := give_mult (EAplus trm1 trm2) in
-      (cut
+      cut
         (let ft := FT in
          let vm := lvar in interp_ExprA ft vm trm1 = interp_ExprA ft vm trm2);
         [ compute in |- *; auto
@@ -287,13 +287,14 @@ Ltac field_gen_aux FT :=
            apply_simplif apply_assoc; multiply mul;
            [ apply_simplif apply_multiply;
               apply_simplif ltac:(apply_inverse mul);
-              let id := grep_mult in
-              clear id; weak_reduce; clear ft vm; first
-              [ inverse_test FT; ring | field_gen_aux FT ]
-           | idtac ] ])
+              (let id := grep_mult in
+               clear id; weak_reduce; clear ft vm; first
+              [ inverse_test FT; legacy ring | field_gen_aux FT ])
+           | idtac ] ]
   end.
 
-Ltac field_gen FT := unfolds FT; (inverse_test FT; ring) || field_gen_aux FT.
+Ltac field_gen FT :=
+  unfolds FT; (inverse_test FT; legacy ring) || field_gen_aux FT.
 
 (*****************************)
 (*    Term Simplification    *)
@@ -429,4 +430,4 @@ Ltac field_term FT exp :=
    simpl_all_monomials
     ltac:(assoc_distrib ltac:(simpl_all_monomials ltac:(simpl_inv tma))) in
   let trep := eval_weak_reduce (interp_ExprA FT lvar tsmp) in
-  (replace exp with trep; [ ring trep | field_gen FT ]).
+  (replace exp with trep; [ legacy ring trep | field_gen FT ]).
diff --git a/contrib/field/Field_Theory.v b/contrib/field/LegacyField_Theory.v
index fff3c414..9c3a12fb 100644
--- a/contrib/field/Field_Theory.v
+++ b/contrib/field/LegacyField_Theory.v
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field_Theory.v 8866 2006-05-28 16:21:04Z herbelin $ *)
+(* $Id: LegacyField_Theory.v 9288 2006-10-26 18:25:06Z herbelin $ *)
 
 Require Import List.
 Require Import Peano_dec.
-Require Import Ring.
-Require Import Field_Compl.
+Require Import LegacyRing.
+Require Import LegacyField_Compl.
 
 Record Field_Theory : Type := 
   {A : Type;
@@ -88,66 +88,66 @@ Let AinvT := Ainv T.
 Let RTT := RT T.
 Let Th_inv_defT := Th_inv_def T.
 
-Add Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) (
+Add Legacy Abstract Ring (A T) (Aplus T) (Amult T) (Aone T) (
  Azero T) (Aopp T) (Aeq T) (RT T).
 
-Add Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT.
+Add Legacy Abstract Ring AT AplusT AmultT AoneT AzeroT AoppT AeqT RTT.
 
 (***************************)
 (*    Lemmas to be used    *)
 (***************************)
 
-Lemma AplusT_sym : forall r1 r2:AT, AplusT r1 r2 = AplusT r2 r1.
+Lemma AplusT_comm : forall r1 r2:AT, AplusT r1 r2 = AplusT r2 r1.
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AplusT_assoc :
  forall r1 r2 r3:AT, AplusT (AplusT r1 r2) r3 = AplusT r1 (AplusT r2 r3).
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
-Lemma AmultT_sym : forall r1 r2:AT, AmultT r1 r2 = AmultT r2 r1.
+Lemma AmultT_comm : forall r1 r2:AT, AmultT r1 r2 = AmultT r2 r1.
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AmultT_assoc :
  forall r1 r2 r3:AT, AmultT (AmultT r1 r2) r3 = AmultT r1 (AmultT r2 r3).
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AplusT_Ol : forall r:AT, AplusT AzeroT r = r.
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AmultT_1l : forall r:AT, AmultT AoneT r = r.
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AplusT_AoppT_r : forall r:AT, AplusT r (AoppT r) = AzeroT.
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma AmultT_AplusT_distr :
  forall r1 r2 r3:AT,
    AmultT r1 (AplusT r2 r3) = AplusT (AmultT r1 r2) (AmultT r1 r3).
 Proof.
-  intros; ring.
+  intros; legacy ring.
 Qed.
 
 Lemma r_AplusT_plus : forall r r1 r2:AT, AplusT r r1 = AplusT r r2 -> r1 = r2.
 Proof.
   intros; transitivity (AplusT (AplusT (AoppT r) r) r1).
-  ring.
+  legacy ring.
   transitivity (AplusT (AplusT (AoppT r) r) r2).
   repeat rewrite AplusT_assoc; rewrite <- H; reflexivity.
-  ring.
+  legacy ring.
 Qed.
  
 Lemma r_AmultT_mult :
@@ -162,28 +162,28 @@ Qed.
 
 Lemma AmultT_Or : forall r:AT, AmultT r AzeroT = AzeroT.
 Proof.
-  intro; ring.
+  intro; legacy ring.
 Qed.
  
 Lemma AmultT_Ol : forall r:AT, AmultT AzeroT r = AzeroT.
 Proof.
-  intro; ring.
+  intro; legacy ring.
 Qed.
  
 Lemma AmultT_1r : forall r:AT, AmultT r AoneT = r.
 Proof.
-  intro; ring.
+  intro; legacy ring.
 Qed.
  
 Lemma AinvT_r : forall r:AT, r <> AzeroT -> AmultT r (AinvT r) = AoneT.
 Proof.
-  intros; rewrite AmultT_sym; apply Th_inv_defT; auto.
+  intros; rewrite AmultT_comm; apply Th_inv_defT; auto.
 Qed.
  
 Lemma Rmult_neq_0_reg :
  forall r1 r2:AT, AmultT r1 r2 <> AzeroT -> r1 <> AzeroT /\ r2 <> AzeroT.
 Proof.
-  intros r1 r2 H; split; red in |- *; intro; apply H; rewrite H0; ring.
+  intros r1 r2 H; split; red in |- *; intro; apply H; rewrite H0; legacy ring.
 Qed.
 
 (************************)
@@ -276,7 +276,7 @@ Lemma merge_mult_correct :
    interp_ExprA lvar (merge_mult e1 e2) = interp_ExprA lvar (EAmult e1 e2).
 Proof.
 simple induction e1; auto; intros.
-elim e0; try (intros; simpl in |- *; ring).
+elim e0; try (intros; simpl in |- *; legacy ring).
 unfold interp_ExprA in H2; fold interp_ExprA in H2;
  cut
   (AmultT (interp_ExprA lvar e2)
@@ -286,8 +286,8 @@ unfold interp_ExprA in H2; fold interp_ExprA in H2;
      (AmultT (AmultT (interp_ExprA lvar e) (interp_ExprA lvar e4))
         (interp_ExprA lvar e2)) (interp_ExprA lvar e3)).
 intro H3; rewrite H3; rewrite <- H2; rewrite merge_mult_correct1;
- simpl in |- *; ring.
-ring.
+ simpl in |- *; legacy ring.
+legacy ring.
 Qed.
 
 Lemma assoc_mult_correct1 :
@@ -308,7 +308,7 @@ Lemma assoc_mult_correct :
 Proof.
 simple induction e; auto; intros.
 elim e0; intros.
-intros; simpl in |- *; ring.
+intros; simpl in |- *; legacy ring.
 simpl in |- *; rewrite (AmultT_1l (interp_ExprA lvar (assoc_mult e1)));
  rewrite (AmultT_1l (interp_ExprA lvar e1)); apply H0.
 simpl in |- *; rewrite (H0 lvar); auto.
@@ -317,9 +317,9 @@ simpl in |- *; rewrite merge_mult_correct; simpl in |- *;
  rewrite assoc_mult_correct1; rewrite H2; simpl in |- *;
  rewrite <- assoc_mult_correct1 in H1; unfold interp_ExprA at 3 in H1;
  fold interp_ExprA in H1; rewrite (H0 lvar) in H1;
- rewrite (AmultT_sym (interp_ExprA lvar e3) (interp_ExprA lvar e1));
+ rewrite (AmultT_comm (interp_ExprA lvar e3) (interp_ExprA lvar e1));
  rewrite <- AmultT_assoc; rewrite H1; rewrite AmultT_assoc; 
- ring.
+ legacy ring.
 simpl in |- *; rewrite (H0 lvar); auto.
 simpl in |- *; rewrite (H0 lvar); auto.
 simpl in |- *; rewrite (H0 lvar); auto.
@@ -344,7 +344,7 @@ Lemma merge_plus_correct :
    interp_ExprA lvar (merge_plus e1 e2) = interp_ExprA lvar (EAplus e1 e2).
 Proof.
 simple induction e1; auto; intros.
-elim e0; try intros; try (simpl in |- *; ring).
+elim e0; try intros; try (simpl in |- *; legacy ring).
 unfold interp_ExprA in H2; fold interp_ExprA in H2;
  cut
   (AplusT (interp_ExprA lvar e2)
@@ -354,8 +354,8 @@ unfold interp_ExprA in H2; fold interp_ExprA in H2;
      (AplusT (AplusT (interp_ExprA lvar e) (interp_ExprA lvar e4))
         (interp_ExprA lvar e2)) (interp_ExprA lvar e3)).
 intro H3; rewrite H3; rewrite <- H2; rewrite merge_plus_correct1;
- simpl in |- *; ring.
-ring.
+ simpl in |- *; legacy ring.
+legacy ring.
 Qed.
 
 Lemma assoc_plus_correct :
@@ -387,7 +387,7 @@ simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
      (AplusT (AplusT (interp_ExprA lvar e2) (interp_ExprA lvar e3))
         (interp_ExprA lvar e1))); rewrite <- AplusT_assoc;
  rewrite
-  (AplusT_sym (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)))
+  (AplusT_comm (interp_ExprA lvar (assoc e1)) (interp_ExprA lvar (assoc e2)))
   ; rewrite assoc_plus_correct; rewrite H1; simpl in |- *; 
  rewrite (H0 lvar);
  rewrite <-
@@ -397,10 +397,10 @@ simpl in |- *; rewrite merge_plus_correct; simpl in |- *;
  rewrite
   (AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e1)
      (interp_ExprA lvar e3));
- rewrite (AplusT_sym (interp_ExprA lvar e1) (interp_ExprA lvar e3));
+ rewrite (AplusT_comm (interp_ExprA lvar e1) (interp_ExprA lvar e3));
  rewrite <-
   (AplusT_assoc (interp_ExprA lvar e2) (interp_ExprA lvar e3)
-     (interp_ExprA lvar e1)); apply AplusT_sym.
+     (interp_ExprA lvar e1)); apply AplusT_comm.
 unfold assoc in |- *; fold assoc in |- *; unfold interp_ExprA in |- *;
  fold interp_ExprA in |- *; rewrite assoc_mult_correct; 
  rewrite (H0 lvar); simpl in |- *; auto.
@@ -454,8 +454,8 @@ Lemma distrib_mult_right_correct :
    AmultT (interp_ExprA lvar e1) (interp_ExprA lvar e2).
 Proof.
 simple induction e1; try intros; simpl in |- *; auto.
-rewrite AmultT_sym; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar);
- rewrite (H0 e2 lvar); ring.
+rewrite AmultT_comm; rewrite AmultT_AplusT_distr; rewrite (H e2 lvar);
+ rewrite (H0 e2 lvar); legacy ring.
 Qed.
 
 Lemma distrib_mult_left_correct :
@@ -466,18 +466,18 @@ Proof.
 simple induction e1; try intros; simpl in |- *.
 rewrite AmultT_Ol; rewrite distrib_mult_right_correct; simpl in |- *;
  apply AmultT_Or.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym. 
-rewrite AmultT_sym;
+rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm. 
+rewrite AmultT_comm;
  rewrite
   (AmultT_AplusT_distr (interp_ExprA lvar e2) (interp_ExprA lvar e)
      (interp_ExprA lvar e0));
- rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e));
- rewrite (AmultT_sym (interp_ExprA lvar e2) (interp_ExprA lvar e0));
+ rewrite (AmultT_comm (interp_ExprA lvar e2) (interp_ExprA lvar e));
+ rewrite (AmultT_comm (interp_ExprA lvar e2) (interp_ExprA lvar e0));
  rewrite (H e2 lvar); rewrite (H0 e2 lvar); auto.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym.
-rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_sym.
+rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
+rewrite distrib_mult_right_correct; simpl in |- *; apply AmultT_comm.
 Qed.
 
 Lemma distrib_correct :
@@ -491,7 +491,7 @@ simpl in |- *; rewrite <- (H lvar); rewrite <- (H0 lvar);
  unfold distrib in |- *; simpl in |- *; apply distrib_mult_left_correct.
 simpl in |- *; fold AoppT in |- *; rewrite <- (H lvar);
  unfold distrib in |- *; simpl in |- *; rewrite distrib_mult_right_correct;
- simpl in |- *; fold AoppT in |- *; ring.
+ simpl in |- *; fold AoppT in |- *; legacy ring.
 Qed.
 
 (**** Multiplication by the inverse product ****)
@@ -527,7 +527,7 @@ Lemma multiply_aux_correct :
 Proof.
 simple induction e; simpl in |- *; intros; try rewrite merge_mult_correct;
  auto.
-  simpl in |- *; rewrite (H0 lvar); ring.
+  simpl in |- *; rewrite (H0 lvar); legacy ring.
 Qed.
 
 Lemma multiply_correct :
@@ -595,8 +595,8 @@ simpl in |- *; case (eqExprA e0 (EAinv a)); intros.
 rewrite e2; simpl in |- *; fold AinvT in |- *.
 rewrite <-
  (AmultT_assoc (interp_ExprA lvar a) (AinvT (interp_ExprA lvar a))
-    (interp_ExprA lvar e1)); rewrite AinvT_r; [ ring | assumption ].
-simpl in |- *; rewrite H0; auto; ring.
+    (interp_ExprA lvar e1)); rewrite AinvT_r; [ legacy ring | assumption ].
+simpl in |- *; rewrite H0; auto; legacy ring.
 simpl in |- *; fold AoppT in |- *; case (eqExprA (EAopp e0) (EAinv a));
  intros; [ inversion e1 | simpl in |- *; trivial ].
 unfold monom_remove in |- *; case (eqExprA (EAinv e0) (EAinv a)); intros.
@@ -619,7 +619,7 @@ simple induction a; simpl in |- *; intros; try rewrite monom_remove_correct;
 elim (Rmult_neq_0_reg (interp_ExprA lvar e) (interp_ExprA lvar e0) H1);
  intros.
 rewrite (H0 (monom_remove e e1) lvar H3); rewrite monom_remove_correct; auto.
-ring.
+legacy ring.
 Qed.
 
 Lemma monom_simplif_correct :
@@ -644,3 +644,7 @@ unfold inverse_simplif in |- *; rewrite monom_simplif_correct; auto.
 Qed.
 
 End Theory_of_fields.
+
+(* Compatibility *)
+Notation AplusT_sym := AplusT_comm (only parsing).
+Notation AmultT_sym := AmultT_comm (only parsing).
diff --git a/contrib/field/field.ml4 b/contrib/field/field.ml4
index 47e583fd..dab5a45c 100644
--- a/contrib/field/field.ml4
+++ b/contrib/field/field.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: field.ml4 8866 2006-05-28 16:21:04Z herbelin $ *)
+(* $Id: field.ml4 9273 2006-10-25 11:30:36Z barras $ *)
 
 open Names
 open Pp
@@ -86,7 +86,7 @@ let add_field a aplus amult aone azero aopp aeq ainv aminus_o adiv_o rth
       Ring.add_theory true true false a None None None aplus amult aone azero
         (Some aopp) aeq rth Quote.ConstrSet.empty
      with | UserError("Add Semi Ring",_) -> ());
-    let th = mkApp ((constant ["Field_Theory"] "Build_Field_Theory"),
+    let th = mkApp ((constant ["LegacyField_Theory"] "Build_Field_Theory"),
       [|a;aplus;amult;aone;azero;aopp;aeq;ainv;aminus_o;adiv_o;rth;ainv_l|]) in
     begin
       let _ = type_of (Global.env ()) Evd.empty th in ();
@@ -139,7 +139,7 @@ ARGUMENT EXTEND minus_div_arg
 END
 
 VERNAC COMMAND EXTEND Field
-  [ "Add" "Field" 
+  [ "Add" "Legacy" "Field" 
       constr(a) constr(aplus) constr(amult) constr(aone)
       constr(azero) constr(aopp) constr(aeq)
       constr(ainv) constr(rth) constr(ainv_l) minus_div_arg(md) ]
@@ -153,7 +153,7 @@ END
 
 (* Guesses the type and calls field_gen with the right theory *)
 let field g =
-  Coqlib.check_required_library ["Coq";"field";"Field"];
+  Coqlib.check_required_library ["Coq";"field";"LegacyField"];
   let typ = 
     match Hipattern.match_with_equation (pf_concl g) with
       | Some (eq,t::args) when eq = (Coqlib.build_coq_eq_data()).Coqlib.eq -> t
@@ -175,7 +175,7 @@ let guess_theory env evc = function
 
 (* Guesses the type and calls Field_Term with the right theory *)
 let field_term l g =
-  Coqlib.check_required_library ["Coq";"field";"Field"];
+  Coqlib.check_required_library ["Coq";"field";"LegacyField"];
   let env = (pf_env g)
   and evc = (project g) in
   let th = valueIn (VConstr (guess_theory env evc l))
@@ -187,7 +187,7 @@ let field_term l g =
 
 (* Declaration of Field *)
 
-TACTIC EXTEND field
-| [ "field" ] -> [ field ]
-| [ "field" ne_constr_list(l) ] -> [ field_term l ]
+TACTIC EXTEND legacy_field
+| [ "legacy" "field" ] -> [ field ]
+| [ "legacy" "field" ne_constr_list(l) ] -> [ field_term l ]
 END
diff --git a/contrib/first-order/formula.ml b/contrib/first-order/formula.ml
index fde48d2b..0be468aa 100644
--- a/contrib/first-order/formula.ml
+++ b/contrib/first-order/formula.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: formula.ml 7493 2005-11-02 22:12:16Z mohring $ *)
+(* $Id: formula.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Hipattern
 open Names
@@ -46,7 +46,6 @@ let rec nb_prod_after n c=
     | _ -> 0
 
 let construct_nhyps ind gls =
-  let env=pf_env gls in
   let nparams = (fst (Global.lookup_inductive ind)).mind_nparams in
   let constr_types = Inductiveops.arities_of_constructors (pf_env gls) ind in 
   let hyp = nb_prod_after nparams in	
diff --git a/contrib/first-order/g_ground.ml4 b/contrib/first-order/g_ground.ml4
index f9c4cea2..366f563b 100644
--- a/contrib/first-order/g_ground.ml4
+++ b/contrib/first-order/g_ground.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma"  i*)
 
-(* $Id: g_ground.ml4 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: g_ground.ml4 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Formula
 open Sequent
@@ -24,7 +24,7 @@ open Libnames
 
 (* declaring search depth as a global option *)
 
-let ground_depth=ref 5
+let ground_depth=ref 3
 
 let _=
   let gdopt=
@@ -34,13 +34,28 @@ let _=
       optread=(fun ()->Some !ground_depth); 
       optwrite=
    (function 
-	None->ground_depth:=5
+	None->ground_depth:=3
       |	Some i->ground_depth:=(max i 0))}
   in
     declare_int_option gdopt
-      
+
+let congruence_depth=ref 100
+
+let _=
+  let gdopt=
+    { optsync=true;
+      optname="Congruence Depth";
+      optkey=SecondaryTable("Congruence","Depth"); 
+      optread=(fun ()->Some !congruence_depth); 
+      optwrite=
+   (function 
+	None->congruence_depth:=0
+      |	Some i->congruence_depth:=(max i 0))}
+  in
+    declare_int_option gdopt
+
 let default_solver=(Tacinterp.interp <:tactic<auto with *>>)
-    
+
 let fail_solver=tclFAIL 0 (Pp.str "GTauto failed")
 		      
 type external_env=
@@ -94,3 +109,19 @@ TACTIC EXTEND gintuition
   [ "gintuition" tactic_opt(t) ] ->
      [ gen_ground_tac false (option_map eval_tactic t) Void ]
 END
+
+
+let default_declarative_automation gls = 
+  tclORELSE 
+    (Cctac.congruence_tac !congruence_depth []) 
+    (gen_ground_tac true 
+       (Some (tclTHEN
+		default_solver
+		(Cctac.congruence_tac !congruence_depth [])))
+       Void) gls
+
+
+
+let () = 
+  Decl_proof_instr.register_automation_tac default_declarative_automation
+
diff --git a/contrib/fourier/Fourier.v b/contrib/fourier/Fourier.v
index 8836b76e..1a1a5055 100644
--- a/contrib/fourier/Fourier.v
+++ b/contrib/fourier/Fourier.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Fourier.v 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: Fourier.v 9178 2006-09-26 11:18:22Z barras $ *)
 
 (* "Fourier's method to solve linear inequations/equations systems.".*)
 
@@ -17,7 +17,7 @@ Declare ML Module "fourierR".
 Declare ML Module "field".
 
 Require Export Fourier_util.
-Require Export Field.
+Require Export LegacyField.
 Require Export DiscrR.
 
 Ltac fourier := abstract (fourierz; field; discrR).
diff --git a/contrib/funind/functional_principles_proofs.ml b/contrib/funind/functional_principles_proofs.ml
index 7977d4e0..14e2233f 100644
--- a/contrib/funind/functional_principles_proofs.ml
+++ b/contrib/funind/functional_principles_proofs.ml
@@ -39,12 +39,12 @@ let do_observe_tac s tac g =
 	    Cerrors.explain_exn e ++ str " on goal " ++ goal ); 
    raise e;;
 
-
-let observe_tac s tac g =
+let observe_tac_stream s tac g = 
   if do_observe ()
-  then do_observe_tac (str s) tac g
+  then do_observe_tac  s tac g
   else tac g
 
+let observe_tac s tac g = observe_tac_stream (str s) tac g
 
 let tclTRYD tac = 
   if  !Options.debug  || do_observe ()
@@ -179,10 +179,11 @@ let nf_betaiotazeta = (* Reductionops.local_strong Reductionops.whd_betaiotazeta
 let change_eq env sigma hyp_id (context:Sign.rel_context) x t end_of_type  = 
   let nochange msg  = 
     begin 
-(*       observe (str ("Not treating ( "^msg^" )") ++ pr_lconstr t    ); *)
+      observe (str ("Not treating ( "^msg^" )") ++ pr_lconstr t    );
       failwith "NoChange"; 
     end
   in    
+  let eq_constr = Reductionops.is_conv env sigma in 
   if not (noccurn 1 end_of_type)
   then nochange "dependent"; (* if end_of_type depends on this term we don't touch it  *)
     if not (isApp t) then nochange "not an equality";
@@ -194,6 +195,7 @@ let change_eq env sigma hyp_id (context:Sign.rel_context) x t end_of_type  =
     in 
     if not (closed0 t1) then nochange "not a closed lhs";    
     let rec compute_substitution sub t1 t2 = 
+      observe (str "compute_substitution : " ++ pr_lconstr t1 ++ str " === " ++ pr_lconstr t2);
       if isRel t2 
       then 
 	let t2 = destRel t2  in 
@@ -313,9 +315,13 @@ let h_reduce_with_zeta =
 
 
 let rewrite_until_var arg_num eq_ids : tactic =
+  (* tests if the declares recursive argument is neither a Constructor nor 
+     an applied Constructor since such a form for the recursive argument 
+     will break the Guard when trying to save the Lemma. 
+  *)
   let test_var g = 
     let _,args = destApp (pf_concl g) in 
-    not (isConstruct args.(arg_num))
+    not ((isConstruct args.(arg_num)) || isAppConstruct args.(arg_num))
   in
   let rec do_rewrite eq_ids g  = 
     if test_var g 
@@ -499,7 +505,7 @@ let clean_goal_with_heq ptes_infos continue_tac dyn_infos  =
     tclTHENLIST 
       [
 	tac ;
-	(continue_tac new_infos)
+	observe_tac "clean_hyp_with_heq continue" (continue_tac new_infos)
       ]
       g    
 
@@ -779,7 +785,7 @@ let build_proof
       finish_proof dyn_infos)
   in
   observe_tac "build_proof"
-    (build_proof do_finish_proof dyn_infos) 
+    (build_proof (clean_goal_with_heq ptes_infos do_finish_proof) dyn_infos) 
 
 
 
@@ -884,7 +890,8 @@ let generate_equation_lemma fnames f fun_num nb_params nb_args rec_args_num =
 (*   observe (str "f_body_with_params_and_other_fun " ++  pr_lconstr f_body_with_params_and_other_fun); *)
   let eq_rhs = nf_betaiotazeta (mkApp(compose_lam params f_body_with_params_and_other_fun,Array.init (nb_params + nb_args) (fun i -> mkRel(nb_params + nb_args - i)))) in
 (*   observe (str "eq_rhs " ++  pr_lconstr eq_rhs); *)
-  let type_ctxt,type_of_f = Sign.decompose_prod_n_assum (nb_params + nb_args) f_def.const_type in
+  let type_ctxt,type_of_f = Sign.decompose_prod_n_assum (nb_params + nb_args) 
+    (Typeops.type_of_constant_type (Global.env()) f_def.const_type) in
   let eqn = mkApp(Lazy.force eq,[|type_of_f;eq_lhs;eq_rhs|]) in
   let lemma_type = it_mkProd_or_LetIn ~init:eqn type_ctxt in
   let f_id = id_of_label (con_label (destConst f)) in
@@ -1332,10 +1339,11 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_lemma_constr eqs : tactic =
 	      h_intro hid;
 	      Elim.h_decompose_and (mkVar hid); 
 	      backtrack_eqs_until_hrec hrec eqs;
-	      tclCOMPLETE (tclTHENS  (* We must have exactly ONE subgoal !*)
-		(apply (mkVar hrec))
-		[ tclTHENSEQ 
-		    [
+	      observe_tac ("new_prove_with_tcc ( applying "^(string_of_id hrec)^" )" )
+		(tclTHENS  (* We must have exactly ONE subgoal !*)
+		   (apply (mkVar hrec))
+		   [ tclTHENSEQ 
+		       [
 			 thin [hrec];
 			 apply (Lazy.force acc_inv);
 			 (fun g -> 
@@ -1344,11 +1352,12 @@ let new_prove_with_tcc is_mes acc_inv hrec tcc_lemma_constr eqs : tactic =
 			      unfold_in_concl [([], evaluable_of_global_reference (delayed_force ltof_ref))] g 
 			    else tclIDTAC g
 			 );
-			 tclTRY(Recdef.list_rewrite true eqs);
-			 observe_tac "finishing"  (tclCOMPLETE (Eauto.gen_eauto false (false,5) [] (Some [])))
+			 observe_tac "rew_and_finish"
+			   (tclTHEN 
+			      (tclTRY(Recdef.list_rewrite true eqs))
+			      (observe_tac "finishing"  (tclCOMPLETE (Eauto.gen_eauto false (false,5) [] (Some [])))))
 		       ]
-		]
-			  )
+		])
 	    ])
 	    gls
 
@@ -1371,7 +1380,7 @@ let is_valid_hypothesis predicates_name =
 	| _ -> false 
   in
   is_valid_hypothesis 
-
+(*
 let fresh_id avoid na = 
   let id =  
     match na with 
@@ -1450,7 +1459,7 @@ let prove_principle_for_gen
     let wf_tac = 
       if is_mes 
       then 
-	Recdef.tclUSER_if_not_mes 
+	(fun b -> Recdef.tclUSER_if_not_mes b None)
       else fun _ -> prove_with_tcc tcc_lemma_ref []
     in
     let start_tac g = 
@@ -1543,7 +1552,7 @@ let prove_principle_for_gen
 		   let pte_info = 
 		     { proving_tac =
 			 (fun eqs -> 
-			    observe_tac "prove_with_tcc" 
+			    observe_tac "new_prove_with_tcc" 
 			      (new_prove_with_tcc is_mes acc_inv hrec  tcc_lemma_ref (List.map mkVar eqs))
 			 );
 		       is_valid = is_valid_hypothesis predicates_names 
@@ -1583,13 +1592,160 @@ let prove_principle_for_gen
 	 arg_tac;
 	 start_tac
 	] g
+*)
 
-
-
-
-
-
-
+let prove_principle_for_gen
+    (f_ref,functional_ref,eq_ref) tcc_lemma_ref is_mes
+    rec_arg_num rec_arg_type relation gl = 
+  let princ_type = pf_concl gl in 
+  let princ_info = compute_elim_sig princ_type in 
+  let fresh_id = 
+    let avoid = ref (pf_ids_of_hyps gl) in 
+    fun na -> 
+      let new_id = 
+	  match na with 
+	    | Name id -> fresh_id !avoid (string_of_id id) 
+	    | Anonymous -> fresh_id !avoid "H" 
+      in
+      avoid := new_id :: !avoid;
+      Name new_id
+  in
+  let fresh_decl (na,b,t) = (fresh_id na,b,t) in
+  let princ_info : elim_scheme = 
+    { princ_info with 
+	params = List.map fresh_decl princ_info.params;
+	predicates = List.map fresh_decl princ_info.predicates; 
+	branches = List.map fresh_decl princ_info.branches; 
+	args = List.map fresh_decl princ_info.args
+    }
+  in
+  let wf_tac = 
+    if is_mes 
+    then 
+      (fun b -> Recdef.tclUSER_if_not_mes b None)
+    else fun _ -> prove_with_tcc tcc_lemma_ref []
+  in
+  let real_rec_arg_num = rec_arg_num - princ_info.nparams in 
+  let npost_rec_arg = princ_info.nargs - real_rec_arg_num + 1 in 
+  let (post_rec_arg,pre_rec_arg) = 
+    Util.list_chop npost_rec_arg princ_info.args
+  in
+  let rec_arg_id = 
+    match post_rec_arg with 
+      | (Name id,_,_)::_ -> id 
+      | _ -> assert false 
+  in
+  let subst_constrs = List.map (fun (na,_,_) -> mkVar (Nameops.out_name na)) (pre_rec_arg@princ_info.params) in 
+  let relation = substl subst_constrs relation in 
+  let input_type = substl subst_constrs rec_arg_type in 
+  let wf_thm_id = Nameops.out_name (fresh_id (Name (id_of_string "wf_R"))) in 
+  let acc_rec_arg_id = 
+    Nameops.out_name (fresh_id (Name (id_of_string ("Acc_"^(string_of_id rec_arg_id)))))
+  in 
+  let revert l = 
+    tclTHEN (h_generalize (List.map mkVar l)) (clear l) 
+  in
+  let fix_id = Nameops.out_name (fresh_id (Name hrec_id)) in 
+  let prove_rec_arg_acc g = 
+      (observe_tac "prove_rec_arg_acc" 
+	 (tclCOMPLETE
+	    (tclTHEN
+	       (forward 
+		  (Some ((fun g -> observe_tac "prove wf" (tclCOMPLETE (wf_tac is_mes)) g)))
+		  (Genarg.IntroIdentifier wf_thm_id)
+		  (mkApp (delayed_force well_founded,[|input_type;relation|])))
+	       (
+		 observe_tac 
+		   "apply wf_thm" 
+		   (h_apply ((mkApp(mkVar wf_thm_id,
+				    [|mkVar rec_arg_id |])),Rawterm.NoBindings)
+		   )
+	       )
+	    )
+	 )
+      )
+      g
+  in
+  let args_ids = List.map (fun (na,_,_) -> Nameops.out_name na) princ_info.args in
+  tclTHENSEQ
+    [ 
+      h_intros 
+	(List.rev_map (fun (na,_,_) -> Nameops.out_name na) 
+	   (princ_info.args@princ_info.branches@princ_info.predicates@princ_info.params)
+	);
+      observe_tac "" (forward
+	 (Some (prove_rec_arg_acc))
+	 (Genarg.IntroIdentifier acc_rec_arg_id)
+ 	 (mkApp (delayed_force acc_rel,[|input_type;relation;mkVar rec_arg_id|]))
+      );
+      observe_tac "reverting" (revert (List.rev (acc_rec_arg_id::args_ids)));
+      observe_tac "h_fix" (h_fix (Some fix_id) (real_rec_arg_num + 1)); 
+      h_intros (List.rev (acc_rec_arg_id::args_ids));
+      Equality.rewriteLR (mkConst eq_ref);
+      observe_tac "finish" (fun gl' -> 
+	 let body = 
+	   let _,args = destApp (pf_concl gl') in 
+	   array_last args
+	 in
+	 let body_info rec_hyps = 
+	   {
+	     nb_rec_hyps = List.length rec_hyps;
+	     rec_hyps = rec_hyps;
+	     eq_hyps = [];
+	     info = body
+	   }
+	 in 
+	 let acc_inv = 
+	   lazy (
+	     mkApp (
+	       delayed_force acc_inv_id,
+	       [|input_type;relation;mkVar rec_arg_id|]
+	     )
+	   )
+	 in
+	 let acc_inv = lazy (mkApp(Lazy.force acc_inv, [|mkVar  acc_rec_arg_id|])) in
+	 let predicates_names = 
+	   List.map (fun (na,_,_) -> Nameops.out_name na) princ_info.predicates
+	 in
+	 let pte_info = 
+	   { proving_tac =
+	       (fun eqs -> 
+		  observe_tac "new_prove_with_tcc" 
+		    (new_prove_with_tcc 
+		       is_mes acc_inv fix_id tcc_lemma_ref (List.map mkVar eqs)
+		    )
+	       );
+	     is_valid = is_valid_hypothesis predicates_names
+	   }
+	 in
+	 let ptes_info : pte_info Idmap.t = 
+	   List.fold_left
+	     (fun map pte_id -> 
+		Idmap.add pte_id 
+		  pte_info			       
+		  map
+	     )
+	     Idmap.empty
+	     predicates_names
+	 in
+	 let make_proof rec_hyps = 
+	   build_proof 
+	     false 
+	     [f_ref]
+	     ptes_info
+	     (body_info rec_hyps)
+	 in
+	 observe_tac "instanciate_hyps_with_args" 
+	   (instanciate_hyps_with_args 
+	      make_proof
+	      (List.map (fun (na,_,_) -> Nameops.out_name na) princ_info.branches)
+	      (List.rev args_ids)
+	   )
+	   gl'
+      )
+			   
+    ]
+    gl    
 
 
 
diff --git a/contrib/funind/functional_principles_types.ml b/contrib/funind/functional_principles_types.ml
index f83eae8d..89ebb75a 100644
--- a/contrib/funind/functional_principles_types.ml
+++ b/contrib/funind/functional_principles_types.ml
@@ -301,9 +301,18 @@ let pp_dur time time' =
   str (string_of_float (System.time_difference time time'))
 
 (* let qed () = save_named true  *)
-let defined () = Command.save_named false
-
-
+let defined () = 
+  try 
+    Command.save_named false 
+  with 
+    | UserError("extract_proof",msg) ->
+	Util.errorlabstrm
+	  "defined"
+	  ((try
+	      str "On goal : " ++ fnl () ++  pr_open_subgoals () ++ fnl ()
+	    with _ -> mt ()
+	   ) ++msg)
+    | e -> raise e
 
 
 
@@ -346,6 +355,7 @@ let generate_functional_principle
     interactive_proof
     old_princ_type sorts new_princ_name funs i proof_tac
     =
+  try 
   let f = funs.(i) in
   let type_sort = Termops.new_sort_in_family InType in
   let new_sorts =
@@ -384,6 +394,9 @@ let generate_functional_principle
 	     Decl_kinds.IsDefinition (Decl_kinds.Scheme)
 	    )
 	);
+	Options.if_verbose 
+	  (fun id -> Pp.msgnl (Ppconstr.pr_id id ++ str " is defined")) 
+	  name;
 	names := name :: !names
       in
       register_with_sort InProp;
@@ -393,6 +406,10 @@ let generate_functional_principle
     build_functional_principle interactive_proof old_princ_type new_sorts funs i proof_tac hook 
   in
   save false new_princ_name entry g_kind hook
+  with 
+    | Defining_principle _ as e -> raise e
+    | e -> raise (Defining_principle e)
+
 (*   defined  () *)
 
 
@@ -591,13 +608,6 @@ let make_scheme (fas : (constant*Rawterm.rawsort) list) : Entries.definition_ent
     const::other_result
 
 let build_scheme fas = 
-(*         (fun (f,_) ->  *)
-(* 	 try Libnames.constr_of_global (Nametab.global f) *)
-(* 	 with Not_found ->  *)
-(* 	   Util.error ("Cannot find "^ Libnames.string_of_reference f) *)
-(*       ) *)
-(*       fas *)
-
   let bodies_types = 
     make_scheme 
       (List.map 
diff --git a/contrib/funind/indfun.ml b/contrib/funind/indfun.ml
index dffc8120..82bb2869 100644
--- a/contrib/funind/indfun.ml
+++ b/contrib/funind/indfun.ml
@@ -39,7 +39,8 @@ let functional_induction with_clean c princl pat =
 		      let finfo = (* we first try to find out a graph on f *)
 			try find_Function_infos c' 
 			with Not_found -> 
-			  errorlabstrm "" (str "Cannot find induction information on "++Printer.pr_lconstr (mkConst c') )
+			  errorlabstrm "" (str "Cannot find induction information on "++
+					     Printer.pr_lconstr (mkConst c') )
 		      in
 		      match Tacticals.elimination_sort_of_goal g with 
 			| InProp -> finfo.prop_lemma
@@ -49,8 +50,9 @@ let functional_induction with_clean c princl pat =
 		    let princ =  (* then we get the principle *)
 		      try mkConst (out_some princ_option )
 		      with Failure "out_some" -> 
-			(*i If there is not default lemma defined then, we cross our finger and try to 
-		    find a lemma named f_ind (or f_rec, f_rect) i*)
+			(*i If there is not default lemma defined then, 
+			  we cross our finger and try to find a lemma named f_ind 
+			  (or f_rec, f_rect) i*)
 			let princ_name = 
 			  Indrec.make_elimination_ident
 			    (id_of_label (con_label c'))
@@ -90,45 +92,45 @@ let functional_induction with_clean c princl pat =
     let old_idl = List.fold_right Idset.add (Tacmach.pf_ids_of_hyps g) Idset.empty in 
     let old_idl = Idset.diff old_idl princ_vars in 
     let subst_and_reduce g = 
-      let idl = 
-	map_succeed 
-	  (fun id -> 
-	    if Idset.mem id old_idl then failwith "subst_and_reduce";
-	    id 
-	  )
-	  (Tacmach.pf_ids_of_hyps g)
-      in 
-      let flag = 
-	Rawterm.Cbv
-	  {Rawterm.all_flags 
-	  with Rawterm.rDelta = false; 		 
-	  }
-      in
       if with_clean 
       then
+	let idl = 
+	  map_succeed 
+	    (fun id -> 
+	       if Idset.mem id old_idl then failwith "subst_and_reduce";
+	       id 
+	    )
+	    (Tacmach.pf_ids_of_hyps g)
+	in 
+	let flag = 
+	  Rawterm.Cbv
+	    {Rawterm.all_flags 
+	     with Rawterm.rDelta = false; 		 
+	    }
+	in
 	Tacticals.tclTHEN
 	  (Tacticals.tclMAP (fun id -> Tacticals.tclTRY (Equality.subst [id])) idl )
 	  (Hiddentac.h_reduce flag Tacticals.allClauses)	
 	  g
       else Tacticals.tclIDTAC g 
-
+	
     in
     Tacticals.tclTHEN
       (choose_dest_or_ind 
-	princ_infos
-	args_as_induction_constr
-	princ'
-	pat)
+	 princ_infos
+	 args_as_induction_constr
+	 princ'
+	 pat)
       subst_and_reduce
       g
-
-
+      
+      
 
 
 type annot = 
     Struct of identifier 
-  | Wf of Topconstr.constr_expr * identifier option
-  | Mes of Topconstr.constr_expr * identifier option
+  | Wf of Topconstr.constr_expr * identifier option * Topconstr.constr_expr list
+  | Mes of Topconstr.constr_expr * identifier option * Topconstr.constr_expr list
 
 
 type newfixpoint_expr =
@@ -184,7 +186,7 @@ let build_newrecursive
 	States.unfreeze fs; raise e in
     States.unfreeze fs; def
   in
-  recdef
+  recdef,rec_impls
 	
 
 let compute_annot (name,annot,args,types,body) =
@@ -238,29 +240,47 @@ let prepare_body (name,annot,args,types,body) rt =
   (fun_args,rt')
 
 
-let derive_inversion fix_names = 
-  try
-    Invfun.derive_correctness 
-      Functional_principles_types.make_scheme
-      functional_induction 
-	  (List.map (fun id -> destConst (Tacinterp.constr_of_id (Global.env ()) id)) fix_names)
-      (*i The next call to mk_rel_id is valid since we have just construct the graph 
-	Ensures by : register_built
-	i*) 
-      (List.map (fun id -> destInd (Tacinterp.constr_of_id (Global.env ()) (mk_rel_id id))) fix_names)
-  with e -> 
-    msg_warning (str "Cannot define correction of function and graph" ++ Cerrors.explain_exn e)
-	  
+let derive_inversion fix_names =
+  try 
+    (* we first transform the fix_names identifier into their corresponding constant *)
+    let fix_names_as_constant = 
+      List.map (fun id -> destConst (Tacinterp.constr_of_id (Global.env ()) id)) fix_names 
+    in 
+    (* 
+       Then we check that the graphs have been defined 
+       If one of the graphs haven't been defined 
+       we do nothing
+    *)
+    List.iter (fun c -> ignore (find_Function_infos c)) fix_names_as_constant ;
+    try
+      Invfun.derive_correctness 
+	Functional_principles_types.make_scheme
+	functional_induction 
+	fix_names_as_constant
+	(*i The next call to mk_rel_id is valid since we have just construct the graph 
+	  Ensures by : register_built
+	  i*) 
+	(List.map
+	   (fun id -> destInd (Tacinterp.constr_of_id (Global.env ()) (mk_rel_id id)))
+	   fix_names
+	)
+    with e -> 
+      msg_warning 
+	(str "Cannot built inversion information" ++ 
+	   if do_observe () then Cerrors.explain_exn e else mt ())
+  with _ -> ()
+
 let generate_principle 
-    do_built fix_rec_l recdefs  interactive_proof parametrize 
-    (continue_proof : int -> Names.constant array -> Term.constr array -> int -> Tacmach.tactic) : unit =
+    is_general do_built fix_rec_l recdefs  interactive_proof 
+    (continue_proof : int -> Names.constant array -> Term.constr array -> int -> 
+      Tacmach.tactic) : unit =
   let names = List.map (function (name,_,_,_,_) -> name) fix_rec_l in
   let fun_bodies = List.map2 prepare_body fix_rec_l recdefs in
   let funs_args = List.map fst fun_bodies in
   let funs_types =  List.map (function (_,_,_,types,_) -> types) fix_rec_l in
   try 
     (* We then register the Inductive graphs of the functions  *)
-    Rawterm_to_relation.build_inductive parametrize names funs_args funs_types recdefs;
+    Rawterm_to_relation.build_inductive names funs_args funs_types recdefs;
     if do_built 
     then
       begin
@@ -286,8 +306,7 @@ let generate_principle
 	  list_map_i
 	    (fun i x ->
 	       let princ = destConst (Indrec.lookup_eliminator (ind_kn,i) (InProp)) in 
-	       let princ_type = 
-		 (Global.lookup_constant princ).Declarations.const_type
+	       let princ_type = Typeops.type_of_constant (Global.env()) princ
 	       in
 	       Functional_principles_types.generate_functional_principle
 		 interactive_proof 
@@ -301,12 +320,22 @@ let generate_principle
 	    0
 	    fix_rec_l
 	in 
-	Array.iter add_Function funs_kn;
+	Array.iter (add_Function is_general) funs_kn;
 	()
       end
   with e -> 
-    Pp.msg_warning (Cerrors.explain_exn e) 
-
+    match e with 
+      | Building_graph e -> 
+	    Pp.msg_warning 
+	    (str "Cannot define graph(s) for " ++ 
+	       h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
+	       if do_observe () then (spc () ++ Cerrors.explain_exn e) else mt ())
+      | Defining_principle e -> 
+	    Pp.msg_warning
+	    (str "Cannot define principle(s) for "++ 
+	       h 1 (prlist_with_sep (fun _ -> str","++spc ()) Ppconstr.pr_id names) ++
+	       if do_observe () then Cerrors.explain_exn e else mt ())
+      | _ -> anomaly ""
 
 let register_struct is_rec fixpoint_exprl = 
   match fixpoint_exprl with 
@@ -330,7 +359,7 @@ let generate_correction_proof_wf f_ref tcc_lemma_ref
     tcc_lemma_ref is_mes  rec_arg_num rec_arg_type relation
 
 
-let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body
+let register_wf ?(is_mes=false) fname rec_impls wf_rel_expr wf_arg using_lemmas args ret_type body
     pre_hook 
     =  
   let type_of_f = Command.generalize_constr_expr ret_type args in 
@@ -349,13 +378,13 @@ let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body
   in
   let unbounded_eq = 
     let f_app_args = 
-      Topconstr.CApp 
+      Topconstr.CAppExpl 
 	(dummy_loc, 
-	 (None,Topconstr.mkIdentC fname) ,
+	 (None,(Ident (dummy_loc,fname))) ,
 	 (List.map 
 	    (function
 	       | _,Anonymous -> assert false 
-	       | _,Name e -> (Topconstr.mkIdentC e,None)
+	       | _,Name e -> (Topconstr.mkIdentC e)
 	    ) 
 	    (Topconstr.names_of_local_assums args)
 	 )
@@ -365,7 +394,8 @@ let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body
 		    [(f_app_args,None);(body,None)])
   in
   let eq = Command.generalize_constr_expr unbounded_eq args in 
-  let hook f_ref tcc_lemma_ref functional_ref eq_ref rec_arg_num rec_arg_type nb_args relation =
+  let hook f_ref tcc_lemma_ref functional_ref eq_ref rec_arg_num rec_arg_type
+      nb_args relation =
     try 
       pre_hook 
 	(generate_correction_proof_wf f_ref tcc_lemma_ref is_mes
@@ -377,15 +407,16 @@ let register_wf ?(is_mes=false) fname wf_rel_expr wf_arg args ret_type body
       ()
   in 
   Recdef.recursive_definition 
-    is_mes fname 
+    is_mes fname rec_impls
     type_of_f
     wf_rel_expr
     rec_arg_num
     eq
     hook
+    using_lemmas
 
     
-let register_mes fname wf_mes_expr wf_arg args ret_type body = 
+let register_mes fname rec_impls wf_mes_expr wf_arg using_lemmas args ret_type body = 
   let wf_arg_type,wf_arg = 
     match wf_arg with 
       | None -> 
@@ -424,35 +455,38 @@ let register_mes fname wf_mes_expr wf_arg args ret_type body =
   let wf_rel_from_mes = 
     Topconstr.mkAppC(Topconstr.mkRefC  ltof,[wf_arg_type;fun_from_mes])
   in
-  register_wf ~is_mes:true fname wf_rel_from_mes (Some wf_arg) args ret_type body
+  register_wf ~is_mes:true fname rec_impls wf_rel_from_mes (Some wf_arg) 
+    using_lemmas args ret_type body
 	  
 
 let do_generate_principle register_built interactive_proof fixpoint_exprl  = 
-  let recdefs = build_newrecursive fixpoint_exprl in 
+  let recdefs,rec_impls = build_newrecursive fixpoint_exprl in 
   let _is_struct = 
     match fixpoint_exprl with 
-      | [((name,Some (Wf (wf_rel,wf_x)),args,types,body))] -> 
+      | [((name,Some (Wf (wf_rel,wf_x,using_lemmas)),args,types,body))] -> 
 	  let pre_hook = 
 	    generate_principle 
+	      true
 	      register_built
 	      fixpoint_exprl 
 	      recdefs
 	      true
-	      false
 	  in 
-	  if register_built then register_wf name wf_rel wf_x args types body pre_hook;
+	  if register_built 
+	  then register_wf name rec_impls wf_rel wf_x using_lemmas args types body pre_hook;
 	  false
-      | [((name,Some (Mes (wf_mes,wf_x)),args,types,body))] -> 
+      | [((name,Some (Mes (wf_mes,wf_x,using_lemmas)),args,types,body))] -> 
 	  let pre_hook = 
 	    generate_principle 
+	      true
 	      register_built
 	      fixpoint_exprl 
 	      recdefs
 	      true
-	      false
 	  in 
-	  if register_built then register_mes name wf_mes wf_x args types body pre_hook;
-	  false
+	  if register_built 
+	  then register_mes name rec_impls wf_mes wf_x using_lemmas args types body pre_hook;
+	  true
       | _ -> 
 	  let fix_names = 
 	    List.map (function (name,_,_,_,_) -> name) fixpoint_exprl 
@@ -469,7 +503,9 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl  =
 		     in 
 		     let annot = 
 		       try Some (list_index (Name id) names - 1), Topconstr.CStructRec 
-		       with Not_found -> raise (UserError("",str "Cannot find argument " ++ Ppconstr.pr_id id)) 
+		       with Not_found -> 
+			 raise (UserError("",str "Cannot find argument " ++ 
+					    Ppconstr.pr_id id)) 
 		     in 
  		     (name,annot,args,types,body),(None:Vernacexpr.decl_notation) 
 		 | (name,None,args,types,body),recdef -> 
@@ -479,10 +515,11 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl  =
 			 (dummy_loc,"Function",
 			  Pp.str "the recursive argument needs to be specified in Function")
 		     else 
-		       (name,(Some 0, Topconstr.CStructRec),args,types,body),(None:Vernacexpr.decl_notation)
+		       (name,(Some 0, Topconstr.CStructRec),args,types,body),
+		     (None:Vernacexpr.decl_notation)
 		 | (_,Some (Wf _),_,_,_),_ | (_,Some (Mes _),_,_,_),_-> 
 		     error 
-		       ("Cannot use mutual definition with well-founded recursion")
+		       ("Cannot use mutual definition with well-founded recursion or measure")
 	      ) 
 	      (List.combine fixpoint_exprl recdefs)
 	  in
@@ -493,13 +530,13 @@ let do_generate_principle register_built interactive_proof fixpoint_exprl  =
 	  let is_rec = List.exists (is_rec fix_names) recdefs in
 	  if register_built then register_struct is_rec old_fixpoint_exprl;
 	  generate_principle
+	    false
 	    register_built
 	    fixpoint_exprl
 	    recdefs 
 	    interactive_proof
-	    true
 	    (Functional_principles_proofs.prove_princ_for_struct interactive_proof);
-	  if register_built then derive_inversion  fix_names;
+	  if register_built then derive_inversion fix_names;
 	  true;
   in
   ()
@@ -517,9 +554,13 @@ let rec add_args id new_args b =
   | CArrow(loc,b1,b2) -> 
       CArrow(loc,add_args id new_args  b1, add_args id new_args b2)
   | CProdN(loc,nal,b1) -> 
-      CProdN(loc,List.map (fun (nal,b2) -> (nal,add_args id new_args b2)) nal, add_args id new_args  b1)
+      CProdN(loc,
+	     List.map (fun (nal,b2) -> (nal,add_args id new_args b2)) nal, 
+	     add_args id new_args  b1)
   | CLambdaN(loc,nal,b1) -> 
-      CLambdaN(loc,List.map (fun (nal,b2) -> (nal,add_args id new_args  b2)) nal, add_args id new_args  b1)
+      CLambdaN(loc,
+	       List.map (fun (nal,b2) -> (nal,add_args id new_args  b2)) nal, 
+	       add_args id new_args  b1)
   | CLetIn(loc,na,b1,b2) -> 
       CLetIn(loc,na,add_args id new_args b1,add_args id new_args b2)
   | CAppExpl(loc,(pf,r),exprl) -> 
@@ -530,10 +571,13 @@ let rec add_args id new_args b =
 	| _ -> CAppExpl(loc,(pf,r),List.map (add_args id new_args) exprl)
       end
   | CApp(loc,(pf,b),bl) -> 
-      CApp(loc,(pf,add_args id new_args b), List.map (fun (e,o) -> add_args id new_args e,o) bl)
+      CApp(loc,(pf,add_args id new_args b), 
+	   List.map (fun (e,o) -> add_args id new_args e,o) bl)
   | CCases(loc,b_option,cel,cal) -> 
       CCases(loc,option_map (add_args id new_args) b_option,
-	     List.map (fun (b,(na,b_option)) -> add_args id new_args b,(na,option_map (add_args id new_args) b_option)) cel, 
+	     List.map (fun (b,(na,b_option)) -> 
+			 add_args id new_args b,
+			 (na,option_map (add_args id new_args) b_option)) cel, 
 	     List.map (fun (loc,cpl,e) -> (loc,cpl,add_args id new_args e)) cal
 	    )
   | CLetTuple(loc,nal,(na,b_option),b1,b2) -> 
@@ -558,7 +602,63 @@ let rec add_args id new_args b =
   | CPrim _ -> b
   | CDelimiters _ -> anomaly "add_args : CDelimiters"
   | CDynamic _ -> anomaly "add_args : CDynamic"
+exception Stop of  Topconstr.constr_expr
+
+
+(* [chop_n_arrow n t] chops the [n] first arrows in [t] 
+   Acts on Topconstr.constr_expr 
+*)
+let rec chop_n_arrow n t = 
+  if n <= 0 
+  then t (* If we have already removed all the arrows then return the type *)
+  else (* If not we check the form of [t] *) 
+    match t with 
+      | Topconstr.CArrow(_,_,t) ->  (* If we have an arrow, we discard it and recall [chop_n_arrow] *)
+	  chop_n_arrow (n-1) t
+      | Topconstr.CProdN(_,nal_ta',t') -> (* If we have a forall, to result are possible : 
+					     either we need to discard more than the number of arrows contained
+					     in this product declaration then we just recall [chop_n_arrow] on
+					     the remaining number of arrow to chop and [t'] we discard it and 
+					     recall [chop_n_arrow], either this product contains more arrows 
+					     than the number we need to chop and then we return the new type
+					  *)
+	  begin 
+	    try 
+	      let new_n =
+		let rec aux (n:int) = function 
+		    [] -> n
+		| (nal,t'')::nal_ta' -> 
+		    let nal_l = List.length nal in 
+		    if n >= nal_l
+		    then 
+		      aux (n - nal_l) nal_ta'
+		    else 
+		      let new_t' = Topconstr.CProdN(dummy_loc,((snd (list_chop n nal)),t'')::nal_ta',t')
+		      in 
+		      raise (Stop new_t')
+		in
+		aux n nal_ta'
+	    in 
+	      chop_n_arrow new_n t'
+	    with Stop t -> t
+	  end
+      | _ -> anomaly "Not enough products"
+  
 
+let rec get_args b t : Topconstr.local_binder list * 
+    Topconstr.constr_expr * Topconstr.constr_expr = 
+  match b with 
+    | Topconstr.CLambdaN (loc, (nal_ta), b') -> 
+	begin
+	  let n = 
+	    (List.fold_left (fun n (nal,_) -> 
+			       n+List.length nal) 0 nal_ta )
+	  in
+	  let nal_tas,b'',t'' = get_args b' (chop_n_arrow n t) in 
+	  (List.map (fun (nal,ta) -> 
+		       (Topconstr.LocalRawAssum (nal,ta))) nal_ta)@nal_tas, b'',t'' 
+	end
+    | _ -> [],b,t
 
 
 let make_graph (f_ref:global_reference) =
@@ -578,68 +678,14 @@ let make_graph (f_ref:global_reference) =
 	let env = Global.env () in
 	let body = (force b) in
 	let extern_body,extern_type = 
-	  let old_implicit_args = Impargs.is_implicit_args ()
-	  and old_strict_implicit_args =  Impargs.is_strict_implicit_args ()
-	  and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
-	  let old_rawprint = !Options.raw_print in 
-	  Options.raw_print := true;
-	  Impargs.make_implicit_args false;
-	  Impargs.make_strict_implicit_args false;
-	  Impargs.make_contextual_implicit_args false;
-	  try 
-	    let res =  Constrextern.extern_constr false env body in 
-	    let res' = Constrextern.extern_type false env  c_body.const_type in 
-	    Impargs.make_implicit_args old_implicit_args;
-	    Impargs.make_strict_implicit_args old_strict_implicit_args;
-	    Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-	    Options.raw_print := old_rawprint;
-	    res,res'
-	  with
-	    | UserError(s,msg) as e -> 
-		Impargs.make_implicit_args old_implicit_args;
-		Impargs.make_strict_implicit_args old_strict_implicit_args;
-		Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-		Options.raw_print := old_rawprint;
-		raise e
-	    | e -> 
-		Impargs.make_implicit_args old_implicit_args;
-		Impargs.make_strict_implicit_args old_strict_implicit_args;
-		Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-		Options.raw_print := old_rawprint;
-		raise e
-	in
-	let rec get_args b t : Topconstr.local_binder list * 
-	    Topconstr.constr_expr * Topconstr.constr_expr = 
-(* 	  Pp.msgnl (str "body: " ++Ppconstr.pr_lconstr_expr b); *)
-(* 	  Pp.msgnl (str "type: " ++ Ppconstr.pr_lconstr_expr t); *)
-(* 	  Pp.msgnl (fnl ()); *)
-	  match b with 
-	    | Topconstr.CLambdaN (loc, (nal_ta), b') -> 
-		begin
-		  let n = 
-		    (List.fold_left (fun n (nal,_) -> 
-				       n+List.length nal) 0 nal_ta )
-		  in
-		  let rec chop_n_arrow n t = 
-		    if n > 0 
-		    then 
-		      match t with 
-			| Topconstr.CArrow(_,_,t) -> chop_n_arrow (n-1) t 
-			| Topconstr.CProdN(_,nal_ta',t') -> 
-			    let n' = 
-			      List.fold_left 
-				(fun n (nal,t'') -> 
-				   n+List.length nal) n nal_ta' 
-			    in
-(* 			    assert (n'<= n);  *)
-			    chop_n_arrow (n - n') t'
-			| _ -> anomaly "Not enough products"
-		    else t
-		  in 
-		  let nal_tas,b'',t'' = get_args b' (chop_n_arrow n t) in 
-		  (List.map (fun (nal,ta) -> (Topconstr.LocalRawAssum (nal,ta))) nal_ta)@nal_tas, b'',t'' 
-		end
-	    | _ -> [],b,t
+	  with_full_print 
+	    (fun () -> 
+	       (Constrextern.extern_constr false env body, 
+		Constrextern.extern_type false env
+                  (Typeops.type_of_constant_type env c_body.const_type)
+	       )
+	    )
+	    ()
 	in
 	let (nal_tas,b,t)  = get_args extern_body extern_type in
 	let expr_list = 
@@ -659,7 +705,8 @@ let make_graph (f_ref:global_reference) =
 			   )
 		       in 
 		       let rec_id = 
-			 match List.nth bl' (out_some n)  with |(_,Name id) -> id | _ -> anomaly ""
+			 match List.nth bl' (out_some n)  with 
+			   |(_,Name id) -> id | _ -> anomaly ""
 		       in
 		       let new_args = 
 			 List.flatten 
@@ -667,7 +714,10 @@ let make_graph (f_ref:global_reference) =
 			      (function
  				 | Topconstr.LocalRawDef (na,_)-> []
 			      	 | Topconstr.LocalRawAssum (nal,_) -> 
-				     List.map (fun (loc,n) -> CRef(Libnames.Ident(loc, Nameops.out_name n))) nal
+				     List.map 
+				       (fun (loc,n) -> 
+					  CRef(Libnames.Ident(loc, Nameops.out_name n))) 
+				       nal
 			      )
 			      nal_tas
 			   )
@@ -685,7 +735,9 @@ let make_graph (f_ref:global_reference) =
 	do_generate_principle false false expr_list;
 	(* We register the infos *)
 	let mp,dp,_ = repr_con c in 
-	List.iter (fun (id,_,_,_,_) -> add_Function (make_con mp dp (label_of_id id))) expr_list
+	List.iter 
+	  (fun (id,_,_,_,_) -> add_Function false (make_con mp dp (label_of_id id))) 
+	  expr_list
 
 
 (* let make_graph _ = assert false	 *)
diff --git a/contrib/funind/indfun_common.ml b/contrib/funind/indfun_common.ml
index f41aac20..13b242d5 100644
--- a/contrib/funind/indfun_common.ml
+++ b/contrib/funind/indfun_common.ml
@@ -5,8 +5,8 @@ open Libnames
 
 let mk_prefix pre id = id_of_string (pre^(string_of_id id))
 let mk_rel_id = mk_prefix "R_"
-let mk_correct_id id = Nameops.add_suffix id "_correct"
-let mk_complete_id id = Nameops.add_suffix id "_complete"
+let mk_correct_id id = Nameops.add_suffix (mk_rel_id id) "_correct"
+let mk_complete_id id = Nameops.add_suffix (mk_rel_id id) "_complete"
 let mk_equation_id id = Nameops.add_suffix id "_equation"
 
 let msgnl m =
@@ -233,6 +233,32 @@ let get_proof_clean do_reduce =
   Pfedit.delete_current_proof ();
   result
 
+let with_full_print f a = 
+  let old_implicit_args = Impargs.is_implicit_args ()
+  and old_strict_implicit_args =  Impargs.is_strict_implicit_args ()
+  and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
+  let old_rawprint = !Options.raw_print in 
+  Options.raw_print := true;
+  Impargs.make_implicit_args false;
+  Impargs.make_strict_implicit_args false;
+  Impargs.make_contextual_implicit_args false;
+  try 
+    let res = f a in 
+    Impargs.make_implicit_args old_implicit_args;
+    Impargs.make_strict_implicit_args old_strict_implicit_args;
+    Impargs.make_contextual_implicit_args old_contextual_implicit_args;
+    Options.raw_print := old_rawprint;
+    res
+  with  
+    | e -> 
+	Impargs.make_implicit_args old_implicit_args;
+	Impargs.make_strict_implicit_args old_strict_implicit_args;
+	Impargs.make_contextual_implicit_args old_contextual_implicit_args;
+	Options.raw_print := old_rawprint;
+	raise e
+
+
+
 
 
 
@@ -248,14 +274,18 @@ type function_info =
       rect_lemma : constant option;
       rec_lemma : constant option;
       prop_lemma : constant option;
+      is_general : bool; (* Has this function been defined using general recursive definition *)
     }
       
 
-type function_db  = function_info list
+(* type function_db  = function_info list *)
+
+(* let function_table = ref ([] : function_db) *)
 
-let function_table = ref ([] : function_db)
-  
 
+let from_function = ref Cmap.empty
+let from_graph = ref Indmap.empty
+(*
 let rec do_cache_info finfo = function 
   | [] -> raise Not_found 
   | (finfo'::finfos as l) -> 
@@ -274,6 +304,12 @@ let cache_Function (_,(finfos)) =
   in  
   if new_tbl != !function_table 
   then function_table := new_tbl
+*)
+
+let cache_Function (_,finfos) = 
+  from_function := Cmap.add finfos.function_constant finfos !from_function;
+  from_graph := Indmap.add finfos.graph_ind finfos !from_graph
+
 
 let load_Function _  = cache_Function
 let open_Function _ = cache_Function
@@ -307,6 +343,7 @@ let subst_Function (_,subst,finfos) =
       rect_lemma = rect_lemma' ;
       rec_lemma = rec_lemma';
       prop_lemma = prop_lemma';
+      is_general = finfos.is_general
     }
 
 let classify_Function (_,infos) = Libobject.Substitute infos
@@ -342,6 +379,7 @@ let discharge_Function (_,finfos) =
 	   rect_lemma = rect_lemma';
 	   rec_lemma = rec_lemma';
 	   prop_lemma = prop_lemma' ;
+	   is_general = finfos.is_general
 	 }    
 
 open Term
@@ -357,7 +395,8 @@ let pr_info f_info =
     str "prop_lemma := " ++ (Util.option_fold_right (fun v acc -> Printer.pr_lconstr (mkConst v)) f_info.prop_lemma (mt ()) ) ++ fnl () ++
     str "graph_ind := " ++ Printer.pr_lconstr (mkInd f_info.graph_ind) ++ fnl () 
 
-let pr_table l = 
+let pr_table tb = 
+  let l = Cmap.fold (fun k v acc -> v::acc) tb [] in 
   Util.prlist_with_sep fnl pr_info l
 
 let in_Function,out_Function = 
@@ -376,17 +415,16 @@ let in_Function,out_Function =
 
 (* Synchronisation with reset *)
 let freeze () = 
-  let tbl = !function_table in 
-(*   Pp.msgnl (str "freezing function_table : " ++ pr_table tbl); *)
-  tbl
-
-let unfreeze l = 
+  !from_function,!from_graph
+let unfreeze (functions,graphs) = 
 (*   Pp.msgnl (str "unfreezing function_table : " ++ pr_table l); *)
-  function_table :=
- l
+  from_function := functions;
+  from_graph := graphs
+
 let init () = 
 (*   Pp.msgnl (str "reseting function_table");  *)
-  function_table := []
+  from_function := Cmap.empty;
+  from_graph := Indmap.empty
 
 let _ = 
   Summary.declare_summary "functions_db_sum"
@@ -405,18 +443,18 @@ let find_or_none id =
 
 
 let find_Function_infos f = 
-  List.find (fun finfo ->  finfo.function_constant = f) !function_table
+  Cmap.find f !from_function
 
 
 let find_Function_of_graph ind = 
-  List.find (fun finfo ->  finfo.graph_ind = ind) !function_table
+  Indmap.find ind !from_graph
   
 let update_Function finfo = 
 (*   Pp.msgnl (pr_info finfo); *)
   Lib.add_anonymous_leaf (in_Function finfo)
       
   
-let add_Function f = 
+let add_Function is_general f = 
   let f_id = id_of_label (con_label f) in 
   let equation_lemma = find_or_none (mk_equation_id f_id)
   and correctness_lemma = find_or_none (mk_correct_id f_id) 
@@ -436,12 +474,14 @@ let add_Function f =
       rect_lemma = rect_lemma;
       rec_lemma = rec_lemma;
       prop_lemma = prop_lemma;
-      graph_ind = graph_ind
+      graph_ind = graph_ind;
+      is_general = is_general
+      
     }
   in
   update_Function finfos
 
-let pr_table () = pr_table !function_table
+let pr_table () = pr_table !from_function
 (*********************************)
 (* Debuging *)
 let function_debug = ref false 
@@ -464,3 +504,5 @@ let do_observe () =
       
       
     
+exception Building_graph of exn 
+exception Defining_principle of exn
diff --git a/contrib/funind/indfun_common.mli b/contrib/funind/indfun_common.mli
index 00e1ce8d..7da1d6f0 100644
--- a/contrib/funind/indfun_common.mli
+++ b/contrib/funind/indfun_common.mli
@@ -73,6 +73,12 @@ val get_proof_clean : bool ->
     
 
 
+(* [with_full_print f a] applies [f] to [a] in full printing environment 
+   
+   This function preserves the print settings 
+*)
+val with_full_print : ('a -> 'b) -> 'a -> 'b
+
 
 (*****************)
 
@@ -86,12 +92,13 @@ type function_info =
       rect_lemma : constant option;
       rec_lemma : constant option;
       prop_lemma : constant option;
+      is_general : bool;
     }
 
 val find_Function_infos : constant -> function_info
 val find_Function_of_graph : inductive -> function_info
 (* WARNING: To be used just after the graph definition !!! *)
-val add_Function : constant -> unit
+val add_Function : bool -> constant -> unit
 
 val update_Function : function_info -> unit 
 
@@ -101,5 +108,10 @@ val pr_info : function_info -> Pp.std_ppcmds
 val pr_table : unit -> Pp.std_ppcmds
 
 
-val function_debug : bool ref 
+(* val function_debug : bool ref  *)
 val do_observe : unit -> bool
+
+(* To localize pb *)
+exception Building_graph of exn 
+exception Defining_principle of exn
+
diff --git a/contrib/funind/indfun_main.ml4 b/contrib/funind/indfun_main.ml4
index 00b5f28c..26a1066c 100644
--- a/contrib/funind/indfun_main.ml4
+++ b/contrib/funind/indfun_main.ml4
@@ -103,10 +103,28 @@ TACTIC EXTEND snewfunind
 END
 
 
+let pr_constr_coma_sequence prc _ _ = Util.prlist_with_sep Util.pr_coma prc
+
+ARGUMENT EXTEND constr_coma_sequence'
+  TYPED AS constr_list
+  PRINTED BY pr_constr_coma_sequence
+| [ constr(c) "," constr_coma_sequence'(l) ] -> [ c::l ]
+| [ constr(c) ] -> [ [c] ]
+END
+
+let pr_auto_using prc _prlc _prt = Pptactic.pr_auto_using prc
+
+ARGUMENT EXTEND auto_using'
+  TYPED AS constr_list
+  PRINTED BY pr_auto_using
+| [ "using" constr_coma_sequence'(l) ] -> [ l ]
+| [ ] -> [ [] ]
+END
+
 VERNAC ARGUMENT EXTEND rec_annotation2
   [ "{"  "struct" ident(id)  "}"] -> [ Struct id ]
-| [ "{" "wf" constr(r) ident_opt(id) "}" ] -> [ Wf(r,id) ]
-| [ "{" "measure" constr(r) ident_opt(id) "}" ] -> [ Mes(r,id) ] 
+| [ "{" "wf" constr(r) ident_opt(id) auto_using'(l) "}" ] -> [ Wf(r,id,l) ]
+| [ "{" "measure" constr(r) ident_opt(id) auto_using'(l) "}" ] -> [ Mes(r,id,l) ] 
 END
 
 
@@ -131,8 +149,8 @@ VERNAC ARGUMENT EXTEND rec_definition2
      let check_exists_args an =
        try 
 	 let id = match an with 
-	   | Struct id -> id | Wf(_,Some id) -> id | Mes(_,Some id) -> id 
-	   | Wf(_,None) | Mes(_,None) -> failwith "check_exists_args" 
+	   | Struct id -> id | Wf(_,Some id,_) -> id | Mes(_,Some id,_) -> id 
+	   | Wf(_,None,_) | Mes(_,None,_) -> failwith "check_exists_args" 
 	 in 
 	 (try ignore(Util.list_index (Name id) names - 1); annot
 	  with Not_found ->  Util.user_err_loc
@@ -214,11 +232,17 @@ END
 (* FINDUCTION *)
 
 (* comment this line to see debug msgs *)
-(* let msg x = () ;; let pr_lconstr c = str "" *)
+let msg x = () ;; let pr_lconstr c = str ""
   (* uncomment this to see debugging *)
 let prconstr c =  msg (str"  " ++ Printer.pr_lconstr c ++ str"\n")
 let prlistconstr lc = List.iter prconstr lc
 let prstr s = msg(str s)
+let prNamedConstr s c = 
+  begin
+    msg(str "");
+    msg(str(s^"==>\n ") ++ Printer.pr_lconstr c ++ str "\n<==\n");
+    msg(str "");
+  end
 
 
 
@@ -266,6 +290,55 @@ let rec hdMatchSub inu (test: constr -> bool) : fapp_info list =
     max_rel = max_rel; onlyvars = List.for_all isVar args } 
     ::subres
 
+let mkEq typ c1 c2 = 
+  mkApp (Coqlib.build_coq_eq(),[| typ; c1; c2|])
+
+
+let poseq_unsafe idunsafe cstr gl =
+  let typ = Tacmach.pf_type_of gl cstr in
+  tclTHEN
+    (Tactics.letin_tac true (Name idunsafe) cstr allClauses)
+    (tclTHENFIRST 
+      (Tactics.assert_as true IntroAnonymous (mkEq typ (mkVar idunsafe) cstr)) 
+      Tactics.reflexivity)
+    gl
+  
+
+let poseq id cstr gl =
+  let x = Tactics.fresh_id [] id gl in
+  poseq_unsafe x cstr gl
+
+(* dirty? *)
+
+let list_constr_largs = ref []
+
+let rec poseq_list_ids_rec lcstr gl =
+  match lcstr with
+    | [] -> tclIDTAC gl
+    | c::lcstr' -> 
+	match kind_of_term c with
+	  | Var _ -> 
+	      (list_constr_largs:=c::!list_constr_largs ; poseq_list_ids_rec lcstr' gl)
+	  | _ -> 
+	      let _ = prstr "c = " in
+	      let _ = prconstr c in
+	      let _ = prstr "\n" in
+	      let typ = Tacmach.pf_type_of gl c in
+	      let cname = Termops.id_of_name_using_hdchar (Global.env()) typ Anonymous in
+	      let x = Tactics.fresh_id [] cname gl in
+	      let _ = list_constr_largs:=mkVar x :: !list_constr_largs in
+	      let _ = prstr " list_constr_largs = " in
+	      let _ = prlistconstr !list_constr_largs in
+	      let _ = prstr "\n" in
+
+	      tclTHEN
+		(poseq_unsafe x c)
+		(poseq_list_ids_rec lcstr')
+		gl
+
+let poseq_list_ids lcstr gl = 
+  let _ = list_constr_largs := [] in
+  poseq_list_ids_rec lcstr gl
 
 (** [find_fapp test g] returns the list of [app_info] of all calls to
     functions that satisfy [test] in the conclusion of goal g. Trivial
@@ -296,11 +369,17 @@ let finduction (oid:identifier option) (heuristic: fapp_info list -> fapp_info l
   if List.length ordered_info_list = 0 then Util.error "function not found in goal\n";
   let taclist: Proof_type.tactic list = 
     List.map 
-      (fun info -> 
-	(tclTHEN 
-	  (functional_induction true (applist (info.fname, info.largs)) 
-	    None IntroAnonymous) 
+      (fun info ->
+	(tclTHEN
+	  (tclTHEN (poseq_list_ids info.largs)
+	    (
+	      fun gl -> 
+		  (functional_induction 
+		    true (applist (info.fname, List.rev !list_constr_largs)) 
+		    None IntroAnonymous) gl)) 
 	  nexttac)) ordered_info_list in
+  (* we try each (f t u v) until one does not fail *)
+  (* TODO: try also to mix functional schemes *)
   tclFIRST taclist g
 
 
@@ -313,9 +392,8 @@ let chose_heuristic (oi:int option) : fapp_info list -> fapp_info list =
   match oi with
     | Some i -> (fun l -> [ List.nth l (i-1) ]) (* occurrence was given by the user *)
     | None -> 
-	(* Default heuristic: keep only occurrence where all arguments
+	(* Default heuristic: put first occurrences where all arguments
 	   are *bound* (meaning already introduced) variables *)
-	(* TODO: put other funcalls at the end instead of deleting them *)
 	let ordering x y =
 	  if x.free && x.onlyvars && y.free && y.onlyvars then 0 (* both pertinent *)
 	  else if x.free && x.onlyvars then -1
@@ -325,6 +403,7 @@ let chose_heuristic (oi:int option) : fapp_info list -> fapp_info list =
 	List.sort ordering
 
 
+
 TACTIC EXTEND finduction
     ["finduction" ident(id) natural_opt(oi)] -> 
       [ 
@@ -353,3 +432,36 @@ TACTIC EXTEND fauto
 
 END
 
+
+TACTIC EXTEND poseq
+  [ "poseq" ident(x) constr(c) ] -> 
+      [ poseq x c ]
+END
+
+VERNAC COMMAND EXTEND Showindinfo
+  [ "showindinfo" ident(x) ] -> [ Merge.showind x ]
+END
+
+VERNAC COMMAND EXTEND MergeFunind
+  [ "Mergeschemes" lconstr(c) "with" lconstr(c') "using" ident(id) ] -> 
+     [ 
+       let c1 = Constrintern.interp_constr Evd.empty (Global.env()) c in
+       let c2 = Constrintern.interp_constr Evd.empty (Global.env()) c' in
+       let id1,args1 = 
+	 try 
+	   let hd,args = destApp c1 in
+	   if Term.isInd hd then hd , args 
+	   else raise (Util.error "Ill-formed (fst) argument")
+	 with Invalid_argument _ 
+	     -> Util.error ("Bad argument form for merging schemes") in
+       let id2,args2 = 
+	 try
+ 	   let hd,args = destApp c2 in
+	   if isInd hd then hd , args 
+	   else raise (Util.error "Ill-formed (snd) argument")
+	 with Invalid_argument _ 
+	     -> Util.error ("Bad argument form for merging schemes") in
+       (* TOFO: enlever le ignore et declarer l'inductif *)
+       ignore(Merge.merge c1 c2 args1 args2 id)
+     ]
+END
diff --git a/contrib/funind/invfun.ml b/contrib/funind/invfun.ml
index 084ec7e0..04110ea9 100644
--- a/contrib/funind/invfun.ml
+++ b/contrib/funind/invfun.ml
@@ -44,25 +44,6 @@ let pr_with_bindings prc prlc (c,bl) =
 let pr_constr_with_binding prc (c,bl) :  Pp.std_ppcmds = 
   pr_with_bindings prc prc  (c,bl)
 
-let pr_elim_scheme el = 
-  let env = Global.env () in 
-  let msg = str "params := " ++ Printer.pr_rel_context env el.params in 
-  let env = Environ.push_rel_context el.params env in 
-  let msg = msg ++ fnl () ++ str "predicates := "++ Printer.pr_rel_context env el.predicates in 
-  let env = Environ.push_rel_context el.predicates env in 
-  let msg = msg ++ fnl () ++ str "branches := " ++ Printer.pr_rel_context env el.branches in 
-  let env = Environ.push_rel_context el.branches env in 
-  let msg = msg ++ fnl () ++ str "args := " ++ Printer.pr_rel_context env el.args in 
-  let env = Environ.push_rel_context el.args env in 
-  let msg = 
-    Util.option_fold_right
-      (fun o msg -> msg ++ fnl () ++ str "indarg := " ++ Printer.pr_rel_context env [o]) 
-      el.indarg
-      msg
-  in 
-  let env = Util.option_fold_right (fun o env -> Environ.push_rel_context [o] env) el.indarg env in 
-  msg ++ fnl () ++ str "concl := " ++ Printer.pr_lconstr_env env el.concl
-
 (* The local debuging mechanism *)
 let msgnl = Pp.msgnl
 
@@ -120,7 +101,7 @@ let id_to_constr id =
 
 let generate_type g_to_f f graph i = 
   (*i we deduce the number of arguments of the function and its returned type from the graph i*)
-  let graph_arity = Inductive.type_of_inductive (Global.lookup_inductive (destInd graph))  in 
+  let graph_arity = Inductive.type_of_inductive (Global.env()) (Global.lookup_inductive (destInd graph))  in 
   let ctxt,_ = decompose_prod_assum graph_arity in 
   let fun_ctxt,res_type = 
     match ctxt with 
@@ -443,17 +424,17 @@ let prove_fun_correct functional_induction funs_constr graphs_constr schemes lem
       let params_bindings,avoid =
 	List.fold_left2
 	  (fun (bindings,avoid) (x,_,_) p ->
-	     let id = Termops.next_global_ident_away false (Nameops.out_name x) avoid in
+	     let id = Nameops.next_ident_away (Nameops.out_name x) avoid in
 	     (dummy_loc,Rawterm.NamedHyp id,p)::bindings,id::avoid
 	  )
-	  ([],[])
+	  ([],pf_ids_of_hyps g)
 	  princ_infos.params
 	  (List.rev params)
       in
       let lemmas_bindings =
 	List.rev (fst  (List.fold_left2
 	  (fun (bindings,avoid) (x,_,_) p ->
-	     let id = Termops.next_global_ident_away false (Nameops.out_name x) avoid in
+	     let id = Nameops.next_ident_away (Nameops.out_name x) avoid in 
 	     (dummy_loc,Rawterm.NamedHyp id,nf_zeta p)::bindings,id::avoid)
 	  ([],avoid)
 	  princ_infos.predicates
@@ -471,7 +452,7 @@ let prove_fun_correct functional_induction funs_constr graphs_constr schemes lem
 	  (observe_tac "functional_induction" (
 	     fun g -> 
 	       observe
-		 (str "princ" ++ pr_constr_with_binding (Printer.pr_lconstr_env (pf_env g))  (mkVar principle_id,bindings));
+		 (pr_constr_with_binding (Printer.pr_lconstr_env (pf_env g))  (mkVar principle_id,bindings));
 	       functional_induction  false (applist(funs_constr.(i),List.map mkVar args_names))
 		 (Some (mkVar principle_id,bindings))
 		 pat g
@@ -493,6 +474,31 @@ let generalize_depedent_of x hyp g =
     (pf_hyps g)
     g
 
+
+
+
+
+
+let rec reflexivity_with_destruct_cases g = 
+  let destruct_case () = 
+    try 
+      match kind_of_term (snd (destApp (pf_concl g))).(2) with 
+	| Case(_,_,v,_) -> 
+	    tclTHENSEQ[
+	      h_case (v,Rawterm.NoBindings);
+	      intros;
+	      observe_tac "reflexivity_with_destruct_cases" reflexivity_with_destruct_cases 
+	    ]
+	| _ -> reflexivity
+    with _ -> reflexivity
+  in
+  tclFIRST
+    [ reflexivity;
+      destruct_case ()
+    ]
+    g
+
+
 (* [prove_fun_complete funs graphs schemes lemmas_types_infos i] 
    is the tactic used to prove completness lemma. 
    
@@ -567,11 +573,12 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
     *)
     let rewrite_tac j ids : tactic = 
       let graph_def = graphs.(j) in 
-      if Rtree.is_infinite graph_def.mind_recargs
+      let infos =  try find_Function_infos (destConst funcs.(j)) with Not_found ->  error "No graph found" in 
+      if infos.is_general ||  Rtree.is_infinite graph_def.mind_recargs
       then 
 	let eq_lemma = 
-	  try out_some (find_Function_infos (destConst funcs.(j))).equation_lemma
-	  with Failure "out_some" | Not_found -> anomaly "Cannot find equation lemma"
+	  try out_some (infos).equation_lemma
+	  with Failure "out_some"  -> anomaly "Cannot find equation lemma"
 	in 
 	tclTHENSEQ[
 	  tclMAP h_intro ids;
@@ -677,8 +684,8 @@ let prove_fun_complete funcs graphs schemes lemmas_types_infos i : tactic =
         observe_tac "rewrite_tac" (rewrite_tac this_ind_number this_branche_ids);
 	(* introduce hypothesis with some rewrite *)
         (intros_with_rewrite);
-	(* The proof is complete *)
-        observe_tac "reflexivity" (reflexivity)
+	(* The proof is (almost) complete *)
+        observe_tac "reflexivity" (reflexivity_with_destruct_cases)
       ]
 	g
     in
@@ -758,7 +765,7 @@ let derive_correctness make_scheme functional_induction (funs: constant list) (g
 	   (Decl_kinds.Global,(Decl_kinds.Proof Decl_kinds.Theorem))
 	   (fst lemmas_types_infos.(i))
 	   (fun _ _ -> ());
-	 Pfedit.by (observe_tac ("procve correctness ("^(string_of_id f_id)^")") (proving_tac i));
+	 Pfedit.by (observe_tac ("prove correctness ("^(string_of_id f_id)^")") (proving_tac i));
 	 do_save ();
 	 let finfo = find_Function_infos f_as_constant in 
 	 update_Function
@@ -968,10 +975,17 @@ let invfun qhyp f g =
 			 functional_inversion kn hid  f2 f_correct g
 		       with
 			 | Failure "" -> 
-			     errorlabstrm "" (Ppconstr.pr_id hid ++ str " must contain at leat one function")
+			     errorlabstrm "" (str "Hypothesis" ++ Ppconstr.pr_id hid ++ str " must contain at leat one Function")
 			 | Failure "out_some"  ->  
-			     error "Cannot use equivalence with graph for any side of equality"
-			 | Not_found -> error "No graph found for any side of equality" 
+			     if do_observe () 
+			     then
+			       error "Cannot use equivalence with graph for any side of the equality"
+			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
+			 | Not_found -> 
+			     if do_observe () 
+			     then
+			       error "No graph found for any side of equality" 
+			     else errorlabstrm "" (str "Cannot find inversion information for hypothesis " ++ Ppconstr.pr_id hid)
 		   end
 	       | _ -> errorlabstrm "" (Ppconstr.pr_id hid ++ str " must be an equality ")
 	  )
diff --git a/contrib/funind/merge.ml b/contrib/funind/merge.ml
new file mode 100644
index 00000000..1b796a81
--- /dev/null
+++ b/contrib/funind/merge.ml
@@ -0,0 +1,826 @@
+(************************************************************************)
+(*  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        *)
+(************************************************************************)
+
+(* Merging of induction principles. *)
+
+(*i $Id: i*)
+
+open Util
+open Topconstr
+open Vernacexpr
+open Pp
+open Names
+open Term
+open Declarations
+open Environ
+open Rawterm
+open Rawtermops
+
+(** {1 Utilities}  *)
+
+(** {2 Useful operations on constr and rawconstr} *)
+
+(** Substitutions in constr *)
+let compare_constr_nosub t1 t2 =
+  if compare_constr (fun _ _ -> false) t1 t2 
+  then true
+  else false
+
+let rec compare_constr' t1 t2 =
+  if compare_constr_nosub t1 t2 
+  then true
+  else (compare_constr (compare_constr') t1 t2)
+
+let rec substitterm prof t by_t in_u =
+  if (compare_constr' (lift prof t) in_u)
+  then (lift prof by_t)
+  else map_constr_with_binders succ 
+    (fun i -> substitterm i t by_t) prof in_u
+
+let lift_ldecl n ldecl = List.map (fun (x,y) -> x,lift n y) ldecl
+
+let understand = Pretyping.Default.understand Evd.empty (Global.env())
+
+(** Operations on names and identifiers *)
+let id_of_name = function
+    Anonymous -> id_of_string "H"
+  | Name id   -> id;;
+let name_of_string str = Name (id_of_string str)
+let string_of_name nme = string_of_id (id_of_name nme)
+
+(** [isVarf f x] returns [true] if term [x] is of the form [(Var f)]. *)
+let isVarf f x = 
+    match x with
+      | RVar (_,x) -> Pervasives.compare x f = 0 
+      | _ -> false
+
+(** [ident_global_exist id] returns true if identifier [id] is linked
+    in global environment. *)
+let ident_global_exist id = 
+  try 
+    let ans = CRef (Libnames.Ident (dummy_loc,id)) in
+    let _ = ignore (Constrintern.intern_constr Evd.empty (Global.env()) ans) in
+    true
+  with _ -> false 
+
+(** [next_ident_fresh id] returns a fresh identifier (ie not linked in
+    global env) with base [id]. *)
+let next_ident_fresh (id:identifier) = 
+    let res = ref id in
+    while ident_global_exist !res do res := Nameops.lift_ident !res done;
+    !res
+
+
+(** {2 Debugging} *)
+(* comment this line to see debug msgs *)
+let msg x = () ;; let pr_lconstr c = str ""
+(* uncomment this to see debugging *)
+let prconstr c =  msg (str"  " ++ Printer.pr_lconstr c)
+let prconstrnl c =  msg (str"  " ++ Printer.pr_lconstr c ++ str"\n")
+let prlistconstr lc = List.iter prconstr lc
+let prstr s = msg(str s)
+let prNamedConstr s c = 
+  begin
+    msg(str "");
+    msg(str(s^" {§ ") ++ Printer.pr_lconstr c ++ str " §} ");
+    msg(str "");
+  end
+let prNamedRConstr s c = 
+  begin
+    msg(str "");
+    msg(str(s^" {§ ") ++ Printer.pr_rawconstr c ++ str " §} ");
+    msg(str "");
+  end
+let prNamedLConstr_aux lc = List.iter (prNamedConstr "\n") lc
+let prNamedLConstr s lc = 
+  begin
+    prstr "[§§§ ";
+    prstr s;
+    prNamedLConstr_aux lc;
+    prstr " §§§]\n";
+  end
+let prNamedLDecl s lc = 
+  begin
+    prstr s; prstr "\n";
+    List.iter (fun (nm,_,tp) -> prNamedConstr (string_of_name nm) tp) lc;
+    prstr "\n";
+  end
+
+let showind (id:identifier) =
+  let cstrid = Tacinterp.constr_of_id (Global.env()) id in
+  let ind1,cstrlist = Inductiveops.find_inductive (Global.env()) Evd.empty cstrid in
+  let mib1,ib1 = Inductive.lookup_mind_specif (Global.env()) ind1 in
+  List.iter (fun (nm, optcstr, tp) -> 
+    print_string (string_of_name nm^":");
+    prconstr tp; print_string "\n") 
+    ib1.mind_arity_ctxt;
+  (match ib1.mind_arity with
+    | Monomorphic x ->
+        Printf.printf "arity :"; prconstr x.mind_user_arity
+    | Polymorphic x -> 
+        Printf.printf "arity : universe?");
+  Array.iteri 
+    (fun i x -> Printf.printf"type constr %d :" i ; prconstr x)
+    ib1.mind_user_lc
+
+(** {2 Misc} *)
+
+exception Found of int
+
+(* Array scanning *)
+let array_find (arr: 'a array) (pred: int -> 'a -> bool): int option = 
+  try
+    for i=0 to Array.length arr - 1 do if pred i (arr.(i)) then raise (Found i) done;
+    None
+  with Found i -> Some i
+
+let array_prfx (arr: 'a array) (pred: int -> 'a -> bool): int =
+  try
+    for i=0 to Array.length arr - 1 do if pred i (arr.(i)) then raise (Found i) done;
+    Array.length arr (* all elt are positive *)
+  with Found i -> i
+
+let array_fold_lefti (f: int -> 'a -> 'b -> 'a) (acc:'a) (arr:'b array): 'a = 
+  let i = ref 0 in 
+  Array.fold_left 
+    (fun acc x -> 
+      let res = f !i acc x in i := !i + 1; res)
+    acc arr
+
+(* Like list_chop but except that [i] is the size of the suffix of [l]. *)
+let list_chop_end i l =
+  let size_prefix = List.length l -i in
+  if size_prefix < 0 then failwith "list_chop_end"
+  else list_chop size_prefix l
+
+let list_fold_lefti (f: int -> 'a -> 'b -> 'a) (acc:'a) (arr:'b list): 'a = 
+  let i = ref 0 in 
+  List.fold_left 
+    (fun acc x -> 
+      let res = f !i acc x in i := !i + 1; res)
+    acc arr
+
+let list_filteri (f: int -> 'a -> bool) (l:'a list):'a list = 
+  let i = ref 0 in 
+  List.filter (fun x -> let res = f !i x in i := !i + 1; res) l
+
+
+(** Iteration module *)
+module For = 
+struct
+  let rec map i j (f: int -> 'a)  = if i>j then [] else f i :: (map (i+1) j f)
+  let rec foldup i j (f: 'a -> int -> 'a) acc = 
+    if i>j then acc else let newacc = f acc i in foldup (i+1) j f newacc
+  let rec folddown i j (f: 'a -> int -> 'a) acc = 
+    if i>j then acc else let newacc = f acc j in folddown i (j-1) f newacc
+  let fold i j = if i<j then foldup i j else folddown i j
+end
+
+
+(** {1 Parameters shifting and linking information} *)
+
+(** This type is used to deal with debruijn linked indices. When a
+    variable is linked to a previous one, we will ignore it and refer
+    to previous one. *)
+type linked_var =
+    | Linked of int
+    | Unlinked
+    | Funres
+
+(** When merging two graphs, parameters may become regular arguments,
+    and thus be shifted. This type describe the result of computing
+    the changes. *)
+type 'a shifted_params =
+    {
+      nprm1:'a;
+      nprm2:'a;
+      prm2_unlinked:'a list; (* ranks of unlinked params in nprms2 *)
+      nuprm1:'a;
+      nuprm2:'a;
+      nargs1:'a;
+      nargs2:'a;
+    }
+
+
+let prlinked x =
+  match x with
+    | Linked i -> Printf.sprintf "Linked %d" i
+    | Unlinked -> Printf.sprintf "Unlinked"
+    | Funres -> Printf.sprintf "Funres"
+
+let linkmonad f lnkvar = 
+  match lnkvar with
+    | Linked i -> Linked (f i)
+    | Unlinked -> Unlinked
+    | Funres -> Funres
+
+let linklift lnkvar i = linkmonad (fun x -> x+i) lnkvar
+
+(* This map is used to deal with debruijn linked indices. *)
+module Link = Map.Make (struct type t = int let compare = Pervasives.compare end)
+
+let pr_links l = 
+  Printf.printf "links:\n";
+  Link.iter (fun k e -> Printf.printf "%d : %s\n" k (prlinked e)) l;
+  Printf.printf "_____________\n"
+
+type 'a merged_arg =
+    | Prm_stable of 'a
+    | Prm_linked of 'a
+    | Prm_arg of 'a
+    | Arg_stable of 'a
+    | Arg_linked of 'a
+    | Arg_funres
+
+type merge_infos =
+    {
+      ident:identifier; (* new inductive name *)
+      mib1: mutual_inductive_body;
+      oib1: one_inductive_body; 
+      mib2: mutual_inductive_body;
+      oib2: one_inductive_body; 
+      (* Array of links of the first inductive (should be all stable) *)
+      lnk1: int merged_arg array;
+      (* Array of links of the second inductive (point to the first ind param/args) *)
+      lnk2: int merged_arg array;
+      (* number of rec params of ind1 which remai rec param in merge *)
+      nrecprms1: int;
+      (* number of other rec params of ind1 (which become non parm) *)
+      notherprms1:int;
+      (* number of functional result params of ind2 (which become non parm) *)
+      nfunresprms1:int;
+      (* list of decl of rec parms from ind1 which remain parms *)
+      recprms1: rel_declaration list;
+      (* List of other rec parms from ind1 *)
+      otherprms1: rel_declaration list; (* parms that became args *)
+      funresprms1: rel_declaration list; (* parms that are functional result args *)
+      (* number of rec params of ind2 which remain rec param in merge (and not linked) *)
+      nrecprms2: int;
+      (* number of other params of ind2 (which become non rec parm) *)
+      notherprms2:int;
+      (* number of functional result params of ind2 (which become non parm) *)
+      nfunresprms2:int;
+      (* list of decl of rec parms from ind2 which remain parms (and not linked) *)
+      recprms2: rel_declaration list;
+      (* List of other rec parms from ind2 (which are linked or become non parm) *)
+      otherprms2: rel_declaration list;      
+      funresprms2: rel_declaration list; (* parms that are functional result args *)
+    }
+
+
+let pr_merginfo x =
+  let i,s=
+    match x with 
+      | Prm_linked i -> Some i,"Prm_linked"
+      | Arg_linked i -> Some i,"Arg_linked"
+      | Prm_stable i -> Some i,"Prm_stable"
+      | Prm_arg i -> Some i,"Prm_arg"
+      | Arg_stable i -> Some i,"Arg_stable"
+      | Arg_funres -> None , "Arg_funres" in
+  match i with
+    | Some i -> Printf.sprintf "%s(%d)" s i
+    | None -> Printf.sprintf "%s" s
+
+let isPrm_stable x = match x with Prm_stable _ -> true | _ -> false
+
+let isArg_stable x = match x with Arg_stable _ -> true | _ -> false
+
+let isArg_funres x = match x with Arg_funres -> true | _ -> false
+
+let filter_shift_stable (lnk:int merged_arg array) (l:'a list): 'a list =
+  let prms = list_filteri (fun i _ -> isPrm_stable lnk.(i)) l in
+  let args = list_filteri (fun i _ -> isArg_stable lnk.(i)) l in
+  let fres = list_filteri (fun i _ -> isArg_funres lnk.(i)) l in
+  prms@args@fres
+
+(** Reverse the link map, keeping only linked vars, elements are list
+    of int as several vars may be linked to the same var. *)
+let revlinked lnk =
+  For.fold 0 (Array.length lnk - 1)
+    (fun acc k -> 
+      match lnk.(k) with 
+        | Unlinked | Funres -> acc 
+        | Linked i -> 
+            let old = try Link.find i acc with Not_found -> [] in
+            Link.add i (k::old) acc)
+    Link.empty
+
+let array_switch arr i j = 
+  let aux = arr.(j) in arr.(j) <- arr.(i); arr.(i) <- aux
+
+let filter_shift_stable_right (lnk:int merged_arg array) (l:'a list): 'a list =
+  let larr = Array.of_list l in
+  let _ =
+    Array.iteri
+      (fun j x -> 
+        match x with
+          | Prm_linked i -> array_switch larr i j
+          | Arg_linked i -> array_switch larr i j
+          | Prm_stable i -> ()
+          | Prm_arg i -> ()
+          | Arg_stable i -> ()
+          | Arg_funres -> ()
+      ) lnk in
+  filter_shift_stable lnk (Array.to_list larr)
+
+
+
+
+(** {1 Utilities for merging} *)
+
+let ind1name = id_of_string "__ind1"
+let ind2name = id_of_string "__ind2"
+
+(** Performs verifications on two graphs before merging: they must not
+    be co-inductive, and for the moment they must not be mutual
+    either. *)
+let verify_inds mib1 mib2 =
+  if not mib1.mind_finite then error "First argument is coinductive";
+  if not mib2.mind_finite then error "Second argument is coinductive";
+  if mib1.mind_ntypes <> 1 then error "First argument is mutual";
+  if mib2.mind_ntypes <> 1 then error "Second argument is mutual";
+  ()
+
+
+(** {1 Merging function graphs} *)
+
+(** [shift_linked_params mib1 mib2 lnk] Computes which parameters (rec
+    uniform and ordinary ones) of mutual inductives [mib1] and [mib2]
+    remain uniform when linked by [lnk]. All parameters are
+    considered, ie we take parameters of the first inductive body of
+    [mib1] and [mib2].
+    
+    Explanation: The two inductives have parameters, some of the first
+    are recursively uniform, some of the last are functional result of
+    the functional graph.
+
+   (I x1 x2 ... xk ... xk' ... xn)
+   (J y1 y2 ... xl ... yl' ... ym)
+
+   Problem is, if some rec unif params are linked to non rec unif
+   ones, they become non rec (and the following too). And functinal
+   argument have to be shifted at the end *)
+let shift_linked_params mib1 mib2 (lnk1:linked_var array) (lnk2:linked_var array) id =
+  let linked_targets = revlinked lnk2 in
+  let is_param_of_mib1 x = x < mib1.mind_nparams_rec in
+  let is_param_of_mib2 x = x < mib2.mind_nparams_rec in
+  let is_targetted_by_non_recparam_lnk1 i = 
+    try 
+      let targets = Link.find i linked_targets in 
+      List.exists (fun x -> not (is_param_of_mib2 x)) targets
+    with Not_found -> false in
+  let mlnk1 = 
+    Array.mapi
+      (fun i lkv -> 
+        let isprm = is_param_of_mib1 i in
+        let prmlost = is_targetted_by_non_recparam_lnk1 i in
+        match isprm , prmlost, lnk1.(i) with
+          | true , true , _ -> Prm_arg i (* recparam becoming ordinary *)
+          | true , false , _-> Prm_stable i (* recparam remains recparam*)
+          | false , false , Funres -> Arg_funres
+          | _ , _ , Funres -> assert false (* fun res cannot be a rec param or lost *)
+          | false , _ , _ -> Arg_stable i) (* Args of lnk1 are not linked *)
+      lnk1 in
+  let mlnk2 = 
+    Array.mapi
+      (fun i lkv -> 
+        (* Is this correct if some param of ind2 is lost? *)
+        let isprm = is_param_of_mib2 i in
+        match isprm , lnk2.(i) with
+          | true , Linked j when not (is_param_of_mib1 j) -> 
+              Prm_arg j (* recparam becoming ordinary *)
+          | true , Linked j -> Prm_linked j (*recparam linked to recparam*)
+          | true , Unlinked -> Prm_stable i (* recparam remains recparam*)
+          | false , Linked j -> Arg_linked j (* Args of lnk2 lost *)
+          | false , Unlinked -> Arg_stable i (* Args of lnk2 remains *)
+          | false , Funres -> Arg_funres
+          | true , Funres -> assert false (* fun res cannot be a rec param *)
+      )
+      lnk2 in
+  let oib1 = mib1.mind_packets.(0) in
+  let oib2 = mib2.mind_packets.(0) in
+  (* count params remaining params *)
+  let n_params1 = array_prfx mlnk1 (fun i x -> not (isPrm_stable x)) in
+  let n_params2 = array_prfx mlnk2 (fun i x -> not (isPrm_stable x)) in
+  let bldprms arity_ctxt mlnk = 
+    list_fold_lefti
+      (fun i (acc1,acc2,acc3) x -> 
+        match mlnk.(i) with
+          | Prm_stable _ -> x::acc1 , acc2 , acc3
+          | Prm_arg _ | Arg_stable _ -> acc1 , x::acc2 , acc3
+          | Arg_funres -> acc1 , acc2 , x::acc3
+          | _ -> acc1 , acc2 , acc3) (* Prm_linked and Arg_xxx = forget it *)
+      ([],[],[]) arity_ctxt in
+  let recprms1,otherprms1,funresprms1 = bldprms (List.rev oib1.mind_arity_ctxt) mlnk1 in
+  let recprms2,otherprms2,funresprms2 = bldprms (List.rev oib2.mind_arity_ctxt) mlnk2 in
+  {
+    ident=id;
+    mib1=mib1;
+    oib1 = oib1;
+    mib2=mib2;
+    oib2 = oib2;
+    lnk1 = mlnk1;
+    lnk2 = mlnk2;
+    nrecprms1 = n_params1;
+    recprms1 = recprms1;
+    otherprms1 = otherprms1;
+    funresprms1 = funresprms1;
+    notherprms1 = Array.length mlnk1 - n_params1;
+    nfunresprms1 = List.length funresprms1;
+    nrecprms2 = n_params2;
+    recprms2 = recprms2;
+    otherprms2 = otherprms2;
+    funresprms2 = funresprms2;
+    notherprms2 = Array.length mlnk2 - n_params2;
+    nfunresprms2 = List.length funresprms2;
+  }
+
+
+
+
+(** {1 Merging functions} *)
+
+exception NoMerge
+
+(* lnk is an link array of *all* args (from 1 and 2) *)
+let merge_app c1 c2 id1 id2 shift filter_shift_stable = 
+  let lnk = Array.append shift.lnk1 shift.lnk2 in
+  match c1 , c2 with
+    | RApp(_,f1, arr1), RApp(_,f2,arr2) when isVarf id1 f1 && isVarf id2 f2 -> 
+        let args = filter_shift_stable lnk (arr1 @ arr2) in
+        RApp (dummy_loc,RVar (dummy_loc,shift.ident) , args)
+    | RApp(_,f1, arr1), RApp(_,f2,arr2)  -> raise NoMerge
+    | _ -> raise NoMerge
+
+let merge_app_unsafe c1 c2 shift filter_shift_stable = 
+  let lnk = Array.append shift.lnk1 shift.lnk2 in
+  match c1 , c2 with
+    | RApp(_,f1, arr1), RApp(_,f2,arr2) -> 
+        let args = filter_shift_stable lnk (arr1 @ arr2) in
+        RApp (dummy_loc,RVar(dummy_loc,shift.ident) , args)
+    | _ -> raise NoMerge
+
+
+
+(* Heuristic when merging two lists of hypothesis: merge every rec
+   calls of nrach 1 with all rec calls of branch 2. *)
+(* TODO: reecrire cette heuristique (jusqu'a merge_types) *)
+let onefoud = ref false (* Ugly *)
+
+let rec merge_rec_hyps shift accrec (ltyp:(Names.name * Rawterm.rawconstr) list) 
+    filter_shift_stable =
+  match ltyp with
+    | [] -> []
+    | (nme,(RApp(_,f, largs) as t)) :: lt when isVarf ind2name f -> 
+        let _ = onefoud := true in
+        let rechyps = 
+          List.map 
+            (fun (nme,ind) -> 
+              match ind with
+                | RApp(_,i,args) -> 
+                    nme, merge_app_unsafe ind t shift filter_shift_stable
+                | _ -> assert false)
+            accrec in
+        rechyps @ merge_rec_hyps shift accrec lt filter_shift_stable
+    | e::lt -> e :: merge_rec_hyps shift accrec lt filter_shift_stable
+
+
+let rec build_suppl_reccall (accrec:(name * rawconstr) list) concl2 shift = 
+  List.map (fun (nm,tp) -> (nm,merge_app_unsafe tp concl2 shift)) accrec
+
+
+let find_app (nme:identifier) (ltyp: (name * rawconstr) list) = 
+  try
+    ignore
+      (List.map
+          (fun x -> 
+            match x with
+              | _,(RApp(_,f,_)) when isVarf nme f -> raise (Found 0)
+              | _ -> ())
+          ltyp);
+    false
+  with Found _ -> true
+        
+let rec merge_types shift accrec1 (ltyp1:(name * rawconstr) list)
+    concl1 (ltyp2:(name * rawconstr) list) concl2
+    : (name * rawconstr) list * rawconstr = 
+  let _ = prstr "MERGE_TYPES\n" in
+  let _ = prstr "ltyp 1 : " in
+  let _ = List.iter (fun (nm,tp) -> prNamedRConstr (string_of_name nm) tp) ltyp1 in
+  let _ = prstr "\nltyp 2 : " in
+  let _ = List.iter (fun (nm,tp) -> prNamedRConstr (string_of_name nm) tp) ltyp2 in
+  let _ = prstr "\n" in
+
+
+  let res =
+    match ltyp1 with
+      | [] -> 
+          let isrec1 = (accrec1<>[]) in
+          let isrec2 = find_app ind2name ltyp2 in
+          let _ = if isrec2 then prstr "  ISREC2 TRUE" else prstr "  ISREC2 FALSE" in
+          let _ = if isrec1 then prstr "  ISREC1 TRUE\n" else prstr "  ISREC1 FALSE\n" in
+          let rechyps =
+            if isrec1 && isrec2 
+            then merge_rec_hyps shift accrec1 ltyp2 filter_shift_stable
+            else if isrec1 
+                (* if rec calls in accrec1 and not in ltyp2, add one to ltyp2 *)
+            then merge_rec_hyps shift accrec1 (ltyp2@[name_of_string "concl2",concl2])
+              filter_shift_stable
+            else if isrec2
+            then merge_rec_hyps shift [name_of_string "concl1",concl1] ltyp2
+              filter_shift_stable_right
+            else [] in
+          let _ = prstr"\nrechyps : " in
+          let _ = List.iter 
+            (fun (nm,tp) -> prNamedRConstr (string_of_name nm) tp) rechyps in
+          let _ = prstr "MERGE CONCL :  " in
+          let _ = prNamedRConstr "concl1" concl1 in
+          let _ = prstr " with " in
+          let _ = prNamedRConstr "concl2" concl2 in
+          let _ = prstr "\n" in
+          let concl = 
+            merge_app concl1 concl2 ind1name ind2name shift filter_shift_stable in
+          let _ = prstr "FIN " in
+          let _ = prNamedRConstr "concl" concl in
+          let _ = prstr "\n" in
+          rechyps , concl
+      | (nme,t1)as e ::lt1 -> 
+          match t1 with
+            | RApp(_,f,carr) when isVarf ind1name f -> 
+                merge_types shift (e::accrec1) lt1 concl1 ltyp2 concl2 
+            | _ -> 
+                let recres, recconcl2 =
+                  merge_types shift accrec1 lt1 concl1 ltyp2 concl2 in
+                ((nme,t1) :: recres) , recconcl2
+  in
+  res
+
+
+(** [build_link_map_aux allargs1 allargs2 shift] returns the mapping of
+    linked args [allargs2] to target args of [allargs1] as specified
+    in [shift]. [allargs1] and [allargs2] are in reverse order.  Also
+    returns the list of unlinked vars of [allargs2]. *)
+let build_link_map_aux (allargs1:identifier array) (allargs2:identifier array)
+    (lnk:int merged_arg array) =
+  array_fold_lefti
+    (fun i acc e -> 
+      if i = Array.length lnk - 1 then acc (* functional arg, not in allargs *)
+      else 
+        match e with 
+          | Prm_linked j | Arg_linked j -> Idmap.add allargs2.(i) allargs1.(j) acc
+          | _ -> acc)
+    Idmap.empty lnk
+
+let build_link_map allargs1 allargs2 lnk =
+  let allargs1 =
+    Array.of_list (List.rev (List.map (fun (x,y) -> id_of_name x) allargs1)) in
+  let allargs2 =
+    Array.of_list (List.rev (List.map (fun (x,y) -> id_of_name x) allargs2)) in
+  build_link_map_aux allargs1 allargs2 lnk
+
+
+(** [merge_one_constructor lnk shift typcstr1 typcstr2] merges the two
+    constructor rawtypes [typcstr1] and [typcstr2].  [typcstr1] and
+    [typcstr2] contain all parameters (including rec. unif. ones) of
+    their inductive.
+
+    if  [typcstr1] and [typcstr2] are of the form:
+
+    forall recparams1, forall ordparams1, H1a -> H2a... (I1 x1 y1 ... z1)
+    forall recparams2, forall ordparams2, H2b -> H2b... (I2 x2 y2 ... z2)
+
+    we build:
+
+    forall recparams1 (recparams2 without linked params),
+     forall ordparams1 (ordparams2 without linked params),
+      H1a' -> H2a' -> ...  -> H2a' -> H2b' -> ... 
+        -> (newI x1 ... z1 x2 y2 ...z2 without linked params)
+
+    where Hix' have been adapted, ie: 
+      - linked vars have been changed,
+      - rec calls to I1 and I2 have been replaced by rec calls to
+        newI. More precisely calls to I1 and I2 have been merge by an
+        experimental heuristic (in particular if n o rec calls for I1
+        or I2 is found, we use the conclusion as a rec call). See
+        [merge_types] above.
+
+    Precond: vars sets of [typcstr1] and [typcstr2] must be disjoint.
+
+    TODO: return nothing if equalities (after linking) are contradictory. *)
+let merge_one_constructor (shift:merge_infos) (typcstr1:rawconstr)
+    (typcstr2:rawconstr) : rawconstr =
+  (* FIXME: les noms des parametres corerspondent en principe au
+     parametres du niveau mib, mais il faudrait s'en assurer *)
+  (* shift.nfunresprmsx last args are functional result *)
+  let nargs1 = 
+    shift.mib1.mind_nparams + shift.oib1.mind_nrealargs - shift.nfunresprms1 in
+  let nargs2 =
+    shift.mib2.mind_nparams + shift.oib2.mind_nrealargs - shift.nfunresprms2 in
+  let allargs1,rest1 = raw_decompose_prod_n nargs1 typcstr1 in
+  let allargs2,rest2 = raw_decompose_prod_n nargs2 typcstr2 in  
+  (* Build map of linked args of [typcstr2], and apply it to [typcstr2]. *)
+  let linked_map = build_link_map allargs1 allargs2 shift.lnk2 in
+  let rest2 = change_vars linked_map rest2 in
+  let hyps1,concl1 = raw_decompose_prod rest1 in
+  let hyps2,concl2' = raw_decompose_prod rest2 in
+  let ltyp,concl2 = 
+    merge_types shift [] (List.rev hyps1) concl1 (List.rev hyps2) concl2' in
+  let typ = raw_compose_prod concl2 (List.rev ltyp) in
+  let revargs1 = 
+    list_filteri (fun i _ -> isArg_stable shift.lnk1.(i)) (List.rev allargs1) in
+  let revargs2 = 
+    list_filteri (fun i _ -> isArg_stable shift.lnk2.(i)) (List.rev allargs2) in
+  let typwithprms = raw_compose_prod typ (List.rev revargs2 @ List.rev revargs1) in
+  typwithprms
+
+
+(** constructor numbering *)
+let fresh_cstror_suffix , cstror_suffix_init =
+  let cstror_num = ref 0 in
+  (fun () -> 
+    let res = string_of_int !cstror_num in
+    cstror_num := !cstror_num + 1;
+    res) ,
+  (fun () -> cstror_num := 0)
+
+(** [merge_constructor_id id1 id2 shift] returns the identifier of the
+    new constructor from the id of the two merged constructor and
+    the merging info. *)
+let merge_constructor_id id1 id2 shift:identifier = 
+  let id = string_of_id shift.ident ^ "_" ^ fresh_cstror_suffix () in
+  next_ident_fresh (id_of_string id)
+
+
+
+(** [merge_constructors lnk shift avoid] merges the two list of
+    constructor [(name*type)]. These are translated to rawterms
+    first, each of them having distinct var names. *)
+let rec merge_constructors (shift:merge_infos) (avoid:Idset.t)
+    (typcstr1:(identifier * types) list) 
+    (typcstr2:(identifier * types) list) : (identifier * rawconstr) list =
+  List.flatten 
+    (List.map
+        (fun (id1,typ1) -> 
+          let typ1 = substitterm 0 (mkRel 1) (mkVar ind1name) typ1 in
+          let rawtyp1 = Detyping.detype false (Idset.elements avoid) [] typ1 in
+          let idsoftyp1:Idset.t = ids_of_rawterm rawtyp1 in
+          List.map
+            (fun (id2,typ2) -> 
+              let typ2 = substitterm 0 (mkRel 1) (mkVar ind2name) typ2 in
+              (* Avoid also rawtyp1 names *)
+              let avoid2 = Idset.union avoid idsoftyp1 in
+              let rawtyp2 = Detyping.detype false (Idset.elements avoid2) [] typ2 in
+              let typ = merge_one_constructor shift rawtyp1 rawtyp2 in
+              let newcstror_id = merge_constructor_id id1 id2 shift in
+              newcstror_id , typ)
+            typcstr2)
+        typcstr1)
+    
+(** [merge_inductive_body lnk shift avoid oib1 oib2] merges two
+    inductive bodies [oib1] and [oib2], linking with [lnk], params
+    info in [shift], avoiding identifiers in [avoid]. *)
+let rec merge_inductive_body (shift:merge_infos) avoid (oib1:one_inductive_body)
+    (oib2:one_inductive_body) : (identifier * rawconstr) list =
+  let lcstr1 = Array.to_list oib1.mind_user_lc in
+  let lcstr2 = Array.to_list oib2.mind_user_lc in
+  let lcstr1 = List.combine (Array.to_list oib1.mind_consnames) lcstr1 in
+  let lcstr2 = List.combine (Array.to_list oib2.mind_consnames) lcstr2 in
+  cstror_suffix_init();
+  merge_constructors shift avoid lcstr1 lcstr2
+
+(** [build_raw_params prms_decl avoid] returns a list of variables
+    attributed to the list of decl [prms_decl], avoiding names in
+    [avoid]. *)
+let build_raw_params prms_decl avoid =
+  let dummy_constr = compose_prod prms_decl mkProp in
+  let dummy_rawconstr = Detyping.detype false avoid [] dummy_constr in
+  let res,_ = raw_decompose_prod dummy_rawconstr in
+  res , (avoid @ (Idset.elements (ids_of_rawterm dummy_rawconstr)))
+
+(** [merge_mutual_inductive_body lnk mib1 mib2 shift] merge mutual
+    inductive bodies [mib1] and [mib2] linking vars with
+    [lnk]. [shift] information on parameters of the new inductive.
+    For the moment, inductives are supposed to be non mutual.
+*)
+let rec merge_mutual_inductive_body
+    (mib1:mutual_inductive_body) (mib2:mutual_inductive_body) 
+    (shift:merge_infos) =
+  (* Mutual not treated, we take first ind body of each. *)
+  let nprms1 = mib1.mind_nparams_rec in (* n# of rec uniform parms of mib1 *)
+  let prms1 = (* rec uniform parms of mib1 *)
+    List.map (fun (x,_,y) -> x,y) (fst (list_chop nprms1 mib1.mind_params_ctxt)) in
+
+  (* useless: *)
+  let prms1_named,avoid' = build_raw_params prms1 [] in
+  let prms2_named,avoid = build_raw_params prms1 avoid' in
+  let avoid:Idset.t = List.fold_right Idset.add avoid Idset.empty in  
+  (* *** *)
+
+  merge_inductive_body shift avoid mib1.mind_packets.(0) mib2.mind_packets.(0) 
+
+  
+
+let merge_rec_params_and_arity params1 params2 shift (concl:constr) = 
+  let params = shift.recprms1 @ shift.recprms2 in
+  let resparams, _ =
+    List.fold_left
+      (fun (acc,env) (nme,_,tp) -> 
+        let typ = Constrextern.extern_constr false env tp in
+        let newenv = Environ.push_rel (nme,None,tp) env in
+        LocalRawAssum ([(dummy_loc,nme)] , typ) :: acc , newenv)
+      ([],Global.env())
+      params in
+  let concl = Constrextern.extern_constr false (Global.env()) concl in
+  let arity,_ = 
+    List.fold_left 
+      (fun (acc,env) (nm,_,c) -> 
+        let typ = Constrextern.extern_constr false env c in
+        let newenv = Environ.push_rel (nm,None,c) env in
+        CProdN (dummy_loc, [[(dummy_loc,nm)],typ] , acc) , newenv)
+      (concl,Global.env())
+      (shift.otherprms1@shift.otherprms2@shift.funresprms1@shift.funresprms2) in  
+  resparams,arity
+
+  
+
+(** [rawterm_list_to_inductive_expr ident rawlist] returns the
+    induct_expr corresponding to the the list of constructor types
+    [rawlist], named ident.
+    FIXME: params et cstr_expr (arity) *)
+let rawterm_list_to_inductive_expr mib1 mib2 shift
+    (rawlist:(identifier * rawconstr) list):inductive_expr =
+  let rawterm_to_constr_expr x = (* build a constr_expr from a rawconstr *)
+    Options.with_option Options.raw_print (Constrextern.extern_rawtype Idset.empty) x in
+  let lident = dummy_loc, shift.ident in
+  let bindlist , cstr_expr = (* params , arities *)
+    merge_rec_params_and_arity 
+      mib1.mind_params_ctxt mib2.mind_params_ctxt shift mkSet in
+  let lcstor_expr : (bool * (lident * constr_expr)) list  = 
+    List.map (* zeta_normalize t ? *)
+      (fun (id,t) -> false, ((dummy_loc,id),rawterm_to_constr_expr t))
+      rawlist in  
+  lident , bindlist , cstr_expr , lcstor_expr
+
+(** [merge_inductive ind1 ind2 lnk] merges two graphs, linking
+    variables specified in [lnk]. Graphs are not supposed to be mutual
+    inductives for the moment. *)
+let merge_inductive (ind1: inductive) (ind2: inductive) 
+    (lnk1: linked_var array) (lnk2: linked_var array) id =
+  let env = Global.env() in
+  let mib1,_ = Inductive.lookup_mind_specif env ind1 in
+  let mib2,_ = Inductive.lookup_mind_specif env ind2 in
+  let _ = verify_inds mib1 mib2 in (* raises an exception if something wrong *)
+  (* compute params that become ordinary args (because linked to ord. args) *)
+  let shift_prm = shift_linked_params mib1 mib2 lnk1 lnk2 id in
+  let rawlist = merge_mutual_inductive_body mib1 mib2 shift_prm in
+  let indexpr = rawterm_list_to_inductive_expr mib1 mib2 shift_prm rawlist in
+  (* Declare inductive *)
+  Command.build_mutual [(indexpr,None)] true (* means: not coinductive *)
+
+
+
+let merge (cstr1:constr) (cstr2:constr) (args1:constr array) (args2:constr array) id =
+  let env = Global.env() in
+  let ind1,_cstrlist1 = Inductiveops.find_inductive env Evd.empty cstr1 in
+  let ind2,_cstrlist2 = Inductiveops.find_inductive env Evd.empty cstr2 in
+  let lnk1 = (* args1 are unlinked. FIXME? mergescheme (G x x) ?? *)
+    Array.mapi (fun i c -> Unlinked) args1 in
+  let _ = lnk1.(Array.length lnk1 - 1) <- Funres in (* last arg is functional result *)
+  let lnk2 = (* args2 may be linked to args1 members. FIXME: same 
+                as above: vars may be linked inside args2?? *)
+    Array.mapi
+      (fun i c -> 
+        match array_find args1 (fun i x -> x=c) with
+          | Some j -> Linked j
+          | None -> Unlinked) 
+      args2 in
+  let _ = lnk2.(Array.length lnk2 - 1) <- Funres in (* last arg is functional result *)
+  let resa = merge_inductive ind1 ind2 lnk1 lnk2 id in
+  resa
+
+
+
+
+
+(* @article{ bundy93rippling,
+    author = "Alan Bundy and Andrew Stevens and Frank van Harmelen and Andrew Ireland and Alan Smaill",
+    title = "Rippling: A Heuristic for Guiding Inductive Proofs",
+    journal = "Artificial Intelligence",
+    volume = "62",
+    number = "2",
+    pages = "185-253",
+    year = "1993",
+    url = "citeseer.ist.psu.edu/bundy93rippling.html" }
+
+ *)
+(* 
+*** Local Variables: ***
+*** compile-command: "make -C ../.. contrib/funind/merge.cmo" ***
+*** indent-tabs-mode: nil ***
+*** End: ***
+*)
diff --git a/contrib/funind/rawterm_to_relation.ml b/contrib/funind/rawterm_to_relation.ml
index dbf2f944..aca84f06 100644
--- a/contrib/funind/rawterm_to_relation.ml
+++ b/contrib/funind/rawterm_to_relation.ml
@@ -789,7 +789,7 @@ and build_entry_lc_from_case_term env types funname make_discr patterns_to_preve
 	    avoid
 	    matched_expr
 	in
-	(* We know create the precondition of this branch i.e.
+	(* We now create the precondition of this branch i.e.
 
 	   1- the list of variable appearing in the different patterns of this branch and 
 	      the list of equation stating than el = patl (List.flatten ...)
@@ -1074,8 +1074,8 @@ let rec rebuild_return_type rt =
     | _ -> Topconstr.CArrow(dummy_loc,rt,Topconstr.CSort(dummy_loc,RType None))
 
 
-let build_inductive 
-    parametrize funnames (funsargs: (Names.name * rawconstr * bool) list list)  
+let do_build_inductive 
+    funnames (funsargs: (Names.name * rawconstr * bool) list list)  
     returned_types 
     (rtl:rawconstr list) =
   let _time1 = System.get_time () in
@@ -1085,7 +1085,7 @@ let build_inductive
   let funsargs = Array.of_list funsargs in 
   let returned_types = Array.of_list returned_types in
   (* alpha_renaming of the body to prevent variable capture during manipulation *)
-  let rtl_alpha = List.map (function rt ->  (alpha_rt [] rt) ) rtl in
+  let rtl_alpha = List.map (function rt ->  expand_as (alpha_rt [] rt)) rtl in
   let rta = Array.of_list rtl_alpha in
   (*i The next call to mk_rel_id is valid since we are constructing the graph
     Ensures by: obvious
@@ -1108,19 +1108,7 @@ let build_inductive
       (function result (* (args',concl') *) -> 
 	 let rt = compose_raw_context result.context result.value in 
 	 let nb_args = List.length funsargs.(i) in 
-(* 	   let old_implicit_args = Impargs.is_implicit_args () *)
-(* 	   and old_strict_implicit_args =  Impargs.is_strict_implicit_args () *)
-(* 	   and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in *)
-(* 	   let old_rawprint = !Options.raw_print in  *)
-(* 	   Options.raw_print := true; *)
-(* 	   Impargs.make_implicit_args false; *)
-(* 	   Impargs.make_strict_implicit_args false; *)
-(* 	   Impargs.make_contextual_implicit_args false; *)
-(* 	   Pp.msgnl (str "raw constr " ++ pr_rawconstr rt); *)
-(* 	   Impargs.make_implicit_args old_implicit_args; *)
-(* 	   Impargs.make_strict_implicit_args old_strict_implicit_args; *)
-(* 	   Impargs.make_contextual_implicit_args old_contextual_implicit_args; *)
-(* 	   Options.raw_print := old_rawprint; *)
+	 (*  with_full_print (fun rt -> Pp.msgnl (str "raw constr " ++ pr_rawconstr rt)) rt; *)
 	 fst (
 	   rebuild_cons nb_args relnames.(i)
 	     []
@@ -1145,12 +1133,7 @@ let build_inductive
   in
   let rel_constructors = Array.mapi rel_constructors resa in
   (* Computing the set of parameters if asked *)
-  let rels_params = 
-    if parametrize 
-    then
-      compute_params_name relnames_as_set funsargs  rel_constructors 
-    else []
-  in
+  let rels_params = compute_params_name relnames_as_set funsargs  rel_constructors in
   let nrel_params = List.length rels_params in
   let rel_constructors = (* Taking into account the parameters in constructors *)
     Array.map (List.map 
@@ -1182,8 +1165,6 @@ let build_inductive
      Then save the graphs and reset Printing options to their primitive values 
   *)
   let rel_arities = Array.mapi rel_arity funsargs in
-  let old_rawprint = !Options.raw_print in 
-  Options.raw_print := true;
   let rel_params =  
     List.map 
       (fun (n,t,is_defined) -> 
@@ -1199,16 +1180,19 @@ let build_inductive
   let ext_rels_constructors = 
     Array.map (List.map 
       (fun (id,t) -> 
-	 false,((dummy_loc,id),Constrextern.extern_rawtype Idset.empty ((* zeta_normalize *) t))
+	 false,((dummy_loc,id),
+		Options.with_option
+		  Options.raw_print
+		  (Constrextern.extern_rawtype Idset.empty) ((* zeta_normalize *) t)
+	       )
       ))
       (rel_constructors)
   in
   let rel_ind i ext_rel_constructors = 
-    (dummy_loc,relnames.(i)),
-    None,
+    ((dummy_loc,relnames.(i)),
     rel_params,
     rel_arities.(i),
-    ext_rel_constructors
+    ext_rel_constructors),None
   in
   let ext_rel_constructors = (Array.mapi rel_ind ext_rels_constructors) in 
   let rel_inds = Array.to_list ext_rel_constructors in 
@@ -1232,58 +1216,36 @@ let build_inductive
 (* 	rel_inds *)
 (*     ) *)
 (*   in *)
-  let old_implicit_args = Impargs.is_implicit_args ()
-  and old_strict_implicit_args =  Impargs.is_strict_implicit_args ()
-  and old_contextual_implicit_args = Impargs.is_contextual_implicit_args () in
-  Impargs.make_implicit_args false;
-  Impargs.make_strict_implicit_args false;
-  Impargs.make_contextual_implicit_args false;
   let _time2 = System.get_time () in 
-(*   Pp.msgnl (str "Bulding Inductive : " ++ str (string_of_float (System.time_difference time1 time2))); *)
   try 
-    Options.silently (Command.build_mutual rel_inds) true;
-    let _time3 = System.get_time () in 
-(*     Pp.msgnl (str "Bulding Done: "++ str (string_of_float (System.time_difference time2 time3)));  *)
-(* 	let msg = *)
-(* 	  str "while trying to define"++ spc () ++ *)
-(* 	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(true,rel_inds)) ++ fnl () *)
-(* 	in *)
-(*  	Pp.msgnl msg; *)
-    Impargs.make_implicit_args old_implicit_args;
-    Impargs.make_strict_implicit_args old_strict_implicit_args;
-    Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-    Options.raw_print := old_rawprint;
-  with
-    | UserError(s,msg) ->
+    with_full_print (Options.silently (Command.build_mutual rel_inds)) true
+  with 
+    | UserError(s,msg) as e ->
 	let _time3 = System.get_time () in
 (* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
-	Impargs.make_implicit_args old_implicit_args;
-	Impargs.make_strict_implicit_args old_strict_implicit_args;
-	Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-	Options.raw_print := old_rawprint;
 	let msg = 		     
 	  str "while trying to define"++ spc () ++
 	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(true,rel_inds)) ++ fnl () ++
 	    msg
 	in
 	observe (msg);
-	raise 
-	  (UserError(s, msg))
+	raise e
     | e -> 
 	let _time3 = System.get_time () in
 (* 	Pp.msgnl (str "error : "++ str (string_of_float (System.time_difference time2 time3))); *)
-	Impargs.make_implicit_args old_implicit_args;
-	Impargs.make_strict_implicit_args old_strict_implicit_args;
-	Impargs.make_contextual_implicit_args old_contextual_implicit_args;
-	Options.raw_print := old_rawprint;
 	let msg = 		     
 	  str "while trying to define"++ spc () ++
 	    Ppvernac.pr_vernac (Vernacexpr.VernacInductive(true,rel_inds)) ++ fnl () ++
 	    Cerrors.explain_exn e
 	in
  	observe msg;
-	raise 
-	  (UserError("",msg))
+	raise e
 
 
 
+let build_inductive funnames funsargs returned_types rtl = 
+  try 
+    do_build_inductive funnames funsargs returned_types rtl
+  with e -> raise (Building_graph e)
+      
+
diff --git a/contrib/funind/rawterm_to_relation.mli b/contrib/funind/rawterm_to_relation.mli
index 9cd04123..0075fb0a 100644
--- a/contrib/funind/rawterm_to_relation.mli
+++ b/contrib/funind/rawterm_to_relation.mli
@@ -1,5 +1,6 @@
 
 
+
 (*
   [build_inductive parametrize funnames funargs returned_types bodies] 
   constructs and saves the graphs of the functions [funnames] taking [funargs] as arguments 
@@ -7,7 +8,6 @@
 *)
 
 val build_inductive :
-  bool -> (* if true try to detect parameter. Always use it as true except for debug *)
   Names.identifier list -> (* The list of function name *)
   (Names.name*Rawterm.rawconstr*bool) list list -> (* The list of function args *)
   Topconstr.constr_expr list -> (* The list of function returned type *)
diff --git a/contrib/funind/rawtermops.ml b/contrib/funind/rawtermops.ml
index 14805cf4..ed46ec72 100644
--- a/contrib/funind/rawtermops.ml
+++ b/contrib/funind/rawtermops.ml
@@ -35,6 +35,18 @@ let raw_decompose_prod =
 let raw_compose_prod = 
   List.fold_left (fun b (n,t) -> mkRProd(n,t,b))
 
+let raw_decompose_prod_n n = 
+  let rec raw_decompose_prod i args c = 
+    if i<=0 then args,c
+    else
+      match c with
+	| RProd(_,n,t,b) -> 
+	    raw_decompose_prod (i-1) ((n,t)::args) b 
+	| rt -> args,rt
+  in
+  raw_decompose_prod n []
+
+
 let raw_decompose_app = 
   let rec decompose_rapp acc rt =
 (*     msgnl (str "raw_decompose_app on : "++ Printer.pr_rawconstr rt); *)
@@ -321,14 +333,6 @@ let rec alpha_rt excluded rt =
 	     List.map (alpha_rt excluded) args
 	    )
   in 
-  if Indfun_common.do_observe ()  && false 
-  then
-    Pp.msgnl (str "debug: alpha_rt(" ++ str "[" ++
-	      prlist_with_sep (fun _ -> str";") Ppconstr.pr_id excluded ++
-	      str "]" ++ spc () ++ str "," ++ spc () ++
-	      Printer.pr_rawconstr rt ++ spc () ++ str ")" ++ spc () ++ str "=" ++
-	      spc () ++ Printer.pr_rawconstr new_rt
-	   );
   new_rt
 
 and alpha_br excluded (loc,ids,patl,res) = 
@@ -339,12 +343,6 @@ and alpha_br excluded (loc,ids,patl,res) =
   let new_res = alpha_rt new_excluded renamed_res in 
   (loc,new_ids,new_patl,new_res)
     
-
-
-
-
-
-
 (* 
    [is_free_in id rt] checks if [id] is a free variable in [rt]
 *)
@@ -541,6 +539,33 @@ let ids_of_pat =
   in
   ids_of_pat Idset.empty 
   
+let id_of_name = function 
+  | Names.Anonymous -> id_of_string "x" 
+  | Names.Name x -> x
+
+(* TODO: finish Rec caes *)
+let ids_of_rawterm c = 
+  let rec ids_of_rawterm acc c = 
+    let idof = id_of_name in
+    match c with
+      | RVar (_,id) -> id::acc
+      | RApp (loc,g,args) -> 
+          ids_of_rawterm [] g @ List.flatten (List.map (ids_of_rawterm []) args) @ acc
+      | RLambda (loc,na,ty,c) -> idof na :: ids_of_rawterm [] ty @ ids_of_rawterm [] c @ acc
+      | RProd (loc,na,ty,c) -> idof na :: ids_of_rawterm [] ty @ ids_of_rawterm [] c @ acc
+      | RLetIn (loc,na,b,c) -> idof na :: ids_of_rawterm [] b @ ids_of_rawterm [] c @ acc
+      | RCast (loc,c,k,t) -> ids_of_rawterm [] c @ ids_of_rawterm [] t @ acc
+      | RIf (loc,c,(na,po),b1,b2) -> ids_of_rawterm [] c @ ids_of_rawterm [] b1 @ ids_of_rawterm [] b2 @ acc
+      | RLetTuple (_,nal,(na,po),b,c) -> 
+          List.map idof nal @ ids_of_rawterm [] b @ ids_of_rawterm [] c @ acc
+      | RCases (loc,rtntypopt,tml,brchl) -> 
+	  List.flatten (List.map (fun (_,idl,patl,c) -> idl @ ids_of_rawterm [] c) brchl)
+      | RRec _ -> failwith "Fix inside a constructor branch"
+      | (RSort _ | RHole _ | RRef _ | REvar _ | RPatVar _ | RDynamic _) as x -> []
+  in
+  (* build the set *)
+  List.fold_left (fun acc x -> Idset.add x acc) Idset.empty (ids_of_rawterm [] c)
+  
 
 
 
@@ -601,3 +626,46 @@ let zeta_normalize =
     (loc,idl,patl,zeta_normalize_term res)
   in
   zeta_normalize_term 
+
+
+
+
+let expand_as = 
+  
+  let rec add_as map pat = 
+    match pat with 
+      | PatVar _ -> map 
+      | PatCstr(_,_,patl,Name id) -> 
+	  Idmap.add id (pattern_to_term pat) (List.fold_left add_as map patl)
+      | PatCstr(_,_,patl,_) -> List.fold_left add_as map patl
+  in 
+  let rec expand_as map rt = 
+    match rt with 
+      | RRef _ | REvar _ | RPatVar _ | RSort _ | RHole _ -> rt 
+      | RVar(_,id) -> 
+	  begin
+	    try 
+	      Idmap.find id map
+	    with Not_found -> rt 
+	  end
+      | RApp(loc,f,args) -> RApp(loc,expand_as map f,List.map (expand_as map) args)
+      | RLambda(loc,na,t,b) -> RLambda(loc,na,expand_as map t, expand_as map b)
+      | RProd(loc,na,t,b) -> RProd(loc,na,expand_as map t, expand_as map b)
+      | RLetIn(loc,na,v,b) -> RLetIn(loc,na, expand_as map v,expand_as map b)
+      | RLetTuple(loc,nal,(na,po),v,b) ->
+	  RLetTuple(loc,nal,(na,option_map (expand_as map) po),
+		    expand_as map v, expand_as map b)
+      | RIf(loc,e,(na,po),br1,br2) ->
+	  RIf(loc,expand_as map e,(na,option_map (expand_as map) po),
+	      expand_as map br1, expand_as map br2)
+      | RRec _ ->  error "Not handled RRec"
+      | RDynamic _ -> error "Not handled RDynamic"
+      | RCast(loc,b,kind,t) -> RCast(loc,expand_as map b,kind,expand_as map t)
+      | RCases(loc,po,el,brl) ->
+	  RCases(loc, option_map (expand_as map) po, List.map (fun (rt,t) -> expand_as map rt,t) el,
+		List.map (expand_as_br map) brl)
+	    
+  and expand_as_br map (loc,idl,cpl,rt) = 
+    (loc,idl,cpl,    expand_as (List.fold_left add_as map cpl) rt)
+  in
+  expand_as Idmap.empty 
diff --git a/contrib/funind/rawtermops.mli b/contrib/funind/rawtermops.mli
index aa355485..9647640c 100644
--- a/contrib/funind/rawtermops.mli
+++ b/contrib/funind/rawtermops.mli
@@ -31,6 +31,7 @@ val mkRCast : rawconstr* rawconstr -> rawconstr
   These are analogous to the ones constrs
 *)
 val raw_decompose_prod : rawconstr -> (Names.name*rawconstr) list * rawconstr
+val raw_decompose_prod_n : int -> rawconstr -> (Names.name*rawconstr) list * rawconstr
 val raw_compose_prod : rawconstr -> (Names.name*rawconstr) list  ->  rawconstr 
 val raw_decompose_app : rawconstr -> rawconstr*(rawconstr list)
 
@@ -107,8 +108,13 @@ val eq_cases_pattern : cases_pattern -> cases_pattern -> bool
 *)
 val   ids_of_pat : cases_pattern -> Names.Idset.t 
 
+(* TODO: finish this function (Fix not treated) *)
+val ids_of_rawterm: rawconstr -> Names.Idset.t
 
 (* 
    removing let_in construction in a rawterm 
 *)
 val zeta_normalize : Rawterm.rawconstr -> Rawterm.rawconstr
+
+
+val expand_as : rawconstr -> rawconstr
diff --git a/contrib/funind/tacinvutils.ml b/contrib/funind/tacinvutils.ml
index 2877c19d..ce775e0b 100644
--- a/contrib/funind/tacinvutils.ml
+++ b/contrib/funind/tacinvutils.ml
@@ -72,10 +72,11 @@ let  rec mkevarmap_from_listex lex =
 		  let _ = prstr ("evar n. " ^ string_of_int ex ^ " ") in
 		  let _ = prstr "OF TYPE: " in
 		  let _ = prconstr typ in*)
-		  let info ={
+		  let info = {
 			 evar_concl = typ;
 			 evar_hyps = empty_named_context_val;
-			 evar_body = Evar_empty} in
+			 evar_body = Evar_empty;
+		         evar_extra = None} in
 		  Evd.add (mkevarmap_from_listex lex') ex info
 
 let mkEq typ c1 c2 = 
diff --git a/contrib/interface/ascent.mli b/contrib/interface/ascent.mli
index 8f880a76..b6cc55f6 100644
--- a/contrib/interface/ascent.mli
+++ b/contrib/interface/ascent.mli
@@ -21,7 +21,7 @@ and ct_BINDING =
     CT_binding of ct_ID_OR_INT * ct_FORMULA
 and ct_BINDING_LIST =
     CT_binding_list of ct_BINDING list
-and ct_BOOL =
+and t_BOOL =
     CT_false
   | CT_true
 and ct_CASE =
@@ -46,7 +46,7 @@ and ct_COMMAND =
   | CT_coerce_THEOREM_GOAL_to_COMMAND of ct_THEOREM_GOAL
   | CT_abort of ct_ID_OPT_OR_ALL
   | CT_abstraction of ct_ID * ct_FORMULA * ct_INT_LIST
-  | CT_add_field of ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_BINDING_LIST
+  | CT_add_field of ct_FORMULA * ct_FORMULA * ct_FORMULA * ct_FORMULA_OPT
   | CT_add_natural_feature of ct_NATURAL_FEATURE * ct_ID
   | CT_addpath of ct_STRING * ct_ID_OPT
   | CT_arguments_scope of ct_ID * ct_ID_OPT_LIST
@@ -684,7 +684,7 @@ and ct_TACTIC_COM =
   | CT_reflexivity
   | CT_rename of ct_ID * ct_ID
   | CT_repeat of ct_TACTIC_COM
-  | CT_replace_with of ct_FORMULA * ct_FORMULA * ct_ID_OPT * ct_TACTIC_OPT
+  | CT_replace_with of ct_FORMULA * ct_FORMULA * ct_CLAUSE * ct_TACTIC_OPT
   | CT_rewrite_lr of ct_FORMULA * ct_SPEC_LIST * ct_CLAUSE
   | CT_rewrite_rl of ct_FORMULA * ct_SPEC_LIST * ct_CLAUSE
   | CT_right of ct_SPEC_LIST
diff --git a/contrib/interface/blast.ml b/contrib/interface/blast.ml
index 9e450068..dc27cf98 100644
--- a/contrib/interface/blast.ml
+++ b/contrib/interface/blast.ml
@@ -92,7 +92,7 @@ let rec def_const_in_term_rec vl x =
    | Case(_,x,t,a) 
         -> def_const_in_term_rec vl x
    | Cast(x,_,t)-> def_const_in_term_rec vl t
-   | Const(c)  -> def_const_in_term_rec vl (lookup_constant c vl).const_type
+   | Const(c)  -> def_const_in_term_rec vl (Typeops.type_of_constant vl c)
    | _ -> def_const_in_term_rec vl (type_of vl Evd.empty x)
 ;;
 let def_const_in_term_ x =
diff --git a/contrib/interface/centaur.ml4 b/contrib/interface/centaur.ml4
index 8fcdb5d9..730e055b 100644
--- a/contrib/interface/centaur.ml4
+++ b/contrib/interface/centaur.ml4
@@ -396,7 +396,7 @@ let inspect n =
 			 let (_, _, v) = get_variable (basename sp) in
 			   add_search2 (Nametab.locate (qualid_of_sp sp)) v
 		     | (sp,kn), "CONSTANT" ->
-			 let {const_type=typ} = Global.lookup_constant (constant_of_kn kn) in
+			 let typ = Typeops.type_of_constant (Global.env()) (constant_of_kn kn) in
 			   add_search2 (Nametab.locate (qualid_of_sp sp)) typ
 		     | (sp,kn), "MUTUALINDUCTIVE" ->
 			 add_search2 (Nametab.locate (qualid_of_sp sp))
diff --git a/contrib/interface/dad.ml b/contrib/interface/dad.ml
index 578abc49..8096bc31 100644
--- a/contrib/interface/dad.ml
+++ b/contrib/interface/dad.ml
@@ -73,7 +73,7 @@ let rec map_subst (env :env) (subst:patvar_map) = function
   | CPatVar (_,(_,i)) ->
       let constr = List.assoc i subst in
       extern_constr false env constr
-  | x -> map_constr_expr_with_binders (map_subst env) (fun _ x -> x) subst x;;
+  | x -> map_constr_expr_with_binders (fun _ x -> x) (map_subst env) subst x;;
 
 let map_subst_tactic env subst = function
   | TacExtend (loc,("Rewrite" as x),[b;cbl]) ->
diff --git a/contrib/interface/debug_tac.ml4 b/contrib/interface/debug_tac.ml4
index e1b8e712..890bb3ce 100644
--- a/contrib/interface/debug_tac.ml4
+++ b/contrib/interface/debug_tac.ml4
@@ -336,7 +336,7 @@ let debug_tac = function
 add_tactic "DebugTac" debug_tac;;
 *)
 
-Refiner.add_tactic "OnThen" on_then;;
+Tacinterp.add_tactic "OnThen" on_then;;
 
 let rec clean_path tac l = 
   match tac, l with
diff --git a/contrib/interface/name_to_ast.ml b/contrib/interface/name_to_ast.ml
index b06ba199..9a503cfb 100644
--- a/contrib/interface/name_to_ast.ml
+++ b/contrib/interface/name_to_ast.ml
@@ -107,10 +107,10 @@ let convert_one_inductive sp tyi =
   let env = Global.env () in
   let envpar = push_rel_context params env in
   let sp = sp_of_global (IndRef (sp, tyi)) in
-  ((dummy_loc,basename sp), None,
+  (((dummy_loc,basename sp),
    convert_env(List.rev params),
    (extern_constr true envpar arity),
-   convert_constructors envpar cstrnames cstrtypes);;
+   convert_constructors envpar cstrnames cstrtypes), None);;
 
 (* This function converts a Mutual inductive definition to a Coqast.t.
    It is obtained directly from print_mutual in pretty.ml.  However, all
@@ -149,7 +149,7 @@ let make_definition_ast name c typ implicits =
 let constant_to_ast_list kn =
   let cb = Global.lookup_constant kn in
   let c = cb.const_body in
-  let typ = cb.const_type in
+  let typ = Typeops.type_of_constant_type (Global.env()) cb.const_type in
   let l = implicits_of_global (ConstRef kn) in
   (match c with
       None -> 
diff --git a/contrib/interface/showproof.ml b/contrib/interface/showproof.ml
index ce2ee1e7..4bec7350 100644
--- a/contrib/interface/showproof.ml
+++ b/contrib/interface/showproof.ml
@@ -156,16 +156,16 @@ let seq_to_lnhyp sign sign' cl =
 
 let rule_is_complex r =
    match r with
-      Tactic (TacArg (Tacexp t),_) -> true  
-   |  Tactic (TacAtom (_,TacAuto _), _) -> true
-   |  Tactic (TacAtom (_,TacSymmetry _), _) -> true 
+       Nested (Tactic 
+		 ((TacArg (Tacexp _)
+		 |TacAtom (_,(TacAuto _|TacSymmetry _))),_),_) -> true
    |_ -> false
 ;;
 
 let rule_to_ntactic r =
    let rt =
      (match r with
-       Tactic (t,_) -> t
+       Nested(Tactic (t,_),_) -> t
      | Prim (Refine h) -> TacAtom (dummy_loc,TacExact h)
      | _ -> TacAtom (dummy_loc, TacIntroPattern [])) in
    if rule_is_complex r
@@ -234,17 +234,17 @@ let  to_nproof sigma osign pf =
               (List.map (fun x -> (to_nproof_rec sigma sign x).t_proof)
 		 spfl) in
 	  (match r with
-	    Tactic (TacAtom (_, TacAuto _),_) ->
-	      if spfl=[]
-	      then
-	      	{t_info="to_prove";
-	    	  t_goal= {newhyp=[];
-			    t_concl=concl ntree;
-			    t_full_concl=ntree.t_goal.t_full_concl;
-			    t_full_env=ntree.t_goal.t_full_env};
-		  t_proof= Proof (TacAtom (dummy_loc,TacExtend (dummy_loc,"InfoAuto",[])), [ntree])}
-	      else ntree
-	  | _ -> ntree))
+	       Nested(Tactic (TacAtom (_, TacAuto _),_),_) ->
+		 if spfl=[]
+		 then
+	      	   {t_info="to_prove";
+	    	    t_goal= {newhyp=[];
+			     t_concl=concl ntree;
+			     t_full_concl=ntree.t_goal.t_full_concl;
+			     t_full_env=ntree.t_goal.t_full_env};
+		    t_proof= Proof (TacAtom (dummy_loc,TacExtend (dummy_loc,"InfoAuto",[])), [ntree])}
+		 else ntree
+	     | _ -> ntree))
       	else
 	  {t_info="to_prove";
 	    t_goal=(seq_to_lnhyp oldsign nsign cl);
@@ -725,7 +725,7 @@ let rec nsortrec vl x =
    | Case(_,x,t,a) 
         -> nsortrec vl x
    | Cast(x,_, t)-> nsortrec vl t
-   | Const c  -> nsortrec vl (lookup_constant c vl).const_type
+   | Const c  -> nsortrec vl (Typeops.type_of_constant vl c)
    | _ -> nsortrec vl (type_of vl Evd.empty x)
 ;;
 let nsort x =
diff --git a/contrib/interface/vtp.ml b/contrib/interface/vtp.ml
index 064d20ab..fe227f99 100644
--- a/contrib/interface/vtp.ml
+++ b/contrib/interface/vtp.ml
@@ -112,19 +112,12 @@ and fCOMMAND = function
    fFORMULA x2;
    fINT_LIST x3;
    fNODE "abstraction" 3
-| CT_add_field(x1, x2, x3, x4, x5, x6, x7, x8, x9, x10, x11) ->
+| CT_add_field(x1, x2, x3, x4) ->
    fFORMULA x1;
    fFORMULA x2;
    fFORMULA x3;
-   fFORMULA x4;
-   fFORMULA x5;
-   fFORMULA x6;
-   fFORMULA x7;
-   fFORMULA x8;
-   fFORMULA x9;
-   fFORMULA x10;
-   fBINDING_LIST x11;
-   fNODE "add_field" 11
+   fFORMULA_OPT x4;
+   fNODE "add_field" 4
 | CT_add_natural_feature(x1, x2) ->
    fNATURAL_FEATURE x1;
    fID x2;
@@ -1711,7 +1704,7 @@ and fTACTIC_COM = function
 | CT_replace_with(x1, x2,x3,x4) ->
    fFORMULA x1;
    fFORMULA x2;
-   fID_OPT x3;
+   fCLAUSE x3;
    fTACTIC_OPT x4;
    fNODE "replace_with" 4
 | CT_rewrite_lr(x1, x2, x3) ->
diff --git a/contrib/interface/xlate.ml b/contrib/interface/xlate.ml
index 024cb599..6c9e8239 100644
--- a/contrib/interface/xlate.ml
+++ b/contrib/interface/xlate.ml
@@ -497,6 +497,8 @@ let xlate_hyp_location =
   | (_, MetaId _),_ -> 
       xlate_error "MetaId not supported in xlate_hyp_location (should occur only in quotations)"
 
+
+
 let xlate_clause cls =
   let hyps_info =
     match cls.onhyps with
@@ -724,7 +726,9 @@ and (xlate_call_or_tacarg:raw_tactic_arg -> ct_TACTIC_COM) =
     | Reference (Ident (_,s)) -> ident_tac s
     | ConstrMayEval(ConstrTerm a) ->
 	CT_formula_marker(xlate_formula a)
-    | TacFreshId s -> CT_fresh(ctf_STRING_OPT s)
+    | TacFreshId [] -> CT_fresh(ctf_STRING_OPT None)
+    | TacFreshId [ArgArg s] -> CT_fresh(ctf_STRING_OPT (Some s))
+    | TacFreshId _ -> xlate_error "TODO: fresh with many args"
     | t -> xlate_error "TODO LATER: result other than tactic or constr"
 
 and xlate_red_tactic =
@@ -937,6 +941,8 @@ and xlate_tac =
      CT_injection_eq
          (xlate_quantified_hypothesis_opt
 	    (out_gen (wit_opt rawwit_quant_hyp) idopt))
+    | TacExtend (_,"injection_as", [idopt;ipat]) ->
+	xlate_error "TODO: injection as"
     | TacFix (idopt, n) ->
      CT_fixtactic (xlate_ident_opt idopt, CT_int n, CT_fix_tac_list [])
     | TacMutualFix (id, n, fixtac_list) ->
@@ -972,22 +978,36 @@ and xlate_tac =
     | TacRight bindl -> CT_right (xlate_bindings bindl)
     | TacSplit (false,bindl) -> CT_split (xlate_bindings bindl)
     | TacSplit (true,bindl) -> CT_exists (xlate_bindings bindl)
-    | TacExtend (_,"replace", [c1; c2;id_opt;tac_opt]) ->
+    | TacExtend (_,"replace", [c1; c2;cl;tac_opt]) ->
 	let c1 = xlate_formula (out_gen rawwit_constr c1) in
 	let c2 = xlate_formula (out_gen rawwit_constr c2) in
-	let id_opt = 
-	  match out_gen Extratactics.rawwit_in_arg_hyp id_opt with 
-	  | None -> ctv_ID_OPT_NONE
-	  | Some (_,id) ->   ctf_ID_OPT_SOME (xlate_ident id)
-	in
+	let cl = 
+	  (* J.F. : 18/08/2006 
+	     Hack to coerce the "clause" argument of replace to a real clause 
+	     To be remove if we can reuse the clause grammar entrie defined in g_tactic
+	  *)
+	  let cl_as_clause = Extraargs.raw_in_arg_hyp_to_clause (out_gen Extraargs.rawwit_in_arg_hyp cl) in 
+	  let cl_as_xlate_arg = 
+	    {cl_as_clause with 
+	       Tacexpr.onhyps = 
+		option_map 
+		  (fun l -> 
+		     List.map (fun ((l,id),hyp_flag) -> ((l, Tacexpr.AI ((),id)) ,hyp_flag)) l
+		  )
+		  cl_as_clause.Tacexpr.onhyps
+	    }
+	  in
+	  cl_as_xlate_arg
+	in 
+	let cl = xlate_clause cl in 
 	let tac_opt = 
-	  match out_gen (Extratactics.rawwit_by_arg_tac) tac_opt with
+	  match out_gen (Extraargs.rawwit_by_arg_tac) tac_opt with
 	    | None -> CT_coerce_NONE_to_TACTIC_OPT  CT_none
 	    | Some tac ->
 		let tac =  xlate_tactic tac in
 		CT_coerce_TACTIC_COM_to_TACTIC_OPT tac
 	in 
-	CT_replace_with (c1, c2,id_opt,tac_opt)
+	CT_replace_with (c1, c2,cl,tac_opt)
     | TacRewrite(b,cbindl,cl) -> 
      let cl = xlate_clause cl 
      and c = xlate_formula (fst cbindl) 
@@ -1077,12 +1097,12 @@ and xlate_tac =
 	let first_n =
 	  match out_gen (wit_opt rawwit_int_or_var) nopt with
 	    | Some (ArgVar(_, s)) -> xlate_id_to_id_or_int_opt s
-	    | Some ArgArg n -> xlate_int_to_id_or_int_opt n
+	    | Some (ArgArg n) -> xlate_int_to_id_or_int_opt n
 	    | None -> none_in_id_or_int_opt in
 	let second_n =
 	  match out_gen (wit_opt rawwit_int_or_var) popt with
 	    | Some (ArgVar(_, s)) -> xlate_id_to_id_or_int_opt s
-	    | Some ArgArg n -> xlate_int_to_id_or_int_opt n
+	    | Some (ArgArg n) -> xlate_int_to_id_or_int_opt n
 	    | None -> none_in_id_or_int_opt in
 	let _lems =
 	  match out_gen Eauto.rawwit_auto_using lems with
@@ -1625,6 +1645,15 @@ let rec xlate_vernac =
 	CT_solve (CT_int n, xlate_tactic tac,
 		  if b then CT_dotdot
                   else CT_coerce_NONE_to_DOTDOT_OPT CT_none)
+
+(* MMode *)
+
+    | (VernacDeclProof | VernacReturn | VernacProofInstr _) -> 
+	anomaly "No MMode in CTcoq"
+
+
+(* /MMode *)
+
     | VernacFocus nopt -> CT_focus (xlate_int_opt nopt)
     | VernacUnfocus -> CT_unfocus
     |VernacExtend("Extraction", [f;l]) ->
@@ -1645,27 +1674,14 @@ let rec xlate_vernac =
 	CT_no_inline(CT_id_ne_list(loc_qualid_to_ct_ID fst,
 				List.map loc_qualid_to_ct_ID l2))
     | VernacExtend("Field", 
-		   [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl;minusdiv]) ->
+		   [fth;ainv;ainvl;div]) ->
 	(match List.map (fun v -> xlate_formula(out_gen rawwit_constr v))
-                   [a;aplus;amult;aone;azero;aopp;aeq;ainv;fth;ainvl]
+                   [fth;ainv;ainvl]
  	 with
-             [a1;aplus1;amult1;aone1;azero1;aopp1;aeq1;ainv1;fth1;ainvl1] ->
-	       let bind =
-		 match out_gen Field.rawwit_minus_div_arg minusdiv with
-		     None, None ->
-		       CT_binding_list[]
-		   | Some m, None ->
-		       CT_binding_list[
-			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m)]
-		   | None, Some d ->
-		       CT_binding_list[
-			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)]
-		   | Some m, Some d ->
-		       CT_binding_list[
-			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "minus"), xlate_formula m);
-			 CT_binding(CT_coerce_ID_to_ID_OR_INT (CT_ident "div"), xlate_formula d)] in
-		 CT_add_field(a1, aplus1, amult1, aone1, azero1, aopp1, aeq1,
-			      ainv1, fth1, ainvl1, bind)
+             [fth1;ainv1;ainvl1] ->
+	       let adiv1 =
+                 xlate_formula_opt (out_gen (wit_opt rawwit_constr) div) in
+	       CT_add_field(fth1, ainv1, ainvl1, adiv1)
 	   |_ -> assert false)
   | VernacExtend ("HintRewrite", o::f::([b]|[_;b] as args)) ->
       let orient = out_gen Extraargs.rawwit_orient o in
@@ -1768,9 +1784,10 @@ let rec xlate_vernac =
   | VernacShow ShowExistentials -> CT_show_existentials
   | VernacShow ShowScript -> CT_show_script
   | VernacShow(ShowMatch _) -> xlate_error "TODO: VernacShow(ShowMatch _)"
+  | VernacShow(ShowThesis) -> xlate_error "TODO: VernacShow(ShowThesis _)"
   | VernacGo arg -> CT_go (xlate_locn arg)
-  | VernacShow ExplainProof l -> CT_explain_proof (nums_to_int_list l)
-  | VernacShow ExplainTree l ->
+  | VernacShow (ExplainProof l) -> CT_explain_proof (nums_to_int_list l)
+  | VernacShow (ExplainTree l) ->
       CT_explain_prooftree (nums_to_int_list l)
   | VernacCheckGuard -> CT_guarded
   | VernacPrint p ->
@@ -1874,7 +1891,7 @@ let rec xlate_vernac =
          build_record_field_list field_list)
    | VernacInductive (isind, lmi) ->
       let co_or_ind = if isind then "Inductive" else "CoInductive" in
-      let strip_mutind ((_,s), notopt, parameters, c, constructors) =
+      let strip_mutind (((_,s), parameters, c, constructors), notopt) =
           CT_ind_spec
             (xlate_ident s, xlate_binder_list parameters, xlate_formula c,
              build_constructors constructors,
@@ -1883,7 +1900,7 @@ let rec xlate_vernac =
 	  (CT_co_ind co_or_ind, CT_ind_spec_list (List.map strip_mutind lmi))
    | VernacFixpoint ([],_) -> xlate_error "mutual recursive"
    | VernacFixpoint ((lm :: lmi),boxed) ->
-      let strip_mutrec ((fid, (n, ro), bl, arf, ardef), ntn) =
+      let strip_mutrec ((fid, (n, ro), bl, arf, ardef), _ntn) =
         let (struct_arg,bl,arf,ardef) =
 	 (* Pierre L: could the case [n=None && bl=[]] happen ? Normally not *)
 	 (* By the way, how could [bl = []] happen in V8 syntax ?  *)
@@ -1903,7 +1920,7 @@ let rec xlate_vernac =
 	  (CT_fix_rec_list (strip_mutrec lm, List.map strip_mutrec lmi))
    | VernacCoFixpoint ([],boxed) -> xlate_error "mutual corecursive"
    | VernacCoFixpoint ((lm :: lmi),boxed) ->
-      let strip_mutcorec (fid, bl, arf, ardef) =
+      let strip_mutcorec ((fid, bl, arf, ardef), _ntn) =
 	CT_cofix_rec (xlate_ident fid, xlate_binder_list bl,
                       xlate_formula arf, xlate_formula ardef) in
         CT_cofix_decl
diff --git a/contrib/recdef/recdef.ml4 b/contrib/recdef/recdef.ml4
index ed2e5b5f..353fcdb3 100644
--- a/contrib/recdef/recdef.ml4
+++ b/contrib/recdef/recdef.ml4
@@ -119,8 +119,7 @@ let def_of_const t =
 
 let type_of_const t =
    match (kind_of_term t) with
-    Const sp -> 
-      (Global.lookup_constant sp).const_type
+    Const sp -> Typeops.type_of_constant (Global.env()) sp
     |_ -> assert false
 
 let arg_type t =
@@ -133,7 +132,17 @@ let evaluable_of_global_reference r =
       ConstRef sp -> EvalConstRef sp
     | VarRef id -> EvalVarRef id
     | _ -> assert false;;
-  
+
+
+let rank_for_arg_list h = 
+  let predicate a b = 
+      try List.for_all2 eq_constr a b with
+        Invalid_argument _ -> false in
+  let rec rank_aux i = function
+  | [] -> None
+  | x::tl -> if predicate h x then Some i else rank_aux (i+1) tl in
+  rank_aux 0;;
+
 let rec (find_call_occs:
 	   constr -> constr -> (constr list ->constr)*(constr  list list)) =
  fun f expr ->
@@ -144,19 +153,36 @@ let rec (find_call_occs:
      let (largs: constr list) = Array.to_list args in
      let rec find_aux = function
 	 []    -> (fun x -> []), []
-       | a::tl ->
-         (match find_aux tl with
-          (cf, ((arg1::args) as opt_args)) -> 
+       | a::upper_tl ->
+         (match find_aux upper_tl with
+          (cf, ((arg1::args) as args_for_upper_tl)) -> 
            (match find_call_occs f a with
              cf2, (_ :: _ as other_args) ->
-	       let len1 = List.length other_args in
-                 (fun l ->
-                   cf2 l::(cf (nthtl(l,len1)))), other_args@opt_args
-           | _, [] -> (fun x -> a::cf x), opt_args)
+               let rec avoid_duplicates args =
+                  match args with
+                  | [] -> (fun _ -> []), []
+                  | h::tl -> 
+                      let recomb_tl, args_for_tl =
+                          avoid_duplicates tl in
+                    match rank_for_arg_list h args_for_upper_tl with
+                    | None -> 
+                        (fun l -> List.hd l::recomb_tl(List.tl l)),
+                        h::args_for_tl
+                    | Some i ->
+                        (fun l -> List.nth l (i+List.length args_for_tl)::
+                            recomb_tl l),
+                        args_for_tl
+               in
+               let recombine, other_args' =
+                   avoid_duplicates other_args in
+	       let len1 = List.length other_args' in                   
+                   (fun l -> cf2 (recombine l)::cf(nthtl(l,len1))),
+                     other_args'@args_for_upper_tl
+           | _, [] -> (fun x -> a::cf x), args_for_upper_tl)
 	 | _, [] ->
 	   (match find_call_occs f a with
-	     cf, (arg1::args) -> (fun l -> cf l::tl), (arg1::args)
-	   | _, [] -> (fun x -> a::tl), [])) in
+	     cf, (arg1::args) -> (fun l -> cf l::upper_tl), (arg1::args)
+	   | _, [] -> (fun x -> a::upper_tl), [])) in
      begin
        match (find_aux largs) with
 	   cf, [] -> (fun l -> mkApp(g, args)), []
@@ -168,7 +194,7 @@ let rec (find_call_occs:
   | Meta(_) -> error "find_call_occs : Meta"
   | Evar(_) -> error "find_call_occs : Evar"
   | Sort(_)  -> error "find_call_occs : Sort"
-  | Cast(_,_,_) -> error "find_call_occs : cast"
+  | Cast(b,_,_) -> find_call_occs f b
   | Prod(_,_,_) -> error "find_call_occs : Prod"
   | Lambda(_,_,_) -> error "find_call_occs : Lambda"
   | LetIn(_,_,_,_) -> error "find_call_occs : let in"
@@ -182,6 +208,8 @@ let rec (find_call_occs:
   | Fix(_) -> error "find_call_occs : Fix"
   | CoFix(_) -> error "find_call_occs : CoFix";;
 
+
+
 let coq_constant s =
   Coqlib.gen_constant_in_modules "RecursiveDefinition" 
     (Coqlib.init_modules @ Coqlib.arith_modules) s;;
@@ -268,8 +296,17 @@ let rec  mk_intros_and_continue (extra_eqn:bool)
 	  let teq = pf_get_new_id teq_id g in
 	    tclTHENLIST
 	      [ h_intro teq;
-		tclMAP (fun eq -> tclTRY (Equality.general_rewrite_in true teq eq)) (List.rev eqs);
-	        cont_function (mkVar teq::eqs) expr
+		tclMAP 
+		  (fun eq -> tclTRY (Equality.general_rewrite_in true teq eq)) 
+		  (List.rev eqs);
+		(fun g1 -> 
+		   let ty_teq = pf_type_of g1 (mkVar teq) in 
+		   let teq_lhs,teq_rhs = 
+		     let _,args = destApp ty_teq in 
+		     args.(1),args.(2) 
+		   in
+	           cont_function (mkVar teq::eqs) (replace_term teq_lhs teq_rhs expr) g1
+		)
 	      ]
 	      g
 	else
@@ -285,16 +322,18 @@ let simpl_iter () =
        {rBeta=true;rIota=true;rZeta= true; rDelta=false;
         rConst = [ EvalConstRef (const_of_ref (delayed_force iter_ref))]})
     onConcl
-    
+
+(* The boolean value is_mes expresses that the termination is expressed
+  using a measure function instead of a well-founded relation. *)
 let tclUSER is_mes l g = 
-  let b,l = 
+  let clear_tac = 
     match l with 
-	None -> true,[]
-      | Some l -> false,l
+      | None -> h_clear true []
+      | Some l -> tclMAP (fun id -> tclTRY (h_clear false [id])) (List.rev l)
   in
   tclTHENSEQ 
     [
-      (h_clear b l);
+      clear_tac;
       if is_mes 
       then unfold_in_concl [([], evaluable_of_global_reference (delayed_force ltof_ref))]
       else tclIDTAC
@@ -473,12 +512,17 @@ let rec introduce_all_values is_mes acc_inv func context_fn
 		 (observe_tac "acc_inv" (apply (Lazy.force acc_inv)))
 		 [ observe_tac "h_assumption" h_assumption
 		 ;
-		  observe_tac "user proof"  (fun g ->  
-					       tclUSER
-						 is_mes
-						 (Some (hrec::hspec::(retrieve_acc_var g)@specs))
-						 g
-					    )
+		  tclTHENLIST
+		    [
+		      tclTRY(list_rewrite true eqs);
+		      observe_tac "user proof" 
+			(fun g ->  
+			   tclUSER
+			     is_mes
+			     (Some (hrec::hspec::(retrieve_acc_var g)@specs))
+			     g
+			)		     
+		    ]
 		 ]
 	    )
 	   ]) g)
@@ -574,13 +618,14 @@ let hyp_terminates func =
 	     
 
 
-let tclUSER_if_not_mes is_mes = 
+let tclUSER_if_not_mes is_mes names_to_suppress = 
   if is_mes 
   then 
     tclCOMPLETE (h_apply (delayed_force well_founded_ltof,Rawterm.NoBindings))
-  else tclUSER is_mes None
+  else tclUSER is_mes names_to_suppress
 
-let start is_mes input_type ids args_id relation rec_arg_num rec_arg_id tac wf_tac : tactic = 
+let termination_proof_header is_mes input_type ids args_id relation
+    rec_arg_num rec_arg_id tac wf_tac : tactic = 
   begin 
     fun g -> 
       let nargs = List.length args_id in
@@ -596,7 +641,8 @@ let start is_mes input_type ids args_id relation rec_arg_num rec_arg_id tac wf_t
 	  (id_of_string ("Acc_"^(string_of_id rec_arg_id)))
 	  (wf_thm::ids) 
       in 
-      let hrec = next_global_ident_away true hrec_id (wf_rec_arg::wf_thm::ids) in 
+      let hrec = next_global_ident_away true hrec_id
+	(wf_rec_arg::wf_thm::ids) in 
       let acc_inv = 
 	  lazy (
 	    mkApp (
@@ -630,9 +676,9 @@ let start is_mes input_type ids args_id relation rec_arg_num rec_arg_id tac wf_t
 		  )
 	       )
 	       [ 
-		 (* interactive proof of the well_foundness of the relation *) 
-		 wf_tac is_mes;
-		 (* well_foundness -> Acc for any element *)
+		 (* interactive proof that the relation is well_founded *)
+		 observe_tac "wf_tac" (wf_tac is_mes (Some args_id));
+		 (* this gives the accessibility argument *)
 		 observe_tac 
 		   "apply wf_thm" 
 		   (h_apply ((mkApp(mkVar wf_thm,
@@ -694,7 +740,7 @@ let whole_start is_mes func input_type relation rec_arg_num  : tactic =
       in
       let rec_arg_id = List.nth n_ids (rec_arg_num - 1) in
       let expr = instantiate_lambda func_body (mkVar f_id::(List.map mkVar n_ids)) in 
-      start 
+      termination_proof_header 
 	is_mes
 	input_type
 	ids
@@ -716,7 +762,7 @@ let whole_start is_mes func input_type relation rec_arg_num  : tactic =
 	   )
 	     g 
 	)
-	tclUSER_if_not_mes
+	tclUSER_if_not_mes 
 	g 
   end
 
@@ -724,7 +770,7 @@ let whole_start is_mes func input_type relation rec_arg_num  : tactic =
 let get_current_subgoals_types () = 
   let pts =  get_pftreestate () in 
   let _,subs = extract_open_pftreestate pts in 
-  List.map snd subs 
+  List.map snd (List.sort (fun (x,_) (y,_) -> x -y )subs )
 
 
 let build_and_l l = 
@@ -745,8 +791,31 @@ let build_and_l l =
 	  ],nb+1
   in f l
 
+
+let is_rec_res id = 
+  let rec_res_name = string_of_id rec_res_id   in 
+  let id_name = string_of_id id in 
+  try 
+    String.sub id_name 0 (String.length rec_res_name) = rec_res_name 
+  with _ -> false
+
+let clear_goals = 
+  let rec clear_goal t = 
+    match kind_of_term t with 
+      | Prod(Name id as na,t,b) -> 
+	  let b' = clear_goal b in 
+	  if noccurn 1 b' && (is_rec_res id) 
+	  then pop b' 
+	  else if b' == b then t 
+	  else mkProd(na,t,b')
+      | _ -> map_constr clear_goal t
+  in 
+  List.map clear_goal 
+
+
 let build_new_goal_type () = 
   let sub_gls_types = get_current_subgoals_types () in 
+  let sub_gls_types = clear_goals sub_gls_types in 
   let res = build_and_l sub_gls_types in 
   res
   
@@ -767,7 +836,7 @@ let prove_with_tcc lemma _ : tactic =
       
 	     
 
-let open_new_goal ref goal_name (gls_type,decompose_and_tac,nb_goal)   = 
+let open_new_goal using_lemmas ref goal_name (gls_type,decompose_and_tac,nb_goal)   = 
   let current_proof_name = get_current_proof_name () in
   let name = match goal_name with 
     | Some s -> s 
@@ -782,7 +851,11 @@ let open_new_goal ref goal_name (gls_type,decompose_and_tac,nb_goal)   =
     Util.error "\"abstract\" cannot handle existentials";
   let hook _ _ = 
     let lemma = mkConst (Lib.make_con na) in 
-    Array.iteri (fun i _ -> by (observe_tac "tac" (prove_with_tcc lemma i))) (Array.make nb_goal ());
+    Array.iteri 
+      (fun i _ -> 
+	 by (observe_tac ("reusing lemma "^(string_of_id na)) (prove_with_tcc lemma i)))
+      (Array.make nb_goal ())
+    ;
     ref := Some lemma ;
     defined ();
   in
@@ -792,8 +865,28 @@ let open_new_goal ref goal_name (gls_type,decompose_and_tac,nb_goal)   =
     sign
     gls_type 
     hook ;
-  by (decompose_and_tac);
-  if Options.is_verbose () then (pp (Printer.pr_open_subgoals()))
+  by (
+    fun g -> 
+      tclTHEN 
+	(decompose_and_tac)
+	(tclORELSE 
+	(tclFIRST 
+	   (List.map
+	      (fun c -> 
+		 tclTHENSEQ
+		   [intros; 
+		    h_apply (interp_constr Evd.empty (Global.env()) c,Rawterm.NoBindings); 
+		    tclCOMPLETE Auto.default_auto
+		   ]
+	      )
+	      using_lemmas)
+	) tclIDTAC)
+	g);
+  try
+    by tclIDTAC; (* raises UserError _ if the proof is complete *)
+    if Options.is_verbose () then (pp (Printer.pr_open_subgoals()))
+  with UserError _ -> 
+    defined ()
   
     
 let com_terminate 
@@ -804,7 +897,7 @@ let com_terminate
     input_type
     relation 
     rec_arg_num
-    thm_name hook =
+    thm_name using_lemmas hook =
   let (evmap, env) = Command.get_current_context() in
   start_proof thm_name
     (Global, Proof Lemma) (Environ.named_context_val env)
@@ -813,7 +906,7 @@ let com_terminate
 				       input_type relation rec_arg_num ));
   try 
     let new_goal_type = build_new_goal_type () in 
-    open_new_goal tcc_lemma_ref
+    open_new_goal using_lemmas tcc_lemma_ref
       (Some tcc_lemma_name)
       (new_goal_type)
   with Failure "empty list of subgoals!" -> 
@@ -895,9 +988,9 @@ let start_equation (f:global_reference) (term_f:global_reference)
   in
   tclTHENLIST [
     h_intros x;
-    unfold_constr f;
-    simplest_case (mkApp (terminate_constr, Array.of_list (List.map mkVar x)));
-    cont_tactic x] g
+    observe_tac "unfold_constr f" (unfold_constr f);
+    observe_tac "simplest_case" (simplest_case (mkApp (terminate_constr, Array.of_list (List.map mkVar x))));
+    observe_tac "prove_eq" (cont_tactic x)] g
 ;;
 
 let base_leaf_eq func eqs f_id g =
@@ -1021,8 +1114,8 @@ let rec prove_eq  (termine:constr) (f:constr)(functional:global_reference)
 	     _,[] -> 
 	       tclTHENS(mkCaseEq a)(* (simplest_case a) *)
 	  	 (List.map
-		    (mk_intros_and_continue true
-		       (prove_eq  termine f functional) eqs)
+		    (fun expr -> observe_tac "mk_intros_and_continue" (mk_intros_and_continue true
+		       (prove_eq  termine f functional) eqs expr))
 		    (Array.to_list l))
 	   | _,_::_ ->
                	(match find_call_occs f expr with
@@ -1045,13 +1138,13 @@ let rec prove_eq  (termine:constr) (f:constr)(functional:global_reference)
 
 let (com_eqn : identifier ->
        global_reference -> global_reference -> global_reference
-	 -> constr_expr -> unit) =
-  fun eq_name functional_ref f_ref terminate_ref eq ->
+	 -> constr -> unit) =
+  fun eq_name functional_ref f_ref terminate_ref equation_lemma_type ->
     let (evmap, env) = Command.get_current_context() in
-    let eq_constr = interp_constr evmap env eq in
     let f_constr = (constr_of_reference f_ref) in
+    let equation_lemma_type = subst1 f_constr equation_lemma_type in
     (start_proof eq_name (Global, Proof Lemma)
-       (Environ.named_context_val env) eq_constr (fun _ _ -> ());
+       (Environ.named_context_val env) equation_lemma_type (fun _ _ -> ());
      by
        (start_equation f_ref terminate_ref
 	  (fun x ->
@@ -1066,22 +1159,25 @@ let (com_eqn : identifier ->
 	       )
 	  )
        );
-     defined (); 
+     Options.silently defined (); 
     );;
 
 
-let recursive_definition is_mes function_name type_of_f r rec_arg_num eq 
-    generate_induction_principle : unit =
+let recursive_definition is_mes function_name rec_impls type_of_f r rec_arg_num eq 
+    generate_induction_principle using_lemmas : unit =
   let function_type = interp_constr Evd.empty (Global.env()) type_of_f in
-  let env = push_rel (Name function_name,None,function_type) (Global.env()) in
-  let res_vars,eq' = decompose_prod (interp_constr Evd.empty env eq) in 
+  let env = push_named (function_name,None,function_type) (Global.env()) in
+(*   Pp.msgnl (str "function type := " ++ Printer.pr_lconstr function_type); *)
+  let equation_lemma_type = interp_gen (OfType None) Evd.empty env ~impls:([],rec_impls) eq in 
+(*   Pp.msgnl (Printer.pr_lconstr equation_lemma_type); *)
+  let res_vars,eq' = decompose_prod equation_lemma_type in 
   let res = 
 (*     Pp.msgnl (str "res_var :=" ++ Printer.pr_lconstr_env (push_rel_context (List.map (function (x,t) -> (x,None,t)) res_vars) env) eq'); *)
 (*     Pp.msgnl (str "rec_arg_num := " ++ str (string_of_int rec_arg_num)); *)
 (*     Pp.msgnl (str "eq' := " ++ str (string_of_int rec_arg_num)); *)
     match kind_of_term eq' with 
       | App(e,[|_;_;eq_fix|]) -> 
-	  mkLambda (Name function_name,function_type,compose_lam res_vars eq_fix)
+	  mkLambda (Name function_name,function_type,subst_var function_name (compose_lam res_vars  eq_fix))
       | _ -> failwith "Recursive Definition (res not eq)"
   in
   let pre_rec_args,function_type_before_rec_arg = decompose_prod_n (rec_arg_num - 1) function_type in 
@@ -1106,9 +1202,11 @@ let recursive_definition is_mes function_name type_of_f r rec_arg_num eq
     let f_ref = declare_f function_name (IsProof Lemma) arg_types term_ref in
 (*     message "start second proof"; *)
     begin 
-      try com_eqn equation_id functional_ref f_ref term_ref eq
+      try com_eqn equation_id functional_ref f_ref term_ref (subst_var function_name equation_lemma_type)
       with e -> 
 	begin 
+	  if Tacinterp.get_debug () <> Tactic_debug.DebugOff
+	  then anomalylabstrm "" (str "Cannot create equation Lemma " ++ Cerrors.explain_exn e);
 	  ignore(try Vernacentries.vernac_reset_name (Util.dummy_loc,functional_id) with _ -> ());
 	  anomaly "Cannot create equation Lemma"
 	end
@@ -1134,6 +1232,7 @@ let recursive_definition is_mes function_name type_of_f r rec_arg_num eq
       rec_arg_type
       relation rec_arg_num
       term_id
+      using_lemmas
       hook 
   with e -> 
     begin
@@ -1154,10 +1253,10 @@ VERNAC COMMAND EXTEND RecursiveDefinition
 	| None -> 1
 	| Some n -> n 
     in
-    recursive_definition false f type_of_f r rec_arg_num eq (fun _ _ _ _ _  _ _ _ -> ())]
+    recursive_definition false f [] type_of_f r rec_arg_num eq (fun _ _ _ _ _  _ _ _ -> ()) []]
 | [ "Recursive" "Definition" ident(f) constr(type_of_f) constr(r) constr(wf)
      "[" ne_constr_list(proof) "]" constr(eq) ] ->
-  [ ignore(proof);ignore(wf);recursive_definition false f type_of_f r 1 eq  (fun  _ _  _ _ _ _ _ _ -> ())]
+  [ ignore(proof);ignore(wf);recursive_definition false f [] type_of_f r 1 eq  (fun  _ _  _ _ _ _ _ _ -> ()) []]
 END
 
 
diff --git a/contrib/ring/ArithRing.v b/contrib/ring/LegacyArithRing.v
index 68464c10..e062b731 100644
--- a/contrib/ring/ArithRing.v
+++ b/contrib/ring/LegacyArithRing.v
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: LegacyArithRing.v 9179 2006-09-26 12:13:06Z barras $ *)
 
 (* Instantiation of the Ring tactic for the naturals of Arith $*)
 
-Require Export Ring.
+Require Import Bool.
+Require Export LegacyRing.
 Require Export Arith.
 Require Import Eqdep_dec.
 
@@ -36,12 +37,12 @@ Hint Resolve nateq_prop: arithring.
 
 Definition NatTheory : Semi_Ring_Theory plus mult 1 0 nateq.
   split; intros; auto with arith arithring.
-  apply (fun n m p:nat => plus_reg_l m p n) with (n := n).
-  trivial.
+(*  apply (fun n m p:nat => plus_reg_l m p n) with (n := n).
+  trivial.*)
 Defined.
 
 
-Add Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ].
+Add Legacy Semi Ring nat plus mult 1 0 nateq NatTheory [ 0 S ].
 
 Goal forall n:nat, S n = 1 + n.
 intro; reflexivity.
diff --git a/contrib/ring/NArithRing.v b/contrib/ring/LegacyNArithRing.v
index 878346ba..c689fc40 100644
--- a/contrib/ring/NArithRing.v
+++ b/contrib/ring/LegacyNArithRing.v
@@ -6,11 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: LegacyNArithRing.v 9179 2006-09-26 12:13:06Z barras $ *)
 
 (* Instantiation of the Ring tactic for the binary natural numbers *)
 
-Require Export Ring.
+Require Import Bool.
+Require Export LegacyRing.
 Require Export ZArith_base.
 Require Import NArith.
 Require Import Eqdep_dec.
@@ -37,8 +38,9 @@ Definition NTheory : Semi_Ring_Theory Nplus Nmult 1%N 0%N Neq.
     apply Nmult_1_l.
     apply Nmult_0_l.
     apply Nmult_plus_distr_r.
-    apply Nplus_reg_l.
+(*    apply Nplus_reg_l.*)
     apply Neq_prop.
 Qed.
 
-Add Semi Ring N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
+Add Legacy Semi Ring
+  N Nplus Nmult 1%N 0%N Neq NTheory [ Npos 0%N xO xI 1%positive ].
diff --git a/contrib/ring/Ring.v b/contrib/ring/LegacyRing.v
index 6572e79a..dc8635bd 100644
--- a/contrib/ring/Ring.v
+++ b/contrib/ring/LegacyRing.v
@@ -9,7 +9,7 @@
 (* $Id: Ring.v 5920 2004-07-16 20:01:26Z herbelin $ *)
 
 Require Export Bool.
-Require Export Ring_theory.
+Require Export LegacyRing_theory.
 Require Export Quote.
 Require Export Ring_normalize.
 Require Export Ring_abstract.
@@ -32,5 +32,5 @@ destruct n; destruct m; destruct p; reflexivity.
 destruct x; destruct y; reflexivity || simpl in |- *; tauto.
 Defined.
 
-Add Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory
- [ true false ].
\ No newline at end of file
+Add Legacy Ring bool xorb andb true false (fun b:bool => b) eqb BoolTheory
+ [ true false ].
diff --git a/contrib/ring/Ring_theory.v b/contrib/ring/LegacyRing_theory.v
index 5536294e..5df927a6 100644
--- a/contrib/ring/Ring_theory.v
+++ b/contrib/ring/LegacyRing_theory.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_theory.v 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: LegacyRing_theory.v 9179 2006-09-26 12:13:06Z barras $ *)
 
 Require Export Bool.
 
@@ -39,7 +39,7 @@ Record Semi_Ring_Theory : Prop :=
    SR_mult_one_left : forall n:A, 1 * n = n;
    SR_mult_zero_left : forall n:A, 0 * n = 0;
    SR_distr_left : forall n m p:A, (n + m) * p = n * p + m * p;
-   SR_plus_reg_left : forall n m p:A, n + m = n + p -> m = p;
+(*   SR_plus_reg_left : forall n m p:A, n + m = n + p -> m = p;*)
    SR_eq_prop : forall x y:A, Is_true (Aeq x y) -> x = y}.
 
 Variable T : Semi_Ring_Theory.
@@ -52,10 +52,10 @@ Let plus_zero_left := SR_plus_zero_left T.
 Let mult_one_left := SR_mult_one_left T. 
 Let mult_zero_left := SR_mult_zero_left T.
 Let distr_left := SR_distr_left T.
-Let plus_reg_left := SR_plus_reg_left T.
+(*Let plus_reg_left := SR_plus_reg_left T.*)
 
 Hint Resolve plus_comm plus_assoc mult_comm mult_assoc plus_zero_left
-  mult_one_left mult_zero_left distr_left plus_reg_left.
+  mult_one_left mult_zero_left distr_left (*plus_reg_left*).
 
 (* Lemmas whose form is x=y are also provided in form y=x because Auto does
   not symmetry *) 
@@ -126,11 +126,11 @@ Qed.
 Lemma SR_mult_one_right2 : forall n:A, n = n * 1.
 intro; elim mult_comm; auto.
 Qed.
-
+(*
 Lemma SR_plus_reg_right : forall n m p:A, m + n = p + n -> m = p.
 intros n m p; rewrite (plus_comm m n); rewrite (plus_comm p n); eauto.
 Qed.
-
+*)
 End Theory_of_semi_rings.
 
 Section Theory_of_rings.
@@ -320,7 +320,7 @@ symmetry  in |- *; apply Th_mult_opp_opp. Qed.
 Lemma Th_opp_zero : - 0 = 0.
 rewrite <- (plus_zero_left (- 0)).
 auto. Qed.
-
+(*
 Lemma Th_plus_reg_left : forall n m p:A, n + m = n + p -> m = p.
 intros; generalize (f_equal (fun z => - n + z) H).
 repeat rewrite plus_assoc.
@@ -336,7 +336,7 @@ rewrite (plus_comm n m).
 rewrite (plus_comm n p).
 auto.
 Qed.
-
+*)
 Lemma Th_distr_right : forall n m p:A, n * (m + p) = n * m + n * p.
 intros.
 repeat rewrite (mult_comm n).
@@ -349,7 +349,7 @@ Qed.
 
 End Theory_of_rings.
 
-Hint Resolve Th_mult_zero_left Th_plus_reg_left: core.
+Hint Resolve Th_mult_zero_left (*Th_plus_reg_left*): core.
 
 Unset Implicit Arguments.
 
@@ -373,4 +373,4 @@ End product_ring.
 
 Section power_ring.
 
-End power_ring.
\ No newline at end of file
+End power_ring.
diff --git a/contrib/ring/ZArithRing.v b/contrib/ring/LegacyZArithRing.v
index 3999b632..a410fbc5 100644
--- a/contrib/ring/ZArithRing.v
+++ b/contrib/ring/LegacyZArithRing.v
@@ -6,13 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ZArithRing.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: LegacyZArithRing.v 9181 2006-09-26 16:38:33Z barras $ *)
 
 (* Instantiation of the Ring tactic for the binary integers of ZArith *)
 
-Require Export ArithRing.
+Require Export LegacyArithRing.
 Require Export ZArith_base.
 Require Import Eqdep_dec.
+Require Import LegacyRing.
 
 Unboxed Definition Zeq (x y:Z) :=
   match (x ?= y)%Z with
@@ -32,5 +33,5 @@ Definition ZTheory : Ring_Theory Zplus Zmult 1%Z 0%Z Zopp Zeq.
 Qed.
 
 (* NatConstants and NatTheory are defined in Ring_theory.v *)
-Add Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory
+Add Legacy Ring Z Zplus Zmult 1%Z 0%Z Zopp Zeq ZTheory
  [ Zpos Zneg 0%Z xO xI 1%positive ].
diff --git a/contrib/ring/Ring_abstract.v b/contrib/ring/Ring_abstract.v
index c0818da8..115ed5ca 100644
--- a/contrib/ring/Ring_abstract.v
+++ b/contrib/ring/Ring_abstract.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_abstract.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: Ring_abstract.v 9179 2006-09-26 12:13:06Z barras $ *)
 
-Require Import Ring_theory.
+Require Import LegacyRing_theory.
 Require Import Quote.
 Require Import Ring_normalize.
 
@@ -129,7 +129,7 @@ Hint Resolve (SR_mult_zero_left T).
 Hint Resolve (SR_mult_zero_left2 T).
 Hint Resolve (SR_distr_left T).
 Hint Resolve (SR_distr_left2 T).
-Hint Resolve (SR_plus_reg_left T).
+(*Hint Resolve (SR_plus_reg_left T).*)
 Hint Resolve (SR_plus_permute T).
 Hint Resolve (SR_mult_permute T).
 Hint Resolve (SR_distr_right T).
@@ -140,7 +140,7 @@ Hint Resolve (SR_plus_zero_right T).
 Hint Resolve (SR_plus_zero_right2 T).
 Hint Resolve (SR_mult_one_right T).
 Hint Resolve (SR_mult_one_right2 T).
-Hint Resolve (SR_plus_reg_right T).
+(*Hint Resolve (SR_plus_reg_right T).*)
 Hint Resolve refl_equal sym_equal trans_equal.
 (*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
 Hint Immediate T.
@@ -439,7 +439,7 @@ Hint Resolve (Th_mult_zero_left T).
 Hint Resolve (Th_mult_zero_left2 T).
 Hint Resolve (Th_distr_left T).
 Hint Resolve (Th_distr_left2 T).
-Hint Resolve (Th_plus_reg_left T).
+(*Hint Resolve (Th_plus_reg_left T).*)
 Hint Resolve (Th_plus_permute T).
 Hint Resolve (Th_mult_permute T).
 Hint Resolve (Th_distr_right T).
@@ -449,7 +449,7 @@ Hint Resolve (Th_plus_zero_right T).
 Hint Resolve (Th_plus_zero_right2 T).
 Hint Resolve (Th_mult_one_right T).
 Hint Resolve (Th_mult_one_right2 T).
-Hint Resolve (Th_plus_reg_right T).
+(*Hint Resolve (Th_plus_reg_right T).*)
 Hint Resolve refl_equal sym_equal trans_equal.
 (*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
 Hint Immediate T.
diff --git a/contrib/ring/Ring_normalize.v b/contrib/ring/Ring_normalize.v
index 7b40328a..4a082396 100644
--- a/contrib/ring/Ring_normalize.v
+++ b/contrib/ring/Ring_normalize.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ring_normalize.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: Ring_normalize.v 9179 2006-09-26 12:13:06Z barras $ *)
 
-Require Import Ring_theory.
+Require Import LegacyRing_theory.
 Require Import Quote.
 
 Set Implicit Arguments.
@@ -356,7 +356,7 @@ Hint Resolve (SR_mult_zero_left T).
 Hint Resolve (SR_mult_zero_left2 T).
 Hint Resolve (SR_distr_left T).
 Hint Resolve (SR_distr_left2 T).
-Hint Resolve (SR_plus_reg_left T).
+(*Hint Resolve (SR_plus_reg_left T).*)
 Hint Resolve (SR_plus_permute T).
 Hint Resolve (SR_mult_permute T).
 Hint Resolve (SR_distr_right T).
@@ -367,7 +367,7 @@ Hint Resolve (SR_plus_zero_right T).
 Hint Resolve (SR_plus_zero_right2 T).
 Hint Resolve (SR_mult_one_right T).
 Hint Resolve (SR_mult_one_right2 T).
-Hint Resolve (SR_plus_reg_right T).
+(*Hint Resolve (SR_plus_reg_right T).*)
 Hint Resolve refl_equal sym_equal trans_equal.
 (* Hints Resolve refl_eqT sym_eqT trans_eqT. *)
 Hint Immediate T.
@@ -785,7 +785,7 @@ Hint Resolve (Th_mult_zero_left T).
 Hint Resolve (Th_mult_zero_left2 T).
 Hint Resolve (Th_distr_left T).
 Hint Resolve (Th_distr_left2 T).
-Hint Resolve (Th_plus_reg_left T).
+(*Hint Resolve (Th_plus_reg_left T).*)
 Hint Resolve (Th_plus_permute T).
 Hint Resolve (Th_mult_permute T).
 Hint Resolve (Th_distr_right T).
@@ -796,7 +796,7 @@ Hint Resolve (Th_plus_zero_right T).
 Hint Resolve (Th_plus_zero_right2 T).
 Hint Resolve (Th_mult_one_right T).
 Hint Resolve (Th_mult_one_right2 T).
-Hint Resolve (Th_plus_reg_right T).
+(*Hint Resolve (Th_plus_reg_right T).*)
 Hint Resolve refl_equal sym_equal trans_equal.
 (*Hints Resolve refl_eqT sym_eqT trans_eqT.*)
 Hint Immediate T.
diff --git a/contrib/ring/g_ring.ml4 b/contrib/ring/g_ring.ml4
index dccd1944..2f964988 100644
--- a/contrib/ring/g_ring.ml4
+++ b/contrib/ring/g_ring.ml4
@@ -8,13 +8,14 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: g_ring.ml4 7734 2005-12-26 14:06:51Z herbelin $ *)
+(* $Id: g_ring.ml4 9178 2006-09-26 11:18:22Z barras $ *)
 
 open Quote
 open Ring
+open Tacticals
 
 TACTIC EXTEND ring
-  [ "ring" constr_list(l) ] -> [ polynom l ]
+| [ "legacy" "ring" constr_list(l) ] -> [ polynom l ]
 END
 
 (* The vernac commands "Add Ring" and co *)
@@ -23,7 +24,7 @@ let cset_of_constrarg_list l =
   List.fold_right ConstrSet.add (List.map constr_of l) ConstrSet.empty
 
 VERNAC COMMAND EXTEND AddRing
-  [ "Add" "Ring" 
+  [ "Add" "Legacy" "Ring" 
           constr(a) constr(aplus) constr(amult) constr(aone) constr(azero)
           constr(aopp) constr(aeq) constr(t) "[" ne_constr_list(l) "]" ] 
   -> [ add_theory true false false
@@ -40,7 +41,7 @@ VERNAC COMMAND EXTEND AddRing
 			 (constr_of t)
 			 (cset_of_constrarg_list l) ]
 
-| [ "Add" "Semi" "Ring" 
+| [ "Add" "Legacy" "Semi" "Ring" 
       	  constr(a) constr(aplus) constr(amult) constr(aone) constr(azero)
           constr(aeq) constr(t) "[" ne_constr_list(l) "]" ] 
   -> [ add_theory false false false
@@ -57,7 +58,7 @@ VERNAC COMMAND EXTEND AddRing
 			 (constr_of t)
 			 (cset_of_constrarg_list l) ]
 
-| [ "Add" "Abstract" "Ring" 
+| [ "Add" "Legacy" "Abstract" "Ring" 
     	  constr(a) constr(aplus) constr(amult) constr(aone)
           constr(azero) constr(aopp) constr(aeq) constr(t) ] 
   -> [ add_theory true true false
@@ -74,7 +75,7 @@ VERNAC COMMAND EXTEND AddRing
 			 (constr_of t)
 			 ConstrSet.empty ]
 
-| [ "Add" "Abstract" "Semi" "Ring" 
+| [ "Add" "Legacy" "Abstract" "Semi" "Ring" 
           constr(a) constr(aplus) constr(amult) constr(aone)
           constr(azero) constr(aeq) constr(t) ] 
   -> [ add_theory false true false
@@ -91,7 +92,7 @@ VERNAC COMMAND EXTEND AddRing
 			 (constr_of t)
 			 ConstrSet.empty ]
 
-| [ "Add" "Setoid" "Ring"
+| [ "Add" "Legacy" "Setoid" "Ring"
       	  constr(a) constr(aequiv) constr(asetth) constr(aplus) constr(amult) 
 	  constr(aone) constr(azero) constr(aopp) constr(aeq) constr(pm)
 	  constr(mm) constr(om) constr(t) "[" ne_constr_list(l) "]" ] 
@@ -112,7 +113,7 @@ VERNAC COMMAND EXTEND AddRing
 			 (constr_of t)
 			 (cset_of_constrarg_list l) ]
 
-| [ "Add" "Semi" "Setoid" "Ring" 
+| [ "Add" "Legacy" "Semi" "Setoid" "Ring" 
           constr(a) constr(aequiv) constr(asetth) constr(aplus)
 	  constr(amult) constr(aone) constr(azero) constr(aeq) 
           constr(pm) constr(mm) constr(t) "[" ne_constr_list(l) "]" ] 
diff --git a/contrib/ring/quote.ml b/contrib/ring/quote.ml
index 462e5ed8..e0a6cba3 100644
--- a/contrib/ring/quote.ml
+++ b/contrib/ring/quote.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: quote.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+(* $Id: quote.ml 9178 2006-09-26 11:18:22Z barras $ *)
 
 (* The `Quote' tactic *)
 
@@ -298,7 +298,7 @@ let rec closed_under cset t =
   (ConstrSet.mem t cset) or
   (match (kind_of_term t) with
      | Cast(c,_,_) -> closed_under cset c  
-     | App(f,l) -> closed_under cset f & array_for_all (closed_under cset) l
+     | App(f,l) -> closed_under cset f && array_for_all (closed_under cset) l
      | _ -> false)
     
 (*s [btree_of_array [| c1; c2; c3; c4; c5 |]] builds the complete
diff --git a/contrib/ring/ring.ml b/contrib/ring/ring.ml
index 5251dcc5..6b82b75b 100644
--- a/contrib/ring/ring.ml
+++ b/contrib/ring/ring.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ring.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
+(* $Id: ring.ml 9179 2006-09-26 12:13:06Z barras $ *)
 
 (* ML part of the Ring tactic *)
 
@@ -43,7 +43,7 @@ let ring_dir = ["Coq";"ring"]
 let setoids_dir = ["Coq";"Setoids"]
 
 let ring_constant = Coqlib.gen_constant_in_modules "Ring"
-  [ring_dir@["Ring_theory"];
+  [ring_dir@["LegacyRing_theory"];
    ring_dir@["Setoid_ring_theory"];
    ring_dir@["Ring_normalize"];
    ring_dir@["Ring_abstract"];
@@ -885,7 +885,7 @@ let match_with_equiv c = match (kind_of_term c) with
   | _ -> None
 
 let polynom lc gl =
-  Coqlib.check_required_library ["Coq";"ring";"Ring"];
+  Coqlib.check_required_library ["Coq";"ring";"LegacyRing"];
   match lc with 
    (* If no argument is given, try to recognize either an equality or
       a declared relation with arguments c1 ... cn, 
diff --git a/contrib/rtauto/refl_tauto.ml b/contrib/rtauto/refl_tauto.ml
index 445dead2..a1f5e5aa 100644
--- a/contrib/rtauto/refl_tauto.ml
+++ b/contrib/rtauto/refl_tauto.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: refl_tauto.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+(* $Id: refl_tauto.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 module Search = Explore.Make(Proof_search)
 
@@ -303,7 +303,6 @@ let rtauto_tac gls=
     end in
   let build_start_time=System.get_time () in
   let _ = step_count := 0; node_count := 0 in
-  let nhyps = List.length hyps in
   let main = mkApp (force node_count l_Reflect,
 		    [|build_env gamma;
 		      build_form formula;
diff --git a/contrib/setoid_ring/ArithRing.v b/contrib/setoid_ring/ArithRing.v
new file mode 100644
index 00000000..5060bc69
--- /dev/null
+++ b/contrib/setoid_ring/ArithRing.v
@@ -0,0 +1,70 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Import Mult.
+Require Export Ring.
+Set Implicit Arguments.
+
+Ltac isnatcst t :=
+  let t := eval hnf in t in
+  match t with
+    O => true
+  | S ?p => isnatcst p
+  | _ => false
+  end.
+Ltac natcst t :=
+  match isnatcst t with
+    true => t
+  | _ => NotConstant
+  end.
+
+Ltac Ss_to_add f acc :=
+  match f with
+  | S ?f1 => Ss_to_add f1 (S acc)
+  | _ => constr:(acc + f)%nat
+  end.
+
+Ltac natprering :=
+  match goal with
+    |- context C [S ?p] =>
+    match p with
+      O => fail 1 (* avoid replacing 1 with 1+0 ! *)
+    | p => match isnatcst p with 
+           | true => fail 1
+           | false => let v := Ss_to_add p (S 0) in
+                         fold v; natprering
+           end
+    end
+  | _ => idtac
+  end.
+
+ Lemma natSRth : semi_ring_theory O (S O) plus mult (@eq nat).
+ Proof.
+  constructor. exact plus_0_l. exact plus_comm. exact plus_assoc.
+  exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc.
+  exact mult_plus_distr_r. 
+ Qed.
+
+
+Unboxed Fixpoint nateq (n m:nat) {struct m} : bool :=
+  match n, m with
+  | O, O => true
+  | S n', S m' => nateq n' m'
+  | _, _ => false
+  end.
+
+Lemma nateq_ok : forall n m:nat, nateq n m = true -> n = m.
+Proof.
+  simple induction n; simple induction m; simpl; intros; try discriminate.
+  trivial.
+  rewrite (H n1 H1).
+  trivial.
+Qed.
+
+Add Ring natr : natSRth
+  (decidable nateq_ok, constants [natcst], preprocess [natprering]).
diff --git a/contrib/setoid_ring/BinList.v b/contrib/setoid_ring/BinList.v
index 0def087f..0d0fe5a4 100644
--- a/contrib/setoid_ring/BinList.v
+++ b/contrib/setoid_ring/BinList.v
@@ -1,46 +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        *)
+(************************************************************************)
+
 Set Implicit Arguments.
 Require Import BinPos.
+Require Export List.
+Require Export ListTactics.
 Open Scope positive_scope.
 
+Section MakeBinList.
+ Variable A : Type.
+ Variable default : A.
 
-Section LIST.
-
- Variable A:Type.
- Variable default:A.
-
- Inductive list : Type :=
-  | nil : list
-  | cons : A -> list -> list.
-  
- Infix "::" := cons (at level 60, right associativity).
-
- Definition hd l := match l with hd :: _ => hd | _ => default end. 
-
- Definition tl l := match l with _ :: tl => tl | _ => nil end. 
-
- Fixpoint jump (p:positive) (l:list) {struct p} : list :=
+ Fixpoint jump (p:positive) (l:list A) {struct p} : list A :=
   match p with
-  | xH => tl l
+  | xH => tail l
   | xO p => jump p (jump p l)
-  | xI p  => jump p (jump p (tl l))
+  | xI p  => jump p (jump p (tail l))
   end.
 
- Fixpoint nth (p:positive) (l:list) {struct p} : A:=
+ Fixpoint nth (p:positive) (l:list A) {struct p} : A:=
   match p with
-  | xH => hd l
+  | xH => hd default l
   | xO p => nth p (jump p l)
-  | xI p => nth p (jump p (tl l))
+  | xI p => nth p (jump p (tail l))
   end. 
 
- Fixpoint rev_append (rev l : list) {struct l} : list :=
-  match l with
-  | nil => rev
-  | (cons h t) => rev_append (cons h rev) t 
-  end.
- 
- Definition rev l : list := rev_append nil l.
-
- Lemma jump_tl : forall j l, tl (jump j l) = jump j (tl l).
+ Lemma jump_tl : forall j l, tail (jump j l) = jump j (tail l).
  Proof. 
   induction j;simpl;intros.
   repeat rewrite IHj;trivial.
@@ -71,7 +61,7 @@ Section LIST.
  Qed.
 
  Lemma jump_Pdouble_minus_one : forall i l,
-  (jump (Pdouble_minus_one i) (tl l)) = (jump i (jump i l)).
+  (jump (Pdouble_minus_one i) (tail l)) = (jump i (jump i l)).
  Proof.
   induction i;intros;simpl.
   repeat rewrite jump_tl;trivial.
@@ -80,7 +70,7 @@ Section LIST.
  Qed.
 
  
- Lemma nth_jump : forall p l, nth p (tl l) = hd (jump p l).
+ Lemma nth_jump : forall p l, nth p (tail l) = hd default (jump p l).
  Proof.
   induction p;simpl;intros.
   rewrite <-jump_tl;rewrite IHp;trivial.
@@ -89,7 +79,7 @@ Section LIST.
  Qed.
 
  Lemma nth_Pdouble_minus_one :
-  forall p l, nth (Pdouble_minus_one p) (tl l) = nth p (jump p l).
+  forall p l, nth (Pdouble_minus_one p) (tail l) = nth p (jump p l).
  Proof.
   induction p;simpl;intros.
   repeat rewrite jump_tl;trivial.
@@ -98,4 +88,4 @@ Section LIST.
   trivial.
  Qed.
 
-End LIST.
+End MakeBinList.
diff --git a/contrib/setoid_ring/Field.v b/contrib/setoid_ring/Field.v
new file mode 100644
index 00000000..a944ba5f
--- /dev/null
+++ b/contrib/setoid_ring/Field.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        *)
+(************************************************************************)
+
+Require Export Field_theory.
+Require Export Field_tac.
diff --git a/contrib/setoid_ring/Field_tac.v b/contrib/setoid_ring/Field_tac.v
new file mode 100644
index 00000000..786654ab
--- /dev/null
+++ b/contrib/setoid_ring/Field_tac.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        *)
+(************************************************************************)
+
+Require Import Ring_tac BinList Ring_polynom InitialRing.
+Require Export Field_theory.
+
+ (* syntaxification *)
+ Ltac mkFieldexpr C Cst radd rmul rsub ropp rdiv rinv t fv := 
+ let rec mkP t :=
+    match Cst t with
+    | Ring_tac.NotConstant =>
+        match t with 
+        | (radd ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(FEadd e1 e2)
+        | (rmul ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(FEmul e1 e2)
+        | (rsub ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(FEsub e1 e2)
+        | (ropp ?t1) =>
+          let e1 := mkP t1 in constr:(FEopp e1)
+        | (rdiv ?t1 ?t2) => 
+          let e1 := mkP t1 in
+          let e2 := mkP t2 in constr:(FEdiv e1 e2)
+        | (rinv ?t1) =>
+          let e1 := mkP t1 in constr:(FEinv e1)
+        | _ =>
+          let p := Find_at t fv in constr:(@FEX C p)
+        end
+    | ?c => constr:(FEc c)
+    end
+ in mkP t.
+
+Ltac FFV Cst add mul sub opp div inv t fv :=
+ let rec TFV t fv :=
+  match Cst t with
+  | Ring_tac.NotConstant =>
+      match t with
+      | (add ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
+      | (mul ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
+      | (sub ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
+      | (opp ?t1) => TFV t1 fv
+      | (div ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
+      | (inv ?t1) => TFV t1 fv
+      | _ => AddFvTail t fv
+      end
+  | _ => fv
+  end 
+ in TFV t fv.
+
+Ltac ParseFieldComponents lemma req :=
+  match type of lemma with
+  | context [@FEeval ?R ?rO ?add ?mul ?sub ?opp ?div ?inv ?C ?phi _ _] =>
+      (fun f => f add mul sub opp div inv C)
+  | _ => fail 1 "field anomaly: bad correctness lemma (parse)"
+  end.
+
+(* simplifying the non-zero condition... *)
+
+Ltac fold_field_cond req :=
+  let rec fold_concl t :=
+    match t with
+      ?x /\ ?y =>
+        let fx := fold_concl x in let fy := fold_concl y in constr:(fx/\fy)
+    | req ?x ?y -> False => constr:(~ req x y)
+    | _ => t
+    end in
+  match goal with
+    |- ?t => let ft := fold_concl t in change ft
+  end.
+
+Ltac simpl_PCond req :=
+  protect_fv "field_cond";
+  try (exact I);
+  fold_field_cond req.
+
+(* Rewriting (field_simplify) *)
+Ltac Field_simplify lemma Cond_lemma req Cst_tac :=
+  let Make_tac :=
+    match type of lemma with
+    | forall l fe nfe,
+      _ = nfe -> 
+      PCond _ _ _ _ _ _ _ _ _ ->
+      req (FEeval ?rO ?radd ?rmul ?rsub ?ropp ?rdiv ?rinv (C:=?C) ?phi l fe)
+        _ =>
+        let mkFV := FFV Cst_tac radd rmul rsub ropp rdiv rinv in
+        let mkFE := mkFieldexpr C Cst_tac radd rmul rsub ropp rdiv rinv in
+        let simpl_field H := protect_fv "field" in H in
+        fun f rl => f mkFV mkFE simpl_field lemma req rl;
+                    try (apply Cond_lemma; simpl_PCond req)
+    | _ => fail 1 "field anomaly: bad correctness lemma (rewr)"
+    end in
+  Make_tac ReflexiveRewriteTactic.
+(* Pb: second rewrite are applied to non-zero condition of first rewrite... *)
+
+Tactic Notation (at level 0) "field_simplify" constr_list(rl) :=
+  field_lookup
+    (fun req cst_tac _ _ field_simplify_ok cond_ok pre post rl =>
+       pre(); Field_simplify field_simplify_ok cond_ok req cst_tac rl; post()).
+
+
+(* Generic form of field tactics *)
+Ltac Field_Scheme FV_tac SYN_tac SIMPL_tac lemma Cond_lemma req :=
+  let R := match type of req with ?R -> _ => R end in
+  let rec ParseExpr ilemma :=
+    match type of ilemma with
+      forall nfe, ?fe = nfe -> _ =>
+        (fun t => 
+           let x := fresh "fld_expr" in 
+           let H := fresh "norm_fld_expr" in
+           compute_assertion H x fe;
+           ParseExpr (ilemma x H) t;
+           try clear x H)
+    | _ => (fun t => t ilemma)
+    end in
+  let Main r1 r2 :=
+    let fv := FV_tac r1 (@List.nil R) in
+    let fv := FV_tac r2 fv in
+    let fe1 := SYN_tac r1 fv in
+    let fe2 := SYN_tac r2 fv in
+    ParseExpr (lemma fv fe1 fe2)
+    ltac:(fun ilemma =>
+           apply ilemma || fail "field anomaly: failed in applying lemma";
+            [ SIMPL_tac | apply Cond_lemma; simpl_PCond req]) in
+  OnEquation req Main.
+
+(* solve completely a field equation, leaving non-zero conditions to be
+   proved (field) *)
+Ltac Field lemma Cond_lemma req Cst_tac :=
+  let Main radd rmul rsub ropp rdiv rinv C :=
+    let mkFV := FFV Cst_tac radd rmul rsub ropp rdiv rinv in
+    let mkFE := mkFieldexpr C Cst_tac radd rmul rsub ropp rdiv rinv in
+    let Simpl :=
+      vm_compute; reflexivity || fail "not a valid field equation" in
+    Field_Scheme mkFV mkFE Simpl lemma Cond_lemma req in
+  ParseFieldComponents lemma req Main.
+
+Tactic Notation (at level 0) "field" :=
+  field_lookup
+    (fun req cst_tac field_ok _ _ cond_ok pre post rl =>
+       pre(); Field field_ok cond_ok req cst_tac; post()).
+
+(* transforms a field equation to an equivalent (simplified) ring equation,
+   and leaves non-zero conditions to be proved (field_simplify_eq) *)
+Ltac Field_simplify_eq lemma Cond_lemma req Cst_tac :=
+  let Main radd rmul rsub ropp rdiv rinv C :=
+    let mkFV := FFV Cst_tac radd rmul rsub ropp rdiv rinv in
+    let mkFE := mkFieldexpr C Cst_tac radd rmul rsub ropp rdiv rinv in
+    let Simpl := (protect_fv "field") in
+    Field_Scheme mkFV mkFE Simpl lemma Cond_lemma req in
+  ParseFieldComponents lemma req Main.
+
+Tactic Notation (at level 0) "field_simplify_eq" :=
+  field_lookup
+    (fun req cst_tac _ field_simplify_eq_ok _ cond_ok pre post rl =>
+       pre(); Field_simplify_eq field_simplify_eq_ok cond_ok req cst_tac;
+       post()).
+
+(* Adding a new field *)
+
+Ltac ring_of_field f :=
+  match type of f with
+  | almost_field_theory _ _ _ _ _ _ _ _ _ => constr:(AF_AR f)
+  | field_theory _ _ _ _ _ _ _ _ _ => constr:(F_R f)
+  | semi_field_theory _ _ _ _ _ _ _ => constr:(SF_SR f)
+  end.
+
+Ltac coerce_to_almost_field set ext f :=
+  match type of f with
+  | almost_field_theory _ _ _ _ _ _ _ _ _ => f
+  | field_theory _ _ _ _ _ _ _ _ _ => constr:(F2AF set ext f)
+  | semi_field_theory _ _ _ _ _ _ _ => constr:(SF2AF set f)
+  end.
+
+Ltac field_elements set ext fspec rk :=
+  let afth := coerce_to_almost_field set ext fspec in
+  let rspec := ring_of_field fspec in
+  ring_elements set ext rspec rk
+  ltac:(fun arth ext_r morph f => f afth ext_r morph).
+
+
+Ltac field_lemmas set ext inv_m fspec rk :=
+  field_elements set ext fspec rk
+  ltac:(fun afth ext_r morph =>
+    let field_ok := constr:(Field_correct set ext_r inv_m afth morph) in
+    let field_simpl_ok :=
+      constr:(Pphi_dev_div_ok set ext_r inv_m afth morph) in
+    let field_simpl_eq_ok :=
+      constr:(Field_simplify_eq_correct set ext_r inv_m afth morph) in
+    let cond1_ok := constr:(Pcond_simpl_gen set ext_r afth morph) in
+    let cond2_ok := constr:(Pcond_simpl_complete set ext_r afth morph) in
+    (fun f => f afth ext_r morph field_ok field_simpl_ok field_simpl_eq_ok
+                cond1_ok cond2_ok)).
diff --git a/contrib/setoid_ring/Field_theory.v b/contrib/setoid_ring/Field_theory.v
new file mode 100644
index 00000000..f810859c
--- /dev/null
+++ b/contrib/setoid_ring/Field_theory.v
@@ -0,0 +1,1460 @@
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
+Require Ring.
+Import Ring_polynom Ring_tac Ring_theory InitialRing Setoid List.
+Require Import ZArith_base.
+Set Implicit Arguments.
+
+Section MakeFieldPol.
+
+(* Field elements *)     
+ Variable R:Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R->R).
+ Variable (rdiv : R -> R ->  R) (rinv : R ->  R).
+ Variable req : R -> R -> Prop.
+
+ Notation "0" := rO. Notation "1" := rI.
+ Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
+ Notation "x - y " := (rsub x y). Notation "x / y" := (rdiv x y).
+ Notation "- x" := (ropp x). Notation "/ x" := (rinv x).
+ Notation "x == y" := (req x y) (at level 70, no associativity).
+
+ (* Equality properties *)
+ Variable Rsth : Setoid_Theory R req.
+ Variable Reqe : ring_eq_ext radd rmul ropp req.
+ Variable SRinv_ext : forall p q, p == q ->  / p == / q.
+
+ (* Field properties *)
+  Record almost_field_theory : Prop := mk_afield {
+    AF_AR : almost_ring_theory rO rI radd rmul rsub ropp req;
+    AF_1_neq_0 : ~ 1 == 0;
+    AFdiv_def : forall p q, p / q == p * / q;
+    AFinv_l : forall p, ~ p == 0 ->  / p * p == 1
+  }.
+
+Section AlmostField.
+
+ Variable AFth : almost_field_theory.
+ Let ARth := AFth.(AF_AR).
+ Let rI_neq_rO := AFth.(AF_1_neq_0).
+ Let rdiv_def := AFth.(AFdiv_def).
+ Let rinv_l := AFth.(AFinv_l).
+
+ (* Coefficients *) 
+ Variable C: Type.
+ Variable (cO cI: C) (cadd cmul csub : C->C->C) (copp : C->C).
+ Variable ceqb : C->C->bool. 
+ Variable phi : C -> R.
+
+ Variable CRmorph : ring_morph rO rI radd rmul rsub ropp req
+                               cO cI cadd cmul csub copp ceqb phi.
+
+Lemma ceqb_rect : forall c1 c2 (A:Type) (x y:A) (P:A->Type),
+  (phi c1 == phi c2 -> P x) -> P y -> P (if ceqb c1 c2 then x else y).
+Proof.
+intros.
+generalize (fun h => X (morph_eq CRmorph c1 c2 h)).
+case (ceqb c1 c2); auto.
+Qed.
+
+
+ (* C notations *)		 
+ Notation "x +! y" := (cadd x y) (at level 50).
+ Notation "x *! y " := (cmul x y) (at level 40).
+ Notation "x -! y " := (csub x y) (at level 50).
+ Notation "-! x" := (copp x) (at level 35).
+ Notation " x ?=! y" := (ceqb x y) (at level 70, no associativity).
+ Notation "[ x ]" := (phi x) (at level 0).
+
+
+ (* Usefull tactics *)		  
+  Add Setoid R req Rsth as R_set1.
+  Add Morphism radd : radd_ext.  exact (Radd_ext Reqe). Qed.
+  Add Morphism rmul : rmul_ext.  exact (Rmul_ext Reqe). Qed.
+  Add Morphism ropp : ropp_ext.  exact (Ropp_ext Reqe). Qed.
+  Add Morphism rsub : rsub_ext. exact (ARsub_ext Rsth Reqe ARth). Qed.
+  Add Morphism rinv : rinv_ext. exact SRinv_ext. Qed.
+ 
+Let eq_trans := Setoid.Seq_trans _ _ Rsth.
+Let eq_sym := Setoid.Seq_sym _ _ Rsth.
+Let eq_refl := Setoid.Seq_refl _ _ Rsth.
+
+Hint Resolve eq_refl rdiv_def rinv_l rI_neq_rO CRmorph.(morph1) .
+Hint Resolve (Rmul_ext Reqe) (Rmul_ext Reqe) (Radd_ext Reqe)
+             (ARsub_ext Rsth Reqe ARth) (Ropp_ext Reqe) SRinv_ext.
+Hint Resolve (ARadd_0_l  ARth) (ARadd_comm  ARth) (ARadd_assoc ARth)
+             (ARmul_1_l  ARth) (ARmul_0_l  ARth) 
+             (ARmul_comm  ARth) (ARmul_assoc ARth) (ARdistr_l  ARth)
+             (ARopp_mul_l ARth) (ARopp_add  ARth) 
+             (ARsub_def  ARth) .
+
+Notation NPEeval := (PEeval rO radd rmul rsub ropp phi).
+Notation Nnorm := (norm cO cI cadd cmul csub copp ceqb).
+Notation NPphi_dev := (Pphi_dev rO rI radd rmul cO cI ceqb phi).
+
+(* add abstract semi-ring to help with some proofs *)
+Add Ring Rring : (ARth_SRth ARth).
+
+
+(* additional ring properties *)
+
+Lemma rsub_0_l : forall r, 0 - r == - r.
+intros; rewrite (ARsub_def ARth) in |- *; ring.
+Qed.
+
+Lemma rsub_0_r : forall r, r - 0 == r.
+intros; rewrite (ARsub_def ARth) in |- *.
+rewrite (ARopp_zero Rsth Reqe ARth) in |- *;  ring.
+Qed.
+
+(***************************************************************************
+                                                                          
+                       Properties of division                             
+                                                                          
+  ***************************************************************************)
+ 
+Theorem rdiv_simpl: forall p q, ~ q == 0 ->  q * (p / q) == p.
+intros p q H.
+rewrite rdiv_def in |- *.
+transitivity (/ q * q * p); [  ring | idtac ].
+rewrite rinv_l in |- *; auto.
+Qed.
+Hint Resolve rdiv_simpl .
+ 
+Theorem SRdiv_ext:
+ forall p1 p2, p1 == p2 -> forall q1 q2, q1 == q2 ->  p1 / q1 == p2 / q2.
+intros p1 p2 H q1 q2 H0.
+transitivity (p1 * / q1); auto.
+transitivity (p2 * / q2); auto.
+Qed.
+Hint Resolve SRdiv_ext .
+
+ Add Morphism rdiv : rdiv_ext. exact SRdiv_ext. Qed.
+
+Lemma rmul_reg_l : forall p q1 q2,
+  ~ p == 0 -> p * q1 == p * q2 -> q1 == q2.
+intros.
+rewrite <- (@rdiv_simpl q1 p) in |- *; trivial.
+rewrite <- (@rdiv_simpl q2 p) in |- *; trivial.
+repeat rewrite rdiv_def in |- *.
+repeat rewrite (ARmul_assoc ARth) in |- *.
+auto.
+Qed.
+
+Theorem field_is_integral_domain : forall r1 r2,
+  ~ r1 == 0 -> ~ r2 == 0 -> ~ r1 * r2 == 0.
+Proof.
+red in |- *; intros.
+apply H0.
+transitivity (1 * r2); auto.
+transitivity (/ r1 * r1 * r2); auto.
+rewrite <- (ARmul_assoc ARth) in |- *.
+rewrite H1 in |- *.
+apply ARmul_0_r with (1 := Rsth) (2 := ARth).
+Qed.
+
+Theorem ropp_neq_0 : forall r,
+  ~ -(1) == 0 -> ~ r == 0 -> ~ -r == 0.
+intros.
+setoid_replace (- r) with (- (1) * r).
+ apply field_is_integral_domain; trivial.
+ rewrite <- (ARopp_mul_l ARth) in |- *.
+   rewrite (ARmul_1_l ARth) in |- *.
+   reflexivity.
+Qed.
+
+Theorem rdiv_r_r : forall r, ~ r == 0 -> r / r == 1.
+intros.
+rewrite (AFdiv_def AFth) in |- *.
+rewrite (ARmul_comm ARth) in |- *.
+apply (AFinv_l AFth).
+trivial.
+Qed.
+
+Theorem rdiv1: forall r,  r == r / 1.
+intros r; transitivity (1 * (r / 1)); auto.
+Qed.
+ 
+Theorem rdiv2:
+ forall r1 r2 r3 r4,
+ ~ r2 == 0 ->
+ ~ r4 == 0 ->
+ r1 / r2 + r3 / r4 == (r1 * r4 + r3 * r2) / (r2 * r4).
+Proof.
+intros r1 r2 r3 r4 H H0.
+assert (~ r2 * r4 == 0) by complete (apply field_is_integral_domain; trivial).
+apply rmul_reg_l with (r2 * r4); trivial.
+rewrite rdiv_simpl in |- *; trivial.
+rewrite (ARdistr_r Rsth Reqe ARth) in |- *.
+apply (Radd_ext Reqe).
+ transitivity (r2 * (r1 / r2) * r4); [  ring | auto ].
+ transitivity (r2 * (r4 * (r3 / r4))); auto.
+   transitivity (r2 * r3); auto.
+Qed.
+
+
+Theorem rdiv2b:
+ forall r1 r2 r3 r4 r5,
+ ~ (r2*r5) == 0 ->
+ ~ (r4*r5) == 0 ->
+ r1 / (r2*r5) + r3 / (r4*r5) == (r1 * r4 + r3 * r2) / (r2 * (r4 * r5)).
+Proof.
+intros r1 r2 r3 r4 r5 H H0.
+assert (HH1: ~ r2 == 0) by (intros HH; case H; rewrite HH; ring).
+assert (HH2: ~ r5 == 0) by (intros HH; case H; rewrite HH; ring).
+assert (HH3: ~ r4 == 0) by (intros HH; case H0; rewrite HH; ring).
+assert (HH4: ~ r2 * (r4 * r5) == 0) 
+   by complete (repeat apply field_is_integral_domain; trivial).
+apply rmul_reg_l with (r2 * (r4 * r5)); trivial.
+rewrite rdiv_simpl in |- *; trivial.
+rewrite (ARdistr_r Rsth Reqe ARth) in |- *.
+apply (Radd_ext Reqe).
+ transitivity ((r2 * r5) * (r1 / (r2 * r5)) * r4); [  ring | auto ].
+ transitivity ((r4 * r5) * (r3 / (r4 * r5)) * r2); [  ring | auto ].
+Qed.
+
+Theorem rdiv5: forall r1 r2,  - (r1 / r2) == - r1 / r2.
+intros r1 r2.
+transitivity (- (r1 * / r2)); auto.
+transitivity (- r1 * / r2); auto.
+Qed.
+Hint Resolve rdiv5 .
+
+Theorem rdiv3:
+ forall r1 r2 r3 r4,
+ ~ r2 == 0 ->
+ ~ r4 == 0 ->
+ r1 / r2 - r3 / r4 == (r1 * r4 -  r3 * r2) / (r2 * r4).
+intros r1 r2 r3 r4 H H0.
+assert (~ r2 * r4 == 0) by (apply field_is_integral_domain; trivial).
+transitivity (r1 / r2 + - (r3 / r4)); auto.
+transitivity (r1 / r2 + - r3 / r4); auto.
+transitivity ((r1 * r4 + - r3 * r2) / (r2 * r4)); auto.
+apply rdiv2; auto.
+apply SRdiv_ext; auto.
+transitivity (r1 * r4 + - (r3 * r2)); symmetry; auto.
+Qed.
+
+
+Theorem rdiv3b:
+ forall r1 r2 r3 r4 r5,
+ ~ (r2 * r5) == 0 ->
+ ~ (r4 * r5) == 0 ->
+ r1 / (r2*r5) - r3 / (r4*r5) == (r1 * r4 - r3 * r2) / (r2 * (r4 * r5)).
+Proof.
+intros r1 r2 r3 r4 r5 H H0.
+transitivity (r1 / (r2 * r5) + - (r3 / (r4 * r5))); auto.
+transitivity (r1 / (r2 * r5) + - r3 / (r4 * r5)); auto.
+transitivity ((r1 * r4 + - r3 * r2) / (r2 * (r4 * r5))).
+apply rdiv2b; auto; try ring.
+apply (SRdiv_ext); auto.
+transitivity (r1 * r4 + - (r3 * r2)); symmetry; auto.
+Qed.
+
+Theorem rdiv6:
+ forall r1 r2,
+ ~ r1 == 0 -> ~ r2 == 0 ->  / (r1 / r2) == r2 / r1.
+intros r1 r2 H H0.
+assert (~ r1 / r2 == 0) as Hk.
+ intros H1; case H.
+   transitivity (r2 * (r1 / r2)); auto.
+   rewrite H1 in |- *;  ring.
+ apply rmul_reg_l with (r1 / r2); auto.
+   transitivity (/ (r1 / r2) * (r1 / r2)); auto.
+   transitivity 1; auto.
+   repeat rewrite rdiv_def in |- *.
+   transitivity (/ r1 * r1 * (/ r2 * r2)); [ idtac |  ring ].
+   repeat rewrite rinv_l in |- *; auto.
+Qed.
+Hint Resolve rdiv6 .
+ 
+ Theorem rdiv4:
+ forall r1 r2 r3 r4,
+ ~ r2 == 0 ->
+ ~ r4 == 0 ->
+ (r1 / r2) * (r3 / r4) == (r1 * r3) / (r2 * r4).
+Proof.
+intros r1 r2 r3 r4 H H0.
+assert (~ r2 * r4 == 0) by complete (apply field_is_integral_domain; trivial).
+apply rmul_reg_l with (r2 * r4); trivial.
+rewrite rdiv_simpl in |- *; trivial.
+transitivity (r2 * (r1 / r2) * (r4 * (r3 / r4))); [  ring | idtac ].
+repeat rewrite rdiv_simpl in |- *; trivial.
+Qed.
+
+ Theorem rdiv7:
+ forall r1 r2 r3 r4,
+ ~ r2 == 0 ->
+ ~ r3 == 0 ->
+ ~ r4 == 0 ->
+ (r1 / r2) / (r3 / r4) == (r1 * r4) / (r2 * r3).
+Proof.
+intros.
+rewrite (rdiv_def (r1 / r2)) in |- *.
+rewrite rdiv6 in |- *; trivial.
+apply rdiv4; trivial.
+Qed.
+
+Theorem rdiv8: forall r1 r2, ~ r2 == 0 -> r1 == 0 ->  r1 / r2 == 0.
+intros r1 r2 H H0.
+transitivity (r1 * / r2); auto.
+transitivity (0 * / r2); auto.
+Qed.
+
+
+Theorem cross_product_eq : forall r1 r2 r3 r4,
+  ~ r2 == 0 -> ~ r4 == 0 -> r1 * r4 == r3 * r2 -> r1 / r2 == r3 / r4.
+intros.
+transitivity (r1 / r2 * (r4 / r4)).
+ rewrite rdiv_r_r in |- *; trivial.
+   symmetry  in |- *.
+   apply (ARmul_1_r Rsth ARth).
+ rewrite rdiv4 in |- *; trivial.
+   rewrite H1 in |- *.
+   rewrite (ARmul_comm ARth r2 r4) in |- *.
+   rewrite <- rdiv4 in |- *; trivial.
+   rewrite rdiv_r_r in |- *.
+  trivial.
+  apply (ARmul_1_r Rsth ARth).
+Qed.
+
+(***************************************************************************
+                                                                          
+                       Some equality test                             
+                                                                          
+  ***************************************************************************)
+
+Fixpoint positive_eq (p1 p2 : positive) {struct p1} : bool :=
+ match p1, p2 with
+   xH, xH => true
+  | xO p3, xO p4 => positive_eq p3 p4
+  | xI p3, xI p4 => positive_eq p3 p4
+  | _, _ => false
+ end.
+ 
+Theorem positive_eq_correct:
+ forall p1 p2,  if positive_eq p1 p2 then p1 = p2 else p1 <> p2.
+intros p1; elim p1;
+ (try (intros p2; case p2; simpl; auto; intros; discriminate)).
+intros p3 rec p2; case p2; simpl; auto; (try (intros; discriminate)); intros p4.
+generalize (rec p4); case (positive_eq p3 p4); auto.
+intros H1; apply f_equal with ( f := xI ); auto.
+intros H1 H2; case H1; injection H2; auto.
+intros p3 rec p2; case p2; simpl; auto; (try (intros; discriminate)); intros p4.
+generalize (rec p4); case (positive_eq p3 p4); auto.
+intros H1; apply f_equal with ( f := xO ); auto.
+intros H1 H2; case H1; injection H2; auto.
+Qed.
+ 
+(* equality test *)
+Fixpoint PExpr_eq (e1 e2 : PExpr C) {struct e1} : bool :=
+ match e1, e2 with
+   PEc c1, PEc c2 => ceqb c1 c2
+  | PEX p1, PEX p2 => positive_eq p1 p2
+  | PEadd e3 e5, PEadd e4 e6 => if PExpr_eq e3 e4 then PExpr_eq e5 e6 else false
+  | PEsub e3 e5, PEsub e4 e6 => if PExpr_eq e3 e4 then PExpr_eq e5 e6 else false
+  | PEmul e3 e5, PEmul e4 e6 => if PExpr_eq e3 e4 then PExpr_eq e5 e6 else false
+  | PEopp e3, PEopp e4 => PExpr_eq e3 e4
+  | _, _ => false
+ end.
+ 
+Theorem PExpr_eq_semi_correct:
+ forall l e1 e2, PExpr_eq e1 e2 = true ->  NPEeval l e1 == NPEeval l e2.
+intros l e1; elim e1.
+intros c1; intros e2; elim e2; simpl; (try (intros; discriminate)).
+intros c2; apply (morph_eq CRmorph).
+intros p1; intros e2; elim e2; simpl; (try (intros; discriminate)).
+intros p2; generalize (positive_eq_correct p1 p2); case (positive_eq p1 p2);
+ (try (intros; discriminate)); intros H; rewrite H; auto.
+intros e3 rec1 e5 rec2 e2; case e2; simpl; (try (intros; discriminate)).
+intros e4 e6; generalize (rec1 e4); case (PExpr_eq e3 e4);
+ (try (intros; discriminate)); generalize (rec2 e6); case (PExpr_eq e5 e6);
+ (try (intros; discriminate)); auto.
+intros e3 rec1 e5 rec2 e2; case e2; simpl; (try (intros; discriminate)).
+intros e4 e6; generalize (rec1 e4); case (PExpr_eq e3 e4);
+ (try (intros; discriminate)); generalize (rec2 e6); case (PExpr_eq e5 e6);
+ (try (intros; discriminate)); auto.
+intros e3 rec1 e5 rec2 e2; case e2; simpl; (try (intros; discriminate)).
+intros e4 e6; generalize (rec1 e4); case (PExpr_eq e3 e4);
+ (try (intros; discriminate)); generalize (rec2 e6); case (PExpr_eq e5 e6);
+ (try (intros; discriminate)); auto.
+intros e3 rec e2; (case e2; simpl; (try (intros; discriminate))).
+intros e4; generalize (rec e4); case (PExpr_eq e3 e4);
+ (try (intros; discriminate)); auto.
+Qed.
+
+(* add *)
+Definition NPEadd e1 e2 :=
+  match e1, e2 with
+    PEc c1, PEc c2 => PEc (cadd c1 c2)
+  | PEc c, _ => if ceqb c cO then e2 else PEadd e1 e2
+  |  _, PEc c => if ceqb c cO then e1 else PEadd e1 e2
+  | _, _ => PEadd e1 e2
+  end.
+
+Theorem NPEadd_correct:
+ forall l e1 e2, NPEeval l (NPEadd e1 e2) == NPEeval l (PEadd e1 e2).
+Proof.
+intros l e1 e2.
+destruct e1; destruct e2; simpl in |- *; try reflexivity; try apply ceqb_rect;
+ try (intro eq_c; rewrite eq_c in |- *); simpl in |- *;
+ try rewrite (morph0 CRmorph) in |- *; try ring.
+apply (morph_add CRmorph).
+Qed.
+
+(* mul *) 
+Definition NPEmul x y :=
+  match x, y with
+    PEc c1, PEc c2 => PEc (cmul c1 c2)
+  | PEc c, _ =>
+      if ceqb c cI then y else if ceqb c cO then PEc cO else PEmul x y
+  |  _, PEc c =>
+      if ceqb c cI then x else if ceqb c cO then PEc cO else PEmul x y
+  |  _, _ => PEmul x y
+  end.
+             
+Theorem NPEmul_correct : forall l e1 e2,
+  NPEeval l (NPEmul e1 e2) == NPEeval l (PEmul e1 e2).
+intros l e1 e2.
+destruct e1; destruct e2; simpl in |- *; try reflexivity;
+ repeat apply ceqb_rect;
+ try (intro eq_c; rewrite eq_c in |- *); simpl in |- *;
+ try rewrite (morph0 CRmorph) in |- *;
+ try rewrite (morph1 CRmorph) in |- *;
+ try ring.
+apply (morph_mul CRmorph).
+Qed.
+
+(* sub *)
+Definition NPEsub e1 e2 :=
+  match e1, e2 with
+    PEc c1, PEc c2 => PEc (csub c1 c2)
+  | PEc c, _ => if ceqb c cO then PEopp e2 else PEsub e1 e2
+  |  _, PEc c => if ceqb c cO then e1 else PEsub e1 e2
+  | _, _ => PEsub e1 e2
+  end.
+
+Theorem NPEsub_correct:
+ forall l e1 e2,  NPEeval l (NPEsub e1 e2) == NPEeval l (PEsub e1 e2).
+intros l e1 e2.
+destruct e1; destruct e2; simpl in |- *; try reflexivity; try apply ceqb_rect;
+ try (intro eq_c; rewrite eq_c in |- *); simpl in |- *;
+ try rewrite (morph0 CRmorph) in |- *; try reflexivity;
+ try (symmetry; apply rsub_0_l); try (symmetry; apply rsub_0_r).
+apply (morph_sub CRmorph).
+Qed.
+ 
+(* opp *)
+Definition NPEopp e1 :=
+  match e1 with PEc c1 => PEc (copp c1) | _ => PEopp e1 end.
+ 
+Theorem NPEopp_correct:
+ forall l e1,  NPEeval l (NPEopp e1) == NPEeval l (PEopp e1).
+intros l e1; case e1; simpl; auto.
+intros; apply (morph_opp CRmorph).
+Qed.
+ 
+(* simplification *)
+Fixpoint PExpr_simp (e : PExpr C) : PExpr C :=
+ match e with
+   PEadd e1 e2 => NPEadd (PExpr_simp e1) (PExpr_simp e2)
+  | PEmul e1 e2 => NPEmul (PExpr_simp e1) (PExpr_simp e2)
+  | PEsub e1 e2 => NPEsub (PExpr_simp e1) (PExpr_simp e2)
+  | PEopp e1 => NPEopp (PExpr_simp e1)
+  | _ => e
+ end.
+ 
+Theorem PExpr_simp_correct:
+ forall l e,  NPEeval l (PExpr_simp e) == NPEeval l e.
+intros l e; elim e; simpl; auto.
+intros e1 He1 e2 He2.
+transitivity (NPEeval l (PEadd (PExpr_simp e1) (PExpr_simp e2))); auto.
+apply NPEadd_correct.
+simpl; auto.
+intros e1 He1 e2 He2.
+transitivity (NPEeval l (PEsub (PExpr_simp e1) (PExpr_simp e2))); auto.
+apply NPEsub_correct.
+simpl; auto.
+intros e1 He1 e2 He2.
+transitivity (NPEeval l (PEmul (PExpr_simp e1) (PExpr_simp e2))); auto.
+apply NPEmul_correct.
+simpl; auto.
+intros e1 He1.
+transitivity (NPEeval l (PEopp (PExpr_simp e1))); auto.
+apply NPEopp_correct.
+simpl; auto.
+Qed.
+
+
+(****************************************************************************
+                                                                          
+                               Datastructure                              
+                                                                          
+  ***************************************************************************)
+
+(* The input: syntax of a field expression *)
+
+Inductive FExpr : Type :=
+   FEc: C ->  FExpr
+ | FEX: positive ->  FExpr
+ | FEadd: FExpr -> FExpr ->  FExpr
+ | FEsub: FExpr -> FExpr ->  FExpr
+ | FEmul: FExpr -> FExpr ->  FExpr
+ | FEopp: FExpr ->  FExpr
+ | FEinv: FExpr ->  FExpr
+ | FEdiv: FExpr -> FExpr ->  FExpr .
+
+Fixpoint FEeval (l : list R) (pe : FExpr) {struct pe} : R :=
+  match pe with
+  | FEc c     => phi c
+  | FEX x     => BinList.nth 0 x l
+  | FEadd x y => FEeval l x + FEeval l y
+  | FEsub x y => FEeval l x - FEeval l y
+  | FEmul x y => FEeval l x * FEeval l y
+  | FEopp x   => - FEeval l x
+  | FEinv x   => / FEeval l x
+  | FEdiv x y => FEeval l x / FEeval l y
+  end.
+
+(* The result of the normalisation *)
+ 
+Record linear : Type := mk_linear {
+   num : PExpr C;
+   denum : PExpr C;
+   condition : list (PExpr C) }.
+
+(***************************************************************************
+
+                Semantics and properties of side condition
+
+  ***************************************************************************)
+ 
+Fixpoint PCond (l : list R) (le : list (PExpr C)) {struct le} : Prop :=
+  match le with
+  | nil => True
+  | e1 :: nil => ~ req (PEeval rO radd rmul rsub ropp phi l e1) rO
+  | e1 :: l1 => ~ req (PEeval rO radd rmul rsub ropp phi l e1) rO /\ PCond l l1
+  end.
+
+Theorem PCond_cons_inv_l :
+   forall l a l1, PCond l (a::l1) ->  ~ NPEeval l a == 0.
+intros l a l1 H.
+destruct l1; simpl in H |- *; trivial.
+destruct H; trivial.
+Qed.
+ 
+Theorem PCond_cons_inv_r : forall l a l1, PCond l (a :: l1) ->  PCond l l1.
+intros l a l1 H.
+destruct l1; simpl in H |- *; trivial.
+destruct H; trivial.
+Qed.
+
+Theorem PCond_app_inv_l: forall l l1 l2, PCond l (l1 ++ l2) ->  PCond l l1.
+intros l l1 l2; elim l1; simpl app in |- *.
+ simpl in |- *; auto.
+ destruct l0; simpl in *.
+  destruct l2; firstorder.
+  firstorder.
+Qed.
+ 
+Theorem PCond_app_inv_r: forall l l1 l2, PCond l (l1 ++ l2) ->  PCond l l2.
+intros l l1 l2; elim l1; simpl app; auto.
+intros a l0 H H0; apply H; apply PCond_cons_inv_r with ( 1 := H0 ).
+Qed.
+ 
+(* An unsatisfiable condition: issued when a division by zero is detected *)
+Definition absurd_PCond := cons (PEc cO) nil.
+
+Lemma absurd_PCond_bottom : forall l, ~ PCond l absurd_PCond.
+unfold absurd_PCond in |- *; simpl in |- *.
+red in |- *; intros.
+apply H.
+apply (morph0 CRmorph).
+Qed.
+
+(***************************************************************************
+                                                                          
+                               Normalisation                              
+                                                                          
+  ***************************************************************************)
+
+
+Fixpoint isIn (e1 e2: PExpr C) {struct e2}: option (PExpr C) :=
+  match e2 with
+  | PEmul e3 e4 =>
+       match isIn e1 e3 with
+         Some e5 => Some (NPEmul e5 e4)
+       | None => match isIn e1 e4 with
+                 | Some e5 => Some (NPEmul e3 e5)
+                 | None => None
+                 end
+       end
+  | _ =>
+       if PExpr_eq e1 e2 then Some (PEc cI) else None
+   end.
+
+Theorem isIn_correct: forall l e1 e2,
+  match isIn e1 e2 with 
+    (Some e3) => NPEeval l e2 == NPEeval l (NPEmul e1 e3)
+  |  _ => True
+  end.
+Proof.
+intros l e1 e2; elim e2; simpl; auto.
+  intros c;
+   generalize (PExpr_eq_semi_correct l e1 (PEc c));
+   case (PExpr_eq e1 (PEc c)); simpl; auto; intros H.
+   rewrite NPEmul_correct; simpl; auto.
+   rewrite H; auto; simpl. 
+   rewrite (morph1 CRmorph); rewrite (ARmul_1_r Rsth ARth); auto.
+  intros p;
+   generalize (PExpr_eq_semi_correct l e1 (PEX C p));
+   case (PExpr_eq e1 (PEX C p)); simpl; auto; intros H.
+   rewrite NPEmul_correct; simpl; auto.
+   rewrite H; auto; simpl. 
+   rewrite (morph1 CRmorph); rewrite (ARmul_1_r Rsth ARth); auto.
+ intros p Hrec p1 Hrec1.
+   generalize (PExpr_eq_semi_correct l e1 (PEadd p p1));
+   case (PExpr_eq e1 (PEadd p p1)); simpl; auto; intros H.
+   rewrite NPEmul_correct; simpl; auto.
+   rewrite H; auto; simpl. 
+   rewrite (morph1 CRmorph); rewrite (ARmul_1_r Rsth ARth); auto.
+ intros p Hrec p1 Hrec1.
+   generalize (PExpr_eq_semi_correct l e1 (PEsub p p1));
+   case (PExpr_eq e1 (PEsub p p1)); simpl; auto; intros H.
+   rewrite NPEmul_correct; simpl; auto.
+   rewrite H; auto; simpl. 
+   rewrite (morph1 CRmorph); rewrite (ARmul_1_r Rsth ARth); auto.
+ intros p; case (isIn e1 p).
+   intros p2 Hrec p1 Hrec1.
+   rewrite Hrec; auto; simpl. 
+   repeat (rewrite NPEmul_correct; simpl; auto).
+   intros _ p1; case (isIn e1 p1); auto.
+   intros p2 H; rewrite H.
+   repeat (rewrite NPEmul_correct; simpl; auto).
+   ring.
+  intros p;
+   generalize (PExpr_eq_semi_correct l e1 (PEopp p));
+   case (PExpr_eq e1 (PEopp p)); simpl; auto; intros H.
+   rewrite NPEmul_correct; simpl; auto.
+   rewrite H; auto; simpl. 
+   rewrite (morph1 CRmorph); rewrite (ARmul_1_r Rsth ARth); auto.
+Qed.
+
+Record rsplit : Type := mk_rsplit {
+   rsplit_left : PExpr C;
+   rsplit_common : PExpr C;
+   rsplit_right : PExpr C}.
+
+(* Stupid name clash *)
+Let left := rsplit_left.
+Let right := rsplit_right.
+Let common := rsplit_common.
+
+Fixpoint split (e1 e2: PExpr C) {struct e1}: rsplit :=
+  match e1 with
+  | PEmul e3 e4 =>
+      let r1 := split e3 e2 in
+      let r2 := split e4 (right r1) in
+          mk_rsplit (NPEmul (left r1) (left r2))
+                    (NPEmul (common r1) (common r2))
+                    (right r2)
+  | _ => 
+       match isIn e1 e2 with
+         Some e3 => mk_rsplit (PEc cI) e1 e3
+       | None => mk_rsplit e1 (PEc cI) e2
+       end
+  end. 
+
+Theorem split_correct: forall l e1 e2,
+  NPEeval l e1 == NPEeval l (NPEmul (left (split e1 e2))
+                                   (common (split e1 e2)))
+/\
+  NPEeval l e2 == NPEeval l (NPEmul (right (split e1 e2))
+                                   (common (split e1 e2))).
+Proof.
+intros l e1; elim e1; simpl; auto.
+  intros c e2; generalize (isIn_correct l (PEc c) e2);
+    case (isIn (PEc c) e2); auto; intros p;
+    [intros Hp1; rewrite Hp1 | idtac];
+    simpl left; simpl common;  simpl right; auto;
+    repeat rewrite NPEmul_correct; simpl; split; 
+    try rewrite  (morph1 CRmorph); ring.
+  intros p e2; generalize (isIn_correct l (PEX C p) e2);
+    case (isIn (PEX C p) e2); auto; intros p1;
+    [intros Hp1; rewrite Hp1 | idtac];
+    simpl left; simpl common;  simpl right; auto;
+    repeat rewrite NPEmul_correct; simpl; split; 
+    try rewrite  (morph1 CRmorph); ring.
+  intros p1 _ p2 _ e2; generalize (isIn_correct l (PEadd p1 p2) e2);
+    case (isIn (PEadd p1 p2) e2); auto; intros p;
+    [intros Hp1; rewrite Hp1 | idtac];
+    simpl left; simpl common;  simpl right; auto;
+    repeat rewrite NPEmul_correct; simpl; split; 
+    try rewrite  (morph1 CRmorph); ring.
+  intros p1 _ p2 _ e2; generalize (isIn_correct l (PEsub p1 p2) e2);
+    case (isIn (PEsub p1 p2) e2); auto; intros p;
+    [intros Hp1; rewrite Hp1 | idtac];
+    simpl left; simpl common;  simpl right; auto;
+    repeat rewrite NPEmul_correct; simpl; split; 
+    try rewrite  (morph1 CRmorph); ring.
+  intros p1 Hp1 p2 Hp2 e2.
+    repeat rewrite NPEmul_correct; simpl; split.
+    case (Hp1 e2); case (Hp2 (right (split p1 e2))).
+    intros tmp1 _ tmp2 _; rewrite tmp1; rewrite tmp2.
+    repeat rewrite NPEmul_correct; simpl.
+    ring.
+    case (Hp1 e2); case (Hp2 (right (split p1 e2))).
+    intros _ tmp1 _ tmp2; rewrite tmp2;
+    repeat rewrite NPEmul_correct; simpl.
+    rewrite tmp1.
+    repeat rewrite NPEmul_correct; simpl.
+    ring.
+  intros p _ e2; generalize (isIn_correct l (PEopp p) e2);
+    case (isIn (PEopp p) e2); auto; intros p1;
+    [intros Hp1; rewrite Hp1 | idtac];
+    simpl left; simpl common;  simpl right; auto;
+    repeat rewrite NPEmul_correct; simpl; split; 
+    try rewrite  (morph1 CRmorph); ring.
+Qed.
+
+
+Theorem split_correct_l: forall l e1 e2,
+  NPEeval l e1 == NPEeval l (NPEmul (left (split e1 e2))
+                                   (common (split e1 e2))).
+Proof.
+intros l e1 e2; case (split_correct l e1 e2); auto.
+Qed.
+
+Theorem split_correct_r: forall l e1 e2,
+  NPEeval l e2 == NPEeval l (NPEmul (right (split e1 e2))
+                                   (common (split e1 e2))).
+Proof.
+intros l e1 e2; case (split_correct l e1 e2); auto.
+Qed.
+
+Fixpoint Fnorm (e : FExpr) : linear := 
+  match e with
+  | FEc c => mk_linear (PEc c) (PEc cI) nil
+  | FEX x => mk_linear (PEX C x) (PEc cI) nil
+  | FEadd e1 e2 =>
+      let x := Fnorm e1 in
+      let y := Fnorm e2 in
+      let s := split (denum x) (denum y) in
+      mk_linear
+        (NPEadd (NPEmul (num x) (right s)) (NPEmul (num y) (left s)))
+        (NPEmul (left s) (NPEmul (right s) (common s)))
+        (condition x ++ condition y)
+ 
+  | FEsub e1 e2 =>
+      let x := Fnorm e1 in
+      let y := Fnorm e2 in
+      let s := split (denum x) (denum y) in
+      mk_linear
+        (NPEsub (NPEmul (num x) (right s)) (NPEmul (num y) (left s)))
+        (NPEmul (left s) (NPEmul (right s) (common s)))
+        (condition x ++ condition y)
+  | FEmul e1 e2 =>
+      let x := Fnorm e1 in
+      let y := Fnorm e2 in
+      mk_linear (NPEmul (num x) (num y))
+        (NPEmul (denum x) (denum y))
+        (condition x ++ condition y)
+  | FEopp e1 =>
+      let x := Fnorm e1 in
+      mk_linear (NPEopp (num x)) (denum x) (condition x)
+  | FEinv e1 =>
+      let x := Fnorm e1 in
+      mk_linear (denum x) (num x) (num x :: condition x)
+  | FEdiv e1 e2 =>
+      let x := Fnorm e1 in
+      let y := Fnorm e2 in
+      mk_linear (NPEmul (num x) (denum y))
+        (NPEmul (denum x) (num y))
+        (num y :: condition x ++ condition y)
+  end.
+
+
+(* Example *)
+(*
+Eval compute
+   in (Fnorm
+        (FEdiv
+          (FEc cI)
+          (FEadd (FEinv (FEX xH%positive)) (FEinv (FEX (xO xH)%positive))))).
+*)
+
+Theorem Pcond_Fnorm:
+ forall l e,
+ PCond l (condition (Fnorm e)) ->  ~ NPEeval l (denum (Fnorm e)) == 0.
+intros l e; elim e.
+ simpl in |- *; intros _ _; rewrite (morph1 CRmorph) in |- *; exact rI_neq_rO.
+ simpl in |- *; intros _ _; rewrite (morph1 CRmorph) in |- *; exact rI_neq_rO.
+ intros e1 Hrec1 e2 Hrec2 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   rewrite NPEmul_correct in |- *.
+   simpl in |- *.
+   apply field_is_integral_domain.
+   intros HH; case Hrec1; auto.
+     apply PCond_app_inv_l with (1 := Hcond).
+   rewrite (split_correct_l l (denum (Fnorm e1)) (denum (Fnorm e2))).
+   rewrite NPEmul_correct; simpl; rewrite HH; ring.
+   intros HH; case Hrec2; auto.
+     apply PCond_app_inv_r with (1 := Hcond).
+   rewrite (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))); auto.
+ intros e1 Hrec1 e2 Hrec2 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   rewrite NPEmul_correct in |- *.
+   simpl in |- *.
+   apply field_is_integral_domain.
+   intros HH; case Hrec1; auto.
+     apply PCond_app_inv_l with (1 := Hcond).
+   rewrite (split_correct_l l (denum (Fnorm e1)) (denum (Fnorm e2))).
+   rewrite NPEmul_correct; simpl; rewrite HH; ring.
+   intros HH; case Hrec2; auto.
+     apply PCond_app_inv_r with (1 := Hcond).
+   rewrite (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))); auto.
+ intros e1 Hrec1 e2 Hrec2 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   rewrite NPEmul_correct in |- *.
+   simpl in |- *.
+   apply field_is_integral_domain.
+  apply Hrec1.
+    apply PCond_app_inv_l with (1 := Hcond).
+  apply Hrec2.
+    apply PCond_app_inv_r with (1 := Hcond).
+ intros e1 Hrec1 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   auto.
+ intros e1 Hrec1 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   apply PCond_cons_inv_l with (1:=Hcond).
+ intros e1 Hrec1 e2 Hrec2 Hcond.
+   simpl condition in Hcond.
+   simpl denum in |- *.
+   rewrite NPEmul_correct in |- *.
+   simpl in |- *.
+   apply field_is_integral_domain.
+  apply Hrec1.
+    specialize PCond_cons_inv_r with (1:=Hcond); intro Hcond1.
+    apply PCond_app_inv_l with (1 := Hcond1).
+   apply PCond_cons_inv_l with (1:=Hcond).
+Qed.
+Hint Resolve Pcond_Fnorm.
+
+
+(***************************************************************************
+                                                                          
+                       Main theorem                                       
+                                                                          
+  ***************************************************************************)
+
+Theorem Fnorm_FEeval_PEeval:
+ forall l fe,
+ PCond l (condition (Fnorm fe)) ->
+ FEeval l fe == NPEeval l (num (Fnorm fe)) / NPEeval l (denum (Fnorm fe)).
+Proof.
+intros l fe; elim fe; simpl.
+intros c H; rewrite CRmorph.(morph1); apply rdiv1.
+intros p H; rewrite CRmorph.(morph1); apply rdiv1.
+intros e1 He1 e2 He2 HH.
+assert (HH1: PCond l (condition (Fnorm e1))).
+apply PCond_app_inv_l with ( 1 := HH ).
+assert (HH2: PCond l (condition (Fnorm e2))).
+apply PCond_app_inv_r with ( 1 := HH ).
+rewrite (He1 HH1); rewrite (He2 HH2).
+rewrite NPEadd_correct; simpl.
+repeat rewrite NPEmul_correct; simpl.
+generalize (split_correct_l l (denum (Fnorm e1)) (denum (Fnorm e2)))
+   (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))).
+repeat rewrite NPEmul_correct; simpl.
+intros U1 U2; rewrite U1; rewrite U2.
+apply rdiv2b; auto.
+  rewrite <- U1; auto.
+  rewrite <- U2; auto.
+
+intros e1 He1 e2 He2 HH.
+assert (HH1: PCond l (condition (Fnorm e1))).
+apply PCond_app_inv_l with ( 1 := HH ).
+assert (HH2: PCond l (condition (Fnorm e2))).
+apply PCond_app_inv_r with ( 1 := HH ).
+rewrite (He1 HH1); rewrite (He2 HH2).
+rewrite NPEsub_correct; simpl.
+repeat rewrite NPEmul_correct; simpl.
+generalize (split_correct_l l (denum (Fnorm e1)) (denum (Fnorm e2)))
+   (split_correct_r l (denum (Fnorm e1)) (denum (Fnorm e2))).
+repeat rewrite NPEmul_correct; simpl.
+intros U1 U2; rewrite U1; rewrite U2.
+apply rdiv3b; auto.
+  rewrite <- U1; auto.
+  rewrite <- U2; auto.
+
+intros e1 He1 e2 He2 HH.
+assert (HH1: PCond l (condition (Fnorm e1))).
+apply PCond_app_inv_l with ( 1 := HH ).
+assert (HH2: PCond l (condition (Fnorm e2))).
+apply PCond_app_inv_r with ( 1 := HH ).
+rewrite (He1 HH1); rewrite (He2 HH2).
+repeat rewrite NPEmul_correct; simpl.
+apply rdiv4; auto.
+
+intros e1 He1 HH.
+rewrite NPEopp_correct; simpl; rewrite (He1 HH); apply rdiv5; auto.
+
+intros e1 He1 HH.
+assert (HH1: PCond l (condition (Fnorm e1))).
+apply PCond_cons_inv_r with ( 1 := HH ).
+rewrite (He1 HH1); apply rdiv6; auto.
+apply PCond_cons_inv_l with ( 1 := HH ).
+
+intros e1 He1 e2 He2 HH.
+assert (HH1: PCond l (condition (Fnorm e1))).
+apply PCond_app_inv_l with (condition (Fnorm e2)).
+apply PCond_cons_inv_r with ( 1 := HH ).
+assert (HH2: PCond l (condition (Fnorm e2))).
+apply PCond_app_inv_r with (condition (Fnorm e1)).
+apply PCond_cons_inv_r with ( 1 := HH ).
+rewrite (He1 HH1); rewrite (He2 HH2).
+repeat rewrite NPEmul_correct;simpl.
+apply rdiv7; auto.
+apply PCond_cons_inv_l with ( 1 := HH ).
+Qed.
+
+Theorem Fnorm_crossproduct:
+ forall l fe1 fe2,
+ let nfe1 := Fnorm fe1 in
+ let nfe2 := Fnorm fe2 in
+ NPEeval l (PEmul (num nfe1) (denum nfe2)) ==
+ NPEeval l (PEmul (num nfe2) (denum nfe1)) ->
+ PCond l (condition nfe1 ++ condition nfe2) ->
+ FEeval l fe1 == FEeval l fe2.
+intros l fe1 fe2 nfe1 nfe2 Hcrossprod Hcond; subst nfe1 nfe2.
+rewrite Fnorm_FEeval_PEeval in |- *.
+ apply PCond_app_inv_l with (1 := Hcond).
+ rewrite Fnorm_FEeval_PEeval in |- *.
+  apply PCond_app_inv_r with (1 := Hcond).
+  apply cross_product_eq; trivial.
+   apply Pcond_Fnorm.
+     apply PCond_app_inv_l with (1 := Hcond).
+   apply Pcond_Fnorm.
+     apply PCond_app_inv_r with (1 := Hcond).
+Qed.
+
+(* Correctness lemmas of reflexive tactics *)
+
+Theorem Fnorm_correct:
+ forall l fe,
+ Peq ceqb (Nnorm (num (Fnorm fe))) (Pc cO) = true ->
+ PCond l (condition (Fnorm fe)) ->  FEeval l fe == 0.
+intros l fe H H1;
+ apply eq_trans with (1 := Fnorm_FEeval_PEeval l fe H1).
+apply rdiv8; auto.
+transitivity (NPEeval l (PEc cO)); auto.
+apply (ring_correct Rsth Reqe ARth CRmorph); auto.
+simpl; apply (morph0 CRmorph); auto.
+Qed.
+
+(* simplify a field expression into a fraction *)
+(* TODO: simplify when den is constant... *)
+Definition display_linear l num den :=
+  NPphi_dev l num / NPphi_dev l den.
+
+Theorem Pphi_dev_div_ok:
+ forall l fe nfe,
+ Fnorm fe = nfe ->
+ PCond l (condition nfe) ->
+ FEeval l fe == display_linear l (Nnorm (num nfe)) (Nnorm (denum nfe)).
+Proof.
+  intros l fe nfe eq_nfe H; subst nfe.
+  apply eq_trans with (1 := Fnorm_FEeval_PEeval _ _ H).
+  unfold display_linear; apply SRdiv_ext;
+  apply (Pphi_dev_ok Rsth Reqe ARth CRmorph); reflexivity.
+Qed.
+
+(* solving a field equation *)
+Theorem Field_correct :
+ forall l fe1 fe2,
+ forall nfe1, Fnorm fe1 = nfe1 ->
+ forall nfe2, Fnorm fe2 = nfe2 ->
+ Peq ceqb (Nnorm (PEmul (num nfe1) (denum nfe2)))
+          (Nnorm (PEmul (num nfe2) (denum nfe1))) = true ->
+ PCond l (condition nfe1 ++ condition nfe2) ->
+ FEeval l fe1 == FEeval l fe2.
+Proof.
+intros l fe1 fe2 nfe1 eq1 nfe2 eq2 Hnorm Hcond; subst nfe1 nfe2.
+apply Fnorm_crossproduct; trivial.
+apply (ring_correct Rsth Reqe ARth CRmorph); trivial.
+Qed.
+
+(* simplify a field equation : generate the crossproduct and simplify
+   polynomials *)
+Theorem Field_simplify_eq_old_correct :
+ forall l fe1 fe2 nfe1 nfe2,
+ Fnorm fe1 = nfe1 ->
+ Fnorm fe2 = nfe2 ->
+ NPphi_dev l (Nnorm (PEmul (num nfe1) (denum nfe2))) ==
+ NPphi_dev l (Nnorm (PEmul (num nfe2) (denum nfe1))) ->
+ PCond l (condition nfe1 ++ condition nfe2) ->
+ FEeval l fe1 == FEeval l fe2.
+Proof.
+intros l fe1 fe2 nfe1 nfe2 eq1 eq2 Hcrossprod Hcond;  subst nfe1 nfe2.
+apply Fnorm_crossproduct; trivial.
+rewrite (Pphi_dev_gen_ok Rsth Reqe ARth CRmorph) in |- *.
+rewrite (Pphi_dev_gen_ok Rsth Reqe ARth CRmorph) in |- *.
+trivial.
+Qed.
+
+Theorem Field_simplify_eq_correct :
+ forall l fe1 fe2,
+ forall nfe1, Fnorm fe1 = nfe1 ->
+ forall nfe2, Fnorm fe2 = nfe2 ->
+ forall den, split (denum nfe1) (denum nfe2) = den -> 
+ NPphi_dev l (Nnorm (PEmul (num nfe1) (right den))) ==
+ NPphi_dev l (Nnorm (PEmul (num nfe2) (left den))) ->
+ PCond l (condition nfe1 ++ condition nfe2) ->
+ FEeval l fe1 == FEeval l fe2.
+Proof.
+intros l fe1 fe2 nfe1 eq1 nfe2 eq2 den eq3 Hcrossprod Hcond;
+  subst nfe1 nfe2 den.
+apply Fnorm_crossproduct; trivial.
+simpl in |- *.
+elim (split_correct l (denum (Fnorm fe1)) (denum (Fnorm fe2))); intros.
+rewrite H in |- *.
+rewrite H0 in |- *.
+clear H H0.
+rewrite NPEmul_correct in |- *.
+rewrite NPEmul_correct in |- *.
+simpl in |- *.
+repeat rewrite (ARmul_assoc ARth) in |- *.
+rewrite <- (Pphi_dev_gen_ok Rsth Reqe ARth CRmorph) in Hcrossprod.
+rewrite <- (Pphi_dev_gen_ok Rsth Reqe ARth CRmorph) in Hcrossprod.
+simpl in Hcrossprod.
+rewrite Hcrossprod in |- *.
+reflexivity.
+Qed.
+
+Section Fcons_impl.
+
+Variable Fcons : PExpr C -> list (PExpr C) -> list (PExpr C).
+
+Hypothesis PCond_fcons_inv : forall l a l1,
+  PCond l (Fcons a l1) ->  ~ NPEeval l a == 0 /\ PCond l l1.
+
+Fixpoint Fapp (l m:list (PExpr C)) {struct l} : list (PExpr C) :=
+  match l with
+  | nil => m
+  | cons a l1 => Fcons a (Fapp l1 m)
+  end.
+
+Lemma fcons_correct : forall l l1,
+  PCond l (Fapp l1 nil) -> PCond l l1.
+induction l1; simpl in |- *; intros.
+ trivial.
+ elim PCond_fcons_inv with (1 := H); intros.
+   destruct l1; auto.
+Qed.
+
+End Fcons_impl.
+
+Section Fcons_simpl.
+
+(* Some general simpifications of the condition: eliminate duplicates,
+   split multiplications *)
+
+Fixpoint Fcons (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) :=
+ match l with
+   nil       => cons e nil
+ | cons a l1 => if PExpr_eq e a then l else cons a (Fcons e l1)
+ end.
+ 
+Theorem PFcons_fcons_inv:
+ forall l a l1, PCond l (Fcons a l1) ->  ~ NPEeval l a == 0 /\ PCond l l1.
+intros l a l1; elim l1; simpl Fcons; auto.
+simpl; auto.
+intros a0 l0.
+generalize (PExpr_eq_semi_correct l a a0); case (PExpr_eq a a0).
+intros H H0 H1; split; auto.
+rewrite H; auto.
+generalize (PCond_cons_inv_l _ _ _ H1); simpl; auto.
+intros H H0 H1;
+ assert (Hp: ~ NPEeval l a0 == 0 /\ (~ NPEeval l a == 0 /\ PCond l l0)).
+split.
+generalize (PCond_cons_inv_l _ _ _ H1); simpl; auto.
+apply H0.
+generalize (PCond_cons_inv_r _ _ _ H1); simpl; auto.
+generalize Hp; case l0; simpl; intuition.
+Qed.
+
+(* equality of normal forms rather than syntactic equality *)
+Fixpoint Fcons0 (e:PExpr C) (l:list (PExpr C)) {struct l} : list (PExpr C) :=
+ match l with
+   nil       => cons e nil
+ | cons a l1 =>
+     if Peq ceqb (Nnorm e) (Nnorm a) then l else cons a (Fcons0 e l1)
+ end.
+ 
+Theorem PFcons0_fcons_inv:
+ forall l a l1, PCond l (Fcons0 a l1) ->  ~ NPEeval l a == 0 /\ PCond l l1.
+intros l a l1; elim l1; simpl Fcons0; auto.
+simpl; auto.
+intros a0 l0.
+generalize (ring_correct Rsth Reqe ARth CRmorph l a a0);
+  case (Peq ceqb (Nnorm a) (Nnorm a0)).
+intros H H0 H1; split; auto.
+rewrite H; auto.
+generalize (PCond_cons_inv_l _ _ _ H1); simpl; auto.
+intros H H0 H1;
+ assert (Hp: ~ NPEeval l a0 == 0 /\ (~ NPEeval l a == 0 /\ PCond l l0)).
+split.
+generalize (PCond_cons_inv_l _ _ _ H1); simpl; auto.
+apply H0.
+generalize (PCond_cons_inv_r _ _ _ H1); simpl; auto.
+generalize Hp; case l0; simpl; intuition.
+Qed.
+
+Fixpoint Fcons00 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) :=
+ match e with
+   PEmul e1 e2 => Fcons00 e1 (Fcons00 e2 l)
+ | _ => Fcons0 e l
+ end.
+
+Theorem PFcons00_fcons_inv:
+  forall l a l1, PCond l (Fcons00 a l1) -> ~ NPEeval l a == 0 /\ PCond l l1.
+intros l a; elim a; try (intros; apply PFcons0_fcons_inv; auto; fail).
+ intros p H p0 H0 l1 H1.
+   simpl in H1.
+   case (H _ H1); intros H2 H3.
+   case (H0 _ H3); intros H4 H5; split; auto.
+   simpl in |- *.
+   apply field_is_integral_domain; trivial.
+Qed.
+
+
+Definition Pcond_simpl_gen := 
+  fcons_correct _ PFcons00_fcons_inv.
+
+
+(* Specific case when the equality test of coefs is complete w.r.t. the
+   field equality: non-zero coefs can be eliminated, and opposite can
+   be simplified (if -1 <> 0) *)
+
+Hypothesis ceqb_complete : forall c1 c2, phi c1 == phi c2 -> ceqb c1 c2 = true.
+
+Lemma ceqb_rect_complete : forall c1 c2 (A:Type) (x y:A) (P:A->Type),
+  (phi c1 == phi c2 -> P x) ->
+  (~ phi c1 == phi c2 -> P y) ->
+  P (if ceqb c1 c2 then x else y).
+Proof.
+intros.
+generalize (fun h => X (morph_eq CRmorph c1 c2 h)).
+generalize (@ceqb_complete c1 c2).
+case (c1 ?=! c2); auto; intros.
+apply X0.
+red in |- *; intro.
+absurd (false = true); auto;  discriminate.
+Qed.
+
+Fixpoint Fcons1 (e:PExpr C) (l:list (PExpr C)) {struct e} : list (PExpr C) :=
+ match e with
+   PEmul e1 e2 => Fcons1 e1 (Fcons1 e2 l)
+ | PEopp e => if ceqb (copp cI) cO then absurd_PCond else Fcons1 e l
+ | PEc c => if ceqb c cO then absurd_PCond else l
+ | _ => Fcons0 e l
+ end.
+
+Theorem PFcons1_fcons_inv:
+  forall l a l1, PCond l (Fcons1 a l1) -> ~ NPEeval l a == 0 /\ PCond l l1.
+intros l a; elim a; try (intros; apply PFcons0_fcons_inv; auto; fail).
+ simpl in |- *; intros c l1.
+   apply ceqb_rect_complete; intros.
+  elim (@absurd_PCond_bottom l H0).
+  split; trivial.
+    rewrite <- (morph0 CRmorph) in |- *; trivial.
+ intros p H p0 H0 l1 H1.
+   simpl in H1.
+   case (H _ H1); intros H2 H3.
+   case (H0 _ H3); intros H4 H5; split; auto.
+   simpl in |- *.
+   apply field_is_integral_domain; trivial.
+ simpl in |- *; intros p H l1.
+   apply ceqb_rect_complete; intros.
+  elim (@absurd_PCond_bottom l H1).
+  destruct (H _ H1).
+    split; trivial.
+    apply ropp_neq_0; trivial.
+    rewrite (morph_opp CRmorph) in H0.
+    rewrite (morph1 CRmorph) in H0.
+    rewrite (morph0 CRmorph) in H0.
+    trivial.
+Qed.
+
+Definition Fcons2 e l := Fcons1 (PExpr_simp e) l.
+ 
+Theorem PFcons2_fcons_inv:
+ forall l a l1, PCond l (Fcons2 a l1) -> ~ NPEeval l a == 0 /\ PCond l l1.
+unfold Fcons2 in |- *; intros l a l1 H; split;
+ case (PFcons1_fcons_inv l (PExpr_simp a) l1); auto.
+intros H1 H2 H3; case H1.
+transitivity (NPEeval l a); trivial.
+apply PExpr_simp_correct.
+Qed.
+
+Definition Pcond_simpl_complete := 
+  fcons_correct _ PFcons2_fcons_inv.
+
+End Fcons_simpl.
+
+Let Mpc := MPcond_map cO cI cadd cmul csub copp ceqb.
+Let Mp := MPcond_dev rO rI radd rmul req cO cI ceqb phi.
+Let Subst := PNSubstL cO cI cadd cmul ceqb.
+
+(* simplification + rewriting *)
+Theorem Field_subst_correct :
+forall l ul fe m n,
+ PCond l (Fapp Fcons00 (condition (Fnorm fe)) nil) ->
+ Mp (Mpc ul) l ->
+ Peq ceqb (Subst (Nnorm (num (Fnorm fe))) (Mpc ul) m n) (Pc cO) = true ->
+ FEeval l fe == 0.
+intros l ul fe m n H H1 H2.
+assert (H3 := (Pcond_simpl_gen _ _ H)).
+apply eq_trans with (1 := Fnorm_FEeval_PEeval l fe 
+                           (Pcond_simpl_gen _ _ H)).
+apply rdiv8; auto.
+rewrite (PNSubstL_dev_ok Rsth Reqe ARth CRmorph m n
+              _ (num (Fnorm fe)) l H1).
+rewrite <-(Ring_polynom.Pphi_Pphi_dev Rsth Reqe ARth CRmorph).
+rewrite (fun x => Peq_ok Rsth Reqe CRmorph x (Pc cO)); auto.
+simpl; apply (morph0 CRmorph); auto.
+Qed.
+
+
+End AlmostField.
+
+Section FieldAndSemiField.
+
+  Record field_theory : Prop := mk_field {
+    F_R : ring_theory rO rI radd rmul rsub ropp req;
+    F_1_neq_0 : ~ 1 == 0;
+    Fdiv_def : forall p q, p / q == p * / q;
+    Finv_l : forall p, ~ p == 0 ->  / p * p == 1
+  }.
+
+  Definition F2AF f :=
+    mk_afield
+      (Rth_ARth Rsth Reqe f.(F_R)) f.(F_1_neq_0) f.(Fdiv_def) f.(Finv_l).
+
+  Record semi_field_theory : Prop := mk_sfield {
+    SF_SR : semi_ring_theory rO rI radd rmul req;
+    SF_1_neq_0 : ~ 1 == 0;
+    SFdiv_def : forall p q, p / q == p * / q;
+    SFinv_l : forall p, ~ p == 0 ->  / p * p == 1
+  }.
+
+End FieldAndSemiField.
+
+End MakeFieldPol.
+
+  Definition SF2AF R (rO rI:R) radd rmul rdiv rinv req Rsth 
+    (sf:semi_field_theory rO rI radd rmul rdiv rinv req)  :=
+    mk_afield _ _
+      (SRth_ARth Rsth sf.(SF_SR))
+      sf.(SF_1_neq_0)
+      sf.(SFdiv_def)
+      sf.(SFinv_l).
+
+
+Section Complete.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable (rdiv : R -> R ->  R) (rinv : R ->  R).
+ Variable req : R -> R -> Prop.
+  Notation "0" := rO.  Notation "1" := rI.
+  Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
+  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
+  Notation "x / y " := (rdiv x y).  Notation "/ x" := (rinv x).
+  Notation "x == y" := (req x y) (at level 70, no associativity).
+ Variable Rsth : Setoid_Theory R req.
+   Add Setoid R req Rsth as R_setoid3.
+ Variable Reqe : ring_eq_ext radd rmul ropp req.
+   Add Morphism radd : radd_ext3.  exact (Radd_ext Reqe). Qed.
+   Add Morphism rmul : rmul_ext3.  exact (Rmul_ext Reqe). Qed.
+   Add Morphism ropp : ropp_ext3.  exact (Ropp_ext Reqe). Qed.
+
+Section AlmostField.
+
+ Variable AFth : almost_field_theory rO rI radd rmul rsub ropp rdiv rinv req.
+ Let ARth := AFth.(AF_AR).
+ Let rI_neq_rO := AFth.(AF_1_neq_0).
+ Let rdiv_def := AFth.(AFdiv_def).
+ Let rinv_l := AFth.(AFinv_l).
+
+Hypothesis S_inj : forall x y, 1+x==1+y -> x==y.
+
+Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0.
+
+Lemma add_inj_r : forall p x y,
+   gen_phiPOS1 rI radd rmul p + x == gen_phiPOS1 rI radd rmul p + y -> x==y.
+intros p x y.
+elim p using Pind; simpl in |- *; intros.
+ apply S_inj; trivial.
+ apply H.
+   apply S_inj.
+   repeat rewrite (ARadd_assoc ARth) in |- *.
+   rewrite <- (ARgen_phiPOS_Psucc Rsth Reqe ARth) in |- *; trivial.
+Qed.
+
+Lemma gen_phiPOS_inj : forall x y,
+  gen_phiPOS rI radd rmul x == gen_phiPOS rI radd rmul y ->
+  x = y.
+intros x y.
+repeat rewrite <- (same_gen Rsth Reqe ARth) in |- *.
+ElimPcompare x y; intro.
+ intros.
+   apply Pcompare_Eq_eq; trivial.
+ intro.
+   elim gen_phiPOS_not_0 with (y - x)%positive.
+   apply add_inj_r with x.
+   symmetry  in |- *.
+   rewrite (ARadd_0_r Rsth ARth) in |- *.
+   rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
+   rewrite Pplus_minus in |- *; trivial.
+   change Eq with (CompOpp Eq) in |- *.
+   rewrite <- Pcompare_antisym in |- *; trivial.
+   rewrite H in |- *; trivial.
+ intro.
+   elim gen_phiPOS_not_0 with (x - y)%positive.
+   apply add_inj_r with y.
+   rewrite (ARadd_0_r Rsth ARth) in |- *.
+   rewrite <- (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
+   rewrite Pplus_minus in |- *; trivial.
+Qed.
+
+
+Lemma gen_phiN_inj : forall x y,
+  gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y ->
+  x = y.
+destruct x; destruct y; simpl in |- *; intros; trivial.
+ elim gen_phiPOS_not_0 with p.
+   symmetry  in |- *.
+   rewrite (same_gen Rsth Reqe ARth) in |- *; trivial.
+ elim gen_phiPOS_not_0 with p.
+   rewrite (same_gen Rsth Reqe ARth) in |- *; trivial.
+ rewrite gen_phiPOS_inj with (1 := H) in |- *; trivial.
+Qed.
+
+Lemma gen_phiN_complete : forall x y,
+  gen_phiN rO rI radd rmul x == gen_phiN rO rI radd rmul y ->
+  Neq_bool x y = true.
+intros.
+ replace y with x.
+ unfold Neq_bool in |- *.
+   rewrite Ncompare_refl in |- *; trivial.
+ apply gen_phiN_inj; trivial.
+Qed.
+
+End AlmostField.
+
+Section Field.
+
+ Variable Fth : field_theory rO rI radd rmul rsub ropp rdiv rinv req.
+ Let Rth := Fth.(F_R).
+ Let rI_neq_rO := Fth.(F_1_neq_0).
+ Let rdiv_def := Fth.(Fdiv_def).
+ Let rinv_l := Fth.(Finv_l).
+ Let AFth := F2AF Rsth Reqe Fth.
+ Let ARth := Rth_ARth Rsth Reqe Rth.
+
+Lemma ring_S_inj : forall x y, 1+x==1+y -> x==y.
+intros.
+transitivity (x + (1 + - (1))).
+ rewrite (Ropp_def Rth) in |- *.
+   symmetry  in |- *.
+   apply (ARadd_0_r Rsth ARth).
+ transitivity (y + (1 + - (1))).
+  repeat rewrite <- (ARplus_assoc ARth) in |- *.
+    repeat rewrite (ARadd_assoc ARth) in |- *.
+    apply (Radd_ext Reqe).
+   repeat rewrite <- (ARadd_comm ARth 1) in |- *.
+     trivial.
+   reflexivity.
+  rewrite (Ropp_def Rth) in |- *.
+    apply (ARadd_0_r Rsth ARth).
+Qed.
+
+
+ Hypothesis gen_phiPOS_not_0 : forall p, ~ gen_phiPOS1 rI radd rmul p == 0.
+
+Let gen_phiPOS_inject :=
+   gen_phiPOS_inj AFth ring_S_inj gen_phiPOS_not_0.
+
+Lemma gen_phiPOS_discr_sgn : forall x y,
+  ~ gen_phiPOS rI radd rmul x == - gen_phiPOS rI radd rmul y.
+red in |- *; intros.
+apply gen_phiPOS_not_0 with (y + x)%positive.
+rewrite (ARgen_phiPOS_add Rsth Reqe ARth) in |- *.
+transitivity (gen_phiPOS1 1 radd rmul y + - gen_phiPOS1 1 radd rmul y).
+ apply (Radd_ext Reqe); trivial.
+  reflexivity.
+  rewrite (same_gen Rsth Reqe ARth) in |- *.
+    rewrite (same_gen Rsth Reqe ARth) in |- *.
+    trivial.
+ apply (Ropp_def Rth).
+Qed.
+
+Lemma gen_phiZ_inj : forall x y,
+  gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y ->
+  x = y.
+destruct x; destruct y; simpl in |- *; intros.
+ trivial.
+ elim gen_phiPOS_not_0 with p.
+   rewrite (same_gen Rsth Reqe ARth) in |- *.
+   symmetry  in |- *; trivial.
+ elim gen_phiPOS_not_0 with p.
+   rewrite (same_gen Rsth Reqe ARth) in |- *.
+   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
+   rewrite <- H in |- *.
+   apply (ARopp_zero Rsth Reqe ARth).
+ elim gen_phiPOS_not_0 with p.
+   rewrite (same_gen Rsth Reqe ARth) in |- *.
+   trivial.
+ rewrite gen_phiPOS_inject  with (1 := H) in |- *; trivial.
+ elim gen_phiPOS_discr_sgn with (1 := H).
+ elim gen_phiPOS_not_0 with p.
+   rewrite (same_gen Rsth Reqe ARth) in |- *.
+   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
+   rewrite H in |- *.
+   apply (ARopp_zero Rsth Reqe ARth).
+ elim gen_phiPOS_discr_sgn with p0 p.
+   symmetry  in |- *; trivial.
+ replace p0 with p; trivial.
+   apply gen_phiPOS_inject.
+   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p)) in |- *.
+   rewrite <- (Ropp_opp Rsth Reqe Rth (gen_phiPOS 1 radd rmul p0)) in |- *.
+   rewrite H in |- *; trivial.
+   reflexivity.
+Qed.
+
+Lemma gen_phiZ_complete : forall x y,
+  gen_phiZ rO rI radd rmul ropp x == gen_phiZ rO rI radd rmul ropp y ->
+  Zeq_bool x y = true.
+intros.
+ replace y with x.
+ unfold Zeq_bool in |- *.
+   rewrite Zcompare_refl in |- *; trivial.
+ apply gen_phiZ_inj; trivial.
+Qed.
+
+End Field.
+
+End Complete.
+
diff --git a/contrib/setoid_ring/ZRing_th.v b/contrib/setoid_ring/InitialRing.v
index 9060428b..7df68cc0 100644
--- a/contrib/setoid_ring/ZRing_th.v
+++ b/contrib/setoid_ring/InitialRing.v
@@ -1,11 +1,21 @@
-Require Import Ring_th.
-Require Import Pol.
-Require Import Ring_tac.
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
+
 Require Import ZArith_base.
 Require Import BinInt.
 Require Import BinNat.
 Require Import Setoid.
- Set Implicit Arguments.
+Require Import Ring_theory.
+Require Import Ring_tac.
+Require Import Ring_polynom.
+Set Implicit Arguments.
+
+Import RingSyntax.
 
 (** Z is a ring and a setoid*)
 
@@ -187,7 +197,7 @@ Section ZMORPHISM.
   replace Eq with (CompOpp Eq);trivial.
   rewrite <- Pcompare_antisym;simpl.
   rewrite match_compOpp.    
-  rewrite (Radd_sym Rth).
+  rewrite (Radd_comm Rth).
   apply gen_phiZ1_add_pos_neg.
   rewrite (ARgen_phiPOS_add ARth); norm.
  Qed.
@@ -255,6 +265,14 @@ Lemma Neq_bool_ok : forall x y, Neq_bool x y = true -> x = y.
   rewrite H;trivial. 
  Qed.
 
+Lemma Neq_bool_complete : forall x y, Neq_bool x y = true -> x = y.
+ Proof.
+  intros x y;unfold Neq_bool.
+  assert (H:=Ncompare_Eq_eq x y); 
+   destruct (Ncompare x y);intros;try discriminate.
+  rewrite H;trivial. 
+ Qed.
+
 (**Same as above : definition of two,extensionaly equal, generic morphisms *)
 (**from N to any semi-ring*)
 Section NMORPHISM.
@@ -326,271 +344,9 @@ Section NMORPHISM.
  Qed.
 
 End NMORPHISM.
-(*
-Section NNMORPHISM.
-Variable R : Type.
- Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
- Variable req : R -> R -> Prop.
-  Notation "0" := rO.  Notation "1" := rI.
-  Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
-  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
-  Notation "x == y" := (req x y).
-  Variable Rsth : Setoid_Theory R req.
-     Add Setoid R req Rsth as R_setoid5.
-     Ltac rrefl := gen_reflexivity Rsth.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext5.  exact Reqe.(Radd_ext). Qed.
-   Add Morphism rmul : rmul_ext5.  exact Reqe.(Rmul_ext). Qed.
-   Add Morphism ropp : ropp_ext5.  exact Reqe.(Ropp_ext). Qed.
-
- Lemma SReqe : sring_eq_ext radd rmul req.
-  case Reqe; constructor; trivial.
- Qed.
-
- Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub : rsub_ext6. exact (ARsub_ext Rsth Reqe ARth). Qed.
-   Ltac norm := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth.
-   Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-
- Lemma SRth : semi_ring_theory 0 1 radd rmul req. 
-  case ARth; constructor; trivial.
- Qed.
-
-  Definition NN := prod N N.
-  Definition gen_phiNN (x:NN) :=
-    rsub (gen_phiN rO rI radd rmul (fst x)) (gen_phiN rO rI radd rmul (snd x)).
-  Notation "[ x ]" := (gen_phiNN x).   
-
-  Definition NNadd (x y : NN) : NN :=
-    (fst x + fst y, snd x + snd y)%N.
-  Definition NNmul (x y : NN) : NN :=
-    (fst x * fst y + snd x * snd y, fst y * snd x + fst x * snd y)%N.
-  Definition NNopp (x:NN) : NN := (snd x, fst x)%N.
-  Definition NNsub (x y:NN) : NN := (fst x + snd y, fst y + snd x)%N.
-
-
- Lemma gen_phiNN_add : forall x y, [NNadd x y] == [x] + [y].
- Proof.
-intros.
-unfold NNadd, gen_phiNN in |- *; simpl in |- *.
-repeat  rewrite (gen_phiN_add Rsth SReqe SRth).
-norm.
-add_push (- gen_phiN 0 1 radd rmul (snd x)).
-rrefl.
-Qed.
- 
-  Hypothesis ropp_involutive : forall x, - - x == x.
-
-
- Lemma gen_phiNN_mult : forall x y, [NNmul x y] == [x] * [y].
- Proof.
-intros.
-unfold NNmul, gen_phiNN in |- *; simpl in |- *.
-repeat  rewrite (gen_phiN_add Rsth SReqe SRth).
-repeat  rewrite (gen_phiN_mult Rsth SReqe SRth).
-norm.
-rewrite ropp_involutive.
-add_push (- (gen_phiN 0 1 radd rmul (fst y) * gen_phiN 0 1 radd rmul (snd x))).
-add_push ( gen_phiN 0 1 radd rmul (snd x) * gen_phiN 0 1 radd rmul (snd y)).
-rewrite (ARmul_sym ARth (gen_phiN 0 1 radd rmul (fst y))
-            (gen_phiN 0 1 radd rmul (snd x))).
-rrefl.
-Qed.
-
- Lemma gen_phiNN_sub : forall x y, [NNsub x y] == [x] - [y].
-intros.
-unfold NNsub, gen_phiNN; simpl.
-repeat rewrite (gen_phiN_add Rsth SReqe SRth).
-repeat rewrite (ARsub_def ARth).
-repeat rewrite (ARopp_add ARth).
-repeat rewrite (ARadd_assoc ARth).
-rewrite ropp_involutive.
-add_push (- gen_phiN 0 1 radd rmul (fst y)).
-add_push ( - gen_phiN 0 1 radd rmul (snd x)).
-rrefl.
-Qed.
-
-
-Definition NNeqbool (x y: NN) :=
-  andb (Neq_bool (fst x) (fst y)) (Neq_bool (snd x) (snd y)).
-
-Lemma NNeqbool_ok0 : forall x y,
-  NNeqbool x y = true -> x = y.
-unfold NNeqbool in |- *.
-intros.
-assert (Neq_bool (fst x) (fst y) = true).
- generalize H.
-   case (Neq_bool (fst x) (fst y)); simpl in |- *; trivial.
- assert (Neq_bool (snd x) (snd y) = true).
-   rewrite H0 in H; simpl in |- *; trivial.
-  generalize H0 H1.
-    destruct x; destruct y; simpl in |- *.
-    intros.
-     replace n with n1.
-    replace n2 with n0; trivial.
-     apply Neq_bool_ok; trivial.
-   symmetry  in |- *.
-     apply Neq_bool_ok; trivial.
-Qed.
-
-
-(*gen_phiN satisfies morphism specifications*)
- Lemma gen_phiNN_morph : ring_morph 0 1 radd rmul rsub ropp req
-                        (N0,N0) (Npos xH,N0) NNadd NNmul NNsub NNopp NNeqbool gen_phiNN.
- Proof.
-  constructor;intros;simpl; try rrefl.
-  apply gen_phiN_add. apply gen_phiN_sub.  apply gen_phiN_mult.
-  rewrite (Neq_bool_ok x y);trivial. rrefl.
- Qed.
-
-End NNMORPHISM.
-
-Section NSTARMORPHISM.
-Variable R : Type.
- Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
- Variable req : R -> R -> Prop.
-  Notation "0" := rO.  Notation "1" := rI.
-  Notation "x + y" := (radd x y).  Notation "x * y " := (rmul x y).
-  Notation "x - y " := (rsub x y).  Notation "- x" := (ropp x).
-  Notation "x == y" := (req x y).
-  Variable Rsth : Setoid_Theory R req.
-     Add Setoid R req Rsth as R_setoid3.
-     Ltac rrefl := gen_reflexivity Rsth.
- Variable Reqe : ring_eq_ext radd rmul ropp req.
-   Add Morphism radd : radd_ext3.  exact Reqe.(Radd_ext). Qed.
-   Add Morphism rmul : rmul_ext3.  exact Reqe.(Rmul_ext). Qed.
-   Add Morphism ropp : ropp_ext3.  exact Reqe.(Ropp_ext). Qed.
-
- Lemma SReqe : sring_eq_ext radd rmul req.
-  case Reqe; constructor; trivial.
- Qed.
-
- Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
-   Add Morphism rsub : rsub_ext7. exact (ARsub_ext Rsth Reqe ARth). Qed.
-   Ltac norm := gen_srewrite 0 1 radd rmul rsub ropp req Rsth Reqe ARth.
-   Ltac add_push := gen_add_push radd Rsth Reqe ARth.
-
- Lemma SRth : semi_ring_theory 0 1 radd rmul req. 
-  case ARth; constructor; trivial.
- Qed.
-
-  Inductive Nword : Set :=
-    Nlast (p:positive)
-  | Ndigit (n:N) (w:Nword).
-
-  Fixpoint opp_iter (n:nat) (t:R) {struct n} : R :=
-    match n with 
-      O => t
-    | S k => ropp (opp_iter k t)
-    end.
-
-  Fixpoint gen_phiNword (x:Nword) (n:nat) {struct x} : R :=
-    match x with
-      Nlast p => opp_iter n (gen_phi_pos p)
-    | Ndigit N0 w => gen_phiNword w (S n)
-    | Ndigit m w => radd (opp_iter n (gen_phiN m)) (gen_phiNword w (S n))
-    end.
-  Notation "[ x ]" := (gen_phiNword x).   
-
-  Fixpoint Nwadd (x y : Nword) {struct x} : Nword :=
-    match x, y with
-      Nlast p1, Nlast p2 => Nlast (p1+p2)%positive
-    | Nlast p1, Ndigit n w => Ndigit (Npos p1 + n)%N w
-    | Ndigit n w, Nlast p1 => Ndigit (n + Npos p1)%N w
-    | Ndigit n1 w1, Ndigit n2 w2 => Ndigit (n1+n2)%N (Nwadd w1 w2)
-    end.
-  Fixpoint Nwmulp (x:positive) (y:Nword) {struct y} : Nword :=
-    match y with
-      Nlast p => Nlast (x*p)%positive
-    | Ndigit n w => Ndigit (Npos x * n)%N (Nwmulp x w)
-    end.
-  Definition Nwmul (x y : Nword) {struct x} : Nword :=
-    match x with
-      Nlast k => Nmulp k y
-    | Ndigit N0 w => Ndigit N0 (Nwmul w y)
-    | Ndigit (Npos k) w =>
-        Nwadd (Nwmulp k y) (Ndigit N0 (Nwmul w y))
-   end.
-
-  Definition Nwopp (x:Nword) : Nword := Ndigit N0 x.
-  Definition Nwsub (x y:NN) : NN := (Nwadd x (Ndigit N0 y)).
-
-
- Lemma gen_phiNN_add : forall x y, [NNadd x y] == [x] + [y].
- Proof.
-intros.
-unfold NNadd, gen_phiNN in |- *; simpl in |- *.
-repeat  rewrite (gen_phiN_add Rsth SReqe SRth).
-norm.
-add_push (- gen_phiN 0 1 radd rmul (snd x)).
-rrefl.
-Qed.
-
- Lemma gen_phiNN_mult : forall x y, [NNmul x y] == [x] * [y].
- Proof.
-intros.
-unfold NNmul, gen_phiNN in |- *; simpl in |- *.
-repeat  rewrite (gen_phiN_add Rsth SReqe SRth).
-repeat  rewrite (gen_phiN_mult Rsth SReqe SRth).
-norm.
-rewrite ropp_involutive.
-add_push (- (gen_phiN 0 1 radd rmul (fst y) * gen_phiN 0 1 radd rmul (snd x))).
-add_push ( gen_phiN 0 1 radd rmul (snd x) * gen_phiN 0 1 radd rmul (snd y)).
-rewrite (ARmul_sym ARth (gen_phiN 0 1 radd rmul (fst y))
-            (gen_phiN 0 1 radd rmul (snd x))).
-rrefl.
-Qed.
 
- Lemma gen_phiNN_sub : forall x y, [NNsub x y] == [x] - [y].
-intros.
-unfold NNsub, gen_phiNN; simpl.
-repeat rewrite (gen_phiN_add Rsth SReqe SRth).
-repeat rewrite (ARsub_def ARth).
-repeat rewrite (ARopp_add ARth).
-repeat rewrite (ARadd_assoc ARth).
-rewrite ropp_involutive.
-add_push (- gen_phiN 0 1 radd rmul (fst y)).
-add_push ( - gen_phiN 0 1 radd rmul (snd x)).
-rrefl.
-Qed.
-
-
-Definition NNeqbool (x y: NN) :=
-  andb (Neq_bool (fst x) (fst y)) (Neq_bool (snd x) (snd y)).
-
-Lemma NNeqbool_ok0 : forall x y,
-  NNeqbool x y = true -> x = y.
-unfold NNeqbool in |- *.
-intros.
-assert (Neq_bool (fst x) (fst y) = true).
- generalize H.
-   case (Neq_bool (fst x) (fst y)); simpl in |- *; trivial.
- assert (Neq_bool (snd x) (snd y) = true).
-   rewrite H0 in H; simpl in |- *; trivial.
-  generalize H0 H1.
-    destruct x; destruct y; simpl in |- *.
-    intros.
-     replace n with n1.
-    replace n2 with n0; trivial.
-     apply Neq_bool_ok; trivial.
-   symmetry  in |- *.
-     apply Neq_bool_ok; trivial.
-Qed.
-
-
-(*gen_phiN satisfies morphism specifications*)
- Lemma gen_phiNN_morph : ring_morph 0 1 radd rmul rsub ropp req
-                        (N0,N0) (Npos xH,N0) NNadd NNmul NNsub NNopp NNeqbool gen_phiNN.
- Proof.
-  constructor;intros;simpl; try rrefl.
-  apply gen_phiN_add. apply gen_phiN_sub.  apply gen_phiN_mult.
-  rewrite (Neq_bool_ok x y);trivial. rrefl.
- Qed.
-
-End NSTARMORPHISM.
-*)
-
- (* syntaxification of constants in an abstract ring *)
+ (* syntaxification of constants in an abstract ring:
+    the inverse of gen_phiPOS *)
  Ltac inv_gen_phi_pos rI add mul t :=
    let rec inv_cst t :=
    match t with
@@ -600,7 +356,7 @@ End NSTARMORPHISM.
    | (mul (add rI rI) ?p) => (* 2p *)
        match inv_cst p with
          NotConstant => NotConstant
-       | 1%positive => NotConstant
+       | 1%positive => NotConstant (* 2*1 is not convertible to 2 *)
        | ?p => constr:(xO p)
        end
    | (add rI (mul (add rI rI) ?p)) => (* 1+2p *)
@@ -613,6 +369,7 @@ End NSTARMORPHISM.
    end in
    inv_cst t.
 
+(* The inverse of gen_phiN *)
  Ltac inv_gen_phiN rO rI add mul t :=
    match t with
      rO => constr:0%N
@@ -623,6 +380,7 @@ End NSTARMORPHISM.
      end
    end.
 
+(* The inverse of gen_phiZ *)
  Ltac inv_gen_phiZ rO rI add mul opp t :=
    match t with
      rO => constr:0%Z
@@ -637,6 +395,7 @@ End NSTARMORPHISM.
      | ?p => constr:(Zpos p)
      end
    end.
+
 (* coefs = Z (abstract ring) *)
 Module Zpol.
 
@@ -646,23 +405,15 @@ Definition ring_gen_correct
                 (Rth_ARth rSet req_th Rth)
                 Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
                 (@gen_phiZ R rO rI radd rmul ropp)
-            (@gen_phiZ_morph R rO rI radd rmul rsub ropp req rSet req_th Rth).
+                (gen_phiZ_morph rSet req_th Rth).
 
 Definition ring_rw_gen_correct
   R rO rI radd rmul rsub ropp req rSet req_th Rth :=
-  @Pphi_dev_ok  R rO rI radd rmul rsub ropp req rSet req_th
-                (Rth_ARth rSet req_th Rth)
-                Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
-                (@gen_phiZ R rO rI radd rmul ropp)
-            (@gen_phiZ_morph R rO rI radd rmul rsub ropp req rSet req_th Rth).
-
-Definition ring_rw_gen_correct'
-  R rO rI radd rmul rsub ropp req rSet req_th Rth :=
-  @Pphi_dev_ok'  R rO rI radd rmul rsub ropp req rSet req_th
+  @Pphi_dev_ok   R rO rI radd rmul rsub ropp req rSet req_th
                  (Rth_ARth rSet req_th Rth)
                  Z 0%Z 1%Z Zplus Zmult Zminus Zopp Zeq_bool
                  (@gen_phiZ R rO rI radd rmul ropp)
-            (@gen_phiZ_morph R rO rI radd rmul rsub ropp req rSet req_th Rth).
+                 (gen_phiZ_morph rSet req_th Rth).
 
 Definition ring_gen_eq_correct R rO rI radd rmul rsub ropp Rth :=
   @ring_gen_correct
@@ -672,10 +423,6 @@ Definition ring_rw_gen_eq_correct R rO rI radd rmul rsub ropp Rth :=
   @ring_rw_gen_correct
      R rO rI radd rmul rsub ropp (@eq R) (Eqsth R) (Eq_ext _ _ _) Rth.
 
-Definition ring_rw_gen_eq_correct' R rO rI radd rmul rsub ropp Rth :=
-  @ring_rw_gen_correct'
-     R rO rI radd rmul rsub ropp (@eq R) (Eqsth R) (Eq_ext _ _ _) Rth.
-
 End Zpol.
 
 (* coefs = N (abstract semi-ring) *)
@@ -688,115 +435,77 @@ Definition ring_gen_correct
                 (SRth_ARth rSet SRth)
                 N 0%N 1%N Nplus Nmult (SRsub Nplus) (@SRopp N) Neq_bool
                 (@gen_phiN R rO rI radd rmul)
-            (@gen_phiN_morph R rO rI radd rmul req rSet req_th SRth).
+                (gen_phiN_morph rSet req_th SRth).
 
 Definition ring_rw_gen_correct
   R rO rI radd rmul req rSet req_th SRth :=
-  @Pphi_dev_ok  R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet
-                (SReqe_Reqe req_th)
-                (SRth_ARth rSet SRth)
-                N 0%N 1%N Nplus Nmult (SRsub Nplus) (@SRopp N) Neq_bool
-                (@gen_phiN R rO rI radd rmul)
-            (@gen_phiN_morph R rO rI radd rmul req rSet req_th SRth).
-
-Definition ring_rw_gen_correct'
-  R rO rI radd rmul req rSet req_th SRth :=
-  @Pphi_dev_ok'  R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet
+  @Pphi_dev_ok   R rO rI radd rmul (SRsub radd) (@SRopp R) req rSet
                  (SReqe_Reqe req_th)
                  (SRth_ARth rSet SRth)
                  N 0%N 1%N Nplus Nmult (SRsub Nplus) (@SRopp N) Neq_bool
                  (@gen_phiN R rO rI radd rmul)
-            (@gen_phiN_morph R rO rI radd rmul req rSet req_th SRth).
+                 (gen_phiN_morph rSet req_th SRth).
 
 Definition ring_gen_eq_correct R rO rI radd rmul SRth :=
   @ring_gen_correct
      R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth.
 
-Definition ring_rw_gen_eq_correct R rO rI radd rmul SRth :=
-  @ring_rw_gen_correct
-     R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth.
-
 Definition ring_rw_gen_eq_correct' R rO rI radd rmul SRth :=
-  @ring_rw_gen_correct'
+  @ring_rw_gen_correct
      R rO rI radd rmul (@eq R) (Eqsth R) (Eq_s_ext _ _) SRth.
 
 End Npol.
 
-(* Z *)
-
-Ltac isZcst t :=
-  match t with
-    Z0 => constr:true
-  | Zpos ?p => isZcst p
-  | Zneg ?p => isZcst p
-  | xI ?p => isZcst p
-  | xO ?p => isZcst p
-  | xH => constr:true
-  | _ => constr:false
-  end.
-Ltac Zcst t :=
-  match isZcst t with
-    true => t
-  | _ => NotConstant
-  end.
-
-Add New Ring Zr : Zth Computational Zeqb_ok Constant Zcst.
 
-(* N *)
-
-Ltac isNcst t :=
-  match t with
-    N0 => constr:true
-  | Npos ?p => isNcst p
-  | xI ?p => isNcst p
-  | xO ?p => isNcst p
-  | xH => constr:true
-  | _ => constr:false
-  end.
-Ltac Ncst t :=
-  match isNcst t with
-    true => t
-  | _ => NotConstant
+Ltac coerce_to_almost_ring set ext rspec :=
+  match type of rspec with
+  | ring_theory _ _ _ _ _ _ _ => constr:(Rth_ARth set ext rspec)
+  | semi_ring_theory _ _ _ _ _ => constr:(SRth_ARth set rspec)
+  | almost_ring_theory _ _ _ _ _ _ _ => rspec
+  | _ => fail 1 "not a valid ring theory"
   end.
 
-Add New Ring Nr : Nth Computational Neq_bool_ok Constant Ncst.
-
-(* nat *)
-
-Ltac isnatcst t :=
-  match t with
-    O => true
-  | S ?p => isnatcst p
-  | _ => false
-  end.
-Ltac natcst t :=
-  match isnatcst t with
-    true => t
-  | _ => NotConstant
+Ltac coerce_to_ring_ext ext :=
+  match type of ext with
+  | ring_eq_ext _ _ _ _ => ext
+  | sring_eq_ext _ _ _ => constr:(SReqe_Reqe ext)
+  | _ => fail 1 "not a valid ring_eq_ext theory"
   end.
 
- Lemma natSRth : semi_ring_theory O (S O) plus mult (@eq nat).
- Proof.
-  constructor. exact plus_0_l. exact plus_comm. exact plus_assoc.
-  exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc.
-  exact mult_plus_distr_r. 
- Qed.
-
-
-Unboxed Fixpoint nateq (n m:nat) {struct m} : bool :=
-  match n, m with
-  | O, O => true
-  | S n', S m' => nateq n' m'
-  | _, _ => false
+Ltac abstract_ring_morphism set ext rspec :=
+  match type of rspec with
+  | ring_theory _ _ _ _ _ _ _ => constr:(gen_phiZ_morph set ext rspec)
+  | semi_ring_theory _ _ _ _ _ => constr:(gen_phiN_morph set ext rspec)
+  | almost_ring_theory _ _ _ _ _ _ _ =>
+      fail 1 "an almost ring cannot be abstract"
+  | _ => fail 1 "bad ring structure"
   end.
 
-Lemma nateq_ok : forall n m:nat, nateq n m = true -> n = m.
-Proof.
-  simple induction n; simple induction m; simpl; intros; try discriminate.
-  trivial.
-  rewrite (H n1 H1).
-  trivial.
-Qed.
+Ltac ring_elements set ext rspec rk :=
+  let arth := coerce_to_almost_ring set ext rspec in
+  let ext_r := coerce_to_ring_ext ext in
+  let morph :=
+    match rk with
+    | Abstract => abstract_ring_morphism set ext rspec
+    | @Computational ?reqb_ok =>
+        match type of arth with
+        | almost_ring_theory ?rO ?rI ?add ?mul ?sub ?opp _ =>
+            constr:(IDmorph rO rI add mul sub opp set _ reqb_ok)
+        | _ => fail 2 "ring anomaly"
+        end
+    | @Morphism ?m => m
+    | _ => fail 1 "ill-formed ring kind"
+    end in
+  fun f => f arth ext_r morph.
+
+(* Given a ring structure and the kind of morphism,
+   returns 2 lemmas (one for ring, and one for ring_simplify). *)
+
+Ltac ring_lemmas set ext rspec rk :=
+  ring_elements set ext rspec rk
+    ltac:(fun arth ext_r morph =>
+      let lemma1 := constr:(ring_correct set ext_r arth morph) in
+      let lemma2 := constr:(Pphi_dev_ok set ext_r arth morph) in
+      fun f => f arth ext_r morph lemma1 lemma2).
 
-Add New Ring natr : natSRth Computational nateq_ok Constant natcst.
 
diff --git a/contrib/setoid_ring/NArithRing.v b/contrib/setoid_ring/NArithRing.v
new file mode 100644
index 00000000..33e3cb4e
--- /dev/null
+++ b/contrib/setoid_ring/NArithRing.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        *)
+(************************************************************************)
+
+Require Export Ring.
+Require Import BinPos BinNat.
+Import InitialRing.
+
+Set Implicit Arguments.
+
+Ltac isNcst t :=
+  let t := eval hnf in t in
+  match t with
+    N0 => constr:true
+  | Npos ?p => isNcst p
+  | xI ?p => isNcst p
+  | xO ?p => isNcst p
+  | xH => constr:true
+  | _ => constr:false
+  end.
+Ltac Ncst t :=
+  match isNcst t with
+    true => t
+  | _ => NotConstant
+  end.
+
+Add Ring Nr : Nth (decidable Neq_bool_ok, constants [Ncst]).
diff --git a/contrib/setoid_ring/RealField.v b/contrib/setoid_ring/RealField.v
new file mode 100644
index 00000000..13896123
--- /dev/null
+++ b/contrib/setoid_ring/RealField.v
@@ -0,0 +1,105 @@
+Require Import Raxioms.
+Require Import Rdefinitions.
+Require Export Ring Field.
+
+Open Local Scope R_scope.
+
+Lemma RTheory : ring_theory 0 1 Rplus Rmult Rminus Ropp (eq (A:=R)).
+Proof.
+constructor.
+ intro; apply Rplus_0_l.
+ exact Rplus_comm.
+ symmetry  in |- *; apply Rplus_assoc.
+ intro; apply Rmult_1_l.
+ exact Rmult_comm.
+ symmetry  in |- *; apply Rmult_assoc.
+ intros m n p.
+   rewrite Rmult_comm in |- *.
+   rewrite (Rmult_comm n p) in |- *.
+   rewrite (Rmult_comm m p) in |- *.
+   apply Rmult_plus_distr_l.
+ reflexivity.
+ exact Rplus_opp_r.
+Qed.
+
+Lemma Rfield : field_theory 0 1 Rplus Rmult Rminus Ropp Rdiv Rinv (eq(A:=R)).
+Proof.
+constructor.
+ exact RTheory.
+ exact R1_neq_R0.
+ reflexivity.
+ exact Rinv_l.
+Qed.
+
+Lemma Rlt_n_Sn : forall x, x < x + 1.
+Proof.
+intro.
+elim archimed with x; intros.
+destruct H0.
+ apply Rlt_trans with (IZR (up x)); trivial.
+    replace (IZR (up x)) with (x + (IZR (up x) - x))%R.
+  apply Rplus_lt_compat_l; trivial.
+  unfold Rminus in |- *.
+    rewrite (Rplus_comm (IZR (up x)) (- x)) in |- *.
+    rewrite <- Rplus_assoc in |- *.
+    rewrite Rplus_opp_r in |- *.
+    apply Rplus_0_l.
+ elim H0.
+   unfold Rminus in |- *.
+   rewrite (Rplus_comm (IZR (up x)) (- x)) in |- *.
+   rewrite <- Rplus_assoc in |- *.
+   rewrite Rplus_opp_r in |- *.
+   rewrite Rplus_0_l in |- *; trivial.
+Qed.
+
+Notation Rset := (Eqsth R).
+Notation Rext := (Eq_ext Rplus Rmult Ropp).
+
+Lemma Rlt_0_2 : 0 < 2.
+apply Rlt_trans with (0 + 1).
+ apply Rlt_n_Sn.
+ rewrite Rplus_comm in |- *.
+   apply Rplus_lt_compat_l.
+    replace 1 with (0 + 1).
+  apply Rlt_n_Sn.
+  apply Rplus_0_l.
+Qed.
+
+Lemma Rgen_phiPOS : forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x > 0.
+unfold Rgt in |- *.
+induction x; simpl in |- *; intros.
+ apply Rlt_trans with (1 + 0).
+  rewrite Rplus_comm in |- *.
+    apply Rlt_n_Sn.
+  apply Rplus_lt_compat_l.
+    rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *.
+    rewrite Rmult_comm in |- *.
+    apply Rmult_lt_compat_l.
+   apply Rlt_0_2.
+   trivial.
+ rewrite <- (Rmul_0_l Rset Rext RTheory 2) in |- *.
+   rewrite Rmult_comm in |- *.
+   apply Rmult_lt_compat_l.
+  apply Rlt_0_2.
+  trivial.
+  replace 1 with (0 + 1).
+  apply Rlt_n_Sn.
+  apply Rplus_0_l.
+Qed.
+
+
+Lemma Rgen_phiPOS_not_0 :
+  forall x, InitialRing.gen_phiPOS1 1 Rplus Rmult x <> 0.
+red in |- *; intros.
+specialize (Rgen_phiPOS x).
+rewrite H in |- *; intro.
+apply (Rlt_asym 0 0); trivial.
+Qed.
+
+Lemma Zeq_bool_complete : forall x y, 
+  InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp x =
+  InitialRing.gen_phiZ 0%R 1%R Rplus Rmult Ropp y ->
+  Zeq_bool x y = true.
+Proof gen_phiZ_complete Rset Rext Rfield Rgen_phiPOS_not_0.
+
+Add Field RField : Rfield (infinite Zeq_bool_complete).
diff --git a/contrib/setoid_ring/Ring.v b/contrib/setoid_ring/Ring.v
new file mode 100644
index 00000000..167e026f
--- /dev/null
+++ b/contrib/setoid_ring/Ring.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        *)
+(************************************************************************)
+
+Require Import Bool.
+Require Export Ring_theory.
+Require Export Ring_base.
+Require Export Ring_tac.
+
+Lemma BoolTheory :
+  ring_theory false true xorb andb xorb (fun b:bool => b) (eq(A:=bool)).
+split; simpl in |- *.
+destruct x; reflexivity.
+destruct x; destruct y; reflexivity.
+destruct x; destruct y; destruct z; reflexivity.
+reflexivity.
+destruct x; destruct y; reflexivity.
+destruct x; destruct y; reflexivity.
+destruct x; destruct y; destruct z; reflexivity.
+reflexivity.
+destruct x; reflexivity.
+Qed.
+
+Unboxed Definition bool_eq (b1 b2:bool) :=
+  if b1 then b2 else negb b2.
+
+Lemma bool_eq_ok : forall b1 b2, bool_eq b1 b2 = true -> b1 = b2.
+destruct b1; destruct b2; auto.
+Qed.
+
+Ltac bool_cst t :=
+  let t := eval hnf in t in
+  match t with
+    true => constr:true
+  | false => constr:false
+  | _ => NotConstant
+  end.
+
+Add Ring bool_ring : BoolTheory (decidable bool_eq_ok, constants [bool_cst]).
diff --git a/contrib/setoid_ring/Ring_base.v b/contrib/setoid_ring/Ring_base.v
new file mode 100644
index 00000000..95b037e3
--- /dev/null
+++ b/contrib/setoid_ring/Ring_base.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        *)
+(************************************************************************)
+
+(* This module gathers the necessary base to build an instance of the
+   ring tactic. Abstract rings need more theory, depending on
+   ZArith_base. *)
+
+Declare ML Module "newring".
+Require Export Ring_theory.
+Require Export Ring_tac.
+Require Import InitialRing.
diff --git a/contrib/setoid_ring/Ring_equiv.v b/contrib/setoid_ring/Ring_equiv.v
new file mode 100644
index 00000000..945f6c68
--- /dev/null
+++ b/contrib/setoid_ring/Ring_equiv.v
@@ -0,0 +1,74 @@
+Require Import Setoid_ring_theory.
+Require Import LegacyRing_theory.
+Require Import Ring_theory.
+
+Set Implicit Arguments.
+
+Section Old2New.
+
+Variable A : Type.
+
+Variable Aplus : A -> A -> A.
+Variable Amult : A -> A -> A.
+Variable Aone : A.
+Variable Azero : A.
+Variable Aopp : A -> A.
+Variable Aeq : A -> A -> bool.
+Variable R : Ring_Theory Aplus Amult Aone Azero Aopp Aeq.
+
+Let Aminus := fun x y => Aplus x (Aopp y).
+
+Lemma ring_equiv1 :
+  ring_theory Azero Aone Aplus Amult Aminus Aopp (eq (A:=A)).
+Proof.
+destruct R.
+split;  eauto.
+Qed.
+
+End Old2New.
+
+Section New2OldRing.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable Rth : ring_theory rO rI radd rmul rsub ropp (eq (A:=R)).
+
+ Variable reqb : R -> R -> bool.
+ Variable reqb_ok : forall x y, reqb x y = true -> x = y.
+
+ Lemma ring_equiv2 :
+   Ring_Theory radd  rmul rI rO ropp reqb.
+Proof.
+elim Rth; intros; constructor;  eauto.
+intros.
+apply reqb_ok.
+destruct (reqb x y); trivial; intros.
+elim H.
+Qed.
+
+ Definition default_eqb : R -> R -> bool := fun x y => false.
+ Lemma default_eqb_ok : forall x y, default_eqb x y = true -> x = y.
+Proof.
+discriminate 1.
+Qed.
+
+End New2OldRing.
+
+Section New2OldSemiRing.
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul: R->R->R).
+ Variable SRth : semi_ring_theory rO rI radd rmul (eq (A:=R)).
+
+ Variable reqb : R -> R -> bool.
+ Variable reqb_ok : forall x y, reqb x y = true -> x = y.
+
+ Lemma sring_equiv2 :
+   Semi_Ring_Theory radd rmul rI rO reqb.
+Proof.
+elim SRth; intros; constructor;  eauto.
+intros.
+apply reqb_ok.
+destruct (reqb x y); trivial; intros.
+elim H.
+Qed.
+
+End New2OldSemiRing.
diff --git a/contrib/setoid_ring/Pol.v b/contrib/setoid_ring/Ring_polynom.v
index 2bf2574f..7317ab21 100644
--- a/contrib/setoid_ring/Pol.v
+++ b/contrib/setoid_ring/Ring_polynom.v
@@ -1,9 +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        *)
+(************************************************************************)
+
 Set Implicit Arguments.
 Require Import Setoid.
-Require Export BinList.
+Require Import BinList.
 Require Import BinPos.
 Require Import BinInt.
-Require Export Ring_th.
+Require Export Ring_theory.
+
+Import RingSyntax.
 
 Section MakeRingPol.
  
@@ -313,7 +323,13 @@ Section MakeRingPol.
   end.
  Notation "P ** P'" := (Pmul P P').
  
- (** Evaluation of a polynomial towards R *)
+
+ (** Monomial **)
+     
+  Inductive Mon: Set :=
+    mon0: Mon 
+  | zmon: positive -> Mon -> Mon 
+  | vmon: positive -> Mon -> Mon.
 
  Fixpoint pow (x:R) (i:positive) {struct i}: R :=
   match i with
@@ -322,6 +338,96 @@ Section MakeRingPol.
   | xI i => let p := pow x i in x * p * p
   end.
 
+ Fixpoint Mphi(l:list R) (M: Mon) {struct M} : R :=
+  match M with
+     mon0 => rI
+  | zmon j M1  => Mphi (jump j l) M1
+  | vmon i M1 =>
+     let x := hd 0 l in
+     let xi := pow x i in
+    (Mphi (tail l) M1) * xi 
+  end.
+
+ Definition zmon_pred j M :=
+   match j with xH => M | _ => zmon (Ppred j) M end.
+
+ Definition mkZmon j M :=
+   match M with mon0 => mon0 | _ => zmon j M end.
+
+ Fixpoint MFactor (P: Pol) (M: Mon) {struct P}: Pol * Pol :=
+   match P, M with
+        _, mon0 => (Pc cO, P)
+   | Pc _, _    => (P, Pc cO)
+   | Pinj j1 P1, zmon j2 M1 =>
+      match (j1 ?= j2) Eq with
+        Eq => let (R,S) := MFactor P1 M1 in
+                 (mkPinj j1 R, mkPinj j1 S)
+      | Lt => let (R,S) := MFactor P1 (zmon (j2 - j1) M1) in
+                 (mkPinj j1 R, mkPinj j1 S)
+      | Gt => (P, Pc cO)
+      end
+  | Pinj _ _, vmon _ _ => (P, Pc cO)
+  | PX P1 i Q1, zmon j M1 =>
+             let M2 := zmon_pred j M1 in
+             let (R1, S1) := MFactor P1 M in
+             let (R2, S2) := MFactor Q1 M2 in
+               (mkPX R1 i R2, mkPX S1 i S2)
+  | PX P1 i Q1, vmon j M1 =>
+      match (i ?= j) Eq with
+        Eq => let (R1,S1) := MFactor P1 (mkZmon xH M1) in
+                 (mkPX R1 i Q1, S1)
+      | Lt => let (R1,S1) := MFactor P1 (vmon (j - i) M1) in
+                 (mkPX R1 i Q1, S1)
+      | Gt => let (R1,S1) := MFactor P1 (mkZmon xH M1) in
+                 (mkPX R1 i Q1, mkPX S1 (i-j) (Pc cO))
+      end
+   end.
+
+  Definition POneSubst (P1: Pol) (M1: Mon) (P2: Pol): option Pol :=
+    let (Q1,R1) := MFactor P1 M1 in
+    match R1 with 
+     (Pc c) => if c ?=! cO then None 
+               else Some (Padd Q1 (Pmul P2 R1))
+    | _ => Some (Padd Q1 (Pmul P2 R1))
+    end.
+
+  Fixpoint PNSubst1 (P1: Pol) (M1: Mon) (P2: Pol) (n: nat) {struct n}: Pol :=
+    match POneSubst P1 M1 P2 with 
+     Some P3 => match n with S n1 => PNSubst1 P3 M1 P2 n1 | _ => P3 end
+    | _ => P1
+    end.
+
+  Definition PNSubst (P1: Pol) (M1: Mon) (P2: Pol) (n: nat): option Pol :=
+    match POneSubst P1 M1 P2 with 
+     Some P3 => match n with S n1 => Some (PNSubst1 P3 M1 P2 n1) | _ => None end
+    | _ => None
+    end.
+            
+  Fixpoint PSubstL1 (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}: 
+     Pol :=
+    match LM1 with 
+     cons (M1,P2) LM2 => PSubstL1 (PNSubst1 P1 M1 P2 n) LM2 n
+    | _ => P1
+    end.
+
+  Fixpoint PSubstL (P1: Pol) (LM1: list (Mon * Pol)) (n: nat) {struct LM1}: option Pol :=
+    match LM1 with 
+     cons (M1,P2) LM2 =>
+      match PNSubst P1 M1 P2 n with 
+        Some P3 => Some (PSubstL1 P3 LM2 n)
+     |  None => PSubstL P1 LM2 n
+     end
+    | _ => None
+    end.
+
+  Fixpoint PNSubstL (P1: Pol) (LM1: list (Mon * Pol)) (m n: nat) {struct m}: Pol :=
+    match PSubstL P1 LM1 n with 
+     Some P3 => match m with S m1 => PNSubstL P3 LM1 m1 n | _ => P3 end
+    | _ => P1
+    end.
+
+ (** Evaluation of a polynomial towards R *)
+
  Fixpoint Pphi(l:list R) (P:Pol) {struct P} : R :=
   match P with
   | Pc c => [c]
@@ -329,7 +435,7 @@ Section MakeRingPol.
   | PX P i Q => 
      let x := hd 0 l in
      let xi := pow x i in
-    (Pphi l P) * xi + (Pphi (tl l) Q)      
+    (Pphi l P) * xi + (Pphi (tail l) Q)      
   end.
 
  Reserved Notation "P @ l " (at level 10, no associativity).
@@ -418,7 +524,7 @@ Section MakeRingPol.
  Qed.
 
  Lemma mkPX_ok : forall l P i Q, 
-  (mkPX P i Q)@l == P@l*(pow (hd 0 l) i) + Q@(tl l).
+  (mkPX P i Q)@l == P@l*(pow (hd 0 l) i) + Q@(tail l).
  Proof.
   intros l P i Q;unfold mkPX.
   destruct P;try (simpl;rrefl).
@@ -500,7 +606,7 @@ Section MakeRingPol.
   induction P';simpl;intros;Esimpl2.
   generalize P p l;clear P p l.
   induction P;simpl;intros.
-  Esimpl2;apply (ARadd_sym ARth).
+  Esimpl2;apply (ARadd_comm ARth).
   assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
   rewrite H;Esimpl. rewrite IHP';rrefl.
   rewrite H;Esimpl. rewrite IHP';Esimpl.
@@ -519,33 +625,33 @@ Section MakeRingPol.
   rsimpl;add_push (P'1@l * (pow (hd 0 l) p));rrefl.
   rewrite IHP'2;simpl.
   rewrite jump_Pdouble_minus_one;rsimpl;add_push (P'1@l * (pow (hd 0 l) p));rrefl.
-  rewrite IHP'2;rsimpl. add_push (P @ (tl l));rrefl.
+  rewrite IHP'2;rsimpl. add_push (P @ (tail l));rrefl.
   assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
   rewrite IHP'1;rewrite IHP'2;rsimpl.
-  add_push (P3 @ (tl l));rewrite H;rrefl.
+  add_push (P3 @ (tail l));rewrite H;rrefl.
   rewrite IHP'1;rewrite IHP'2;simpl;Esimpl.
   rewrite H;rewrite Pplus_comm.
   rewrite pow_Pplus;rsimpl.
-  add_push (P3 @ (tl l));rrefl.
+  add_push (P3 @ (tail l));rrefl.
   assert (forall P k l, 
            (PaddX Padd P'1 k P) @ l == P@l + P'1@l * pow (hd 0 l) k).
-   induction P;simpl;intros;try apply (ARadd_sym ARth).
-   destruct p2;simpl;try apply (ARadd_sym ARth).
-   rewrite jump_Pdouble_minus_one;apply (ARadd_sym ARth).
+   induction P;simpl;intros;try apply (ARadd_comm ARth).
+   destruct p2;simpl;try apply (ARadd_comm ARth).
+   rewrite jump_Pdouble_minus_one;apply (ARadd_comm ARth).
     assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2.
-    rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tl l0));rrefl.
+    rewrite IHP'1;rsimpl; rewrite H1;add_push (P5 @ (tail l0));rrefl.
     rewrite IHP'1;simpl;Esimpl.
     rewrite H1;rewrite Pplus_comm.
     rewrite pow_Pplus;simpl;Esimpl.
-    add_push (P5 @ (tl l0));rrefl.
+    add_push (P5 @ (tail l0));rrefl.
     rewrite IHP1;rewrite H1;rewrite Pplus_comm.
     rewrite pow_Pplus;simpl;rsimpl.
-    add_push (P5 @ (tl l0));rrefl.
+    add_push (P5 @ (tail l0));rrefl.
   rewrite H0;rsimpl.
-  add_push (P3 @ (tl l)).
+  add_push (P3 @ (tail l)).
   rewrite H;rewrite Pplus_comm.
   rewrite IHP'2;rewrite pow_Pplus;rsimpl.
-  add_push (P3 @ (tl l));rrefl.
+  add_push (P3 @ (tail l));rrefl.
  Qed.
 
  Lemma Psub_ok : forall P' P l, (P -- P')@l == P@l - P'@l.
@@ -553,7 +659,7 @@ Section MakeRingPol.
   induction P';simpl;intros;Esimpl2;trivial.
   generalize P p l;clear P p l.
   induction P;simpl;intros.
-  Esimpl2;apply (ARadd_sym ARth).
+  Esimpl2;apply (ARadd_comm ARth).
   assert (H := ZPminus_spec p p0);destruct (ZPminus p p0).
   rewrite H;Esimpl. rewrite IHP';rsimpl. 
   rewrite H;Esimpl. rewrite IHP';Esimpl.
@@ -569,35 +675,35 @@ Section MakeRingPol.
   repeat rewrite Popp_ok;Esimpl2;rsimpl;add_push [c];try rrefl.
   destruct p0;simpl;Esimpl2.
   rewrite IHP'2;simpl;rsimpl;add_push (P'1@l * (pow (hd 0 l) p));trivial.
-  add_push (P @ (jump p0 (jump p0 (tl l))));rrefl.
+  add_push (P @ (jump p0 (jump p0 (tail l))));rrefl.
   rewrite IHP'2;simpl;rewrite jump_Pdouble_minus_one;rsimpl.
   add_push (- (P'1 @ l * pow (hd 0 l) p));rrefl.
-  rewrite IHP'2;rsimpl;add_push (P @ (tl l));rrefl.
+  rewrite IHP'2;rsimpl;add_push (P @ (tail l));rrefl.
   assert (H := ZPminus_spec p0 p);destruct (ZPminus p0 p);Esimpl2.
   rewrite IHP'1; rewrite IHP'2;rsimpl.
-  add_push (P3 @ (tl l));rewrite H;rrefl.
+  add_push (P3 @ (tail l));rewrite H;rrefl.
    rewrite IHP'1; rewrite IHP'2;rsimpl;simpl;Esimpl.
   rewrite H;rewrite Pplus_comm.
   rewrite pow_Pplus;rsimpl.
-  add_push (P3 @ (tl l));rrefl.
+  add_push (P3 @ (tail l));rrefl.
   assert (forall P k l, 
            (PsubX Psub P'1 k P) @ l == P@l + - P'1@l * pow (hd 0 l) k).
    induction P;simpl;intros.
-   rewrite Popp_ok;rsimpl;apply (ARadd_sym ARth);trivial.
+   rewrite Popp_ok;rsimpl;apply (ARadd_comm ARth);trivial.
    destruct p2;simpl;rewrite Popp_ok;rsimpl.
-   apply (ARadd_sym ARth);trivial.
-   rewrite jump_Pdouble_minus_one;apply (ARadd_sym ARth);trivial.
-   apply (ARadd_sym ARth);trivial.
+   apply (ARadd_comm ARth);trivial.
+   rewrite jump_Pdouble_minus_one;apply (ARadd_comm ARth);trivial.
+   apply (ARadd_comm ARth);trivial.
     assert (H1 := ZPminus_spec p2 k);destruct (ZPminus p2 k);Esimpl2;rsimpl.
-    rewrite IHP'1;rsimpl;add_push (P5 @ (tl l0));rewrite H1;rrefl.
+    rewrite IHP'1;rsimpl;add_push (P5 @ (tail l0));rewrite H1;rrefl.
     rewrite IHP'1;rewrite H1;rewrite Pplus_comm.
     rewrite pow_Pplus;simpl;Esimpl.
-    add_push (P5 @ (tl l0));rrefl.
+    add_push (P5 @ (tail l0));rrefl.
     rewrite IHP1;rewrite H1;rewrite Pplus_comm.
     rewrite pow_Pplus;simpl;rsimpl.
-    add_push (P5 @ (tl l0));rrefl.
+    add_push (P5 @ (tail l0));rrefl.
   rewrite H0;rsimpl.
-  rewrite IHP'2;rsimpl;add_push (P3 @ (tl l)).
+  rewrite IHP'2;rsimpl;add_push (P3 @ (tail l)).
   rewrite H;rewrite Pplus_comm.
   rewrite pow_Pplus;rsimpl.
  Qed.
@@ -609,7 +715,7 @@ Section MakeRingPol.
     (PmulI Pmul_aux P' p P) @ l == P @ l * P' @ (jump p l).
  Proof.
   induction P;simpl;intros.
-  Esimpl2;apply (ARmul_sym ARth).
+  Esimpl2;apply (ARmul_comm ARth).
   assert (H1 := ZPminus_spec p p0);destruct (ZPminus p p0);Esimpl2.
   rewrite H1; rewrite H;rrefl.
   rewrite H1; rewrite H.
@@ -639,13 +745,198 @@ Section MakeRingPol.
  Lemma Pmul_ok : forall P P' l, (P**P')@l == P@l * P'@l.
  Proof.
   destruct P;simpl;intros.
-  Esimpl2;apply (ARmul_sym ARth).
+  Esimpl2;apply (ARmul_comm ARth).
   rewrite (PmulI_ok P (Pmul_aux_ok P)).
-  apply (ARmul_sym ARth).
+  apply (ARmul_comm ARth).
   rewrite Padd_ok; Esimpl2.
   rewrite (PmulI_ok P3 (Pmul_aux_ok P3));trivial.
   rewrite Pmul_aux_ok;mul_push (P' @ l).
-  rewrite (ARmul_sym ARth (P' @ l));rrefl.
+  rewrite (ARmul_comm ARth (P' @ l));rrefl.
+ Qed.
+
+
+ Lemma mkZmon_ok: forall M j l,
+   Mphi l (mkZmon j M) == Mphi l (zmon j M).
+ intros M j l; case M; simpl; intros; rsimpl.
+ Qed.
+
+ Lemma Mphi_ok: forall P M l, 
+    let (Q,R) := MFactor P M in
+      P@l == Q@l + (Mphi l M) * (R@l).
+ Proof.
+ intros P; elim P; simpl; auto; clear P.
+   intros c M l; case M; simpl; auto; try intro p; try intro m;
+   try rewrite (morph0 CRmorph); rsimpl.
+
+   intros i P Hrec M l; case M; simpl; clear M.
+     rewrite (morph0 CRmorph); rsimpl.
+     intros j M.
+     case_eq ((i ?= j) Eq); intros He; simpl.
+       rewrite (Pcompare_Eq_eq _ _ He).
+       generalize (Hrec M (jump j l)); case (MFactor P M);
+        simpl; intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
+       generalize (Hrec (zmon (j -i) M) (jump i l)); 
+       case (MFactor P (zmon (j -i) M)); simpl.
+       intros P2 Q2 H; repeat rewrite mkPinj_ok; auto.
+       rewrite  <- (Pplus_minus _ _ (ZC2 _ _ He)).
+       rewrite Pplus_comm; rewrite jump_Pplus; auto.
+       rewrite (morph0 CRmorph); rsimpl.
+       intros P2 m; rewrite (morph0 CRmorph); rsimpl.
+
+   intros P2 Hrec1 i Q2 Hrec2 M l; case M; simpl; auto.
+   rewrite (morph0 CRmorph); rsimpl.
+   intros j M1.
+     generalize (Hrec1 (zmon j M1) l); 
+     case (MFactor P2 (zmon j M1)).
+     intros R1 S1 H1.
+     generalize (Hrec2 (zmon_pred j M1) (List.tail l)); 
+     case (MFactor Q2 (zmon_pred j M1)); simpl.
+     intros R2 S2 H2; rewrite H1; rewrite H2.
+     repeat rewrite mkPX_ok; simpl.
+     rsimpl.  
+     apply radd_ext; rsimpl.
+     rewrite (ARadd_comm ARth); rsimpl.
+     apply radd_ext; rsimpl.
+     rewrite (ARadd_comm ARth); rsimpl.
+     case j; simpl; auto; try intros j1; rsimpl.
+     rewrite jump_Pdouble_minus_one; rsimpl.
+   intros j M1.
+     case_eq ((i ?= j) Eq); intros He; simpl.
+       rewrite (Pcompare_Eq_eq _ _ He).
+       generalize (Hrec1 (mkZmon xH M1) l); case (MFactor P2 (mkZmon xH M1));
+        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
+       rewrite H; rewrite mkPX_ok; rsimpl.
+       repeat (rewrite <-(ARadd_assoc ARth)).
+       apply radd_ext; rsimpl.
+       rewrite (ARadd_comm ARth); rsimpl.
+       apply radd_ext; rsimpl.
+       repeat (rewrite <-(ARmul_assoc ARth)).
+       rewrite mkZmon_ok.
+       apply rmul_ext; rsimpl.
+       rewrite (ARmul_comm ARth); rsimpl.
+       generalize (Hrec1 (vmon (j - i) M1) l); 
+             case (MFactor P2 (vmon (j - i) M1));
+        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
+       rewrite H; rsimpl; repeat rewrite mkPinj_ok; auto.
+       rewrite mkPX_ok; rsimpl.
+       repeat (rewrite <-(ARadd_assoc ARth)).
+       apply radd_ext; rsimpl.
+       rewrite (ARadd_comm ARth); rsimpl.
+       apply radd_ext; rsimpl.
+       repeat (rewrite <-(ARmul_assoc ARth)).
+       apply rmul_ext; rsimpl.
+       rewrite (ARmul_comm ARth); rsimpl.
+       apply rmul_ext; rsimpl.
+       rewrite <- pow_Pplus.
+       rewrite (Pplus_minus _ _ (ZC2 _ _ He)); rsimpl.
+       generalize (Hrec1 (mkZmon 1 M1) l); 
+             case (MFactor P2 (mkZmon 1 M1));
+        simpl; intros P3 Q3 H; repeat rewrite mkPinj_ok; auto.
+       rewrite H; rsimpl.
+       rewrite mkPX_ok; rsimpl.
+       repeat (rewrite <-(ARadd_assoc ARth)).
+       apply radd_ext; rsimpl.
+       rewrite (ARadd_comm ARth); rsimpl.
+       apply radd_ext; rsimpl.
+       rewrite mkZmon_ok.
+       repeat (rewrite <-(ARmul_assoc ARth)).
+       apply rmul_ext; rsimpl.
+       rewrite (ARmul_comm ARth); rsimpl.
+       rewrite mkPX_ok; simpl; rsimpl.
+       rewrite (morph0 CRmorph); rsimpl.
+       repeat (rewrite <-(ARmul_assoc ARth)).
+       rewrite (ARmul_comm ARth (Q3@l)); rsimpl.
+       apply rmul_ext; rsimpl.
+       rewrite <- pow_Pplus.
+       rewrite (Pplus_minus _ _ He); rsimpl.
+ Qed.
+
+
+ Lemma POneSubst_ok: forall P1 M1 P2 P3 l,
+    POneSubst P1 M1 P2 = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
+ intros P2 M1 P3 P4 l; unfold POneSubst.
+ generalize (Mphi_ok P2 M1 l); case (MFactor P2 M1); simpl; auto.
+ intros Q1 R1; case R1.
+   intros c H; rewrite H.
+   generalize (morph_eq CRmorph c cO);
+        case (c ?=! cO); simpl; auto.
+   intros H1 H2; rewrite H1; auto; rsimpl.
+   discriminate.
+   intros _ H1 H2; injection H1; intros; subst.
+   rewrite H2; rsimpl.
+   rewrite Padd_ok; rewrite Pmul_ok; rsimpl.
+ intros i P5 H; rewrite H.
+   intros HH H1; injection HH; intros; subst; rsimpl.
+   rewrite Padd_ok; rewrite Pmul_ok; rewrite H1; rsimpl.
+ intros i P5 P6 H1 H2 H3; rewrite H1; rewrite H3.
+   injection H2; intros; subst; rsimpl.
+   rewrite Padd_ok; rewrite Pmul_ok; rsimpl.
+ Qed.
+
+
+ Lemma PNSubst1_ok: forall n P1 M1 P2 l,
+    Mphi l M1 == P2@l -> P1@l == (PNSubst1 P1 M1 P2 n)@l.
+ Proof.
+ intros n; elim n; simpl; auto.
+   intros P2 M1 P3 l H.
+   generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l); 
+   case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
+   intros P4 Hrec; rewrite (Hrec P4); auto; rsimpl.
+ intros n1 Hrec P2 M1 P3 l H.
+   generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l); 
+   case (POneSubst P2 M1 P3); [idtac | intros; rsimpl].
+   intros P4 Hrec1; rewrite (Hrec1 P4); auto; rsimpl.
+ Qed.
+
+ Lemma PNSubst_ok: forall n P1 M1 P2 l P3,
+    PNSubst P1 M1 P2 n = Some P3 -> Mphi l M1 == P2@l -> P1@l == P3@l.
+ Proof.
+ intros n P2 M1 P3 l P4; unfold PNSubst.
+ generalize (fun P4 => @POneSubst_ok P2 M1 P3 P4 l); 
+ case (POneSubst P2 M1 P3); [idtac | intros; discriminate].
+ intros P5 H1; case n; try (intros; discriminate). 
+ intros n1 H2; injection H2; intros; subst.
+ rewrite <- PNSubst1_ok; auto.
+ Qed.
+
+ Fixpoint MPcond (LM1: list (Mon * Pol)) (l: list R) {struct LM1} : Prop :=            
+    match LM1 with 
+     cons (M1,P2) LM2 =>  (Mphi l M1 == P2@l) /\ (MPcond LM2 l)
+    | _ => True
+    end.
+
+ Lemma PSubstL1_ok: forall n LM1 P1 l,
+    MPcond LM1 l ->  P1@l == (PSubstL1 P1 LM1 n)@l.
+ Proof.
+ intros n LM1; elim LM1; simpl; auto.
+   intros; rsimpl.
+ intros (M2,P2) LM2 Hrec P3 l [H H1].
+ rewrite <- Hrec; auto.
+ apply PNSubst1_ok; auto.
+ Qed.
+
+ Lemma PSubstL_ok: forall n LM1 P1 P2 l,
+   PSubstL P1 LM1 n = Some P2 -> MPcond LM1 l ->  P1@l == P2@l.
+ Proof.
+ intros n LM1; elim LM1; simpl; auto.
+   intros; discriminate.
+ intros (M2,P2) LM2 Hrec P3 P4 l.
+ generalize (PNSubst_ok n P3 M2 P2); case (PNSubst P3 M2 P2 n).
+   intros P5 H0 H1 [H2 H3]; injection H1; intros; subst.
+   rewrite <- PSubstL1_ok; auto.
+ intros l1 H [H1 H2]; auto.
+ Qed.
+
+ Lemma PNSubstL_ok: forall m n LM1 P1 l,
+    MPcond LM1 l ->  P1@l == (PNSubstL P1 LM1 m n)@l.
+ Proof.
+ intros m; elim m; simpl; auto.
+   intros n LM1 P2 l H; generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
+     case (PSubstL P2 LM1 n); intros; rsimpl; auto.
+ intros m1 Hrec n LM1 P2 l H.
+ generalize (fun P3 => @PSubstL_ok n LM1 P2 P3 l);
+     case (PSubstL P2 LM1 n); intros; rsimpl; auto.
+ rewrite <- Hrec; auto.
  Qed.
 
  (** Definition of polynomial expressions *)
@@ -714,7 +1005,7 @@ Section MakeRingPol.
   | |- context [(?P1 ++ ?P2)@?l] => rewrite (Padd_ok P2 P1 l)
   | |- context [(?P1 -- ?P2)@?l] => rewrite (Psub_ok P2 P1 l)
   | |- context [(norm (PEopp ?pe))@?l] => rewrite (norm_PEopp l pe)
-  end;Esimpl2;try rrefl;try apply (ARadd_sym ARth).
+  end;Esimpl2;try rrefl;try apply (ARadd_comm ARth).
 
  Lemma norm_ok : forall l pe,  PEeval l pe == (norm pe)@l.
  Proof.
@@ -757,12 +1048,12 @@ Section MakeRingPol.
  Fixpoint add_mult_dev (rP:R) (P:Pol) (fv lm:list R) {struct P} : R :=
   (* rP + P@l * lm *)
   match P with
-  | Pc c => if c ?=! cI then mkadd_mult rP (rev lm) 
-    else mkadd_mult rP (cons [c] (rev lm))
+  | Pc c => if c ?=! cI then mkadd_mult rP (rev' lm) 
+    else mkadd_mult rP (cons [c] (rev' lm))
   | Pinj j Q => add_mult_dev rP Q (jump j fv) lm
   | PX P i Q => 
      let rP := add_mult_dev rP P fv (powl i (hd 0 fv) lm) in
-     if Q ?== P0 then rP else add_mult_dev rP Q (tl fv) lm
+     if Q ?== P0 then rP else add_mult_dev rP Q (tail fv) lm
   end.
  
  Definition mkmult1 lm :=
@@ -774,14 +1065,14 @@ Section MakeRingPol.
  Fixpoint mult_dev (P:Pol) (fv lm : list R) {struct P} : R :=
   (* P@l * lm *)							      
   match P with
-  | Pc c => if c ?=! cI then mkmult1 (rev lm) else mkmult [c] (rev lm)
+  | Pc c => if c ?=! cI then mkmult1 (rev' lm) else mkmult [c] (rev' lm)
   | Pinj j Q => mult_dev Q (jump j fv) lm
   | PX P i Q => 
      let rP := mult_dev P fv (powl i (hd 0 fv) lm) in
-     if Q ?== P0 then rP else add_mult_dev rP Q (tl fv) lm
+     if Q ?== P0 then rP else add_mult_dev rP Q (tail fv) lm
   end. 
 
- Definition Pphi_dev fv P := mult_dev P fv (nil R).
+ Definition Pphi_dev fv P := mult_dev P fv nil.
 
  Add Morphism mkmult : mkmult_ext.
   intros r r0 eqr l;generalize l r r0 eqr;clear l r r0 eqr;
@@ -808,21 +1099,21 @@ Section MakeRingPol.
  Qed.
 
  Lemma mkmult_rev_append : forall lm l r,
-  mkmult r (rev_append l lm) == mkmult (mkmult r l) lm.
+  mkmult r (rev_append lm l) == mkmult (mkmult r l) lm.
  Proof.
  induction lm; simpl in |- *; intros.
  rrefl.
  rewrite IHlm; simpl in |- *.
-   repeat rewrite <- (ARmul_sym ARth a); rewrite <- mul_mkmult.
+   repeat rewrite <- (ARmul_comm ARth a); rewrite <- mul_mkmult.
    rrefl.
  Qed.
 
  Lemma powl_mkmult_rev : forall p r x lm,
-  mkmult r (rev (powl p x lm)) == mkmult (pow x p * r) (rev lm).
+  mkmult r (rev' (powl p x lm)) == mkmult (pow x p * r) (rev' lm).
  Proof.
   induction p;simpl;intros.
   repeat rewrite IHp.
-  unfold rev;simpl.
+  unfold rev';simpl.
   repeat rewrite mkmult_rev_append.
   simpl.
   setoid_replace (pow x p * (pow x p * r) * x) 
@@ -831,18 +1122,18 @@ Section MakeRingPol.
   repeat rewrite IHp.
   setoid_replace (pow x p * (pow x p * r) ) 
     with (pow x p * pow x p * r);Esimpl.
-  unfold rev;simpl. repeat rewrite mkmult_rev_append;simpl.
-  rewrite (ARmul_sym ARth);rrefl.
+  unfold rev';simpl. repeat rewrite mkmult_rev_append;simpl.
+  rewrite (ARmul_comm ARth);rrefl.
  Qed.
 
  Lemma Pphi_add_mult_dev : forall P rP fv lm, 
-    rP + P@fv * mkmult1 (rev lm) == add_mult_dev rP P fv lm.
+    rP + P@fv * mkmult1 (rev' lm) == add_mult_dev rP P fv lm.
  Proof.
   induction P;simpl;intros.
   assert (H := (morph_eq CRmorph) c cI).
    destruct (c ?=! cI).
     rewrite (H (refl_equal true));rewrite (morph1 CRmorph);Esimpl.
-    destruct (rev lm);Esimpl;rrefl.
+    destruct (rev' lm);Esimpl;rrefl.
     rewrite mkmult1_mkmult;rrefl.
    apply IHP.
    replace (match P3 with
@@ -865,7 +1156,7 @@ Section MakeRingPol.
  Qed.
                                      
  Lemma Pphi_mult_dev : forall P fv lm,
-	 P@fv * mkmult1 (rev lm) == mult_dev P fv lm.
+	 P@fv * mkmult1 (rev' lm) == mult_dev P fv lm.
  Proof.
   induction P;simpl;intros.
    assert (H := (morph_eq CRmorph) c cI).
@@ -898,298 +1189,44 @@ Section MakeRingPol.
   rewrite <- Pphi_mult_dev;simpl;Esimpl.
  Qed.
 
- Lemma Pphi_dev_ok :  forall l pe,  PEeval l pe == Pphi_dev l (norm pe).
+ Lemma Pphi_dev_gen_ok :  forall l pe,  PEeval l pe == Pphi_dev l (norm pe).
  Proof.
   intros l pe;rewrite <- Pphi_Pphi_dev;apply norm_ok.
  Qed.
 
- Lemma Pphi_dev_ok' :
+ Lemma Pphi_dev_ok :
    forall l pe npe, norm pe = npe -> PEeval l pe == Pphi_dev l npe.
  Proof.
-  intros l pe npe npe_eq; subst npe; apply Pphi_dev_ok.
- Qed.
- 
-(* The same but building a PExpr *)
-(*
- Fixpoint Pmkmult (r:PExpr) (lm:list PExpr) {struct lm}: PExpr :=
-  match lm with
-  | nil => r
-  | cons h t => Pmkmult (PEmul r h) t
-  end.
-		       
- Definition Pmkadd_mult rP lm :=
-  match lm with
-  | nil => PEadd rP (PEc cI)
-  | cons h t => PEadd rP (Pmkmult h t)
-  end.
-
- Fixpoint Ppowl (i:positive) (x:PExpr) (l:list PExpr) {struct i}: list PExpr :=
-  match i with
-  | xH => cons x l
-  | xO i => Ppowl i x (Ppowl i x l)
-  | xI i => Ppowl i x (Ppowl i x (cons x l))
-  end.
-			       
- Fixpoint Padd_mult_dev
-     (rP:PExpr) (P:Pol) (fv lm:list PExpr) {struct P} : PExpr :=
-  (* rP + P@l * lm *)
-  match P with
-  | Pc c => if c ?=! cI then Pmkadd_mult rP (rev lm) 
-    else Pmkadd_mult rP (cons [PEc c] (rev lm))
-  | Pinj j Q => Padd_mult_dev rP Q (jump j fv) lm
-  | PX P i Q => 
-     let rP := Padd_mult_dev rP P fv (Ppowl i (hd P0 fv) lm) in
-     if Q ?== P0 then rP else Padd_mult_dev rP Q (tl fv) lm
-  end.
- 
- Definition Pmkmult1 lm :=
-  match lm with
-  | nil => PEc cI
-  | cons h t => Pmkmult h t
-  end.
-   
- Fixpoint Pmult_dev (P:Pol) (fv lm : list PExpr) {struct P} : PExpr :=
-  (* P@l * lm *)							      
-  match P with
-  | Pc c => if c ?=! cI then Pmkmult1 (rev lm) else Pmkmult [PEc c] (rev lm)
-  | Pinj j Q => Pmult_dev Q (jump j fv) lm
-  | PX P i Q => 
-     let rP := Pmult_dev P fv (Ppowl i (hd (PEc r0) fv) lm) in
-     if Q ?== P0 then rP else Padd_mult_dev rP Q (tl fv) lm
-  end. 
-
- Definition Pphi_dev2 fv P := Pmult_dev P fv (nil PExpr).
-
-...
-*)
-  (************************************************)
- (* avec des parentheses mais un peu plus efficace *)
-
-
- (**************************************************
-
-  Fixpoint pow_mult (i:positive) (x r:R){struct i}:R :=
-  match i with
-  | xH => r * x
-  | xO i => pow_mult i x (pow_mult i x r)
-  | xI i => pow_mult i x (pow_mult i x (r * x))
-  end.
- 
- Definition pow_dev i x :=
-  match i with
-  | xH => x
-  | xO i => pow_mult (Pdouble_minus_one i) x x
-  | xI i => pow_mult (xO i) x x
-  end.
-
- Lemma pow_mult_pow : forall i x r, pow_mult i x r == pow x i * r.
- Proof.
-  induction i;simpl;intros.
-  rewrite (IHi x (pow_mult i x (r * x)));rewrite (IHi x (r*x));rsimpl.
-  mul_push x;rrefl.
-  rewrite (IHi x (pow_mult i x r));rewrite (IHi x r);rsimpl.
-  apply ARth.(ARmul_sym).
- Qed.
-
- Lemma pow_dev_pow : forall p x, pow_dev p x == pow x p.
- Proof.
-  destruct p;simpl;intros.
-  rewrite (pow_mult_pow p x (pow_mult p x x)).
-  rewrite (pow_mult_pow p x x);rsimpl;mul_push x;rrefl.
-  rewrite (pow_mult_pow (Pdouble_minus_one p) x x).
-  rewrite (ARth.(ARmul_sym) (pow x (Pdouble_minus_one p)) x).
-  rewrite <- (pow_Psucc x (Pdouble_minus_one p)).
-  rewrite Psucc_o_double_minus_one_eq_xO;simpl; rrefl.
-  rrefl.
- Qed.
-
- Fixpoint Pphi_dev (fv:list R) (P:Pol) {struct P} : R :=
-  match P with
-  | Pc c => [c]
-  | Pinj j Q => Pphi_dev (jump j fv) Q
-  | PX P i Q => 
-    let rP := mult_dev P fv (pow_dev i (hd 0 fv)) in
-    add_dev rP Q (tl fv)
-  end
+  intros l pe npe npe_eq; subst npe; apply Pphi_dev_gen_ok.
+ Qed. 
 
- with add_dev (ra:R) (P:Pol) (fv:list R) {struct P} : R :=
-   match P with
-  | Pc c => if c ?=! cO then ra else ra + [c] 
-  | Pinj j Q => add_dev ra Q (jump j fv)
-  | PX P i Q =>
-    let ra := add_mult_dev ra P fv (pow_dev i (hd 0 fv)) in
-    add_dev ra Q (tl fv)
-  end
- 
- with mult_dev (P:Pol) (fv:list R) (rm:R) {struct P} : R :=
-  match P with
-  | Pc c => if c ?=! cI then rm else [c]*rm
-  | Pinj j Q => mult_dev Q (jump j fv) rm
-  | PX P i Q =>
-    let ra := mult_dev P fv (pow_mult i (hd 0 fv) rm) in
-    add_mult_dev ra Q (tl fv) rm
-  end
-
- with add_mult_dev (ra:R) (P:Pol) (fv:list R) (rm:R) {struct P} : R :=
-  match P with
-  | Pc c =>  if c ?=! cO then ra else ra + [c]*rm
-  | Pinj j Q => add_mult_dev ra Q (jump j fv) rm
-  | PX P i Q =>
-    let rmP := pow_mult i (hd 0 fv) rm in
-    let raP := add_mult_dev ra P fv rmP in
-    add_mult_dev raP Q (tl fv) rm
-  end.
- 
- Lemma Pphi_add_mult_dev : forall P ra fv rm,
-    add_mult_dev ra P fv rm == ra + P@fv * rm.
- Proof.
-  induction P;simpl;intros.
-  assert (H := CRmorph.(morph_eq) c cO).
-   destruct (c ?=! cO).
-    rewrite (H (refl_equal true));rewrite CRmorph.(morph0);Esimpl.
-    rrefl.
-  apply IHP.
-  rewrite (IHP2 (add_mult_dev ra P2 fv (pow_mult p (hd 0 fv) rm)) (tl fv) rm).
-  rewrite (IHP1 ra fv (pow_mult p (hd 0 fv) rm)).
-  rewrite (pow_mult_pow p (hd 0 fv) rm);rsimpl.
- Qed.
-  
- Lemma Pphi_add_dev : forall P ra fv, add_dev ra P fv == ra + P@fv.
- Proof.
-  induction P;simpl;intros.
-  assert (H := CRmorph.(morph_eq) c cO).
-   destruct (c ?=! cO).
-    rewrite (H (refl_equal true));rewrite CRmorph.(morph0);Esimpl.
-    rrefl.
-  apply IHP.
-  rewrite (IHP2 (add_mult_dev ra P2 fv (pow_dev p (hd 0 fv))) (tl fv)).
-  rewrite (Pphi_add_mult_dev P2 ra fv (pow_dev p (hd 0 fv))).
-  rewrite  (pow_dev_pow p (hd 0 fv));rsimpl. 
- Qed.
+ Fixpoint MPcond_dev (LM1: list (Mon * Pol)) (l: list R) {struct LM1} : Prop :=            
+    match LM1 with 
+     cons (M1,P2) LM2 =>  (Mphi l M1 == Pphi_dev l P2) /\ (MPcond_dev LM2 l)
+    | _ => True
+    end.
 
- Lemma Pphi_mult_dev : forall P fv rm, mult_dev P fv rm == P@fv * rm.
- Proof.
-  induction P;simpl;intros.
-  assert (H := CRmorph.(morph_eq) c cI).
-   destruct (c ?=! cI).
-    rewrite (H (refl_equal true));rewrite CRmorph.(morph1);Esimpl.
-    rrefl.
-  apply IHP.
-  rewrite (Pphi_add_mult_dev P3 
-	    (mult_dev P2 fv (pow_mult p (hd 0 fv) rm)) (tl fv) rm).
-  rewrite (IHP1 fv  (pow_mult p (hd 0 fv) rm)).
-  rewrite (pow_mult_pow p (hd 0 fv) rm);rsimpl.
- Qed.
+ Fixpoint MPcond_map (LM1: list (Mon * PExpr)): list (Mon * Pol) :=            
+    match LM1 with 
+     cons (M1,P2) LM2 =>  cons (M1, norm P2) (MPcond_map LM2)
+    | _ => nil
+    end.
 
- Lemma Pphi_Pphi_dev : forall P fv, P@fv == Pphi_dev fv P.
+ Lemma MP_cond_dev_imp_MP_cond: forall LM1 l,
+     MPcond_dev LM1 l -> MPcond LM1 l.
  Proof.
-  induction P;simpl;intros.
-  rrefl. trivial.
-  rewrite (Pphi_add_dev P3 (mult_dev P2 fv (pow_dev p (hd 0 fv))) (tl fv)).
-  rewrite (Pphi_mult_dev P2 fv (pow_dev p (hd 0 fv))).
-  rewrite (pow_dev_pow p (hd 0 fv));rsimpl.
+ intros LM1; elim LM1; simpl; auto.
+ intros (M2,P2) LM2 Hrec l [H1 H2]; split; auto.
+ rewrite H1; rewrite Pphi_Pphi_dev; rsimpl. 
  Qed.
 
- Lemma Pphi_dev_ok :  forall l pe,  PEeval l pe == Pphi_dev l (norm pe).
- Proof.
-  intros l pe;rewrite <- (Pphi_Pphi_dev (norm pe) l);apply norm_ok.
+ Lemma PNSubstL_dev_ok: forall m n lm pe l,
+    let LM :=  MPcond_map lm in
+    MPcond_dev LM l -> PEeval l pe == Pphi_dev l (PNSubstL (norm pe) LM m n).
+ intros m n lm p3 l LM H.
+ rewrite <- Pphi_Pphi_dev; rewrite <- PNSubstL_ok; auto.
+   apply MP_cond_dev_imp_MP_cond; auto.
+ rewrite Pphi_Pphi_dev; apply Pphi_dev_ok; auto.
  Qed.
 
- Ltac Trev l :=  
-  let rec rev_append rev l :=
-   match l with
-   | (nil _) => constr:(rev)
-   | (cons ?h ?t) => let rev := constr:(cons h rev) in rev_append rev t 
-   end in
- rev_append (nil R) l.
-
- Ltac TPphi_dev add mul :=
-  let tl l := match l with (cons ?h ?t) => constr:(t) end in
-  let rec jump j l :=
-   match j with
-   | xH => tl l
-   | (xO ?j) => let l := jump j l in jump j l
-   | (xI ?j) => let t := tl l in let l := jump j l in jump j l
-   end in
-  let rec pow_mult i x r :=
-   match i with
-   | xH => constr:(mul r x)
-   | (xO ?i) => let r := pow_mult i x r in pow_mult i x r
-   | (xI ?i) => 
-     let r := constr:(mul r x) in
-     let r := pow_mult i x r in 
-     pow_mult i x r
-   end in
-  let pow_dev i x :=
-   match i with
-   | xH => x
-   | (xO ?i) => 
-      let i := eval compute in (Pdouble_minus_one i) in pow_mult i x x
-   | (xI ?i) => pow_mult (xO i) x x
-   end in
-  let rec add_mult_dev ra P fv rm :=
-   match P with
-   | (Pc ?c) => 
-     match eval compute in (c ?=! cO) with
-     | true => constr:ra 
-     | _ => let rc := eval compute in [c] in constr:(add ra (mul rc rm))
-     end
-   | (Pinj ?j ?Q) => 
-     let fv := jump j fv in add_mult_dev ra Q fv rm
-   | (PX ?P ?i ?Q) =>
-     match fv with 
-     | (cons ?hd ?tl) =>
-       let rmP := pow_mult i hd rm in
-       let raP := add_mult_dev ra P fv rmP in
-       add_mult_dev raP Q tl rm
-     end
-   end in
-  let rec mult_dev P fv rm :=
-   match P with
-   | (Pc ?c) =>
-     match eval compute in (c ?=! cI) with
-     | true => constr:rm 
-     | false => let rc := eval compute in [c] in constr:(mul rc rm)
-     end
-   | (Pinj ?j ?Q) => let fv := jump j fv in mult_dev Q fv rm
-   | (PX ?P ?i ?Q) =>
-     match fv with
-     | (cons ?hd ?tl) =>
-       let rmP := pow_mult i hd rm in
-       let ra := mult_dev P fv rmP in
-       add_mult_dev ra Q tl rm
-     end
-   end in
-  let rec add_dev ra P fv :=
-   match P with
-   | (Pc ?c) =>
-     match eval compute in (c ?=! cO) with
-     | true => ra
-     | false => let rc := eval compute in [c] in constr:(add ra rc)
-     end
-   | (Pinj ?j ?Q) => let fv := jump j fv in add_dev ra Q fv
-   | (PX ?P ?i ?Q) =>
-     match fv with
-     | (cons ?hd ?tl) =>
-       let rmP := pow_dev i hd in
-       let ra := add_mult_dev ra P fv rmP in
-       add_dev ra Q tl
-     end
-   end in
-  let rec Pphi_dev fv P :=
-   match P with
-   | (Pc ?c) => eval compute in [c]
-   | (Pinj ?j ?Q) => let fv := jump j fv in Pphi_dev fv Q
-   | (PX ?P ?i ?Q) =>
-     match fv with
-     | (cons ?hd ?tl) =>
-       let rm := pow_dev i hd in
-       let rP := mult_dev P fv rm in
-       add_dev rP Q tl
-     end
-   end in
-  Pphi_dev.
- 
- **************************************************************)
-
 End MakeRingPol. 
diff --git a/contrib/setoid_ring/Ring_tac.v b/contrib/setoid_ring/Ring_tac.v
index 6c3f87a5..95efde7f 100644
--- a/contrib/setoid_ring/Ring_tac.v
+++ b/contrib/setoid_ring/Ring_tac.v
@@ -1,76 +1,73 @@
 Set Implicit Arguments.
 Require Import Setoid.
-Require Import BinList.
 Require Import BinPos.
-Require Import Pol.
+Require Import Ring_polynom.
+Require Import BinList.
 Declare ML Module "newring".
 
-(* Some Tactics *)
-
-Ltac compute_assertion id t :=
-  let t' := eval compute in t in
-  (assert (id : t = t'); [exact_no_check (refl_equal t')|idtac]).
 
-Ltac compute_assertion' id  id' t :=
-  let t' := eval compute in t in
+(* adds a definition id' on the normal form of t and an hypothesis id
+   stating that t = id' (tries to produces a proof as small as possible) *)
+Ltac compute_assertion id  id' t :=
+  let t' := eval vm_compute in t in
   (pose (id' := t');
    assert (id : t = id');
    [exact_no_check (refl_equal id')|idtac]).
 
-Ltac compute_replace' id t :=
-  let t' := eval compute in t in
-  (replace t with t' in id; [idtac|exact_no_check (refl_equal t')]).
+(********************************************************************)
+(* Tacticals to build reflexive tactics *)
 
-Ltac bin_list_fold_right fcons fnil l :=
-  match l with
-  | (cons ?x ?tl) => fcons x ltac:(bin_list_fold_right fcons fnil tl)
-  | (nil _) => fnil
+Ltac OnEquation req :=
+  match goal with
+  | |- req ?lhs ?rhs => (fun f => f lhs rhs)
+  | _ => fail 1 "Goal is not an equation (of expected equality)"
   end.
 
-Ltac bin_list_fold_left fcons fnil l :=
-  match l with
-  | (cons ?x ?tl) => bin_list_fold_left fcons ltac:(fcons x fnil) tl
-  | (nil _) => fnil
-  end.
 
-Ltac bin_list_iter f l :=
-  match l with
-  | (cons ?x ?tl) => f x; bin_list_iter f tl
-  | (nil _) => idtac
+Ltac OnMainSubgoal H ty :=
+  match ty with
+  | _ -> ?ty' =>
+     let subtac := OnMainSubgoal H ty' in
+     fun tac => lapply H; [clear H; intro H; subtac tac | idtac]
+  | _ => (fun tac => tac)
   end.
- 
-(** A tactic that reverses a list *)
-Ltac Trev R l :=  
-  let rec rev_append rev l :=
-   match l with
-   | (nil _) => constr:(rev)
-   | (cons ?h ?t) => let rev := constr:(cons h rev) in rev_append rev t 
-   end in
- rev_append (nil R) l.
 
-(* to avoid conflicts with Coq booleans*)
+Ltac ApplyLemmaAndSimpl tac lemma pe:=
+  let npe := fresh "ast_nf" in
+  let H := fresh "eq_nf" in
+  let Heq := fresh "thm" in
+  let npe_spec :=
+    match type of (lemma pe) with
+      forall npe, ?npe_spec = npe -> _ => npe_spec
+    | _ => fail 1 "ApplyLemmaAndSimpl: cannot find norm expression"
+    end in
+  (compute_assertion H npe npe_spec;
+   (assert (Heq:=lemma _ _ H) || fail "anomaly: failed to apply lemma");
+   clear H;
+   OnMainSubgoal Heq ltac:(type of Heq)
+     ltac:(tac Heq; rewrite Heq; clear Heq npe)).
+
+(* General scheme of reflexive tactics using of correctness lemma
+   that involves normalisation of one expression *)
+Ltac ReflexiveRewriteTactic FV_tac SYN_tac SIMPL_tac lemma2 req rl :=
+  let R := match type of req with ?R -> _ => R end in
+  (* build the atom list *)
+  let fv := list_fold_left FV_tac (@List.nil R) rl in
+  (* some type-checking to avoid late errors *)
+  (check_fv fv;
+   (* rewrite steps *)
+   list_iter
+     ltac:(fun r =>
+       let ast := SYN_tac r fv in
+       try ApplyLemmaAndSimpl SIMPL_tac (lemma2 fv) ast)
+     rl).
+
+(********************************************************)
+
+(* An object to return when an expression is not recognized as a constant *)
 Definition NotConstant := false.
- 		       
-Ltac IN a l :=
- match l with
- | (cons a ?l) => true
- | (cons _ ?l) => IN a l
- | (nil _) => false
- end.
-
-Ltac AddFv a l :=
- match (IN a l) with
- | true => l
- | _ => constr:(cons a l)
- end.
-
-Ltac Find_at a l :=
- match l with
- | (nil _) => fail 1 "ring anomaly"
- | (cons a _) => constr:1%positive
- | (cons _ ?l) => let p := Find_at a l in eval compute in (Psucc p)
- end.
 		      
+(* Building the atom list of a ring expression *)
 Ltac FV Cst add mul sub opp t fv :=
  let rec TFV t fv :=
   match Cst t with
@@ -80,13 +77,13 @@ Ltac FV Cst add mul sub opp t fv :=
       | (mul ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
       | (sub ?t1 ?t2) => TFV t2 ltac:(TFV t1 fv)
       | (opp ?t1) => TFV t1 fv
-      | _ => AddFv t fv
+      | _ => AddFvTail t fv
       end
   | _ => fv
-  end 
+  end
  in TFV t fv.
 
- (* syntaxification *)
+ (* syntaxification of ring expressions *)
  Ltac mkPolexpr C Cst radd rmul rsub ropp t fv := 
  let rec mkP t :=
     match Cst t with
@@ -111,644 +108,53 @@ Ltac FV Cst add mul sub opp t fv :=
  in mkP t.
 
 (* ring tactics *)
-Ltac Make_ring_rewrite_step lemma pe:=
-  let npe := fresh "npe" in
-  let H := fresh "eq_npe" in
-  let Heq := fresh "ring_thm" in
-  let npe_spec :=
-    match type of (lemma pe) with
-      forall (npe:_), ?npe_spec = npe -> _ => npe_spec
-    | _ => fail 1 "cannot find norm expression"
-    end in
-  (compute_assertion' H  npe npe_spec;
-   assert (Heq:=lemma _ _ H); clear H;
-   protect_fv in Heq;
-   (rewrite Heq; clear Heq npe) || clear npe).
-
-
-Ltac Make_ring_rw_list Cst_tac lemma req rl :=
-  match type of lemma with
-    forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C),
-    _ = npe ->
-    req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ =>
-  let mkFV := FV Cst_tac add mul sub opp in
-  let mkPol := mkPolexpr C Cst_tac add mul sub opp in
-  (* build the atom list *)
-  let rfv := bin_list_fold_left mkFV (nil R) rl in
-  let fv := Trev R rfv in
-  (* rewrite *)
-  bin_list_iter
-    ltac:(fun r =>
-      let pe := mkPol r fv in
-      Make_ring_rewrite_step (lemma fv) pe)
-    rl
-  | _ => fail 1 "bad lemma"
-  end.
-
-Ltac Make_ring_rw Cst_tac lemma req r :=
-  Make_ring_rw_list Cst_tac lemma req (cons r (nil _)).
-
- (* Building the generic tactic *)
-
- Ltac Make_ring_tac Cst_tac lemma1 lemma2 req :=
-  match type of lemma2 with
-    forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C),
-    _ = npe ->
-    req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ =>
-  match goal with
-  | |- req ?r1 ?r2 =>
-    let mkFV := FV Cst_tac add mul sub opp in
-    let mkPol := mkPolexpr C Cst_tac add mul sub opp in
-    let rfv := mkFV (add r1 r2) (nil R) in
-    let fv := Trev R rfv in
-    let pe1 := mkPol r1 fv in
-    let pe2 := mkPol r2 fv in
-    ((apply (lemma1 fv pe1 pe2);
-      vm_compute;
-      exact (refl_equal true)) ||
-     (Make_ring_rewrite_step (lemma2 fv) pe1;
-      Make_ring_rewrite_step (lemma2 fv) pe2))
-  | _ => fail 1 "goal is not an equality from a declared ring"
-  end
-  end.
-
-
-(* coefs belong to the same type as the target ring (concrete ring) *)
-Definition ring_id_correct
-  R rO rI radd rmul rsub ropp req rSet req_th ARth reqb reqb_ok :=
-  @ring_correct R rO rI radd rmul rsub ropp req rSet req_th ARth
-                R rO rI radd rmul rsub ropp reqb
-               (@IDphi R)
-               (@IDmorph R rO rI radd rmul rsub ropp req rSet reqb reqb_ok).
-
-Definition ring_rw_id_correct
-  R rO rI radd rmul rsub ropp req rSet req_th ARth reqb reqb_ok :=
-  @Pphi_dev_ok  R rO rI radd rmul rsub ropp req rSet req_th ARth
-                R rO rI radd rmul rsub ropp reqb
-               (@IDphi R)
-               (@IDmorph R rO rI radd rmul rsub ropp req rSet reqb reqb_ok).
-
-Definition ring_rw_id_correct'
-  R rO rI radd rmul rsub ropp req rSet req_th ARth reqb reqb_ok :=
-  @Pphi_dev_ok'  R rO rI radd rmul rsub ropp req rSet req_th ARth
-                 R rO rI radd rmul rsub ropp reqb
-                (@IDphi R)
-                (@IDmorph R rO rI radd rmul rsub ropp req rSet reqb reqb_ok).
-
-Definition ring_id_eq_correct R rO rI radd rmul rsub ropp ARth reqb reqb_ok :=
- @ring_id_correct R rO rI radd rmul rsub ropp (@eq R)
-    (Eqsth R) (Eq_ext _ _ _) ARth reqb reqb_ok.
-
-Definition ring_rw_id_eq_correct
-   R rO rI radd rmul rsub ropp ARth reqb reqb_ok :=
- @ring_rw_id_correct R rO rI radd rmul rsub ropp (@eq R)
-    (Eqsth R) (Eq_ext _ _ _) ARth reqb reqb_ok.
-
-Definition ring_rw_id_eq_correct'
-   R rO rI radd rmul rsub ropp ARth reqb reqb_ok :=
- @ring_rw_id_correct' R rO rI radd rmul rsub ropp (@eq R)
-    (Eqsth R) (Eq_ext _ _ _) ARth reqb reqb_ok.
-
-(*
-Require Import ZArith.
-Require Import Setoid.
-Require Import Ring_tac.
-Import BinList.
-Import Ring_th.
-Open Scope Z_scope.
-
-Add New Ring Zr : (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth)
-  Computational Zeqb_ok
-  Constant Zcst.
-
-Goal forall a b, (a+b*2)*(a+b*2)=1.
-intros.
- setoid ring ((a + b * 2) * (a + b * 2)).
-
-  Make_ring_rw_list Zcst
-    (ring_rw_id_correct' (Eqsth Z) (Eq_ext _ _ _)
-      (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok)
-    (eq (A:=Z))
-   (cons ((a+b)*(a+b)) (nil _)).
-
-
-Goal forall a b, (a+b)*(a+b)=1.
-intros.
-Ltac zringl :=
-  Make_ring_rw3_list ltac:(inv_gen_phiZ 0 1 Zplus Zmult Zopp)
-    (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-      (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok)
-    (eq (A:=Z))
-(BinList.cons ((a+b)*(a+b)) (BinList.nil _)).
-
-Open Scope Z_scope.
-
-let Cst_tac := inv_gen_phiZ 0 1 Zplus Zmult Zopp in
-let lemma :=
-    constr:(ring_rw_id_correct' (Eqsth Z) (Eq_ext _ _ _)
-             (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in
-let req := constr:(eq (A:=Z)) in
-let rl := constr:(cons ((a+b)*(a+b)) (nil _)) in
-Make_ring_rw_list Cst_tac lemma req rl.
-
-let fv := constr:(cons a (cons b (nil _))) in
-let pe :=
-  constr:(PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) in
-Make_ring_rewrite_step (lemma fv) pe.
-
-
-
-
-OK
-
-Lemma L0 :
- forall (l : list Z) (pe : PExpr Z) pe',
-       pe' = norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe ->
-       PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe =
-       Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe'.
-intros;  subst pe'.
-apply
- (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-    (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok).
-Qed.
-Lemma L0' :
- forall (l : list Z) (pe : PExpr Z) pe',
-       norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe = pe' ->
-       PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe =
-       Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe'.
-intros;  subst pe'.
-apply
- (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-    (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok).
-Qed.
-
-pose (pe:=PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))).
-compute_assertion ipattern:H (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe).
-let fv := constr:(cons a (cons b (nil _))) in
-assert (Heq := L0 fv _ (sym_equal H)); clear H.
- protect_fv' in Heq.
- rewrite Heq; clear Heq; clear pe.
-
-
-MIEUX (mais taille preuve = taille de pe + taille de nf(pe)... ):
-
-
-Lemma L :
- forall (l : list Z) (pe : PExpr Z) pe' (x y :Z),
-       pe' = norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe ->
-       x = PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe ->
-       y = Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe' ->
-       x=y.
-intros;  subst x y pe'.
-apply
- (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-    (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok).
-Qed.
-Lemma L' :
- forall (l : list Z) (pe : PExpr Z) pe' (x y :Z),
-       Peq Zeq_bool pe'  (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool pe) = true ->
-       x = PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) l pe ->
-       y = Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) l pe' ->
-       forall (P:Z->Type), P y -> P x.
-intros.
- rewrite L with (2:=H0) (3:=H1); trivial.
-apply (Peq_ok (Eqsth Z) (Eq_ext _ _ _)
-   (IDmorph 0 1 Zplus Zminus Zmult Zopp (Eqsth Z) Zeq_bool Zeqb_ok) ).
-
-  (IDmorph (Eqsth Z) (Eq_ext _ _ _) Zeqb_ok).
-
-
-    (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth)).
-Qed.
-
-eapply L'
- with (x:=(a+b)*(a+b))
-      (pe:=PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2)))
-      (l:=cons a (cons b (nil Z)));[compute;reflexivity|reflexivity|idtac|idtac];norm_evars;[protect_fv';reflexivity|idtac];norm_evars.
-
-
-
-
-
-set (x:=a).
-set (x0:=b).
-set (fv:=cons x (cons x0 (nil Z))).
-let fv:=constr:(cons a (cons b (nil Z))) in
-let lemma := constr : (ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-      (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in
-let pe :=
-  constr :  (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) in
-assert (Heq := lemma fv pe).
-set (npe:=norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool
-             (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2)))).
-fold npe in Heq.
-move npe after fv.
-let fv' := eval red in fv in
-compute in npe.
-subst npe.
-let fv' := eval red in fv in
-compute_without_globals_of (fv',Zplus,0,1,Zmult,Zopp,Zminus) in Heq.
-rewrite Heq.
-clear Heq fv; subst x x0.
-
-
-simpl in Heq.
-unfold Pphi_dev in Heq.
-unfold mult_dev in Heq.
-unfold P0, Peq in *.
-unfold Zeq_bool at 3, Zcompare, Pcompare in Heq.
-unfold fv, hd, tl in Heq.
-unfold powl, rev, rev_append in Heq.
-unfold mkmult1 in Heq.
-unfold mkmult in Heq.
-unfold add_mult_dev in |- *.
-unfold add_mult_dev at 2 in Heq.
-unfold P0, Peq at 1 in Heq.
-unfold Zeq_bool at 2 3 4 5 6, Zcompare, Pcompare in Heq.
-unfold hd, powl, rev, rev_append in Heq.
-unfold mkadd_mult in Heq.
-unfold mkmult in Heq.
-unfold add_mult_dev in Heq.
-unfold P0, Peq in Heq.
-unfold Zeq_bool, Zcompare, Pcompare in Heq.
-unfold hd,powl, rev,rev_append in Heq.
-unfold mkadd_mult in Heq.
-unfold mkmult in Heq.
-unfold IDphi in Heq.
-
- fv := cons x (cons x0 (nil Z))
- PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))
- Heq : PEeval 0 Zplus Zmult Zminus Zopp (IDphi (R:=Z)) fv
-          (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))) =
-        Pphi_dev 0 1 Zplus Zmult 0 1 Zeq_bool (IDphi (R:=Z)) fv
-          (norm 0 1 Zplus Zmult Zminus Zopp Zeq_bool
-             (PEmul (PEadd (PEX Z 1) (PEX Z 2)) (PEadd (PEX Z 1) (PEX Z 2))))
-
-
 
-let Cst_tac := inv_gen_phiZ 0 1 Zplus Zmult Zopp in
-let lemma :=
-    constr:(ring_rw_id_correct (Eqsth Z) (Eq_ext _ _ _)
-             (Rth_ARth (Eqsth Z) (Eq_ext _ _ _) Zth) Zeq_bool Zeqb_ok) in
-let req := constr:(eq (A:=Z)) in
-let rl := constr:(BinList.cons ((a+b)*(a+b)) (BinList.nil _)) in
-  match type of lemma with
-    forall (l:list ?R) (pe:PExpr ?C),
-    req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ =>
-  Constant natcst.
-
-
-Require Import Setoid.
-Open Scope nat_scope.
-
-Require Import Ring_th.
-Require Import Arith.
-
-Add New Ring natr : (SRth_ARth (Eqsth nat) natSRth)
-  Computational nateq_ok
-  Constant natcst.
-
-
-Require Import Rbase.
-Open Scope R_scope.	      
-
- Lemma Rth : ring_theory 0 1 Rplus Rmult Rminus Ropp (@eq R).
- Proof.
-  constructor. exact Rplus_0_l. exact Rplus_comm. 
-  intros;symmetry;apply Rplus_assoc.
-  exact Rmult_1_l. exact Rmult_comm. 
-  intros;symmetry;apply Rmult_assoc.
-  exact Rmult_plus_distr_r. trivial. exact Rplus_opp_r.
- Qed.
-
-Add New Ring Rr : Rth Abstract.
-
-Goal forall a b, (a+b*10)*(a+b*10)=1.
-intros.
-
-Module Zring.
-  Import Zpol.
-  Import BinPos.
-  Import BinInt.
-
-Ltac is_PCst p :=
- match p with
- | xH => true
- | (xO ?p') => is_PCst p'
- | (xI ?p') => is_PCst p'
- | _ => false
- end.
-
-Ltac ZCst t :=
- match t with
- | Z0 => constr:t 
- | (Zpos ?p) =>
-    match (is_PCst p) with
-    | false => NotConstant
-    | _ => constr:t
-    end
- | (Zneg ?p) =>
-    match (is_PCst p) with
-    | false => NotConstant
-    | _ => constr:t
-    end
- | _ => NotConstant
- end.
-		  
-Ltac zring := 
-  Make_ring_tac ZCst
-    (Zpol.ring_gen_eq_correct Zth) (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z).
-
-Ltac zrewrite :=
-  Make_ring_rw3 ZCst (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z).
-
-Ltac zrewrite_list :=
-  Make_ring_rw3_list ZCst (Zpol.ring_rw_gen_eq_correct Zth) (@eq Z).
-
-End Zring.
-*)
-
-
-
-(*
-(*** Intanciation for Z*)
-Require Import ZArith.
-Open Scope Z_scope.
-
-Module Zring.
-  Let R := Z.
-  Let rO := 0.
-  Let rI := 1.
-  Let radd := Zplus.
-  Let rmul := Zmult.
-  Let rsub := Zminus.
-  Let ropp := Zopp.
-  Let Rth := Zth.
-  Let reqb := Zeq_bool.
-  Let req_morph := Zeqb_ok.
-
-  (* CE_Entries *)
-  Let C := R.
-  Let cO := rO.
-  Let cI := rI.
-  Let cadd := radd.
-  Let cmul := rmul.
-  Let csub := rsub.
-  Let copp := ropp.
-  Let req := (@eq R). 
-  Let ceqb := reqb.
-  Let phi := @IDphi R.
-  Let Rsth : Setoid_Theory R req := Eqsth R.
-  Let Reqe : ring_eq_ext radd rmul ropp req :=
-   (@Eq_ext R radd rmul ropp).
-  Let ARth : almost_ring_theory rO rI radd rmul rsub ropp req :=
-   (@Rth_ARth R rO rI radd rmul rsub ropp req Rsth Reqe Rth).
-  Let CRmorph : ring_morph rO rI radd rmul rsub ropp req
-                           cO cI cadd cmul csub copp ceqb phi :=
-   (@IDmorph R rO rI radd rmul rsub ropp req Rsth reqb req_morph).
-
-  Definition Peq := Eval red in (Pol.Peq ceqb).
-  Definition mkPinj := Eval red in (@Pol.mkPinj C). 
-  Definition mkPX :=
-   Eval red;
-        change (Pol.Peq ceqb) with Peq;
-        change (@Pol.mkPinj Z) with mkPinj in
-   (Pol.mkPX cO ceqb). 
-
-  Definition P0 := Eval red in (Pol.P0 cO).
-  Definition P1 := Eval red in (Pol.P1 cI).
-
-  Definition X :=
-   Eval red; change (Pol.P0 cO) with P0; change (Pol.P1 cI) with P1 in
-   (Pol.X cO cI).
-
-  Definition mkX :=
-   Eval red; change (Pol.X cO cI) with X in
-   (mkX cO cI).
-
-  Definition PaddC
-  Definition PaddI
-  Definition PaddX
-
-  Definition Padd :=
-   Eval red in
-        
-   (Pol.Padd cO cadd ceqb)
-
-  Definition PmulC
-  Definition PmulI
-  Definition Pmul_aux
-  Definition Pmul
-
-  Definition PsubC
-  Definition PsubI
-  Definition PsubX
-  Definition Psub
-
-
-
-  Definition norm :=
-   Eval red;
-        change (Pol.Padd cO cadd ceqb) with Padd;
-        change (Pol.Pmul cO cI cadd cmul ceqb) with Pmul;
-        change (Pol.Psub cO cadd csub copp ceqb) with Psub;
-        change (Pol.Popp copp) with Psub;
-  
- in
-   (Pol.norm cO cI cadd cmul csub copp ceqb).
-
-
-
-End Zring.
-		  
-Ltac is_PCst p :=
- match p with
- | xH => true
- | (xO ?p') => is_PCst p'
- | (xI ?p') => is_PCst p'
- | _ => false
- end.
-
-Ltac ZCst t :=
- match t with
- | Z0 => constr:t 
- | (Zpos ?p) =>
-    match (is_PCst p) with
-    | false => NotConstant
-    | _ => t
-    end
- | (Zneg ?p) =>
-    match (is_PCst p) with
-    | false => NotConstant
-    | _ => t
-    end
- | _ => NotConstant
- end.
-		  
-Ltac zring := 
-  Zring.Make_ring_tac Zplus Zmult Zminus Zopp (@eq Z) ZCst.
-
-Ltac zrewrite :=
-  Zring.Make_ring_rw3 Zplus Zmult Zminus Zopp ZCst.
-*)
-
-(*	      
-(* Instanciation for Bool *)	      
-Require Import Bool.
-	      
-Module BCE.
- Definition R := bool.
- Definition rO := false.
- Definition rI := true.
- Definition radd := xorb.
- Definition rmul := andb.
- Definition rsub := xorb.
- Definition ropp b:bool := b.
- Lemma Rth : ring_theory rO rI radd rmul rsub ropp (@eq bool).
- Proof.
-  constructor.
-   exact false_xorb.
-   exact xorb_comm.
-   intros; symmetry  in |- *; apply xorb_assoc.
-   exact andb_true_b.
-   exact andb_comm.
-   exact andb_assoc.
-   destruct x; destruct y; destruct z; reflexivity.
-   intros; reflexivity.
-   exact xorb_nilpotent.
- Qed.
-
- Definition reqb := eqb.
- Definition req_morph := eqb_prop.
-End BCE.
-
-Module BEntries := CE_Entries BCE.
-
-Module Bring := MakeRingPol BEntries.
-
-Ltac BCst t :=
-  match t with
-   | true => true
-   | false => false
-   | _ => NotConstant
-   end.
-
-Ltac bring := 
-  Bring.Make_ring_tac xorb andb xorb (fun b:bool => b) (@eq bool) BCst.
-
-Ltac brewrite :=
-  Zring.Make_ring_rw3 Zplus Zmult Zminus Zopp ZCst.
-*)
-
-(*Module Rring.
-
-(* Instanciation for R *)	      
-Require Import Rbase.
-Open Scope R_scope.	      
-
- Lemma Rth : ring_theory 0 1 Rplus Rmult Rminus Ropp (@eq R).
- Proof.
-  constructor. exact Rplus_0_l. exact Rplus_comm. 
-  intros;symmetry;apply Rplus_assoc.
-  exact Rmult_1_l. exact Rmult_comm. 
-  intros;symmetry;apply Rmult_assoc.
-  exact Rmult_plus_distr_r. trivial. exact Rplus_opp_r.
- Qed.
-
-Ltac RCst := inv_gen_phiZ 0 1 Rplus Rmul Ropp.
-
-Ltac rring :=
-  Make_ring_tac RCst
-    (Zpol.ring_gen_eq_correct Rth) (Zpol.ring_rw_gen_eq_correct Rth) (@eq R).
-
-Ltac rrewrite :=
-  Make_ring_rw3 RCst (Zpol.ring_rw_gen_eq_correct Rth) (@eq R).
-
-Ltac rrewrite_list :=
-  Make_ring_rw3_list RCst (Zpol.ring_rw_gen_eq_correct Rth) (@eq R).
-
-End Rring.
-*)
-(************************)
-(*
-(* Instanciation for N *)	     
-Require Import NArith.
-Open Scope N_scope.
-		
-Module NCSE.
- Definition R := N.
- Definition rO := 0.
- Definition rI := 1.
- Definition radd := Nplus.
- Definition rmul := Nmult.
- Definition SRth := Nth.
- Definition reqb := Neq_bool.
- Definition req_morph := Neq_bool_ok.
-End NCSE.
-
-Module NEntries := CSE_Entries NCSE.
-
-Module Nring := MakeRingPol NEntries.
-
-Ltac NCst := inv_gen_phiN 0 1 Nplus Nmult.
-
-Ltac nring :=  
-  Nring.Make_ring_tac Nplus Nmult (@SRsub N Nplus) (@SRopp N) (@eq N) NCst.
-
-Ltac nrewrite :=
-  Nring.Make_ring_rw3 Nplus Nmult  (@SRsub N Nplus) (@SRopp N) NCst.
-	       
-(* Instanciation for nat *)	       
-Open Scope nat_scope.
-
-Module NatASE.
- Definition R := nat.
- Definition rO := 0.
- Definition rI := 1.
- Definition radd := plus.
- Definition rmul := mult.
- Lemma SRth : semi_ring_theory O (S O) plus mult (@eq nat).
- Proof.
-  constructor. exact plus_0_l. exact plus_comm. exact plus_assoc.
-  exact mult_1_l. exact mult_0_l. exact mult_comm. exact mult_assoc.
-  exact mult_plus_distr_r. 
- Qed.
-End NatASE.
-
-Module NatEntries := ASE_Entries NatASE.
+ Ltac Ring Cst_tac lemma1 req :=
+  let Make_tac :=
+    match type of lemma1 with
+    | forall (l:list ?R) (pe1 pe2:PExpr ?C),
+      _ = true ->
+      req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe1) _ =>
+        let mkFV := FV Cst_tac add mul sub opp in
+        let mkPol := mkPolexpr C Cst_tac add mul sub opp in
+        fun f => f R mkFV mkPol
+    | _ => fail 1 "ring anomaly: bad correctness lemma"
+    end in
+  let Main r1 r2 R mkFV mkPol :=
+    let fv := mkFV r1 (@List.nil R) in
+    let fv := mkFV r2 fv in
+    check_fv fv;
+    (let pe1 := mkPol r1 fv in
+     let pe2 := mkPol r2 fv in
+     apply (lemma1 fv pe1 pe2) || fail "typing error while applying ring";
+     vm_compute;
+     exact (refl_equal true) || fail "not a valid ring equation") in
+  Make_tac ltac:(OnEquation req Main).
+
+Ltac Ring_simplify Cst_tac lemma2 req rl :=
+  let Make_tac :=
+    match type of lemma2 with 
+      forall (l:list ?R) (pe:PExpr ?C) (npe:Pol ?C),
+      _ = npe ->
+      req (PEeval ?rO ?add ?mul ?sub ?opp ?phi l pe) _ =>
+      let mkFV := FV Cst_tac add mul sub opp in
+      let mkPol := mkPolexpr C Cst_tac add mul sub opp in
+      let simpl_ring H := protect_fv "ring" in H in
+      (fun tac => tac mkFV mkPol simpl_ring lemma2 req rl)
+    | _ => fail 1 "ring anomaly: bad correctness lemma"
+    end in
+  Make_tac ReflexiveRewriteTactic.
 
-Module Natring := MakeRingPol NatEntries.
 
-Ltac natCst t := 
- match t with
- | O => N0
- | (S ?n) =>
-    match (natCst n) with
-    | NotConstant => NotConstant
-    | ?p => constr:(Nsucc p)
-    end
- | _ => NotConstant
- end.
-		  
-Ltac natring :=
- Natring.Make_ring_tac plus mult (@SRsub nat plus) (@SRopp nat) (@eq nat) natCst.
+Tactic Notation (at level 0) "ring" :=
+  ring_lookup
+    (fun req sth ext morph arth cst_tac lemma1 lemma2 pre post rl =>
+       pre(); Ring cst_tac lemma1 req).
 
-Ltac natrewrite :=
-  Natring.Make_ring_rw3 plus mult (@SRsub nat plus) (@SRopp nat) natCst.
-	  
-(* Generic tactic, checks the type of the terms and applies the
-suitable instanciation*)
-		  
-Ltac newring :=  
- match goal with
- | |- (?r1 = ?r2) =>
-   match (type of r1) with
-   | Z => zring
-   | R => rring
-   | bool => bring
-   | N => nring
-   | nat => natring
-   end
- end.
+Tactic Notation (at level 0) "ring_simplify" constr_list(rl) :=
+  ring_lookup
+    (fun req sth ext morph arth cst_tac lemma1 lemma2 pre post rl =>
+       pre(); Ring_simplify cst_tac lemma2 req rl; post()) rl.
 
-*)
+(* A simple macro tactic to be prefered to ring_simplify *)
+Ltac ring_replace t1 t2 := replace t1 with t2 by ring.
diff --git a/contrib/setoid_ring/Ring_th.v b/contrib/setoid_ring/Ring_theory.v
index 9583dd2d..2f7378eb 100644
--- a/contrib/setoid_ring/Ring_th.v
+++ b/contrib/setoid_ring/Ring_theory.v
@@ -1,7 +1,15 @@
-Require Import Setoid.
- Set Implicit Arguments.
+(************************************************************************)
+(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
+(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
+(*   \VV/  **************************************************************)
+(*    //   *      This file is distributed under the terms of the       *)
+(*         *       GNU Lesser General Public License Version 2.1        *)
+(************************************************************************)
 
+Require Import Setoid.
+Set Implicit Arguments.
 
+Module RingSyntax.
 Reserved Notation "x ?=! y" (at level 70, no associativity).
 Reserved Notation "x +! y " (at level 50, left associativity).
 Reserved Notation "x -! y" (at level 50, left associativity).
@@ -11,14 +19,13 @@ Reserved Notation "-! x" (at level 35, right associativity).
 Reserved Notation "[ x ]" (at level 1, no associativity).
 
 Reserved Notation "x ?== y" (at level 70, no associativity).
-Reserved Notation "x ++ y " (at level 50, left associativity).
 Reserved Notation "x -- y" (at level 50, left associativity).
 Reserved Notation "x ** y" (at level 40, left associativity).
 Reserved Notation "-- x" (at level 35, right associativity).
 
 Reserved Notation "x == y" (at level 70, no associativity).
-
-
+End RingSyntax.
+Import RingSyntax.
 
 Section DEFINITIONS.
  Variable R : Type.
@@ -32,24 +39,24 @@ Section DEFINITIONS.
  (** Semi Ring *)
  Record semi_ring_theory : Prop := mk_srt {
     SRadd_0_l   : forall n, 0 + n == n;
-    SRadd_sym   : forall n m, n + m == m + n ;
+    SRadd_comm   : forall n m, n + m == m + n ;
     SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p;
     SRmul_1_l   : forall n, 1*n == n;
     SRmul_0_l   : forall n, 0*n == 0; 
-    SRmul_sym   : forall n m, n*m == m*n;
+    SRmul_comm   : forall n m, n*m == m*n;
     SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p;
     SRdistr_l   : forall n m p, (n + m)*p == n*p + m*p
   }.
   
  (** Almost Ring *)
-(*Almost ring are no ring : Ropp_def is missi**)
+(*Almost ring are no ring : Ropp_def is missing **)
  Record almost_ring_theory : Prop := mk_art {
     ARadd_0_l   : forall x, 0 + x == x;
-    ARadd_sym   : forall x y, x + y == y + x;
+    ARadd_comm   : forall x y, x + y == y + x;
     ARadd_assoc : forall x y z, x + (y + z) == (x + y) + z;
     ARmul_1_l   : forall x, 1 * x == x;
     ARmul_0_l   : forall x, 0 * x == 0;
-    ARmul_sym   : forall x y, x * y == y * x;
+    ARmul_comm   : forall x y, x * y == y * x;
     ARmul_assoc : forall x y z, x * (y * z) == (x * y) * z;
     ARdistr_l   : forall x y z, (x + y) * z == (x * z) + (y * z);
     ARopp_mul_l : forall x y, -(x * y) == -x * y;
@@ -60,10 +67,10 @@ Section DEFINITIONS.
  (** Ring *)
  Record ring_theory : Prop := mk_rt {
     Radd_0_l    : forall x, 0 + x == x;
-    Radd_sym    : forall x y, x + y == y + x;
+    Radd_comm    : forall x y, x + y == y + x;
     Radd_assoc  : forall x y z, x + (y + z) == (x + y) + z;
     Rmul_1_l    : forall x, 1 * x == x;
-    Rmul_sym    : forall x y, x * y == y * x;
+    Rmul_comm    : forall x y, x * y == y * x;
     Rmul_assoc  : forall x y z, x * (y * z) == (x * y) * z;
     Rdistr_l    : forall x y z, (x + y) * z == (x * z) + (y * z);
     Rsub_def    : forall x y, x - y == x + -y;
@@ -193,9 +200,9 @@ Section ALMOST_RING.
 
  Lemma SRth_ARth : almost_ring_theory 0 1 radd rmul SRsub SRopp req.
  Proof (mk_art 0 1 radd rmul SRsub SRopp req
-    (SRadd_0_l SRth) (SRadd_sym SRth) (SRadd_assoc SRth)
+    (SRadd_0_l SRth) (SRadd_comm SRth) (SRadd_assoc SRth)
     (SRmul_1_l SRth) (SRmul_0_l SRth)
-    (SRmul_sym SRth) (SRmul_assoc SRth) (SRdistr_l SRth)
+    (SRmul_comm SRth) (SRmul_assoc SRth) (SRdistr_l SRth)
     SRopp_mul_l SRopp_add SRsub_def).
  
  (** Identity morphism for semi-ring equipped with their almost-ring structure*)
@@ -246,17 +253,17 @@ Section ALMOST_RING.
 
   rewrite (Rdistr_l Rth);rewrite (Rmul_1_l Rth).
   rewrite <- (Radd_assoc Rth); rewrite (Ropp_def Rth).
-  rewrite (Radd_sym Rth); rewrite (Radd_0_l Rth);sreflexivity.
+  rewrite (Radd_comm Rth); rewrite (Radd_0_l Rth);sreflexivity.
  Qed.
 
  Lemma Ropp_mul_l : forall x y, -(x * y) == -x * y.
  Proof.
   intros x y;rewrite <-(Radd_0_l Rth (- x * y)).
-  rewrite (Radd_sym Rth).
+  rewrite (Radd_comm Rth).
   rewrite <-(Ropp_def Rth (x*y)).
   rewrite (Radd_assoc Rth).
   rewrite <- (Rdistr_l Rth).
-  rewrite (Rth.(Radd_sym) (-x));rewrite (Ropp_def Rth).
+  rewrite (Rth.(Radd_comm) (-x));rewrite (Ropp_def Rth).
   rewrite Rmul_0_l;rewrite (Radd_0_l Rth);sreflexivity.
  Qed.
  
@@ -266,17 +273,17 @@ Section ALMOST_RING.
   rewrite <- ((Ropp_def Rth) x).
   rewrite <- ((Radd_0_l Rth) (x + - x + - (x + y))).
   rewrite <- ((Ropp_def Rth) y).
-  rewrite ((Radd_sym Rth) x).
-  rewrite ((Radd_sym Rth) y).
+  rewrite ((Radd_comm Rth) x).
+  rewrite ((Radd_comm Rth) y).
   rewrite <- ((Radd_assoc Rth) (-y)).
   rewrite <- ((Radd_assoc Rth) (- x)).
   rewrite ((Radd_assoc Rth)  y).
-  rewrite ((Radd_sym Rth) y).
+  rewrite ((Radd_comm Rth) y).
   rewrite <- ((Radd_assoc Rth)  (- x)).
   rewrite ((Radd_assoc Rth) y).
-  rewrite ((Radd_sym Rth) y);rewrite (Ropp_def Rth).
-  rewrite ((Radd_sym Rth) (-x) 0);rewrite (Radd_0_l Rth).
-  apply (Radd_sym Rth).
+  rewrite ((Radd_comm Rth) y);rewrite (Ropp_def Rth).
+  rewrite ((Radd_comm Rth) (-x) 0);rewrite (Radd_0_l Rth).
+  apply (Radd_comm Rth).
  Qed.
  
  Lemma Ropp_opp : forall x, - -x == x.
@@ -284,13 +291,13 @@ Section ALMOST_RING.
   intros x; rewrite <- (Radd_0_l Rth (- -x)).
   rewrite <- (Ropp_def Rth x).
   rewrite <- (Radd_assoc Rth); rewrite (Ropp_def Rth).
-  rewrite ((Radd_sym Rth) x);apply (Radd_0_l Rth).
+  rewrite ((Radd_comm Rth) x);apply (Radd_0_l Rth).
  Qed.
 
  Lemma  Rth_ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
  Proof
-  (mk_art 0 1 radd rmul rsub ropp req (Radd_0_l Rth) (Radd_sym Rth) (Radd_assoc Rth)
-    (Rmul_1_l Rth) Rmul_0_l (Rmul_sym Rth) (Rmul_assoc Rth) (Rdistr_l Rth)
+  (mk_art 0 1 radd rmul rsub ropp req (Radd_0_l Rth) (Radd_comm Rth) (Radd_assoc Rth)
+    (Rmul_1_l Rth) Rmul_0_l (Rmul_comm Rth) (Rmul_assoc Rth) (Rdistr_l Rth)
     Ropp_mul_l Ropp_add (Rsub_def Rth)).
 
  (** Every semi morphism between two rings is a morphism*) 
@@ -315,12 +322,12 @@ Section ALMOST_RING.
  Proof.
   intros x;rewrite <-  (Rth.(Radd_0_l) [-!x]).
   rewrite <- ((Ropp_def Rth) [x]).
-  rewrite ((Radd_sym Rth) [x]).
+  rewrite ((Radd_comm Rth) [x]).
   rewrite <- (Radd_assoc Rth).
   rewrite <- (Smorph_add Smorph).
   rewrite (Ropp_def Cth).
   rewrite (Smorph0 Smorph).
-  rewrite (Radd_sym Rth (-[x])).
+  rewrite (Radd_comm Rth (-[x])).
   apply (Radd_0_l Rth);sreflexivity.
  Qed. 
 
@@ -343,6 +350,12 @@ Section ALMOST_RING.
  (** Usefull lemmas on almost ring *)
  Variable ARth : almost_ring_theory 0 1 radd rmul rsub ropp req.
 
+ Lemma ARth_SRth : semi_ring_theory 0 1 radd rmul req.
+Proof.
+elim ARth; intros.
+constructor; trivial.
+Qed.
+
  Lemma ARsub_ext :
       forall x1 x2, x1 == x2 -> forall y1 y2, y1 == y2 -> x1 - y1 == x2 - y2.
  Proof.
@@ -358,15 +371,15 @@ Section ALMOST_RING.
  Ltac mrewrite :=
    repeat first
      [ rewrite (ARadd_0_l ARth)
-     | rewrite <- ((ARadd_sym ARth) 0)
+     | rewrite <- ((ARadd_comm ARth) 0)
      | rewrite (ARmul_1_l ARth)
-     | rewrite <- ((ARmul_sym ARth) 1)
+     | rewrite <- ((ARmul_comm ARth) 1)
      | rewrite (ARmul_0_l ARth)
-     | rewrite <- ((ARmul_sym ARth) 0)
+     | rewrite <- ((ARmul_comm ARth) 0)
      | rewrite (ARdistr_l ARth)
      | sreflexivity
      | match goal with
-       | |- context [?z * (?x + ?y)] => rewrite ((ARmul_sym ARth) z (x+y))
+       | |- context [?z * (?x + ?y)] => rewrite ((ARmul_comm ARth) z (x+y))
        end].
  
  Lemma ARadd_0_r : forall x, (x + 0) == x.
@@ -381,37 +394,37 @@ Section ALMOST_RING.
  Lemma ARdistr_r : forall x y z, z * (x + y) == z*x + z*y.
  Proof. 
   intros;mrewrite. 
-  repeat rewrite (ARth.(ARmul_sym) z);sreflexivity.
+  repeat rewrite (ARth.(ARmul_comm) z);sreflexivity.
  Qed.
 
  Lemma ARadd_assoc1 : forall x y z, (x + y) + z == (y + z) + x.
  Proof.
   intros;rewrite <-(ARth.(ARadd_assoc) x).
-  rewrite (ARth.(ARadd_sym) x);sreflexivity.
+  rewrite (ARth.(ARadd_comm) x);sreflexivity.
  Qed.
 
  Lemma ARadd_assoc2 : forall x y z, (y + x) + z == (y + z) + x.
  Proof.
   intros; repeat rewrite <- (ARadd_assoc ARth);
-   rewrite ((ARadd_sym ARth) x); sreflexivity.
+   rewrite ((ARadd_comm ARth) x); sreflexivity.
  Qed.
 
  Lemma ARmul_assoc1 : forall x y z, (x * y) * z == (y * z) * x.
  Proof.
   intros;rewrite <-((ARmul_assoc ARth) x).
-  rewrite ((ARmul_sym ARth) x);sreflexivity.
+  rewrite ((ARmul_comm ARth) x);sreflexivity.
  Qed.
  
  Lemma ARmul_assoc2 : forall x y z, (y * x) * z == (y * z) * x.
  Proof.
   intros; repeat rewrite <- (ARmul_assoc ARth);
-   rewrite ((ARmul_sym ARth) x); sreflexivity.
+   rewrite ((ARmul_comm ARth) x); sreflexivity.
  Qed.
 
  Lemma ARopp_mul_r : forall x y,  - (x * y) == x * -y.
  Proof.
-  intros;rewrite ((ARmul_sym ARth) x y);
-   rewrite (ARopp_mul_l ARth); apply (ARmul_sym ARth).
+  intros;rewrite ((ARmul_comm ARth) x y);
+   rewrite (ARopp_mul_l ARth); apply (ARmul_comm ARth).
  Qed.
 
  Lemma ARopp_zero : -0 == 0.
@@ -420,8 +433,37 @@ Section ALMOST_RING.
   repeat rewrite ARmul_0_r; sreflexivity.
  Qed.
 
+
+
 End ALMOST_RING.
 
+Section AddRing.
+
+ Variable R : Type.
+ Variable (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R).
+ Variable req : R -> R -> Prop.
+
+Inductive ring_kind : Type :=
+| Abstract
+| Computational
+    (R:Type)
+    (req : R -> R -> Prop)
+    (reqb : R -> R -> bool)
+    (_ : forall x y, (reqb x y) = true -> req x y)
+| Morphism
+    (R : Type)
+    (rO rI : R) (radd rmul rsub: R->R->R) (ropp : R -> R)
+    (req : R -> R -> Prop)
+    (C : Type)
+    (cO cI : C) (cadd cmul csub : C->C->C) (copp : C->C)
+    (ceqb : C->C->bool)
+    phi
+    (_ : ring_morph rO rI radd rmul rsub ropp req
+                    cO cI cadd cmul csub copp ceqb phi).
+
+End AddRing.
+
+
 (** Some simplification tactics*)
 Ltac gen_reflexivity Rsth := apply (Seq_refl _ _ Rsth).
 
diff --git a/contrib/setoid_ring/ZArithRing.v b/contrib/setoid_ring/ZArithRing.v
new file mode 100644
index 00000000..4f47fff0
--- /dev/null
+++ b/contrib/setoid_ring/ZArithRing.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        *)
+(************************************************************************)
+
+Require Export Ring.
+Require Import ZArith_base.
+Import InitialRing.
+
+Set Implicit Arguments.
+
+Ltac isZcst t :=
+  let t := eval hnf in t in
+  match t with
+    Z0 => constr:true
+  | Zpos ?p => isZcst p
+  | Zneg ?p => isZcst p
+  | xI ?p => isZcst p
+  | xO ?p => isZcst p
+  | xH => constr:true
+  | _ => constr:false
+  end.
+Ltac Zcst t :=
+  match isZcst t with
+    true => t
+  | _ => NotConstant
+  end.
+
+Add Ring Zr : Zth
+  (decidable Zeqb_ok, constants [Zcst], preprocess [unfold Zsucc]).
diff --git a/contrib/setoid_ring/newring.ml4 b/contrib/setoid_ring/newring.ml4
index bc2bcb0c..daa2fedb 100644
--- a/contrib/setoid_ring/newring.ml4
+++ b/contrib/setoid_ring/newring.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(*i $Id: newring.ml4 8878 2006-05-30 16:44:25Z herbelin $ i*)
+(*i $Id: newring.ml4 9302 2006-10-27 21:21:17Z barras $ i*)
 
 open Pp
 open Util
@@ -16,6 +16,7 @@ open Names
 open Term
 open Closure
 open Environ
+open Libnames
 open Tactics
 open Rawterm
 open Tacticals
@@ -27,139 +28,53 @@ open Setoid_replace
 open Proof_type
 open Coqlib
 open Tacmach
-open Ppconstr
 open Mod_subst
 open Tacinterp
 open Libobject
 open Printer
-
-(****************************************************************************)
-(* Library linking *)
-
-let contrib_name = "setoid_ring"
-
-
-let ring_dir = ["Coq";contrib_name]
-let setoids_dir = ["Coq";"Setoids"]
-let ring_modules = 
-  [ring_dir@["BinList"];ring_dir@["Ring_th"];ring_dir@["Pol"];
-   ring_dir@["Ring_tac"];ring_dir@["ZRing_th"]]
-let stdlib_modules = [setoids_dir@["Setoid"]]
-
-let coq_constant c =
-  lazy (Coqlib.gen_constant_in_modules "Ring" stdlib_modules c)
-let ring_constant c =
-  lazy (Coqlib.gen_constant_in_modules "Ring" ring_modules c)
-let ringtac_constant m c =
-  lazy (Coqlib.gen_constant_in_modules "Ring" [ring_dir@["ZRing_th";m]] c)
-
-let new_ring_path =
-  make_dirpath (List.map id_of_string ["Ring_tac";contrib_name;"Coq"])
-let ltac s =
-  lazy(make_kn (MPfile new_ring_path) (make_dirpath []) (mk_label s))
-let znew_ring_path =
-  make_dirpath (List.map id_of_string ["ZRing_th";contrib_name;"Coq"])
-let zltac s =
-  lazy(make_kn (MPfile znew_ring_path) (make_dirpath []) (mk_label s))
-let carg c = TacDynamic(dummy_loc,Pretyping.constr_in c)
-
-let mk_cst l s = lazy (Coqlib.gen_constant "newring" l s);;
-let pol_cst s = mk_cst [contrib_name;"Pol"] s ;;
-
-let ic c =
-  let env = Global.env() and sigma = Evd.empty in
-  Constrintern.interp_constr sigma env c
-
-
-(* Ring theory *)
-
-(* almost_ring defs *)
-let coq_almost_ring_theory = ring_constant "almost_ring_theory"
-let coq_ring_lemma1 = ring_constant "ring_correct"
-let coq_ring_lemma2 = ring_constant "Pphi_dev_ok'"
-let ring_comp1 = ring_constant "ring_id_correct"
-let ring_comp2 = ring_constant "ring_rw_id_correct'"
-let ring_abs1 = ringtac_constant "Zpol" "ring_gen_correct"
-let ring_abs2 = ringtac_constant "Zpol" "ring_rw_gen_correct'"
-let sring_abs1 = ringtac_constant "Npol" "ring_gen_correct"
-let sring_abs2 = ringtac_constant "Npol" "ring_rw_gen_correct'"
-
-(* setoid and morphism utilities *)
-let coq_mk_Setoid = coq_constant "Build_Setoid_Theory"
-let coq_eq_setoid = ring_constant "Eqsth"
-let coq_eq_morph = ring_constant "Eq_ext"
-
-(* ring -> almost_ring utilities *)
-let coq_ring_theory = ring_constant "ring_theory"
-let coq_ring_morph = ring_constant "ring_morph"
-let coq_Rth_ARth = ring_constant "Rth_ARth"
-let coq_mk_reqe = ring_constant "mk_reqe"
-
-(* semi_ring -> almost_ring utilities *)
-let coq_semi_ring_theory = ring_constant "semi_ring_theory"
-let coq_SRth_ARth = ring_constant "SRth_ARth"
-let coq_sring_morph = ring_constant "semi_morph"
-let coq_SRmorph_Rmorph = ring_constant "SRmorph_Rmorph"
-let coq_mk_seqe = ring_constant "mk_seqe"
-let coq_SRsub = ring_constant "SRsub"
-let coq_SRopp = ring_constant "SRopp"
-let coq_SReqe_Reqe = ring_constant "SReqe_Reqe"
-
-let ltac_setoid_ring = ltac"Make_ring_tac"
-let ltac_setoid_ring_rewrite = ltac"Make_ring_rw_list"
-let ltac_inv_morphZ = zltac"inv_gen_phiZ"
-let ltac_inv_morphN = zltac"inv_gen_phiN"
-
-let coq_cons = ring_constant "cons"
-let coq_nil = ring_constant "nil"
-
-let lapp f args = mkApp(Lazy.force f,args)
-
-let dest_rel t =
-  match kind_of_term t with
-      App(f,args) when Array.length args >= 2 ->
-        mkApp(f,Array.sub args 0 (Array.length args - 2))
-    | _ -> failwith "cannot find relation"
+open Declare
+open Decl_kinds
+open Entries
 
 (****************************************************************************)
 (* controlled reduction *)
 
-let mark_arg i c = mkEvar(i,[|c|]);;
+let mark_arg i c = mkEvar(i,[|c|])
 let unmark_arg f c =
   match destEvar c with
     | (i,[|c|]) -> f i c
-    | _ -> assert false;;
+    | _ -> assert false
 
-type protect_flag = Eval|Prot|Rec ;;
+type protect_flag = Eval|Prot|Rec
 
-let tag_arg tag_rec map i c =
+let tag_arg tag_rec map subs i c =
   match map i with
-      Eval -> inject c
+      Eval -> mk_clos subs c
     | Prot -> mk_atom c
-    | Rec -> if i = -1 then inject c else tag_rec c
+    | Rec -> if i = -1 then mk_clos subs c else tag_rec c
 
-let rec mk_clos_but f_map t =
+let rec mk_clos_but f_map subs t =
   match f_map t with
-    | Some map -> tag_arg (mk_clos_but f_map) map (-1) t
+    | Some map -> tag_arg (mk_clos_but f_map subs) map subs (-1) t
     | None ->
         (match kind_of_term t with
-            App(f,args) -> mk_clos_app_but f_map f args 0
-          (* unspecified constants are evaluated *)
-          | _ -> inject t)
+            App(f,args) -> mk_clos_app_but f_map subs f args 0
+          | Prod _ -> mk_clos_deep (mk_clos_but f_map) subs t
+          | _ -> mk_atom t)
 
-and mk_clos_app_but f_map f args n =
-  if n >= Array.length args then inject(mkApp(f, args))
+and mk_clos_app_but f_map subs f args n =
+  if n >= Array.length args then mk_atom(mkApp(f, args))
   else
     let fargs, args' = array_chop n args in
     let f' = mkApp(f,fargs) in
     match f_map f' with
         Some map ->
           mk_clos_deep
-            (fun _ -> unmark_arg (tag_arg (mk_clos_but f_map) map))
-            (Esubst.ESID 0)
+            (fun s' -> unmark_arg (tag_arg (mk_clos_but f_map s') map s'))
+            subs
             (mkApp (mark_arg (-1) f', Array.mapi mark_arg args'))
-      | None -> mk_clos_app_but f_map f args (n+1)
-;;
+      | None -> mk_clos_app_but f_map subs f args (n+1)
+
 
 let interp_map l c =
   try
@@ -174,98 +89,320 @@ let interp_map l c =
 let interp_map l t =
   try Some(List.assoc t l) with Not_found -> None
 
-let arg_map =
-  [mk_cst [contrib_name;"BinList"] "cons",(function -1->Eval|2->Rec|_->Prot);
-   mk_cst [contrib_name;"BinList"] "nil", (function -1->Eval|_ -> Prot);
-   (* Pphi_dev: evaluate polynomial and coef operations, protect
-       ring operations and make recursive call on morphism and var map *)
-   pol_cst "Pphi_dev", (function -1|6|7|8|11->Eval|9|10->Rec|_->Prot);
-   (* PEeval: evaluate polynomial, protect ring operations
-      and make recursive call on morphism and var map *)
-   pol_cst "PEeval", (function -1|9->Eval|7|8->Rec|_->Prot);
-   (* Do not evaluate ring operations... *)
-   ring_constant "gen_phiZ", (function -1|6->Eval|_->Prot);
-   ring_constant "gen_phiN", (function -1|5->Eval|_->Prot);
-];;
+let protect_maps = ref ([]:(string*(constr->'a)) list)
+let add_map s m = protect_maps := (s,m) :: !protect_maps
+let lookup_map map =
+  try List.assoc map !protect_maps
+  with Not_found ->
+    errorlabstrm"lookup_map"(str"map "++qs map++str"not found")
 
-(* Equality: do not evaluate but make recursive call on both sides *)
-let is_ring_thm req =
-  interp_map
-    ((req,(function -1->Prot|_->Rec))::
-    List.map (fun (c,map) -> (Lazy.force c,map)) arg_map)
-;;
-
-let protect_red env sigma c =
-  let req = dest_rel c in
+let protect_red map env sigma c =
   kl (create_clos_infos betadeltaiota env)
-    (mk_clos_but (is_ring_thm req) c);;
+    (mk_clos_but (lookup_map map c) (Esubst.ESID 0) c);;
 
-let protect_tac =
-  Tactics.reduct_option (protect_red,DEFAULTcast) None ;;
+let protect_tac map =
+  Tactics.reduct_option (protect_red map,DEFAULTcast) None ;;
 
-let protect_tac_in id =
-  Tactics.reduct_option (protect_red,DEFAULTcast) (Some(([],id),InHyp));;
+let protect_tac_in map id =
+  Tactics.reduct_option (protect_red map,DEFAULTcast) (Some(([],id),InHyp));;
 
 
 TACTIC EXTEND protect_fv
-  [ "protect_fv" "in" ident(id) ] -> 
-    [ protect_tac_in id ]
-| [ "protect_fv" ] -> 
-    [ protect_tac ]
+  [ "protect_fv" string(map) "in" ident(id) ] -> 
+    [ protect_tac_in map id ]
+| [ "protect_fv" string(map) ] -> 
+    [ protect_tac map ]
 END;;
 
 (****************************************************************************)
-(* Ring database *)
+
+let closed_term t l =
+  let l = List.map constr_of_global l in
+  let cs = List.fold_right Quote.ConstrSet.add l Quote.ConstrSet.empty in
+  if Quote.closed_under cs t then tclIDTAC else tclFAIL 0 (mt())
+;;
+
+TACTIC EXTEND closed_term
+  [ "closed_term" constr(t) "[" ne_reference_list(l) "]" ] ->
+    [ closed_term t l ]
+END
+;;
+(*
+let closed_term_ast l =
+  TacFun([Some(id_of_string"t")],
+  TacAtom(dummy_loc,TacExtend(dummy_loc,"closed_term",
+  [Genarg.in_gen Genarg.wit_constr (mkVar(id_of_string"t"));
+   Genarg.in_gen (Genarg.wit_list1 Genarg.wit_ref) l])))
+*)
+let closed_term_ast l =
+  let l = List.map (fun gr -> ArgArg(dummy_loc,gr)) l in
+  TacFun([Some(id_of_string"t")],
+  TacAtom(dummy_loc,TacExtend(dummy_loc,"closed_term",
+  [Genarg.in_gen Genarg.globwit_constr (RVar(dummy_loc,id_of_string"t"),None);
+   Genarg.in_gen (Genarg.wit_list1 Genarg.globwit_ref) l])))
+(*
+let _ = add_tacdef false ((dummy_loc,id_of_string"ring_closed_term"
+*)
+
+(****************************************************************************)
+
+let ic c =
+  let env = Global.env() and sigma = Evd.empty in
+  Constrintern.interp_constr sigma env c
 
 let ty c = Typing.type_of (Global.env()) Evd.empty c
 
+let decl_constant na c =
+  mkConst(declare_constant (id_of_string na) (DefinitionEntry 
+    { const_entry_body = c;
+      const_entry_type = None;
+      const_entry_opaque = true;
+      const_entry_boxed = true}, 
+    IsProof Lemma))
+
+let ltac_call tac args =
+  TacArg(TacCall(dummy_loc, ArgArg(dummy_loc, Lazy.force tac),args))
+
+let ltac_lcall tac args =
+  TacArg(TacCall(dummy_loc, ArgVar(dummy_loc, id_of_string tac),args))
+
+let carg c = TacDynamic(dummy_loc,Pretyping.constr_in c)
+
+let dummy_goal env =
+  {Evd.it=
+    {Evd.evar_concl=mkProp;
+     Evd.evar_hyps=named_context_val env;
+     Evd.evar_body=Evd.Evar_empty;
+     Evd.evar_extra=None};
+   Evd.sigma=Evd.empty}
+
+let exec_tactic env n f args =
+  let lid = list_tabulate(fun i -> id_of_string("x"^string_of_int i)) n in
+  let res = ref [||] in
+  let get_res ist =
+    let l = List.map (fun id ->  List.assoc id ist.lfun) lid in
+    res := Array.of_list l;
+    TacId[] in
+  let getter =
+    Tacexp(TacFun(List.map(fun id -> Some id) lid,
+                  glob_tactic(tacticIn get_res))) in
+  let _ =
+    Tacinterp.eval_tactic(ltac_call f (args@[getter])) (dummy_goal env) in
+  !res
+
+let constr_of = function
+  | VConstr c -> c
+  | _ -> failwith "Ring.exec_tactic: anomaly"
+
+let stdlib_modules =
+  [["Coq";"Setoids";"Setoid"];
+   ["Coq";"Lists";"List"]
+  ]
+
+let coq_constant c =
+  lazy (Coqlib.gen_constant_in_modules "Ring" stdlib_modules c)
+
+let coq_mk_Setoid = coq_constant "Build_Setoid_Theory"
+let coq_cons = coq_constant "cons"
+let coq_nil = coq_constant "nil"
+
+let lapp f args = mkApp(Lazy.force f,args)
+
+let rec dest_rel t =
+  match kind_of_term t with
+      App(f,args) when Array.length args >= 2 ->
+        let rel = mkApp(f,Array.sub args 0 (Array.length args - 2)) in
+        if closed0 rel then
+          (rel,args.(Array.length args - 2),args.(Array.length args - 1))
+        else error "ring: cannot find relation (not closed)"
+    | Prod(_,_,c) -> dest_rel c
+    | _ -> error "ring: cannot find relation"
+
+(****************************************************************************)
+(* Library linking *)
+
+let contrib_name = "setoid_ring"
+
+let cdir = ["Coq";contrib_name]
+let contrib_modules =
+  List.map (fun d -> cdir@d)
+    [["Ring_theory"];["Ring_polynom"]; ["Ring_tac"];["InitialRing"];
+     ["Field_tac"]; ["Field_theory"]
+    ]
+
+let my_constant c =
+  lazy (Coqlib.gen_constant_in_modules "Ring" contrib_modules c)
+
+let new_ring_path =
+  make_dirpath (List.map id_of_string ["Ring_tac";contrib_name;"Coq"])
+let ltac s =
+  lazy(make_kn (MPfile new_ring_path) (make_dirpath []) (mk_label s))
+let znew_ring_path =
+  make_dirpath (List.map id_of_string ["InitialRing";contrib_name;"Coq"])
+let zltac s =
+  lazy(make_kn (MPfile znew_ring_path) (make_dirpath []) (mk_label s))
+
+let mk_cst l s = lazy (Coqlib.gen_constant "newring" l s);;
+let pol_cst s = mk_cst [contrib_name;"Ring_polynom"] s ;;
+
+(* Ring theory *)
+
+(* almost_ring defs *)
+let coq_almost_ring_theory = my_constant "almost_ring_theory"
+
+(* setoid and morphism utilities *)
+let coq_eq_setoid = my_constant "Eqsth"
+let coq_eq_morph = my_constant "Eq_ext"
+let coq_eq_smorph = my_constant "Eq_s_ext"
+
+(* ring -> almost_ring utilities *)
+let coq_ring_theory = my_constant "ring_theory"
+let coq_mk_reqe = my_constant "mk_reqe"
+
+(* semi_ring -> almost_ring utilities *)
+let coq_semi_ring_theory = my_constant "semi_ring_theory"
+let coq_mk_seqe = my_constant "mk_seqe"
+
+let ltac_inv_morphZ = zltac"inv_gen_phiZ"
+let ltac_inv_morphN = zltac"inv_gen_phiN"
+
+let coq_abstract = my_constant"Abstract"
+let coq_comp = my_constant"Computational"
+let coq_morph = my_constant"Morphism"
+
+(* Equality: do not evaluate but make recursive call on both sides *)
+let map_with_eq arg_map c =
+  let (req,_,_) = dest_rel c in
+  interp_map
+    ((req,(function -1->Prot|_->Rec))::
+    List.map (fun (c,map) -> (Lazy.force c,map)) arg_map)
+
+let _ = add_map "ring"
+  (map_with_eq
+    [coq_cons,(function -1->Eval|2->Rec|_->Prot);
+    coq_nil, (function -1->Eval|_ -> Prot);
+    (* Pphi_dev: evaluate polynomial and coef operations, protect
+       ring operations and make recursive call on the var map *)
+    pol_cst "Pphi_dev", (function -1|6|7|8|9|11->Eval|10->Rec|_->Prot);
+    (* PEeval: evaluate morphism and polynomial, protect ring 
+       operations and make recursive call on the var map *)
+    pol_cst "PEeval", (function -1|7|9->Eval|8->Rec|_->Prot)])
+
+(****************************************************************************)
+(* Ring database *)
 
 type ring_info =
     { ring_carrier : types;
       ring_req : constr;
+      ring_setoid : constr;
+      ring_ext : constr;
+      ring_morph : constr;
+      ring_th : constr;
       ring_cst_tac : glob_tactic_expr;
       ring_lemma1 : constr;
-      ring_lemma2 : constr }
+      ring_lemma2 : constr;
+      ring_pre_tac : glob_tactic_expr;
+      ring_post_tac : glob_tactic_expr }
 
 module Cmap = Map.Make(struct type t = constr let compare = compare end)
 
 let from_carrier = ref Cmap.empty
 let from_relation = ref Cmap.empty
+let from_name = ref Spmap.empty
+
+let ring_for_carrier r = Cmap.find r !from_carrier
+let ring_for_relation rel = Cmap.find rel !from_relation
+let ring_lookup_by_name ref =
+  Spmap.find (Nametab.locate_obj (snd(qualid_of_reference ref))) !from_name
+
+
+let find_ring_structure env sigma l cl oname =
+  match oname, l with
+      Some rf, _ ->
+        (try ring_lookup_by_name rf
+        with Not_found ->
+          errorlabstrm "ring"
+            (str "found no ring named "++pr_reference rf))
+    | None, t::cl' ->
+        let ty = Retyping.get_type_of env sigma t in
+        let check c =
+          let ty' = Retyping.get_type_of env sigma c in
+          if not (Reductionops.is_conv env sigma ty ty') then
+            errorlabstrm "ring"
+              (str"arguments of ring_simplify do not have all the same type")
+        in
+        List.iter check cl';
+        (try ring_for_carrier ty
+        with Not_found ->
+          errorlabstrm "ring"
+            (str"cannot find a declared ring structure over"++
+             spc()++str"\""++pr_constr ty++str"\""))
+    | None, [] ->
+        let (req,_,_) = dest_rel cl in
+        (try ring_for_relation req
+        with Not_found ->
+          errorlabstrm "ring"
+            (str"cannot find a declared ring structure for equality"++
+             spc()++str"\""++pr_constr req++str"\""))
 
 let _ = 
   Summary.declare_summary "tactic-new-ring-table"
-    { Summary.freeze_function = (fun () -> !from_carrier,!from_relation);
+    { Summary.freeze_function =
+        (fun () -> !from_carrier,!from_relation,!from_name);
       Summary.unfreeze_function =
-        (fun (ct,rt) -> from_carrier := ct; from_relation := rt);
+        (fun (ct,rt,nt) ->
+          from_carrier := ct; from_relation := rt; from_name := nt);
       Summary.init_function =
-        (fun () -> from_carrier := Cmap.empty; from_relation := Cmap.empty);
+        (fun () ->
+          from_carrier := Cmap.empty; from_relation := Cmap.empty;
+          from_name := Spmap.empty);
       Summary.survive_module = false;
       Summary.survive_section = false }
 
-let add_entry _ e =
-  let _ = ty e.ring_lemma1 in
+let add_entry (sp,_kn) e =
+(*  let _ = ty e.ring_lemma1 in
   let _ = ty e.ring_lemma2 in
+*)
   from_carrier := Cmap.add e.ring_carrier e !from_carrier;
-  from_relation := Cmap.add e.ring_req e !from_relation
+  from_relation := Cmap.add e.ring_req e !from_relation;
+  from_name := Spmap.add sp e !from_name 
 
 
 let subst_th (_,subst,th) = 
   let c' = subst_mps subst th.ring_carrier in                   
   let eq' = subst_mps subst th.ring_req in
+  let set' = subst_mps subst th.ring_setoid in
+  let ext' = subst_mps subst th.ring_ext in
+  let morph' = subst_mps subst th.ring_morph in
+  let th' = subst_mps subst th.ring_th in
   let thm1' = subst_mps subst th.ring_lemma1 in
   let thm2' = subst_mps subst th.ring_lemma2 in
   let tac'= subst_tactic subst th.ring_cst_tac in
+  let pretac'= subst_tactic subst th.ring_pre_tac in
+  let posttac'= subst_tactic subst th.ring_post_tac in
   if c' == th.ring_carrier &&
      eq' == th.ring_req &&
+     set' = th.ring_setoid &&
+     ext' == th.ring_ext &&
+     morph' == th.ring_morph &&
+     th' == th.ring_th &&
      thm1' == th.ring_lemma1 &&
      thm2' == th.ring_lemma2 &&
-     tac' == th.ring_cst_tac then th
+     tac' == th.ring_cst_tac &&
+     pretac' == th.ring_pre_tac &&
+     posttac' == th.ring_post_tac then th
   else
     { ring_carrier = c';
       ring_req = eq';
+      ring_setoid = set';
+      ring_ext = ext';
+      ring_morph = morph';
+      ring_th = th';
       ring_cst_tac = tac';
       ring_lemma1 = thm1';
-      ring_lemma2 = thm2' }
+      ring_lemma2 = thm2';
+      ring_pre_tac = pretac';
+      ring_post_tac = posttac' }
 
 
 let (theory_to_obj, obj_to_theory) = 
@@ -280,10 +417,6 @@ let (theory_to_obj, obj_to_theory) =
       export_function = export_th }
 
 
-let ring_for_carrier r = Cmap.find r !from_carrier
-
-let ring_for_relation rel = Cmap.find rel !from_relation
-
 let setoid_of_relation r =
   lapp coq_mk_Setoid
     [|r.rel_a; r.rel_aeq;
@@ -293,43 +426,19 @@ let op_morph r add mul opp req m1 m2 m3 =
   lapp coq_mk_reqe [| r; add; mul; opp; req; m1; m2; m3 |]
 
 let op_smorph r add mul req m1 m2 =
-  lapp coq_SReqe_Reqe
-    [| r;add;mul;req;lapp coq_mk_seqe [| r; add; mul; req; m1; m2 |]|]
-
-let sr_sub r add = lapp coq_SRsub [|r;add|]
-let sr_opp r = lapp coq_SRopp [|r|]
+  lapp coq_mk_seqe [| r; add; mul; req; m1; m2 |]
 
-let dest_morphism kind th sth =
-  let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th in
-  match kind_of_term th_typ with
-      App(f,[|_;_;_;_;_;_;_;_;c;czero;cone;cadd;cmul;csub;copp;ceqb;phi|])
-        when f = Lazy.force coq_ring_morph ->
-          (th,[|c;czero;cone;cadd;cmul;csub;copp;ceqb;phi|])
-    | App(f,[|r;zero;one;add;mul;req;c;czero;cone;cadd;cmul;ceqb;phi|])
-        when f = Lazy.force coq_sring_morph && kind=Some true->
-        let th =
-          lapp coq_SRmorph_Rmorph
-            [|r;zero;one;add;mul;req;sth;c;czero;cone;cadd;cmul;ceqb;phi;th|]in
-        (th,[|c;czero;cone;cadd;cmul;cadd;sr_opp c;ceqb;phi|])
-    | _ -> failwith "bad ring_morph lemma"
-
-let dest_eq_test th =
-  let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th in
-  match decompose_prod th_typ with
-      (_,h)::_,_ ->
-        (match snd(destApplication h) with
-            [|_;lhs;_|] -> fst(destApplication lhs)
-          | _ -> failwith "bad lemma for decidability of equality")
-    | _ -> failwith "bad lemma for decidability of equality"
-
-let default_ring_equality is_semi (r,add,mul,opp,req) =
+let default_ring_equality (r,add,mul,opp,req) =
   let is_setoid = function
       {rel_refl=Some _; rel_sym=Some _;rel_trans=Some _} -> true
     | _ -> false in
   match default_relation_for_carrier ~filter:is_setoid r with
       Leibniz _ ->
         let setoid = lapp coq_eq_setoid [|r|] in
-        let op_morph = lapp coq_eq_morph [|r;add;mul;opp|] in
+        let op_morph =
+          match opp with
+              Some opp -> lapp coq_eq_morph [|r;add;mul;opp|]
+            | None -> lapp coq_eq_smorph [|r;add;mul|] in
         (setoid,op_morph)
     | Relation rel ->
         let setoid = setoid_of_relation rel in
@@ -347,8 +456,12 @@ let default_ring_equality is_semi (r,add,mul,opp,req) =
           with Not_found ->
             error "ring multiplication should be declared as a morphism" in
         let op_morph =
-          if is_semi <> Some true then
-            (let opp_m = default_morphism ~filter:is_endomorphism opp in
+          match opp with
+            | Some opp ->
+            (let opp_m =
+              try default_morphism ~filter:is_endomorphism opp
+              with Not_found ->
+                error "ring opposite should be declared as a morphism" in
              let op_morph =
                op_morph r add mul opp req add_m.lem mul_m.lem opp_m.lem in
              msgnl
@@ -358,7 +471,7 @@ let default_ring_equality is_semi (r,add,mul,opp,req) =
                str"\""++spc()++str"and \""++pr_constr opp_m.morphism_theory++
                str"\"");
              op_morph)
-          else
+            | None ->
             (msgnl
               (str"Using setoid \""++pr_constr rel.rel_aeq++str"\"" ++ spc() ++  
                str"and morphisms \""++pr_constr add_m.morphism_theory++
@@ -367,159 +480,475 @@ let default_ring_equality is_semi (r,add,mul,opp,req) =
             op_smorph r add mul req add_m.lem mul_m.lem) in
         (setoid,op_morph)
 
-let build_setoid_params is_semi r add mul opp req eqth =
+let build_setoid_params r add mul opp req eqth =
   match eqth with
       Some th -> th
-    | None -> default_ring_equality is_semi (r,add,mul,opp,req)
+    | None -> default_ring_equality (r,add,mul,opp,req)
 
-let dest_ring th_spec =
-  let th_typ = Retyping.get_type_of (Global.env()) Evd.empty th_spec in
+let dest_ring env sigma th_spec =
+  let th_typ = Retyping.get_type_of env sigma th_spec in
   match kind_of_term th_typ with
       App(f,[|r;zero;one;add;mul;sub;opp;req|])
         when f = Lazy.force coq_almost_ring_theory ->
-          (None,r,zero,one,add,mul,sub,opp,req)
+          (None,r,zero,one,add,mul,Some sub,Some opp,req)
     | App(f,[|r;zero;one;add;mul;req|])
         when f = Lazy.force coq_semi_ring_theory ->
-        (Some true,r,zero,one,add,mul,sr_sub r add,sr_opp r,req)
+        (Some true,r,zero,one,add,mul,None,None,req)
     | App(f,[|r;zero;one;add;mul;sub;opp;req|])
         when f = Lazy.force coq_ring_theory ->
-        (Some false,r,zero,one,add,mul,sub,opp,req)
+        (Some false,r,zero,one,add,mul,Some sub,Some opp,req)
     | _ -> error "bad ring structure"
 
 
-let build_almost_ring kind r zero one add mul sub opp req sth morph th =
-  match kind with
-      None -> th
-    | Some true ->
-        lapp coq_SRth_ARth [|r;zero;one;add;mul;req;sth;th|]
-    | Some false ->
-        lapp coq_Rth_ARth [|r;zero;one;add;mul;sub;opp;req;sth;morph;th|]
-
 
 type coeff_spec =
     Computational of constr (* equality test *)
   | Abstract (* coeffs = Z *)
   | Morphism of constr (* general morphism *)
 
+
+let reflect_coeff rkind =
+  (* We build an ill-typed terms on purpose... *)
+  match rkind with
+      Abstract -> Lazy.force coq_abstract
+    | Computational c -> lapp coq_comp [|c|]
+    | Morphism m -> lapp coq_morph [|m|]
+
 type cst_tac_spec =
     CstTac of raw_tactic_expr
-  | Closed of constr list
-
-
-let add_theory name rth eqth morphth cst_tac =
-  Coqlib.check_required_library ["Coq";"setoid_ring";"Ring_tac"];
-  let (kind,r,zero,one,add,mul,sub,opp,req) = dest_ring rth in
-  let (sth,morph) = build_setoid_params kind r add mul opp req eqth in
-  let args0 = [|r;zero;one;add;mul;sub;opp;req;sth;morph|] in
-  let (lemma1,lemma2) =
-    match morphth with
-      | Computational c ->
-          let reqb = dest_eq_test c in
-          let rth = 
-            build_almost_ring
-              kind r zero one add mul sub opp req sth  morph rth in
-          let args = Array.append args0 [|rth;reqb;c|] in
-          (lapp ring_comp1 args, lapp ring_comp2 args)
-      | Morphism m ->
-          let (m,args1) = dest_morphism kind m sth in
-          let rth = 
-            build_almost_ring
-              kind r zero one add mul sub opp req sth morph rth in
-          let args = Array.concat [args0;[|rth|]; args1; [|m|]] in
-          (lapp coq_ring_lemma1 args, lapp coq_ring_lemma2 args)
-      | Abstract ->
-          Coqlib.check_required_library ["Coq";"setoid_ring";"ZRing_th"];
-          let args1 = Array.append args0 [|rth|] in
-          (match kind with
-              None -> error "an almost_ring cannot be abstract"
-            | Some true ->
-                (lapp sring_abs1 args1, lapp sring_abs2 args1)
-            | Some false ->
-                (lapp ring_abs1 args1, lapp ring_abs2 args1)) in
-  let cst_tac = match cst_tac with
+  | Closed of reference list
+
+let interp_cst_tac kind (zero,one,add,mul,opp) cst_tac =
+  match cst_tac with
       Some (CstTac t) -> Tacinterp.glob_tactic t
-    | Some (Closed lc) -> failwith "TODO"
+    | Some (Closed lc) -> closed_term_ast (List.map Nametab.global lc)
     | None ->
-        (match kind with
-            Some true ->
+        (match opp, kind with
+            None, _ ->
               let t = ArgArg(dummy_loc,Lazy.force ltac_inv_morphN) in
               TacArg(TacCall(dummy_loc,t,List.map carg [zero;one;add;mul]))
-          | Some false ->
+          | Some opp, Some _ ->
               let t = ArgArg(dummy_loc, Lazy.force ltac_inv_morphZ) in
               TacArg(TacCall(dummy_loc,t,List.map carg [zero;one;add;mul;opp]))
-          | _ -> error"a tactic must be specified for an almost_ring") in
+          | _ -> error"a tactic must be specified for an almost_ring")
+
+let add_theory name rth eqth morphth cst_tac (pre,post) =
+  let env = Global.env() in
+  let sigma = Evd.empty in
+  let (kind,r,zero,one,add,mul,sub,opp,req) = dest_ring env sigma rth in
+  let (sth,ext) = build_setoid_params r add mul opp req eqth in
+  let rk = reflect_coeff morphth in
+  let params =
+    exec_tactic env 5 (zltac"ring_lemmas") (List.map carg[sth;ext;rth;rk]) in
+  let lemma1 = constr_of params.(3) in
+  let lemma2 = constr_of params.(4) in
+
+  let lemma1 = decl_constant (string_of_id name^"_ring_lemma1") lemma1 in
+  let lemma2 = decl_constant (string_of_id name^"_ring_lemma2") lemma2 in
+  let cst_tac = interp_cst_tac kind (zero,one,add,mul,opp) cst_tac in
+  let pretac =
+    match pre with
+        Some t -> Tacinterp.glob_tactic t
+      | _ -> TacId [] in
+  let posttac =
+    match post with
+        Some t -> Tacinterp.glob_tactic t
+      | _ -> TacId [] in
   let _ =
     Lib.add_leaf name
       (theory_to_obj
         { ring_carrier = r;
           ring_req = req;
+          ring_setoid = sth;
+          ring_ext = constr_of params.(1);
+          ring_morph = constr_of params.(2);
+          ring_th = constr_of params.(0);
           ring_cst_tac = cst_tac;
           ring_lemma1 = lemma1;
-          ring_lemma2 = lemma2 }) in
+          ring_lemma2 = lemma2;
+          ring_pre_tac = pretac;
+          ring_post_tac = posttac }) in
   ()
 
-VERNAC ARGUMENT EXTEND ring_coefs
-| [ "Computational" constr(c)] -> [ Computational (ic c) ]
-| [ "Abstract" ] -> [ Abstract ]
-| [ "Coefficients" constr(m)] -> [ Morphism (ic m) ]
-| [ ] -> [ Abstract ]
+type ring_mod =
+    Ring_kind of coeff_spec
+  | Const_tac of cst_tac_spec
+  | Pre_tac of raw_tactic_expr
+  | Post_tac of raw_tactic_expr
+  | Setoid of Topconstr.constr_expr * Topconstr.constr_expr
+
+VERNAC ARGUMENT EXTEND ring_mod
+  | [ "decidable" constr(eq_test) ] -> [ Ring_kind(Computational (ic eq_test)) ]
+  | [ "abstract" ] -> [ Ring_kind Abstract ]
+  | [ "morphism" constr(morph) ] -> [ Ring_kind(Morphism (ic morph)) ]
+  | [ "constants" "[" tactic(cst_tac) "]" ] -> [ Const_tac(CstTac cst_tac) ]
+  | [ "closed" "[" ne_global_list(l) "]" ] -> [ Const_tac(Closed l) ]
+  | [ "preprocess" "[" tactic(pre) "]" ] -> [ Pre_tac pre ]
+  | [ "postprocess" "[" tactic(post) "]" ] -> [ Post_tac post ]
+  | [ "setoid" constr(sth) constr(ext) ] -> [ Setoid(sth,ext) ]
 END
 
-VERNAC ARGUMENT EXTEND ring_cst_tac
-| [ "Constant" tactic(c)] -> [ Some(CstTac c) ]
-| [ "[" ne_constr_list(l) "]" ] -> [ Some(Closed (List.map ic l)) ]
-| [ ] -> [ None ]
-END
+let set_once s r v =
+  if !r = None then r := Some v else error (s^" cannot be set twice")
+
+let process_ring_mods l =
+  let kind = ref None in
+  let set = ref None in
+  let cst_tac = ref None in
+  let pre = ref None in
+  let post = ref None in
+  List.iter(function
+      Ring_kind k -> set_once "ring kind" kind k
+    | Const_tac t -> set_once "tactic recognizing constants" cst_tac t
+    | Pre_tac t -> set_once "preprocess tactic" pre t
+    | Post_tac t -> set_once "postprocess tactic" post t
+    | Setoid(sth,ext) -> set_once "setoid" set (ic sth,ic ext)) l;
+  let k = match !kind with Some k -> k | None -> Abstract in
+  (k, !set, !cst_tac, !pre, !post)
 
 VERNAC COMMAND EXTEND AddSetoidRing
-| [ "Add" "New" "Ring" ident(id) ":" constr(t) ring_coefs(c)
-      "Setoid" constr(e) constr(m) ring_cst_tac(tac) ] ->
-    [ add_theory id (ic t) (Some (ic e, ic m)) c tac ]
-| [ "Add" "New" "Ring" ident(id) ":" constr(t) ring_coefs(c) 
-      ring_cst_tac(tac) ] ->
-    [ add_theory id (ic t) None c tac ]
+  | [ "Add" "Ring" ident(id) ":" constr(t) ring_mods(l) ] ->
+    [ let (k,set,cst,pre,post) = process_ring_mods l in
+      add_theory id (ic t) set k cst (pre,post) ]
 END
 
-
 (*****************************************************************************)
 (* The tactics consist then only in a lookup in the ring database and
    call the appropriate ltac. *)
 
-let ring gl = 
-  let req = dest_rel (pf_concl gl) in
-  let e =
-    try ring_for_relation req
-    with Not_found ->
-      errorlabstrm "ring"
-        (str"cannot find a declared ring structure for equality"++
-         spc()++str"\""++pr_constr req++str"\"") in
-  Tacinterp.eval_tactic
-    (TacArg(TacCall(dummy_loc,
-      ArgArg(dummy_loc, Lazy.force ltac_setoid_ring),
-      Tacexp e.ring_cst_tac::
-      List.map carg [e.ring_lemma1;e.ring_lemma2;e.ring_req])))
-    gl
-
-let ring_rewrite rl =
-  let ty = Retyping.get_type_of (Global.env()) Evd.empty (List.hd rl) in
-  let e =
-    try ring_for_carrier ty
-    with Not_found ->
-      errorlabstrm "ring"
-        (str"cannot find a declared ring structure over"++
-         spc()++str"\""++pr_constr ty++str"\"") in
-  let rl = List.fold_right (fun x l -> lapp coq_cons [|ty;x;l|]) rl
-    (lapp coq_nil [|ty|]) in
+let make_term_list carrier rl gl =
+  let rl = 
+    match rl with
+	[] -> let (_,t1,t2) = dest_rel (pf_concl gl) in [t1;t2]
+      | _ -> rl in
+  List.fold_right
+    (fun x l -> lapp coq_cons [|carrier;x;l|]) rl
+    (lapp coq_nil [|carrier|])
+
+let ring_lookup (f:glob_tactic_expr) rl gl =
+  let env = pf_env gl in
+  let sigma = project gl in
+  let e = find_ring_structure env sigma rl (pf_concl gl) None in
+  let rl = carg (make_term_list e.ring_carrier rl gl) in
+  let req = carg e.ring_req in
+  let sth = carg e.ring_setoid in
+  let ext = carg e.ring_ext in
+  let morph = carg e.ring_morph in
+  let th = carg e.ring_th in
+  let cst_tac = Tacexp e.ring_cst_tac in
+  let lemma1 = carg e.ring_lemma1 in
+  let lemma2 = carg e.ring_lemma2 in
+  let pretac = Tacexp(TacFun([None],e.ring_pre_tac)) in
+  let posttac = Tacexp(TacFun([None],e.ring_post_tac)) in
   Tacinterp.eval_tactic
-    (TacArg(TacCall(dummy_loc,
-      ArgArg(dummy_loc, Lazy.force ltac_setoid_ring_rewrite),
-      Tacexp e.ring_cst_tac::List.map carg [e.ring_lemma2;e.ring_req;rl])))
+    (TacLetIn
+      ([(dummy_loc,id_of_string"f"),None,Tacexp f],
+       ltac_lcall "f"
+         [req;sth;ext;morph;th;cst_tac;lemma1;lemma2;pretac;posttac;rl])) gl
+
+TACTIC EXTEND ring_lookup
+| [ "ring_lookup" tactic(f) constr_list(l) ] -> [ ring_lookup (fst f) l ]
+END
+
+(***********************************************************************)
+
+let new_field_path =
+  make_dirpath (List.map id_of_string ["Field_tac";contrib_name;"Coq"])
+
+let field_ltac s =
+  lazy(make_kn (MPfile new_field_path) (make_dirpath []) (mk_label s))
+
+
+let _ = add_map "field"
+  (map_with_eq
+    [coq_cons,(function -1->Eval|2->Rec|_->Prot);
+    coq_nil, (function -1->Eval|_ -> Prot);
+    (* display_linear: evaluate polynomials and coef operations, protect
+       field operations and make recursive call on the var map *)
+    my_constant "display_linear",
+      (function -1|7|8|9|10|12|13->Eval|11->Rec|_->Prot);
+    (* Pphi_dev: evaluate polynomial and coef operations, protect
+       ring operations and make recursive call on the var map *)
+    my_constant "Pphi_dev", (function -1|6|7|8|9|11->Eval|10->Rec|_->Prot);
+    (* PEeval: evaluate morphism and polynomial, protect ring 
+       operations and make recursive call on the var map *)
+    my_constant "FEeval", (function -1|9|11->Eval|10->Rec|_->Prot)]);;
+
+
+let _ = add_map "field_cond"
+  (map_with_eq
+    [coq_cons,(function -1->Eval|2->Rec|_->Prot);
+     coq_nil, (function -1->Eval|_ -> Prot);
+    (* PCond: evaluate morphism and denum list, protect ring
+       operations and make recursive call on the var map *)
+     my_constant "PCond", (function -1|8|10->Eval|9->Rec|_->Prot)]);;
+
+
+let afield_theory = my_constant "almost_field_theory"
+let field_theory = my_constant "field_theory"
+let sfield_theory = my_constant "semi_field_theory"
+let af_ar = my_constant"AF_AR"
+let f_r = my_constant"F_R"
+let sf_sr = my_constant"SF_SR"
+let dest_field env sigma th_spec =
+  let th_typ = Retyping.get_type_of env sigma th_spec in
+  match kind_of_term th_typ with
+    | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|])
+        when f = Lazy.force afield_theory ->
+        let rth = lapp af_ar
+          [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in
+        (None,r,zero,one,add,mul,Some sub,Some opp,div,inv,req,rth)
+    | App(f,[|r;zero;one;add;mul;sub;opp;div;inv;req|])
+        when f = Lazy.force field_theory ->
+        let rth =
+          lapp f_r
+            [|r;zero;one;add;mul;sub;opp;div;inv;req;th_spec|] in
+        (Some false,r,zero,one,add,mul,Some sub,Some opp,div,inv,req,rth)
+    | App(f,[|r;zero;one;add;mul;div;inv;req|])
+        when f = Lazy.force sfield_theory ->
+        let rth = lapp sf_sr
+          [|r;zero;one;add;mul;div;inv;req;th_spec|] in
+        (Some true,r,zero,one,add,mul,None,None,div,inv,req,rth)
+    | _ -> error "bad field structure"
+
+type field_info =
+    { field_carrier : types;
+      field_req : constr;
+      field_cst_tac : glob_tactic_expr;
+      field_ok : constr;
+      field_simpl_eq_ok : constr;
+      field_simpl_ok : constr;
+      field_cond : constr;
+      field_pre_tac : glob_tactic_expr;
+      field_post_tac : glob_tactic_expr }
+
+let field_from_carrier = ref Cmap.empty
+let field_from_relation = ref Cmap.empty
+let field_from_name = ref Spmap.empty
+
+
+let field_for_carrier r = Cmap.find r !field_from_carrier
+let field_for_relation rel = Cmap.find rel !field_from_relation
+let field_lookup_by_name ref =
+  Spmap.find (Nametab.locate_obj (snd(qualid_of_reference ref)))
+    !field_from_name
+
+
+let find_field_structure env sigma l cl oname =
+  check_required_library (cdir@["Field_tac"]);
+  match oname, l with
+      Some rf, _ ->
+        (try field_lookup_by_name rf
+        with Not_found ->
+          errorlabstrm "field"
+            (str "found no field named "++pr_reference rf))
+    | None, t::cl' ->
+        let ty = Retyping.get_type_of env sigma t in
+        let check c =
+          let ty' = Retyping.get_type_of env sigma c in
+          if not (Reductionops.is_conv env sigma ty ty') then
+            errorlabstrm "field"
+              (str"arguments of field_simplify do not have all the same type")
+        in
+        List.iter check cl';
+        (try field_for_carrier ty
+        with Not_found ->
+          errorlabstrm "field"
+            (str"cannot find a declared field structure over"++
+             spc()++str"\""++pr_constr ty++str"\""))
+    | None, [] ->
+        let (req,_,_) = dest_rel cl in
+        (try field_for_relation req
+        with Not_found ->
+          errorlabstrm "field"
+            (str"cannot find a declared field structure for equality"++
+             spc()++str"\""++pr_constr req++str"\""))
+
+let _ = 
+  Summary.declare_summary "tactic-new-field-table"
+    { Summary.freeze_function =
+        (fun () -> !field_from_carrier,!field_from_relation,!field_from_name);
+      Summary.unfreeze_function =
+        (fun (ct,rt,nt) ->
+          field_from_carrier := ct; field_from_relation := rt;
+          field_from_name := nt);
+      Summary.init_function =
+        (fun () ->
+          field_from_carrier := Cmap.empty; field_from_relation := Cmap.empty;
+          field_from_name := Spmap.empty);
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+let add_field_entry (sp,_kn) e =
+(*
+  let _ = ty e.field_ok in
+  let _ = ty e.field_simpl_eq_ok in
+  let _ = ty e.field_simpl_ok in
+  let _ = ty e.field_cond in
+*)
+  field_from_carrier := Cmap.add e.field_carrier e !field_from_carrier;
+  field_from_relation := Cmap.add e.field_req e !field_from_relation;
+  field_from_name := Spmap.add sp e !field_from_name 
+
+let subst_th (_,subst,th) = 
+  let c' = subst_mps subst th.field_carrier in                   
+  let eq' = subst_mps subst th.field_req in
+  let thm1' = subst_mps subst th.field_ok in
+  let thm2' = subst_mps subst th.field_simpl_eq_ok in
+  let thm3' = subst_mps subst th.field_simpl_ok in
+  let thm4' = subst_mps subst th.field_cond in
+  let tac'= subst_tactic subst th.field_cst_tac in
+  let pretac'= subst_tactic subst th.field_pre_tac in
+  let posttac'= subst_tactic subst th.field_post_tac in
+  if c' == th.field_carrier &&
+     eq' == th.field_req &&
+     thm1' == th.field_ok &&
+     thm2' == th.field_simpl_eq_ok &&
+     thm3' == th.field_simpl_ok &&
+     thm4' == th.field_cond &&
+     tac' == th.field_cst_tac &&
+     pretac' == th.field_pre_tac &&
+     posttac' == th.field_post_tac then th
+  else
+    { field_carrier = c';
+      field_req = eq';
+      field_cst_tac = tac';
+      field_ok = thm1';
+      field_simpl_eq_ok = thm2';
+      field_simpl_ok = thm3';
+      field_cond = thm4';
+      field_pre_tac = pretac';
+      field_post_tac = posttac' }
+
+let (ftheory_to_obj, obj_to_ftheory) = 
+  let cache_th (name,th) = add_field_entry name th
+  and export_th x = Some x in
+  declare_object
+    {(default_object "tactic-new-field-theory") with
+      open_function = (fun i o -> if i=1 then cache_th o);
+      cache_function = cache_th;
+      subst_function = subst_th;
+      classify_function = (fun (_,x) -> Substitute x);
+      export_function = export_th }
 
-let setoid_ring = function
-  | [] -> ring
-  | l -> ring_rewrite l
+let default_field_equality r inv req =
+  let is_setoid = function
+      {rel_refl=Some _; rel_sym=Some _;rel_trans=Some _} -> true
+    | _ -> false in
+  match default_relation_for_carrier ~filter:is_setoid r with
+      Leibniz _ ->
+        mkApp((Coqlib.build_coq_eq_data()).congr,[|r;r;inv|])
+    | Relation rel ->
+        let is_endomorphism = function
+            { args=args } -> List.for_all
+                (function (var,Relation rel) ->
+                  var=None && eq_constr req rel
+                  | _ -> false) args in
+        let inv_m =
+          try default_morphism ~filter:is_endomorphism inv
+          with Not_found ->
+            error "field inverse should be declared as a morphism" in
+        inv_m.lem
+
+let add_field_theory name fth eqth morphth cst_tac inj (pre,post) =
+  let env = Global.env() in
+  let sigma = Evd.empty in
+  let (kind,r,zero,one,add,mul,sub,opp,div,inv,req,rth) =
+    dest_field env sigma fth in
+  let (sth,ext) = build_setoid_params r add mul opp req eqth in
+  let eqth = Some(sth,ext) in
+  let _ = add_theory name rth eqth morphth cst_tac (None,None) in
+  let inv_m = default_field_equality r inv req in
+  let rk = reflect_coeff morphth in
+  let params =
+    exec_tactic env 8 (field_ltac"field_lemmas")
+      (List.map carg[sth;ext;inv_m;fth;rk]) in
+  let lemma1 = constr_of params.(3) in
+  let lemma2 = constr_of params.(4) in
+  let lemma3 = constr_of params.(5) in
+  let cond_lemma =
+    match inj with
+      | Some thm -> mkApp(constr_of params.(7),[|thm|])
+      | None -> constr_of params.(6) in
+  let lemma1 = decl_constant (string_of_id name^"_field_lemma1") lemma1 in
+  let lemma2 = decl_constant (string_of_id name^"_field_lemma2") lemma2 in
+  let lemma3 = decl_constant (string_of_id name^"_field_lemma3") lemma3 in
+  let cond_lemma = decl_constant (string_of_id name^"_lemma4") cond_lemma in
+  let cst_tac = interp_cst_tac kind (zero,one,add,mul,opp) cst_tac in
+  let pretac =
+    match pre with
+        Some t -> Tacinterp.glob_tactic t
+      | _ -> TacId [] in
+  let posttac =
+    match post with
+        Some t -> Tacinterp.glob_tactic t
+      | _ -> TacId [] in
+  let _ =
+    Lib.add_leaf name
+      (ftheory_to_obj
+        { field_carrier = r;
+          field_req = req;
+          field_cst_tac = cst_tac;
+          field_ok = lemma1;
+          field_simpl_eq_ok = lemma2;
+          field_simpl_ok = lemma3;
+          field_cond = cond_lemma;
+          field_pre_tac = pretac;
+          field_post_tac = posttac }) in  ()
+
+type field_mod =
+    Ring_mod of ring_mod
+  | Inject of Topconstr.constr_expr
+
+VERNAC ARGUMENT EXTEND field_mod
+  | [ ring_mod(m) ] -> [ Ring_mod m ]
+  | [ "infinite" constr(inj) ] -> [ Inject inj ]
+END
 
-TACTIC EXTEND setoid_ring
-  [ "setoid" "ring" constr_list(l) ] -> [ setoid_ring l ]
+let process_field_mods l =
+  let kind = ref None in
+  let set = ref None in
+  let cst_tac = ref None in
+  let pre = ref None in
+  let post = ref None in
+  let inj = ref None in
+  List.iter(function
+      Ring_mod(Ring_kind k) -> set_once "field kind" kind k
+    | Ring_mod(Const_tac t) ->
+        set_once "tactic recognizing constants" cst_tac t
+    | Ring_mod(Pre_tac t) -> set_once "preprocess tactic" pre t
+    | Ring_mod(Post_tac t) -> set_once "postprocess tactic" post t
+    | Ring_mod(Setoid(sth,ext)) -> set_once "setoid" set (ic sth,ic ext)
+    | Inject i -> set_once "infinite property" inj (ic i)) l;
+  let k = match !kind with Some k -> k | None -> Abstract in
+  (k, !set, !inj, !cst_tac, !pre, !post)
+
+VERNAC COMMAND EXTEND AddSetoidField
+| [ "Add" "Field" ident(id) ":" constr(t) field_mods(l) ] -> 
+  [ let (k,set,inj,cst_tac,pre,post) = process_field_mods l in
+    add_field_theory id (ic t) set k cst_tac inj (pre,post) ]
 END
 
+let field_lookup (f:glob_tactic_expr) rl gl =
+  let env = pf_env gl in
+  let sigma = project gl in
+  let e = find_field_structure env sigma rl (pf_concl gl) None in
+  let rl = carg (make_term_list e.field_carrier rl gl) in
+  let req = carg e.field_req in
+  let cst_tac = Tacexp e.field_cst_tac in
+  let field_ok = carg e.field_ok in
+  let field_simpl_ok = carg e.field_simpl_ok in
+  let field_simpl_eq_ok = carg e.field_simpl_eq_ok in
+  let cond_ok = carg e.field_cond in
+  let pretac = Tacexp(TacFun([None],e.field_pre_tac)) in
+  let posttac = Tacexp(TacFun([None],e.field_post_tac)) in
+  Tacinterp.eval_tactic
+    (TacLetIn
+      ([(dummy_loc,id_of_string"f"),None,Tacexp f],
+       ltac_lcall "f"
+         [req;cst_tac;field_ok;field_simpl_ok;field_simpl_eq_ok;cond_ok;
+          pretac;posttac;rl])) gl
+
+TACTIC EXTEND field_lookup
+| [ "field_lookup" tactic(f) constr_list(l) ] -> [ field_lookup (fst f) l ]
+END
diff --git a/contrib/subtac/Utils.v b/contrib/subtac/Utils.v
index b1694d7c..219cd75b 100644
--- a/contrib/subtac/Utils.v
+++ b/contrib/subtac/Utils.v
@@ -4,7 +4,7 @@ Notation "'fun' { x : A | P } => Q" :=
   (fun x:{x:A|P} => Q)
   (at level 200, x ident, right associativity).
 
-Notation "( x & y )" := (@existS _ _ x y) : core_scope.
+Notation "( x & ? )" := (@exist _ _ x _) : core_scope.
 
 Definition ex_pi1 (A : Prop) (P : A -> Prop) (t : ex P) : A.
 intros.
@@ -44,3 +44,4 @@ end.
 
 Ltac destruct_exists := repeat (destruct_one_pair) .
 
+Extraction Inline proj1_sig.
diff --git a/contrib/subtac/eterm.ml b/contrib/subtac/eterm.ml
index 859f9013..790e61a0 100644
--- a/contrib/subtac/eterm.ml
+++ b/contrib/subtac/eterm.ml
@@ -32,47 +32,48 @@ let list_assoc_index x l =
     | [] -> raise Not_found
   in aux 0 l
 
+
 (** Substitute evar references in t using De Bruijn indices, 
   where n binders were passed through. *)
-let subst_evars evs n t = 
+let subst_evar_constr evs n t = 
+  let seen = ref Intset.empty in
   let evar_info id = 
     let rec aux i = function
-	(k, h, v) :: tl -> 
-	  trace (str "Searching for " ++ int id ++ str " found: " ++ int k);
-	  if k = id then (i, h, v) else aux (succ i) tl
+	(k, x) :: tl -> 
+	  if k = id then x else aux (succ i) tl
       | [] -> raise Not_found
-    in 
-    let (idx, hyps, v) = aux 0 evs in
-      n + idx + 1, hyps
+    in aux 0 evs
   in
   let rec substrec depth c = match kind_of_term c with
     | Evar (k, args) ->
-	(let index, hyps = 
-	   try evar_info k
-	   with Not_found -> 
-	     anomaly ("eterm: existential variable " ^ string_of_int k ^ " not found")
-	 in
-	 (try trace (str "Evar " ++ int k ++ str " found, applied to " ++ int (Array.length args) ++ str "arguments," ++
-		       int (List.length hyps) ++ str " hypotheses"); 	      with _ -> () );
-	 let ex = mkRel (index + depth) in
-	   (* Evar arguments are created in inverse order, 
-	      and we must not apply to defined ones (i.e. LetIn's)
-	   *)
-	 let args =
-	   let rec aux hyps args acc =
+	let (id, idstr), hyps, _, _ = 
+	  try evar_info k
+	  with Not_found -> 
+	    anomaly ("eterm: existential variable " ^ string_of_int k ^ " not found")
+	in
+        seen := Intset.add id !seen;
+	  (try trace (str "Evar " ++ int k ++ str " found, applied to " ++ int (Array.length args) ++ str "arguments," ++
+			int (List.length hyps) ++ str " hypotheses"); 	      with _ -> () );
+	  (* Evar arguments are created in inverse order, 
+	     and we must not apply to defined ones (i.e. LetIn's)
+	  *)
+	let args =
+	  let rec aux hyps args acc =
 	     match hyps, args with
 		 ((_, None, _) :: tlh), (c :: tla) -> 
 		   aux tlh tla ((map_constr_with_binders succ substrec depth c) :: acc)
 	       | ((_, Some _, _) :: tlh), (_ :: tla) ->
 		   aux tlh tla acc
 	       | [], [] -> acc
-	       | _, _ -> failwith "subst_evars: invalid argument"
+	       | _, _ -> acc (*failwith "subst_evars: invalid argument"*)
 	   in aux hyps (Array.to_list args) [] 
 	 in
-	   mkApp (ex, Array.of_list args))
+	   mkApp (mkVar idstr, Array.of_list args)
     | _ -> map_constr_with_binders succ substrec depth c
   in 
-    substrec 0 t
+  let t' = substrec 0 t in
+    t', !seen
+
       
 (** Substitute variable references in t using De Bruijn indices, 
   where n binders were passed through. *)
@@ -89,73 +90,80 @@ let subst_vars acc n t =
 
 (** Rewrite type of an evar ([ H1 : t1, ... Hn : tn |- concl ])
   to a product : forall H1 : t1, ..., forall Hn : tn, concl.
-  Changes evars and hypothesis references to De Bruijn indices.
+    Changes evars and hypothesis references to variable references.
 *)
 let etype_of_evar evs ev hyps =
   let rec aux acc n = function
       (id, copt, t) :: tl ->
-	let t' = subst_evars evs n t in
+	let t', s = subst_evar_constr evs n t in
 	let t'' = subst_vars acc 0 t' in
- 	  mkNamedProd_or_LetIn (id, copt, t'') (aux (id :: acc) (succ n) tl)
+	let copt', s = 
+	  match copt with
+	      Some c -> 
+		let c', s' = subst_evar_constr evs n c in
+		  Some c', Intset.union s s'
+	    | None -> None, s
+	in
+	let copt' = option_map (subst_vars acc 0) copt' in
+ 	let rest, s' = aux (id :: acc) (succ n) tl in
+	  mkNamedProd_or_LetIn (id, copt', t'') rest, Intset.union s' s
     | [] ->
-	let t' = subst_evars evs n ev.evar_concl in
-	  subst_vars acc 0 t'	
+	let t', s = subst_evar_constr evs n ev.evar_concl in
+	  subst_vars acc 0 t', s
   in aux [] 0 (rev hyps)
 
 
 open Tacticals
     
-let eterm_term evm t tycon = 
+let rec take n l = 
+  if n = 0 then [] else List.hd l :: take (pred n) (List.tl l)    
+
+let trunc_named_context n ctx = 
+  let len = List.length ctx in
+    take (len - n) ctx
+  
+let eterm_obligations name nclen evm t tycon = 
   (* 'Serialize' the evars, we assume that the types of the existentials
      refer to previous existentials in the list only *)
   let evl = List.rev (to_list evm) in
-    trace (str "Eterm, transformed to list");
+  trace (str "Eterm, transformed to list");
+  let evn = 
+    let i = ref (-1) in
+      List.rev_map (fun (id, ev) -> incr i; 
+		  (id, (!i, id_of_string (string_of_id name ^ "_obligation_" ^ string_of_int (succ !i))), ev)) evl
+  in
   let evts = 
     (* Remove existential variables in types and build the corresponding products *)
     fold_right 
-      (fun (id, ev) l ->
+      (fun (id, (n, nstr), ev) l ->
 	 trace (str "Eterm: " ++ str "treating evar: " ++ int id);
 	 let hyps = Environ.named_context_of_val ev.evar_hyps in
-	 let y' = (id, hyps, etype_of_evar l ev hyps) in
+	 let hyps = trunc_named_context nclen hyps in
+	 trace (str "Named context is: " ++ Printer.pr_named_context (Global.env ()) hyps);
+	 let evtyp, deps = etype_of_evar l ev hyps in
+	 trace (str "Evar " ++ str (string_of_int n) ++ str "'s type is: " ++ Termops.print_constr_env (Global.env ()) evtyp);
+	 let y' = (id, ((n, nstr), hyps, evtyp, deps)) in
 	   y' :: l) 
-      evl []
+      evn []
   in 
-  let t' = (* Substitute evar refs in the term by De Bruijn indices *)
-    subst_evars evts 0 t 
-  in
-  let evar_names = 
-    List.map (fun (id, _, c) -> (id_of_string ("Evar" ^ string_of_int id)), c) evts
-  in
-  let evar_bl =
-    List.map (fun (id, c) -> Name id, None, c) evar_names
-  in
-  let anon_evar_bl = List.map (fun (_, x, y) -> (Anonymous, x, y)) evar_bl in
-    (* Generalize over the existential variables *)
-  let t'' = Termops.it_mkLambda_or_LetIn t' evar_bl 
-  and tycon = option_map 
-		(fun typ -> Termops.it_mkProd_wo_LetIn typ anon_evar_bl) tycon
-  in
-  let _declare_evar (id, c) =
-    let id = id_of_string ("Evar" ^ string_of_int id) in
-      ignore(Declare.declare_variable id (Names.empty_dirpath, Declare.SectionLocalAssum c,
-					  Decl_kinds.IsAssumption Decl_kinds.Definitional))
+  let t', _ = (* Substitute evar refs in the term by variables *)
+    subst_evar_constr evts 0 t 
   in
-  let _declare_assert acc (id, c) =
-    let id = id_of_string ("Evar" ^ string_of_int id) in
-      tclTHEN acc (Tactics.assert_tac false (Name id) c)
+  let evars = 
+    List.map (fun (_, ((_, name), _, typ, deps)) -> name, typ, deps) evts
   in
     (try 
        trace (str "Term given to eterm" ++ spc () ++
-	      Termops.print_constr_env (Global.env ()) t);
+		Termops.print_constr_env (Global.env ()) t);
        trace (str "Term constructed in eterm" ++ spc () ++
-	      Termops.print_constr_env (Global.env ()) t'');
-       ignore(option_map 
-		(fun typ ->
-		   trace (str "Type :" ++ spc () ++
-			  Termops.print_constr_env (Global.env ()) typ))
-		tycon);
+		Termops.print_constr_env (Global.env ()) t');
+       ignore(iter
+		(fun (name, typ, deps) ->
+		   trace (str "Evar :" ++ spc () ++ str (string_of_id name) ++
+			    Termops.print_constr_env (Global.env ()) typ))
+		evars);
      with _ -> ());
-    t'', tycon, evar_names
+    Array.of_list (List.rev evars), t'
 
 let mkMetas n = 
   let rec aux i acc = 
@@ -163,12 +171,12 @@ let mkMetas n =
     else acc
   in aux n []
 
-let eterm evm t (tycon : types option) = 
-  let t, tycon, evs = eterm_term evm t tycon in
-    match tycon with
-	Some typ -> Tactics.apply_term (mkCast (t, DEFAULTcast, typ)) []
-      | None -> Tactics.apply_term t (mkMetas (List.length evs))
+(* let eterm evm t (tycon : types option) =  *)
+(*   let t, tycon, evs = eterm_term evm t tycon in *)
+(*     match tycon with *)
+(* 	Some typ -> Tactics.apply_term (mkCast (t, DEFAULTcast, typ)) [] *)
+(*       | None -> Tactics.apply_term t (mkMetas (List.length evs)) *)
      
-open Tacmach
+(* open Tacmach *)
 
-let etermtac (evm, t) = eterm evm t None
+let etermtac (evm, t) = assert(false) (*eterm evm t None *)
diff --git a/contrib/subtac/eterm.mli b/contrib/subtac/eterm.mli
index fbe2ac1d..3a571ee1 100644
--- a/contrib/subtac/eterm.mli
+++ b/contrib/subtac/eterm.mli
@@ -6,15 +6,19 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: eterm.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
+(*i $Id: eterm.mli 9326 2006-10-31 12:57:26Z msozeau $ i*)
 
 open Tacmach
 open Term
 open Evd
 open Names
+open Util
 
 val mkMetas : int -> constr list
 
-val eterm_term : evar_map -> constr -> types option -> constr * types option * (identifier * types) list
+(* val eterm_term : evar_map -> constr -> types option -> constr * types option * (identifier * types) list *)
+
+val eterm_obligations : identifier -> int -> evar_map -> constr -> types option -> 
+  (identifier * types * Intset.t) array * constr (* Obl. name, type as product and dependencies as indexes into the array *)
 
 val etermtac : open_constr -> tactic
diff --git a/contrib/subtac/g_subtac.ml4 b/contrib/subtac/g_subtac.ml4
index b56ecc3d..243cb191 100644
--- a/contrib/subtac/g_subtac.ml4
+++ b/contrib/subtac/g_subtac.ml4
@@ -10,7 +10,7 @@
   Syntax for the subtac terms and types.
   Elaborated from correctness/psyntax.ml4 by Jean-Christophe Filliâtre *)
 
-(* $Id: g_subtac.ml4 8917 2006-06-07 16:59:05Z herbelin $ *)
+(* $Id: g_subtac.ml4 9326 2006-10-31 12:57:26Z msozeau $ *)
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
@@ -30,6 +30,7 @@ open Topconstr
 
 module Gram = Pcoq.Gram
 module Vernac = Pcoq.Vernac_
+module Tactic = Pcoq.Tactic
 
 module SubtacGram =
 struct
@@ -40,15 +41,31 @@ end
 
 open SubtacGram 
 open Util
+open Pcoq
+
+let sigref = mkRefC (Qualid (dummy_loc, Libnames.qualid_of_string "Coq.Init.Specif.sig"))
 
 GEXTEND Gram
-  GLOBAL: subtac_gallina_loc;
+  GLOBAL: subtac_gallina_loc Constr.binder_let Constr.binder;
  
   subtac_gallina_loc:
     [ [ g = Vernac.gallina -> loc, g ] ]
     ;
+
+  Constr.binder_let:
+    [ [ "("; id=Prim.name; ":"; t=Constr.lconstr; "|"; c=Constr.lconstr; ")" -> 
+	  let typ = mkAppC (sigref, [mkLambdaC ([id], t, c)]) in
+	    LocalRawAssum ([id], typ)
+    ] ];
+
+  Constr.binder:
+    [ [ "("; id=Prim.name; ":"; c=Constr.lconstr; "|"; p=Constr.lconstr; ")" ->
+	  let typ = mkAppC (sigref, [mkLambdaC ([id], c, p)]) in
+	    ([id], typ) ] ];
+
   END
 
+
 type ('a,'b) gallina_loc_argtype = (Vernacexpr.vernac_expr located, 'a, 'b) Genarg.abstract_argument_type
 
 let (wit_subtac_gallina_loc : (Genarg.tlevel, Proof_type.tactic) gallina_loc_argtype),
@@ -57,6 +74,11 @@ let (wit_subtac_gallina_loc : (Genarg.tlevel, Proof_type.tactic) gallina_loc_arg
   Genarg.create_arg "subtac_gallina_loc"
 
 VERNAC COMMAND EXTEND Subtac
-[ "Program" subtac_gallina_loc(g) ] -> 
-  [ Subtac.subtac g ]
+[ "Program" subtac_gallina_loc(g) ] -> [ Subtac.subtac g ]
+| [ "Obligation" integer(num) "of" ident(name) ] -> [ Subtac_obligations.subtac_obligation (num, Some name) ]
+| [ "Obligation" integer(num) ] -> [ Subtac_obligations.subtac_obligation (num, None) ]      
+| [ "Solve" "Obligations" "of" ident(name) "using" tactic(t) ] -> [ Subtac_obligations.solve_obligations (Some name) (Tacinterp.interp t) ]
+| [ "Solve" "Obligations" "using" tactic(t) ] -> [ Subtac_obligations.solve_obligations None (Tacinterp.interp t) ]
+| [ "Obligations" "of" ident(name) ] -> [ Subtac_obligations.show_obligations (Some name) ]
+| [ "Obligations" ] -> [ Subtac_obligations.show_obligations None ]
 END
diff --git a/contrib/subtac/subtac.ml b/contrib/subtac/subtac.ml
index ffb16a19..26e8f715 100644
--- a/contrib/subtac/subtac.ml
+++ b/contrib/subtac/subtac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: subtac.ml 8964 2006-06-20 13:52:21Z msozeau $ *)
+(* $Id: subtac.ml 9284 2006-10-26 12:06:57Z msozeau $ *)
 
 open Global
 open Pp
@@ -156,19 +156,19 @@ let subtac (loc, command) =
     match command with
 	VernacDefinition (defkind, (locid, id), expr, hook) -> 
 	    (match expr with
-		 ProveBody (bl, c) -> 
-		   let evm, c, ctyp = Subtac_pretyping.subtac_process env isevars id bl c None in
-		     trace (str "Starting proof");
-		     Command.start_proof id goal_kind c hook;
-		     trace (str "Started proof");	     
+		 ProveBody (bl, c) -> Subtac_pretyping.subtac_proof env isevars id bl c None
+(* 		   let evm, c, ctyp =  in *)
+(* 		     trace (str "Starting proof"); *)
+(* 		     Command.start_proof id goal_kind c hook; *)
+(* 		     trace (str "Started proof");	      *)
 		     
 	       | DefineBody (bl, _, c, tycon) -> 
-		   let evm, c, ctyp = Subtac_pretyping.subtac_process env isevars id bl c tycon in
-		   let tac = Eterm.etermtac (evm, c) in 
-		     trace (str "Starting proof");
-		     Command.start_proof id goal_kind ctyp hook;
-		     trace (str "Started proof");
-		     Pfedit.by tac)
+		   Subtac_pretyping.subtac_proof env isevars id bl c tycon
+		     (* let tac = Eterm.etermtac (evm, c) in  *)
+		     (* 		     trace (str "Starting proof"); *)
+		     (* 		     Command.start_proof id goal_kind ctyp hook; *)
+		     (* 		     trace (str "Started proof"); *)
+		     (* 		     Pfedit.by tac) *))
       | VernacFixpoint (l, b) -> 
 	  let _ = trace (str "Building fixpoint") in
 	    ignore(Subtac_command.build_recursive l b)
@@ -223,24 +223,30 @@ let subtac (loc, command) =
 		++ x ++ spc () ++ str "and" ++ spc () ++ y
 	in msg_warning cmds
     
-    | Type_errors.TypeError (env, e) ->
-	debug 2 (Himsg.explain_type_error env e)
+    | Type_errors.TypeError (env, exn) as e ->
+	debug 2 (Himsg.explain_type_error env exn);
+	raise e
 	  
-    | Pretype_errors.PretypeError (env, e) ->
-	debug 2 (Himsg.explain_pretype_error env e)
+    | Pretype_errors.PretypeError (env, exn) as e ->
+	debug 2 (Himsg.explain_pretype_error env exn);
+	raise e
 	  
-    | Stdpp.Exc_located (loc, e) ->
+    | (Stdpp.Exc_located (loc, e')) as e ->
 	debug 2 (str "Parsing exception: ");
-	(match e with
-	   | Type_errors.TypeError (env, e) ->
-	       debug 2 (Himsg.explain_type_error env e)
+	(match e' with
+	   | Type_errors.TypeError (env, exn) ->
+	       debug 2 (Himsg.explain_type_error env exn);
+	       raise e
 		 
-	   | Pretype_errors.PretypeError (env, e) ->
-	       debug 2 (Himsg.explain_pretype_error env e)
+	   | Pretype_errors.PretypeError (env, exn) ->
+	       debug 2 (Himsg.explain_pretype_error env exn);
+	       raise e
 
-	   | e -> msg_warning (str "Unexplained exception: " ++ Cerrors.explain_exn e))
+	   | e'' -> msg_warning (str "Unexpected exception: " ++ Cerrors.explain_exn e'');
+	       raise e)
   
     | e -> 
-	msg_warning (str "Uncatched exception: " ++ Cerrors.explain_exn e)
+	msg_warning (str "Uncatched exception: " ++ Cerrors.explain_exn e);
+	raise e
 
 
diff --git a/contrib/subtac/subtac_coercion.ml b/contrib/subtac/subtac_coercion.ml
index 78c3c70b..da5c497c 100644
--- a/contrib/subtac/subtac_coercion.ml
+++ b/contrib/subtac/subtac_coercion.ml
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: subtac_coercion.ml 8964 2006-06-20 13:52:21Z msozeau $ *)
+(* $Id: subtac_coercion.ml 9284 2006-10-26 12:06:57Z msozeau $ *)
 
 open Util
 open Names
@@ -91,7 +91,9 @@ module Coercion = struct
   let hnf env isevars c = whd_betadeltaiota env (evars_of !isevars) c
 
   let rec mu env isevars t =   
+    let isevars = ref isevars in
     let rec aux v = 
+      let v = hnf env isevars v in
       match disc_subset v with
 	  Some (u, p) -> 
 	    let f, ct = aux u in
@@ -135,8 +137,9 @@ module Coercion = struct
 		 | Type x, Type y when x = y -> None (* false *)
 		 | _ -> subco ())
 	  | Prod (name, a, b), Prod (name', a', b') ->
-	      let c1 = coerce_unify env a' a in
+	      let name' = Name (Nameops.next_ident_away (id_of_string "x") (Termops.ids_of_context env)) in
 	      let env' = push_rel (name', None, a') env in
+	      let c1 = coerce_unify env' (lift 1 a') (lift 1 a) in
 	      let c2 = coerce_unify env' b b' in
 		(match c1, c2 with
 		     None, None -> failwith "subtac.coerce': Should have detected equivalence earlier"
diff --git a/contrib/subtac/subtac_command.ml b/contrib/subtac/subtac_command.ml
index c738d7a6..b433af2c 100644
--- a/contrib/subtac/subtac_command.ml
+++ b/contrib/subtac/subtac_command.ml
@@ -43,6 +43,7 @@ open Notation
 module SPretyping = Subtac_pretyping.Pretyping
 open Subtac_utils
 open Pretyping
+open Subtac_obligations
 
 (*********************************************************************)
 (* Functions to parse and interpret constructions *)
@@ -149,15 +150,6 @@ let collect_non_rec env =
   in 
   searchrec [] 
 
-let definition_message id =
-  Options.if_verbose message ((string_of_id id) ^ " is defined")
-
-let recursive_message v =
-  match Array.length v with
-    | 0 -> error "no recursive definition"
-    | 1 -> (Printer.pr_global v.(0) ++ str " is recursively defined")
-    | _ -> hov 0 (prvect_with_sep pr_coma Printer.pr_global v ++
-		    spc () ++ str "are recursively defined")
 
 let filter_map f l = 
   let rec aux acc = function
@@ -190,9 +182,12 @@ let build_wellfounded (recname, n, bl,arityc,body) r measure notation boxed =
   let env = Global.env() in 
   let pr c = my_print_constr env c in
   let prr = Printer.pr_rel_context env in
+  let prn = Printer.pr_named_context env in
   let pr_rel env = Printer.pr_rel_context env in
+  let nc = named_context env in
+  let nc_len = named_context_length nc in
   let _ = 
-    try debug 2 (str "Rewriting fixpoint: " ++ Ppconstr.pr_id recname ++ 
+    try debug 2 (str "In named context: " ++ prn (named_context env) ++ str "Rewriting fixpoint: " ++ Ppconstr.pr_id recname ++ 
 		 Ppconstr.pr_binders bl ++ str " : " ++ 
 		 Ppconstr.pr_constr_expr arityc ++ str " := " ++ spc () ++
 		 Ppconstr.pr_constr_expr body)
@@ -204,25 +199,35 @@ let build_wellfounded (recname, n, bl,arityc,body) r measure notation boxed =
   let argid = match argname with Name n -> n | _ -> assert(false) in
   let _liftafter = lift_binders 1 after_length after in
   let envwf = push_rel_context before env in
-  let wf_rel, measure_fn = 
-    let rconstr = interp_constr isevars envwf r in
-    if measure then
-      let lt_rel = constr_of_global (Lazy.force lt_ref) in
-      let name s = Name (id_of_string s) in
-	mkLambda (name "x", argtyp,
-		  mkLambda (name "y", argtyp,
-			    mkApp (lt_rel,
-				   [| mkApp (rconstr, [| mkRel 2 |]) ;
-				      mkApp (rconstr, [| mkRel 1 |]) |]))),
-	Some rconstr
-    else rconstr, None
+  let wf_rel, wf_rel_fun, measure_fn = 
+    let rconstr_body, rconstr = 
+      let app = mkAppC (r, [mkIdentC (id_of_name argname)]) in
+       let env = push_rel_context [arg] envwf in
+       let capp = interp_constr isevars env app in
+ 	capp, mkLambda (argname, argtyp, capp)
+     in
+       if measure then
+ 	let lt_rel = constr_of_global (Lazy.force lt_ref) in
+ 	let name s = Name (id_of_string s) in
+ 	let wf_rel_fun = 
+ 	  (fun x y ->
+ 	      mkApp (lt_rel, [| subst1 x rconstr_body; 
+ 				subst1 y rconstr_body |])) 
+ 	in
+ 	let wf_rel = 
+ 	  mkLambda (name "x", argtyp,
+ 		    mkLambda (name "y", lift 1 argtyp,
+ 			      wf_rel_fun (mkRel 2) (mkRel 1)))
+ 	in
+ 	  wf_rel, wf_rel_fun , Some rconstr
+       else rconstr, (fun x y -> mkApp (rconstr, [|x; y|])), None
   in
   let wf_proof = mkApp (Lazy.force well_founded, [| argtyp ; wf_rel |])
   in
   let argid' = id_of_string (string_of_id argid ^ "'") in
   let wfarg len = (Name argid', None, 
-		   mkSubset (Name argid') argtyp 
-		     (mkApp (wf_rel, [|mkRel 1; mkRel (len + 1)|])))
+  		   mkSubset (Name argid') argtyp 
+		     (wf_rel_fun (mkRel 1) (mkRel (len + 1))))
   in
   let top_bl = after @ (arg :: before) in
   let intern_bl = after @ (wfarg 1 :: arg :: before) in
@@ -234,7 +239,7 @@ let build_wellfounded (recname, n, bl,arityc,body) r measure notation boxed =
   let projection = 
     mkApp (proj, [| argtyp ;
 		    (mkLambda (Name argid', argtyp,
-			       (mkApp (wf_rel, [|mkRel 1; mkRel 3|])))) ;
+			       (wf_rel_fun (mkRel 1) (mkRel 3)))) ;
 		    mkRel 1
 		 |])
   in
@@ -299,40 +304,16 @@ let build_wellfounded (recname, n, bl,arityc,body) r measure notation boxed =
   in
   let evm = non_instanciated_map env isevars in
   let _ = try trace (str "Non instanciated evars map: " ++ Evd.pr_evar_map evm)  with _ -> () in
-  let evars_def, evars_typ, evars = Eterm.eterm_term evm fullcoqc (Some fullctyp) in 	
-  let evars_typ = out_some evars_typ in
-  (try trace (str "Building evars sum for : ");
-     List.iter
-       (fun (n, t) -> trace (str "Evar " ++ str (string_of_id n) ++ spc () ++ my_print_constr env t))
-       evars;
-   with _ -> ());
-  let (sum_tac, sumg) = Subtac_utils.build_dependent_sum evars in
-  (try trace (str "Evars sum: " ++ my_print_constr env sumg);
-     trace (str "Evars type: " ++ my_print_constr env evars_typ);
-   with _ -> ());
-  let proofid = id_of_string (string_of_id recname ^ "_evars_proof") in
-    Command.start_proof proofid goal_proof_kind sumg
-      (fun strength gr -> 
-	 debug 2 (str "Proof finished");
-	 let def = constr_of_global gr in
-	 let args = Subtac_utils.destruct_ex def sumg in
-	 let _, newdef = decompose_lam_n (List.length args) evars_def in
-	 let constr = Term.substl (List.rev args) newdef in
-	   debug 2 (str "Applied existentials : " ++ my_print_constr env constr);
-	   let ce = 
-	     { const_entry_body = constr;
-	       const_entry_type = Some fullctyp;
-	       const_entry_opaque = false;
-	       const_entry_boxed = boxed} 
-	   in
-	   let _constant = Declare.declare_constant 
-			    recname (DefinitionEntry ce,IsDefinition Definition)
-	   in
-	     definition_message recname);
-    trace (str "Started existentials proof");
-    Pfedit.by sum_tac;
-    trace (str "Applied sum tac")  
-
+  let evars, evars_def = Eterm.eterm_obligations recname nc_len evm fullcoqc (Some fullctyp) in
+    (try trace (str "Generated obligations : ");
+       Array.iter
+	 (fun (n, t, _) -> trace (str "Evar " ++ str (string_of_id n) ++ spc () ++ my_print_constr env t))
+	 evars;
+     with _ -> ());    
+      trace (str "Adding to obligations list");
+      Subtac_obligations.add_entry recname evars_def fullctyp evars;
+      trace (str "Added to obligations list")
+(*
 let build_mutrec l boxed = 
   let sigma = Evd.empty
   and env0 = Global.env()
@@ -543,7 +524,7 @@ let build_mutrec l boxed =
 		 Environ.NoBody -> trace (str "Constant has no body")
 	       | Environ.Opaque -> trace (str "Constant is opaque")
       )
-
+*)
 let out_n = function
     Some n -> n
   | None -> 0
@@ -563,8 +544,8 @@ let build_recursive (lnameargsardef:(fixpoint_expr * decl_notation) list) boxed
 		       errorlabstrm "Subtac_command.build_recursive"
 			 (str "Well-founded fixpoints not allowed in mutually recursive blocks"))
 	    lnameargsardef
-	in
-	  build_mutrec lnameargsardef boxed;
-	  assert(false)
+	in assert(false)
+	     (*build_mutrec lnameargsardef boxed*)
+	  
       
       
diff --git a/contrib/subtac/subtac_command.mli b/contrib/subtac/subtac_command.mli
index 90ffb892..846e06cf 100644
--- a/contrib/subtac/subtac_command.mli
+++ b/contrib/subtac/subtac_command.mli
@@ -37,7 +37,6 @@ val interp_constr_judgment :
   env ->
   constr_expr -> unsafe_judgment
 val list_chop_hd : int -> 'a list -> 'a list * 'a * 'a list
-val recursive_message : global_reference array -> std_ppcmds
 
 val build_recursive :
   (fixpoint_expr * decl_notation) list -> bool -> unit
diff --git a/contrib/subtac/subtac_obligations.ml b/contrib/subtac/subtac_obligations.ml
new file mode 100644
index 00000000..7b13b402
--- /dev/null
+++ b/contrib/subtac/subtac_obligations.ml
@@ -0,0 +1,249 @@
+open Printf
+open Pp
+open Subtac_utils
+
+open Term
+open Names
+open Libnames
+open Summary
+open Libobject
+open Entries
+open Decl_kinds
+open Util
+open Evd
+
+type obligation =
+    { obl_name : identifier;
+      obl_type : types;
+      obl_body : constr option;
+      obl_deps : Intset.t;
+    }
+
+type obligations = (obligation array * int)
+
+type program_info = {
+  prg_name: identifier;
+  prg_body: constr;
+  prg_type: types;
+  prg_obligations: obligations;
+}
+
+let evar_of_obligation o = { evar_hyps = Environ.empty_named_context_val ; 
+			     evar_concl = o.obl_type ; 
+			     evar_body = Evar_empty ;
+			     evar_extra = None }
+
+module ProgMap = Map.Make(struct type t = identifier let compare = compare end)
+
+let map_replace k v m = ProgMap.add k v (ProgMap.remove k m)
+
+let map_cardinal m = 
+  let i = ref 0 in 
+    ProgMap.iter (fun _ _ -> incr i) m;
+    !i
+
+exception Found of program_info
+
+let map_first m = 
+  try
+    ProgMap.iter (fun _ v -> raise (Found v)) m;
+    assert(false)
+  with Found x -> x
+    
+let from_prg : program_info ProgMap.t ref = ref ProgMap.empty
+
+let _ = 
+  Summary.declare_summary "program-tcc-table"
+    { Summary.freeze_function = (fun () -> !from_prg);
+      Summary.unfreeze_function =
+        (fun v -> from_prg := v);
+      Summary.init_function =
+        (fun () -> from_prg := ProgMap.empty);
+      Summary.survive_module = false;
+      Summary.survive_section = false }
+
+let declare_definition prg = 
+(*  let obls_constrs = 
+    Array.fold_right (fun x acc -> (out_some x.obl_evar.evar_body) :: acc) (fst prg.prg_obligations) []
+  in*)
+  let ce = 
+    { const_entry_body = prg.prg_body;
+      const_entry_type = Some prg.prg_type;
+      const_entry_opaque = false;
+      const_entry_boxed = false} 
+  in
+  let _constant = Declare.declare_constant 
+    prg.prg_name (DefinitionEntry ce,IsDefinition Definition)
+  in
+    Subtac_utils.definition_message prg.prg_name
+    
+open Evd
+
+let terms_of_evar ev = 
+  match ev.evar_body with
+      Evar_defined b ->
+	let nc = Environ.named_context_of_val ev.evar_hyps in
+	let body = Termops.it_mkNamedLambda_or_LetIn b nc in
+	let typ = Termops.it_mkNamedProd_or_LetIn ev.evar_concl nc in
+	  body, typ
+    | _ -> assert(false)
+	  
+let declare_obligation obl body =
+  let ce = 
+    { const_entry_body = body;
+      const_entry_type = Some obl.obl_type;
+      const_entry_opaque = true;
+      const_entry_boxed = false} 
+  in
+  let constant = Declare.declare_constant obl.obl_name (DefinitionEntry ce,IsProof Property)
+  in
+    Subtac_utils.definition_message obl.obl_name;
+    { obl with obl_body = Some (mkConst constant) }
+      
+let try_tactics obls = 
+  Array.map
+    (fun obl ->
+       match obl.obl_body with
+	   None ->
+	     (try
+		let ev = evar_of_obligation obl in
+		let c = Subtac_utils.solve_by_tac ev Auto.default_full_auto in	       
+		  declare_obligation obl c		  
+	      with _ -> obl)
+	 | _ -> obl)
+    obls
+        
+let add_entry n b t obls =
+  Options.if_verbose pp (str (string_of_id n) ++ str " has type-checked");
+  let init_obls e = 
+    Array.map
+      (fun (n, t, d) ->
+         { obl_name = n ; obl_body = None; obl_type = t; obl_deps = d })
+      e
+  in
+    if Array.length obls = 0 then (
+      Options.if_verbose ppnl (str ".");
+    declare_definition { prg_name = n ; prg_body = b ; prg_type = t ; prg_obligations = ([||], 0) } )
+    else (
+      let len = Array.length obls in
+      let _ = Options.if_verbose ppnl (str ", generating " ++ int len ++ str " obligation(s)") in
+      let obls = init_obls obls in
+      let rem = Array.fold_left (fun acc obl -> if obl.obl_body = None then succ acc else acc) 0 obls in
+      let prg = { prg_name = n ; prg_body = b ; prg_type = t ; prg_obligations = (obls, rem) } in
+	if rem < len then 
+	  Options.if_verbose ppnl (int rem ++ str " obligation(s) remaining.");
+	if rem = 0 then 
+	  declare_definition prg
+	else
+	  from_prg := ProgMap.add n prg !from_prg)
+	    
+let error s = Util.error s
+
+let get_prog name =
+  let prg_infos = !from_prg in
+    match name with
+	Some n -> ProgMap.find n prg_infos
+      | None -> 
+	  (let n = map_cardinal prg_infos in
+	     match n with 
+		 0 -> error "No obligations remaining"
+	       | 1 -> map_first prg_infos
+	       | _ -> error "More than one program with unsolved obligations")
+
+let update_obls prg obls rem = 
+  let prg' = { prg with prg_obligations = (obls, rem) } in
+    if rem > 1 then (
+      debug 2 (int rem ++ str " obligations remaining");
+      from_prg := map_replace prg.prg_name prg' !from_prg)
+    else (
+      declare_definition prg';
+      from_prg := ProgMap.remove prg.prg_name !from_prg
+    )		 
+	    
+let is_defined obls x = obls.(x).obl_body <> None
+
+let deps_remaining obls x = 
+  let deps = obls.(x).obl_deps in
+    Intset.fold
+      (fun x acc -> 
+	 if is_defined obls x then acc
+	 else x :: acc)
+      deps []
+
+let subst_deps obls obl =
+  let t' = 
+    Intset.fold
+      (fun x acc ->
+	 let xobl = obls.(x) in
+	 let oblb = out_some xobl.obl_body in
+	   Term.subst1 oblb (Term.subst_var xobl.obl_name acc))
+      obl.obl_deps obl.obl_type
+  in { obl with obl_type = t' }
+
+let subtac_obligation (user_num, name) =
+  let num = pred user_num in
+  let prg = get_prog name in
+  let obls, rem = prg.prg_obligations in
+    if num < Array.length obls then
+      let obl = obls.(num) in
+	match obl.obl_body with
+	    None -> 
+	      (match deps_remaining obls num with
+		  [] ->
+		    let obl = subst_deps obls obl in
+		    Command.start_proof obl.obl_name Subtac_utils.goal_proof_kind obl.obl_type
+		      (fun strength gr -> 
+			 debug 2 (str "Proof of obligation " ++ int user_num ++ str " finished");		   
+			 let obl = { obl with obl_body = Some (Libnames.constr_of_global gr) } in
+			 let obls = Array.copy obls in
+			 let _ = obls.(num) <- obl in
+			   update_obls prg obls (pred rem));
+		    trace (str "Started obligation " ++ int user_num ++ str "  proof")
+     		 | l -> msgnl (str "Obligation " ++ int user_num ++ str " depends on obligation(s) "
+		     ++ str (string_of_list ", " (fun x -> string_of_int (succ x)) l)))
+	  | Some r -> error "Obligation already solved"
+    else error (sprintf "Unknown obligation number %i" (succ num))
+      
+      
+let obligations_of_evars evars =
+  let arr = 
+    Array.of_list
+      (List.map
+	 (fun (n, t) ->
+	    { obl_name = n;
+	      obl_type = t;
+	      obl_body = None;
+	      obl_deps = Intset.empty;
+	    }) evars)
+  in arr, Array.length arr
+
+let solve_obligations n tac = 
+  let prg = get_prog n in
+  let obls, rem = prg.prg_obligations in
+  let rem = ref rem in
+  let obls' = 
+    Array.map (fun x -> 
+		 match x.obl_body with 
+		     Some _ -> x
+		   | None -> 
+		       try
+			 let t = Subtac_utils.solve_by_tac (evar_of_obligation x) tac in
+			   decr rem;
+			   { x with obl_body = Some t }
+		       with _ -> x)
+      obls
+  in
+    update_obls prg obls' !rem
+
+open Pp
+let show_obligations n =
+  let prg = get_prog n in
+  let obls, rem = prg.prg_obligations in
+    msgnl (int rem ++ str " obligation(s) remaining: ");
+    Array.iteri (fun i x -> 
+		   match x.obl_body with 
+		       None -> msgnl (int (succ i) ++ str " : " ++ spc () ++ 
+					my_print_constr (Global.env ()) x.obl_type)
+		    | Some _ -> ())
+      obls
+			
diff --git a/contrib/subtac/subtac_obligations.mli b/contrib/subtac/subtac_obligations.mli
new file mode 100644
index 00000000..7d93d57b
--- /dev/null
+++ b/contrib/subtac/subtac_obligations.mli
@@ -0,0 +1,10 @@
+open Util
+
+val add_entry : Names.identifier -> Term.constr -> Term.types ->
+  (Names.identifier * Term.types * Intset.t) array -> unit
+
+val subtac_obligation : int * Names.identifier option -> unit
+
+val solve_obligations : Names.identifier option -> Proof_type.tactic -> unit
+
+val show_obligations : Names.identifier option -> unit
diff --git a/contrib/subtac/subtac_pretyping.ml b/contrib/subtac/subtac_pretyping.ml
index 261e0c5b..a243ba34 100644
--- a/contrib/subtac/subtac_pretyping.ml
+++ b/contrib/subtac/subtac_pretyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: subtac_pretyping.ml 8889 2006-06-01 20:23:56Z msozeau $ *)
+(* $Id: subtac_pretyping.ml 9326 2006-10-31 12:57:26Z msozeau $ *)
 
 open Global
 open Pp
@@ -151,3 +151,13 @@ let subtac_process env isevars id l c tycon =
   let evm = non_instanciated_map env isevars in
   let _ = try trace (str "Non instanciated evars map: " ++ Evd.pr_evar_map evm)  with _ -> () in
     evm, fullcoqc, fullctyp
+
+open Subtac_obligations
+
+let subtac_proof env isevars id l c tycon =
+  let nc = named_context env in
+  let nc_len = named_context_length nc in
+  let evm, coqc, coqt = subtac_process env isevars id l c tycon in
+  let evars, def = Eterm.eterm_obligations id nc_len evm coqc (Some coqt) in
+    trace (str "Adding to obligations list");
+    add_entry id def coqt evars
diff --git a/contrib/subtac/subtac_pretyping.mli b/contrib/subtac/subtac_pretyping.mli
index 97e56ecb..b62a8766 100644
--- a/contrib/subtac/subtac_pretyping.mli
+++ b/contrib/subtac/subtac_pretyping.mli
@@ -10,3 +10,6 @@ module Pretyping : Pretyping.S
 
 val subtac_process : env -> evar_defs ref -> identifier -> local_binder list ->
   constr_expr -> constr_expr option -> evar_map * constr * types
+
+val subtac_proof : env -> evar_defs ref -> identifier -> local_binder list ->
+  constr_expr -> constr_expr option -> unit
diff --git a/contrib/subtac/subtac_pretyping_F.ml b/contrib/subtac/subtac_pretyping_F.ml
index 65952750..46af5886 100644
--- a/contrib/subtac/subtac_pretyping_F.ml
+++ b/contrib/subtac/subtac_pretyping_F.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: subtac_pretyping_F.ml 8889 2006-06-01 20:23:56Z msozeau $ *)
+(* $Id: subtac_pretyping_F.ml 9316 2006-10-29 22:49:11Z herbelin $ *)
 
 open Pp
 open Util
@@ -315,12 +315,11 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
 	let resj = j_nf_evar (evars_of !isevars) (apply_rec env 1 fj ftycon args) in
 	let resj =
 	  match kind_of_term resj.uj_val with
-	  | App (f,args) when isInd f ->
+	  | App (f,args) when isInd f or isConst f ->
 	      let sigma = evars_of !isevars in
-	      let t = Retyping.type_of_inductive_knowing_parameters env sigma (destInd f) args in
-	      let s = snd (splay_arity env sigma t) in
-	      on_judgment_type (set_inductive_level env s) resj
-		(* Rem: no need to send sigma: no head evar, it's an arity *)
+	      let c = mkApp (f,Array.map (whd_evar sigma) args) in
+	      let t = Retyping.get_type_of env sigma c in
+	      make_judge c t
 	  | _ -> resj in
 	inh_conv_coerce_to_tycon loc env isevars resj tycon
 
@@ -557,35 +556,6 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
 	  (pretype_type empty_valcon env isevars lvar c).utj_val in
       nf_evar (evars_of !isevars) c'
 
-  (* [check_evars] fails if some unresolved evar remains *)
-  (* it assumes that the defined existentials have already been substituted
-     (should be done in unsafe_infer and unsafe_infer_type) *)
-
-  let check_evars env initial_sigma isevars c =
-    let sigma = evars_of !isevars in
-    let rec proc_rec c =
-      match kind_of_term c with
-	| Evar (ev,args) ->
-            assert (Evd.mem sigma ev);
-	    if not (Evd.mem initial_sigma ev) then
-              let (loc,k) = evar_source ev !isevars in
-		error_unsolvable_implicit loc env sigma k
-	| _ -> iter_constr proc_rec c
-    in
-      proc_rec c(*;
-		  let (_,pbs) = get_conv_pbs !isevars (fun _ -> true) in
-		  if pbs <> [] then begin
-		  pperrnl
-		  (str"TYPING OF "++Termops.print_constr_env env c++fnl()++
-		  prlist_with_sep fnl
-		  (fun  (pb,c1,c2) ->
-		  Termops.print_constr c1 ++
-		  (if pb=Reduction.CUMUL then str " <="++ spc()
-		  else str" =="++spc()) ++
-		  Termops.print_constr c2)
-		  pbs ++ fnl())
-		  end*)
-
   (* TODO: comment faire remonter l'information si le typage a resolu des
      variables du sigma original. il faudrait que la fonction de typage
      retourne aussi le nouveau sigma...
@@ -595,6 +565,7 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
     let isevars = ref (create_evar_defs sigma) in
     let j = pretype empty_tycon env isevars ([],[]) c in
     let j = j_nf_evar (evars_of !isevars) j in
+    let isevars,_ = consider_remaining_unif_problems env !isevars in
       check_evars env sigma isevars (mkCast(j.uj_val,DEFAULTcast, j.uj_type));
       j
 
@@ -611,8 +582,10 @@ module SubtacPretyping_F (Coercion : Coercion.S) = struct
   let ise_pretype_gen fail_evar sigma env lvar kind c =
     let isevars = ref (Evd.create_evar_defs sigma) in
     let c = pretype_gen isevars env lvar kind c in
+    let isevars,_ = consider_remaining_unif_problems env !isevars in
+    let c = nf_evar (evars_of isevars) c in
       if fail_evar then check_evars env sigma isevars c;
-      !isevars, c
+      isevars, c
 
   (** Entry points of the high-level type synthesis algorithm *)
 
diff --git a/contrib/subtac/subtac_utils.ml b/contrib/subtac/subtac_utils.ml
index d4db7c27..7b96758a 100644
--- a/contrib/subtac/subtac_utils.ml
+++ b/contrib/subtac/subtac_utils.ml
@@ -80,25 +80,34 @@ open Pp
 let my_print_constr = Termops.print_constr_env
 let my_print_constr_expr = Ppconstr.pr_constr_expr
 let my_print_context = Termops.print_rel_context
+let my_print_named_context = Termops.print_named_context
 let my_print_env = Termops.print_env
 let my_print_rawconstr = Printer.pr_rawconstr_env
 let my_print_evardefs = Evd.pr_evar_defs
 
 let my_print_tycon_type = Evarutil.pr_tycon_type
 
-let debug_level = 2
+let debug_level = 1
+
+let debug_on = true
 
 let debug n s = 
-  if !Options.debug && n >= debug_level then
-    msgnl s
+  if debug_on then
+    if !Options.debug && n >= debug_level then
+      msgnl s
+    else ()
   else ()
 
 let debug_msg n s = 
-  if !Options.debug  && n >= debug_level then s
+  if debug_on then
+    if !Options.debug  && n >= debug_level then s
+    else mt ()
   else mt ()
 
 let trace s = 
-  if !Options.debug  && debug_level > 0 then msgnl s
+  if debug_on then
+    if !Options.debug  && debug_level > 0 then msgnl s
+    else ()
   else ()
 
 let wf_relations = Hashtbl.create 10
@@ -167,30 +176,6 @@ let goal_fix_kind = Decl_kinds.Global, Decl_kinds.DefinitionBody Decl_kinds.Fixp
 open Tactics
 open Tacticals
 
-let build_dependent_sum l =
-  let rec aux (tac, typ) = function
-      (n, t) :: tl ->
-	let t' = mkLambda (Name n, t, typ) in
-	  trace (spc () ++ str ("treating evar " ^ string_of_id n));
-	  (try trace (str " assert: " ++ my_print_constr (Global.env ()) t)	    	     
-	   with _ -> ());
-	let tac' = 
-	  tclTHENS (assert_tac true (Name n) t) 
-	    ([intros;
-	      (tclTHENSEQ 
-		 [constructor_tac (Some 1) 1 
-		    (Rawterm.ImplicitBindings [mkVar n]);
-		  tac]);
-	     ])
-	in
-	let newt = mkApp (Lazy.force ex_ind, [| t; t'; |]) in
-	  aux (tac', newt) tl
-    | [] -> tac, typ
-  in 
-    match l with 
-	(_, hd) :: tl -> aux (intros, hd) tl
-      | [] -> raise (Invalid_argument "build_dependent_sum")
-
 let id x = x
 
 let build_dependent_sum l =
@@ -438,3 +423,32 @@ let rewrite_cases env c =
   let c' = rewrite_cases c in
   let _ = trace (str "Rewrote cases: " ++ spc () ++ my_print_rawconstr env c') in
     c'
+
+let id_of_name = function
+    Name n -> n
+  | Anonymous -> raise (Invalid_argument "id_of_name")
+
+let definition_message id =
+  Options.if_verbose message ((string_of_id id) ^ " is defined")
+
+let recursive_message v =
+  match Array.length v with
+    | 0 -> error "no recursive definition"
+    | 1 -> (Printer.pr_global v.(0) ++ str " is recursively defined")
+    | _ -> hov 0 (prvect_with_sep pr_coma Printer.pr_global v ++
+		    spc () ++ str "are recursively defined")
+
+(* Solve an obligation using tactics, return the corresponding proof term *)
+let solve_by_tac ev t =
+  debug 1 (str "Solving goal using tactics: " ++ Evd.pr_evar_info ev);
+  let goal = Proof_trees.mk_goal ev.evar_hyps ev.evar_concl None in
+  let ts = Tacmach.mk_pftreestate goal in
+  let solved_state = Tacmach.solve_pftreestate t ts in
+  let c = Tacmach.extract_pftreestate solved_state in
+    debug 1 (str "Term constructed in solve by tac: " ++ my_print_constr (Global.env ()) c);
+    c
+
+let rec string_of_list sep f = function
+    [] -> ""
+  | x :: [] -> f x
+  | x :: ((y :: _) as tl) -> f x ^ sep ^ string_of_list sep f tl
diff --git a/contrib/subtac/subtac_utils.mli b/contrib/subtac/subtac_utils.mli
index 4a7e8177..ebfc5123 100644
--- a/contrib/subtac/subtac_utils.mli
+++ b/contrib/subtac/subtac_utils.mli
@@ -10,6 +10,7 @@ open Rawterm
 open Util
 open Evarutil
 open Names
+open Sign
 
 val contrib_name : string
 val subtac_dir : string list
@@ -51,6 +52,7 @@ val my_print_constr : env -> constr -> std_ppcmds
 val my_print_constr_expr : constr_expr -> std_ppcmds
 val my_print_evardefs : evar_defs -> std_ppcmds
 val my_print_context : env -> std_ppcmds
+val my_print_named_context : env -> std_ppcmds
 val my_print_env : env -> std_ppcmds
 val my_print_rawconstr : env -> rawconstr -> std_ppcmds
 val my_print_tycon_type : env -> type_constraint_type -> std_ppcmds
@@ -88,3 +90,11 @@ val and_tac : (identifier * 'a * constr * Proof_type.tactic) list ->
 val destruct_ex : constr -> constr -> constr list
 
 val rewrite_cases : Environ.env -> Rawterm.rawconstr -> Rawterm.rawconstr
+val id_of_name : name -> identifier
+
+val definition_message : identifier -> unit
+val recursive_message : global_reference array -> std_ppcmds
+
+val solve_by_tac : evar_info -> Tacmach.tactic -> constr
+
+val string_of_list : string -> ('a -> string) -> 'a list -> string
diff --git a/contrib/subtac/test/ListDep.v b/contrib/subtac/test/ListDep.v
new file mode 100644
index 00000000..7ab720f6
--- /dev/null
+++ b/contrib/subtac/test/ListDep.v
@@ -0,0 +1,86 @@
+Require Import List.
+Require Import Coq.subtac.Utils.
+
+Set Implicit Arguments.
+
+Definition sub_list (A : Set) (l' l : list A) := (forall v, In v l' -> In v l) /\ length l' <= length l.
+
+Lemma sub_list_tl : forall A : Set, forall x (l l' : list A), sub_list (x :: l) l' -> sub_list l l'.
+Proof.
+  intros.
+  inversion H.
+  split.
+  intros.
+  apply H0.
+  auto with datatypes.
+  auto with arith.
+Qed.
+
+Section Map_DependentRecursor.
+  Variable U V : Set.
+  Variable l : list U.
+  Variable f : { x : U | In x l } -> V.
+
+  Program Fixpoint map_rec ( l' : list U | sub_list l' l )
+    { measure l' length } : { r : list V | length r = length l' } :=
+    match l' with
+    nil => nil
+    | cons x tl => let tl' := map_rec tl in
+	f x :: tl'
+    end.
+    
+    Obligation 1.
+    intros.
+    destruct tl' ; simpl ; simpl in e.
+    subst x0 tl0.
+    rewrite <- Heql'.
+    rewrite e.
+    auto.
+    Qed.
+
+    Obligation 2.
+    simpl.
+    intros.
+    destruct l'.
+    simpl in Heql'.
+    destruct x0 ; simpl ; try discriminate.
+    inversion Heql'.
+    inversion s.
+    apply H.
+    auto with datatypes.
+    Qed.
+
+
+    Obligation 3 of map_rec.
+    simpl.
+    intros.
+    rewrite <- Heql'.
+    simpl ; auto with arith.
+    Qed.
+
+    Obligation 4.
+    simpl.
+    intros.
+    destruct l'.
+    simpl in Heql'.
+    destruct x0 ; simpl ; try discriminate.
+    inversion Heql'.
+    subst x tl.
+    apply sub_list_tl with u ; auto.
+    Qed.
+  
+    Obligation 5.
+    intros.
+    rewrite <- Heql' ; auto.
+    Qed.
+    
+    Program Definition map : list V := map_rec l.
+    Obligation 1.
+      split ; auto.
+    Qed.
+    
+End Map_DependentRecursor.
+
+Extraction map.
+Extraction map_rec.
+
diff --git a/contrib/xml/cic2acic.ml b/contrib/xml/cic2acic.ml
index f217b037..ff07c3c4 100644
--- a/contrib/xml/cic2acic.ml
+++ b/contrib/xml/cic2acic.ml
@@ -241,7 +241,7 @@ let typeur sigma metamap =
           Util.anomaly ("type_of: variable "^(Names.string_of_id id)^" unbound"))
     | T.Const c ->
         let cb = Environ.lookup_constant c env in
-        T.body_of_type cb.Declarations.const_type
+        Typeops.type_of_constant_type env (cb.Declarations.const_type)
     | T.Evar ev -> Evd.existential_type sigma ev
     | T.Ind ind -> T.body_of_type (Inductiveops.type_of_inductive env ind)
     | T.Construct cstr ->
diff --git a/contrib/xml/doubleTypeInference.ml b/contrib/xml/doubleTypeInference.ml
index a3336817..c7d3b4ff 100644
--- a/contrib/xml/doubleTypeInference.ml
+++ b/contrib/xml/doubleTypeInference.ml
@@ -122,7 +122,7 @@ let double_type_of env sigma cstr expectedty subterms_to_types =
         Typeops.judge_of_variable env id
 	  
      | T.Const c ->
-        E.make_judge cstr (E.constant_type env c)
+        E.make_judge cstr (Typeops.type_of_constant env c)
 	  
      | T.Ind ind ->
         E.make_judge cstr (Inductiveops.type_of_inductive env ind)
diff --git a/contrib/xml/proof2aproof.ml b/contrib/xml/proof2aproof.ml
index 678b650c..92cbf6df 100644
--- a/contrib/xml/proof2aproof.ml
+++ b/contrib/xml/proof2aproof.ml
@@ -63,21 +63,24 @@ let nf_evar sigma ~preserve =
 (* Warning: statuses, goals, prim_rules and tactic_exprs are not unshared! *)
 let rec unshare_proof_tree =
  let module PT = Proof_type in
-  function {PT.open_subgoals = status ; PT.goal = goal ; PT.ref = ref} ->
+  function {PT.open_subgoals = status ; 
+	    PT.goal = goal ; 
+	    PT.ref = ref} ->
    let unshared_ref =
     match ref with
        None -> None
      | Some (rule,pfs) ->
         let unshared_rule =
          match rule with
-            PT.Prim prim -> PT.Prim prim
-          | PT.Change_evars -> PT.Change_evars
-          | PT.Tactic (tactic_expr, pf) ->
-             PT.Tactic (tactic_expr, unshare_proof_tree pf)
-        in
+             PT.Nested (cmpd, pf) ->
+               PT.Nested (cmpd, unshare_proof_tree pf)
+	   | other -> other
+	in
          Some (unshared_rule, List.map unshare_proof_tree pfs)
    in
-    {PT.open_subgoals = status ; PT.goal = goal ; PT.ref = unshared_ref}
+    {PT.open_subgoals = status ; 
+     PT.goal = goal ; 
+     PT.ref = unshared_ref}
 ;;
 
 module ProofTreeHash =
@@ -103,7 +106,7 @@ let extract_open_proof sigma pf =
        {PT.ref=Some(PT.Prim _,_)} as pf ->
         L.prim_extractor proof_extractor vl pf
 	  
-     | {PT.ref=Some(PT.Tactic (_,hidden_proof),spfl)} ->
+     | {PT.ref=Some(PT.Nested (_,hidden_proof),spfl)} ->
 	 let sgl,v = Refiner.frontier hidden_proof in
 	 let flat_proof = v spfl in
          ProofTreeHash.add proof_tree_to_flattened_proof_tree node flat_proof ;
diff --git a/contrib/xml/proofTree2Xml.ml4 b/contrib/xml/proofTree2Xml.ml4
index 578c1ed2..dbdc79a8 100644
--- a/contrib/xml/proofTree2Xml.ml4
+++ b/contrib/xml/proofTree2Xml.ml4
@@ -141,7 +141,7 @@ Pp.ppnl (Pp.(++) (Pp.str
               (fun i n -> [< i ; (aux n old_hyps) >]) [<>] nodes)
 
      | {PT.goal=goal;
-        PT.ref=Some(PT.Tactic (tactic_expr,hidden_proof),nodes)} ->
+        PT.ref=Some(PT.Nested (PT.Tactic(tactic_expr,_),hidden_proof),nodes)} ->
          (* [hidden_proof] is the proof of the tactic;                     *)
          (* [nodes] are the proof of the subgoals generated by the tactic; *)
          (* [flat_proof] if the proof-tree obtained substituting [nodes]   *)
@@ -194,6 +194,12 @@ Pp.ppnl (Pp.(++) (Pp.str
           (List.fold_left
             (fun i n -> [< i ; (aux n old_hyps) >]) [<>] nodes)
 
+     | {PT.ref=Some((PT.Nested(PT.Proof_instr (_,_),_)|PT.Decl_proof _),nodes)} ->
+         Util.anomaly "Not Implemented" 
+
+     | {PT.ref=Some(PT.Daimon,_)} ->
+         X.xml_empty "Hidden_open_goal" of_attribute
+
      | {PT.ref=None;PT.goal=goal} ->
          X.xml_empty "Open_goal" of_attribute
   in
diff --git a/contrib/xml/xmlcommand.ml b/contrib/xml/xmlcommand.ml
index b6b1c7b6..f286d2c8 100644
--- a/contrib/xml/xmlcommand.ml
+++ b/contrib/xml/xmlcommand.ml
@@ -408,7 +408,7 @@ let mk_inductive_obj sp mib packs variables nparams hyps finite =
        let {D.mind_consnames=consnames ;
             D.mind_typename=typename } = p
        in
-        let arity = Inductive.type_of_inductive (mib,p) in
+        let arity = Inductive.type_of_inductive (Global.env()) (mib,p) in
         let lc = Inductiveops.arities_of_constructors (Global.env ()) (sp,!tyno) in
         let cons =
          (Array.fold_right (fun (name,lc) i -> (name,lc)::i)
@@ -522,6 +522,7 @@ let print internal glob_ref kind xml_library_root =
        let id = N.id_of_label (N.con_label kn) in
        let {D.const_body=val0 ; D.const_type = typ ; D.const_hyps = hyps} =
         G.lookup_constant kn in
+       let typ = Typeops.type_of_constant_type (Global.env()) typ in
         Cic2acic.Constant kn,mk_constant_obj id val0 typ variables hyps
     | Ln.IndRef (kn,_) ->
        let mib = G.lookup_mind kn in
@@ -531,7 +532,7 @@ let print internal glob_ref kind xml_library_root =
             D.mind_finite=finite} = mib in
           Cic2acic.Inductive kn,mk_inductive_obj kn mib packs variables nparams hyps finite
     | Ln.ConstructRef _ ->
-       Util.anomaly ("print: this should not happen")
+       Util.error ("a single constructor cannot be printed in XML")
   in
   let fn = filename_of_path xml_library_root tag in
   let uri = Cic2acic.uri_of_kernel_name tag in
@@ -547,14 +548,12 @@ let print_ref qid fn =
 (*  where dest is either None (for stdout) or (Some filename) *)
 (* pretty prints via Xml.pp the proof in progress on dest     *)
 let show_pftreestate internal fn (kind,pftst) id =
- let str = Names.string_of_id id in
  let pf = Tacmach.proof_of_pftreestate pftst in
  let typ = (Proof_trees.goal_of_proof pf).Evd.evar_concl in
  let val0,evar_map,proof_tree_to_constr,proof_tree_to_flattened_proof_tree,
      unshared_pf
  =
   Proof2aproof.extract_open_pftreestate pftst in
- let kn = Lib.make_kn id in
  let env = Global.env () in
  let obj =
   mk_current_proof_obj (fst kind = Decl_kinds.Local) id val0 typ evar_map env in
diff --git a/dev/doc/perf-analysis b/dev/doc/perf-analysis
index 23259156..f4cb3bff 100644
--- a/dev/doc/perf-analysis
+++ b/dev/doc/perf-analysis
@@ -1,6 +1,27 @@
 Performance analysis for V8-0 branch
 ------------------------------------
 
+Oct 29, 2006: polymorphism on definitions (+ 4%)
+
+Oct 17, 2006: improvement in new field [r9248]
+  (QArith -3%, geometry: -2%)
+
+Oct 5, 2006: fixing wrong unification of Meta below binders
+  (e.g. CatsInZFC: +10%, CoRN: -2.5%, Godel: +4%, 
+   DISTRIBUTED_REFERENCE_COUNTING: +10%, CoLoR: +1%)
+
+Sep 26, 2006: new field [r9178-9181]
+  (QArith: -16%, geometry: -5%, Float: +6%, BDDS:+5% but no ring in it)
+
+  Sep 12, 2006: Rocq/AREA_METHOD extended (~ 530s)
+  Aug 12, 2006: Rocq/AREA_METHOD added (~ 480s)
+  May 30, 2006: Nancy/CoLoR added (~ 319s)
+
+May 17, 2006: changes in List.v (DISTRIBUTED_REFERENCE_COUNTING: -)
+
+May 5, 2006: improvement in closure (array instead of lists)
+  (e.g. CatsInZFC: -10%, CoRN: -3%, 
+
   Dec 29, 2005: new test and use of -vm in Stalmarck
 
   Dec 27, 2005: contrib Karatsuba added (~ 30s)
diff --git a/dev/include b/dev/include
index 563edd04..42d2a017 100644
--- a/dev/include
+++ b/dev/include
@@ -25,6 +25,7 @@
 #install_printer  (* tactic *) pptac;;
 #install_printer  (* object *) ppobj;;
 #install_printer  (* global_reference *) ppglobal;;
+#install_printer  (* generic_argument *) pp_generic_argument;;
 
 #install_printer  (* fconstr *) ppfconstr;;
 
diff --git a/dev/ocamldebug-coq.template b/dev/ocamldebug-coq.template
index 5c4c4475..44680d6d 100644
--- a/dev/ocamldebug-coq.template
+++ b/dev/ocamldebug-coq.template
@@ -9,20 +9,7 @@ CAMLBIN=CAMLBINDIRECTORY
 OCAMLDEBUG=$CAMLBIN/ocamldebug
 export CAMLP4LIB=`$CAMLBIN/camlp4 -where`
 
-args=""
-coqdebug="no"
-for op in $*
-    do case `basename $op` in
-	coq-debug-programs.out) 
-	    coqdebug="yes"
-	    args="-is programs.coq";;
-	*coq*) coqdebug="yes";;
-       esac
-done
-
-case $coqdebug in
-    yes)
-	exec $OCAMLDEBUG \
+exec $OCAMLDEBUG \
 	-I $CAMLP4LIB \
 	-I $COQTOP/config \
 	-I $COQTOP/lib -I $COQTOP/kernel \
@@ -30,13 +17,12 @@ case $coqdebug in
         -I $COQTOP/interp -I $COQTOP/proofs -I $COQTOP/tactics \
 	-I $COQTOP/toplevel -I $COQTOP/dev -I $COQTOP/config \
 	-I $COQTOP/translate \
-        -I $COQTOP/contrib/correctness \
         -I $COQTOP/contrib/extraction -I $COQTOP/contrib/field \
-        -I $COQTOP/contrib/fourier    -I $COQTOP/contrib/graphs \
+        -I $COQTOP/contrib/fourier    -I $COQTOP/contrib/first-order \
         -I $COQTOP/contrib/interface  -I $COQTOP/contrib/jprover \
         -I $COQTOP/contrib/omega      -I $COQTOP/contrib/romega \
         -I $COQTOP/contrib/ring       -I $COQTOP/contrib/xml \
 	-I $COQTOP/contrib/subtac     -I $COQTOP/contrib/funind \
-	$* $args;;
-    *) exec $OCAMLDEBUG $*;;
-esac
+        -I $COQTOP/contrib/rtauto     -I $COQTOP/contrib/setoid_ring \
+        -I $COQTOP/contrib/recdef     -I $COQTOP/contrib/dp \
+	$*
diff --git a/dev/tools/Makefile.common b/dev/tools/Makefile.common
index 1ff5cf79..e69de29b 100644
--- a/dev/tools/Makefile.common
+++ b/dev/tools/Makefile.common
@@ -1,52 +0,0 @@
-# this Makefile contains goals common for directory and main devel makefiles
-
-ifndef TOPDIR
-TOPDIR=..
-endif
-
-ifndef BASEDIR
-BASEDIR=
-endif
-
-# the following entries are used to make synchronize two source trees
-# (on big computer and on a laptop for example)
-
-OTHER_FILE=$(TOPDIR)/dev/other
-OTHER=$(shell cat $(OTHER_FILE))
-
-# this is a directory of useful temporary things
-WORKDIR=tmp
-
-ifneq (,$(findstring n,$(MAKEFLAGS)))
-NFLAG=-n
-else
-NFLAG=
-endif
-
-check_other:
-	+@(if [ "$(OTHER)" = "" ] ; then \
-	  echo You must put the ssh path to the other Coq source in $(OTHER_FILE) ; \
-	  echo For example: chrzaszc@ruta:coq/V7 ; \
-	  exit 1; \
-	fi)
-
-get:	check_other
-	+rsync -Cauvz $(NFLAG) $(OTHER)/ $(TOPDIR)/
-	+@(if [ -d $(TOPDIR)/$(WORKDIR) ]; then \
-	  rsync -auvz $(NFLAG) $(OTHER)/tmp/ $(TOPDIR)/tmp/ ; \
-	fi)
-
-put:	check_other
-	+rsync -Cauvz $(NFLAG) $(TOPDIR)/ $(OTHER)/
-	+@(if [ -d $(TOPDIR)/$(WORKDIR) ]; then \
-	  rsync -auvz $(NFLAG) $(TOPDIR)/tmp/ $(OTHER)/tmp/ ; \
-	fi)
-
-sync:	get put
-
-
-conflicts:
-	cvs status | grep File | grep conflicts | less
-
-confl:	conflicts
-
diff --git a/dev/tools/Makefile.devel b/dev/tools/Makefile.devel
index f3abb62d..8dcc70cf 100644
--- a/dev/tools/Makefile.devel
+++ b/dev/tools/Makefile.devel
@@ -16,9 +16,9 @@ usage::
 usage::
 	@echo "  setup-devel	-- set the devel makefile"
 setup-devel:
-	@ln -sfv dev/Makefile.devel makefile
+	@ln -sfv dev/tools/Makefile.devel makefile
 	@(for i in $(SOURCEDIRS); do \
-	    (cd $(TOPDIR)/$$i; ln -sfv ../dev/Makefile.dir Makefile) \
+	    (cd $(TOPDIR)/$$i; ln -sfv ../dev/tools/Makefile.dir Makefile) \
 	done)
 
 
@@ -42,14 +42,14 @@ quick:
 
 include Makefile
 
-include $(TOPDIR)/dev/Makefile.common
+include $(TOPDIR)/dev/tools/Makefile.common
 
-# this file is better described in dev/Makefile.dir
+# this file is better described in dev/tools/Makefile.dir
 include .depend.devel
 
-#if dev/Makefile.local exists, it is included
-ifneq ($(wildcard $(TOPDIR)/dev/Makefile.local),)
-include $(TOPDIR)/dev/Makefile.local
+#if dev/tools/Makefile.local exists, it is included
+ifneq ($(wildcard $(TOPDIR)/dev/tools/Makefile.local),)
+include $(TOPDIR)/dev/tools/Makefile.local
 endif
 
 
@@ -71,4 +71,4 @@ usage::
 vars:
 	@(cd $(TOPDIR); \
 	echo export COQTOP=`pwd`/ ; \
-	echo export COQBIN=`pwd`/bin/ )
\ No newline at end of file
+	echo export COQBIN=`pwd`/bin/ )
diff --git a/dev/tools/Makefile.dir b/dev/tools/Makefile.dir
index 68c917ac..1a1bb90b 100644
--- a/dev/tools/Makefile.dir
+++ b/dev/tools/Makefile.dir
@@ -1,6 +1,6 @@
 # make a link to this file if you are working hard in one directory of Coq
-#   ln -s ../dev/Makefile.dir Makefile
-# if you are working in a sub/dir/ make a link to dev/Makefile.subdir instead
+#   ln -s ../dev/tools/Makefile.dir Makefile
+# if you are working in a sub/dir/ make a link to dev/tools/Makefile.subdir instead
 # this Makefile provides many useful facilities to develop Coq
 # it is not completely compatible with .ml4 files unfortunately
 
diff --git a/dev/tools/Makefile.subdir b/dev/tools/Makefile.subdir
index ff1f3077..cb914bd1 100644
--- a/dev/tools/Makefile.subdir
+++ b/dev/tools/Makefile.subdir
@@ -1,7 +1,7 @@
 # if you work in a sub/sub-rectory of Coq
 # you should make a link to that makefile 
-#    ln -s ../../dev/Makefile.subdir Makefile
-# in order to have all the facilities of dev/Makefile.dir
+#    ln -s ../../dev/tools/Makefile.subdir Makefile
+# in order to have all the facilities of dev/tools/Makefile.dir
 
 TOPDIR=../..
 include $(TOPDIR)/dev/tools/Makefile.dir
diff --git a/dev/top_printers.ml b/dev/top_printers.ml
index 273f109c..e1ee29e4 100644
--- a/dev/top_printers.ml
+++ b/dev/top_printers.ml
@@ -27,6 +27,8 @@ open Clenv
 open Cerrors
 open Evd
 open Goptions
+open Genarg
+
 
 let _ = Constrextern.print_evar_arguments := true
 let _ = set_bool_option_value (SecondaryTable ("Printing","Matching")) false
@@ -145,9 +147,9 @@ let constr_display csr =
   | Fix ((t,i),(lna,tl,bl)) ->
       "Fix(([|"^(Array.fold_right (fun x i -> (string_of_int x)^(if not(i="")
         then (";"^i) else "")) t "")^"|],"^(string_of_int i)^"),"
-      ^(array_display tl)^","
+      ^(array_display tl)^",[|"
       ^(Array.fold_right (fun x i -> (name_display x)^(if not(i="")
-        then (";"^i) else "")) lna "")^","
+        then (";"^i) else "")) lna "")^"|],"
       ^(array_display bl)^")"
   | CoFix(i,(lna,tl,bl)) ->
       "CoFix("^(string_of_int i)^"),"
@@ -309,6 +311,39 @@ let ppfconstr c = ppconstr (Closure.term_of_fconstr c)
 let pploc x = let (l,r) = unloc x in
   print_string"(";print_int l;print_string",";print_int r;print_string")"
 
+(* extendable tactic arguments *)
+let rec pr_argument_type = function
+  (* Basic types *)
+  | BoolArgType -> str"bool"
+  | IntArgType -> str"int"
+  | IntOrVarArgType -> str"int-or-var"
+  | StringArgType -> str"string"
+  | PreIdentArgType -> str"pre-ident"
+  | IntroPatternArgType -> str"intro-pattern"
+  | IdentArgType -> str"ident"
+  | VarArgType -> str"var"
+  | RefArgType -> str"ref"
+  (* Specific types *)
+  | SortArgType -> str"sort"
+  | ConstrArgType -> str"constr"
+  | ConstrMayEvalArgType -> str"constr-may-eval"
+  | QuantHypArgType -> str"qhyp"
+  | OpenConstrArgType _ -> str"open-constr"
+  | ConstrWithBindingsArgType -> str"constr-with-bindings"
+  | BindingsArgType -> str"bindings"
+  | RedExprArgType -> str"redexp"
+  | List0ArgType t -> pr_argument_type t ++ str" list0"
+  | List1ArgType t -> pr_argument_type t ++ str" list1"
+  | OptArgType t -> pr_argument_type t ++ str" opt"
+  | PairArgType (t1,t2) ->
+      str"("++ pr_argument_type t1 ++ str"*" ++ pr_argument_type t2 ++str")"
+  | ExtraArgType s -> str"\"" ++ str s ++ str "\""
+
+let pp_argument_type t = pp (pr_argument_type t)
+
+let pp_generic_argument arg =
+  pp(str"<genarg:"++pr_argument_type(genarg_tag arg)++str">")
+
 (**********************************************************************)
 (* Vernac-level debugging commands                                    *)
 
diff --git a/dev/vm_printers.ml b/dev/vm_printers.ml
index c037eca7..1e114489 100644
--- a/dev/vm_printers.ml
+++ b/dev/vm_printers.ml
@@ -65,8 +65,6 @@ and ppatom a =
       print_string (string_of_kn sp);
       print_string ","; print_int i;
       print_string ")"
-  | Afix_app _ -> print_vfix_app ()
-  | Aswitch _ -> print_vswith()
 
 and ppwhd whd =
   match whd with 
@@ -74,9 +72,7 @@ and ppwhd whd =
   | Vprod _ -> print_string "product"
   | Vfun _ -> print_string "function"
   | Vfix _ -> print_vfix()
-  | Vfix_app _ -> print_vfix_app()
   | Vcofix _ -> print_string "cofix"
-  | Vcofix_app _ -> print_string "cofix_app"
   | Vconstr_const i -> print_string "C(";print_int i;print_string")"
   | Vconstr_block b -> ppvblock b      
   | Vatom_stk(a,s) ->
diff --git a/doc/RecTutorial/RecTutorial.tex b/doc/RecTutorial/RecTutorial.tex
index 9ee913d4..df8bc9f1 100644
--- a/doc/RecTutorial/RecTutorial.tex
+++ b/doc/RecTutorial/RecTutorial.tex
@@ -49,7 +49,7 @@ Pierre Cast\'eran\thanks{Pierre.Casteran@labri.fr}}
 
 \begin{abstract}
 This document\footnote{The first versions of this document were entirely written by Eduardo Gimenez.
-Pierre Cast\'eran wrote the 2004 revision.} is an introduction to the definition and
+Pierre Cast\'eran wrote the 2004 and 2006 revisions.} is an introduction to the definition and
 use of inductive and co-inductive  types in the {\coq} proof environment. It explains how types like natural numbers and infinite streams are defined
 in {\coq}, and the kind of proof techniques that can be used to reason
 about them (case analysis, induction, inversion of predicates,
@@ -123,6 +123,7 @@ about dependent case analysis. Finally, Section
 --i.e., types containing infinite objects-- and the principle of
 co-induction.
 
+
 Thanks to  Bruno Barras, Yves Bertot, Hugo Herbelin, Jean-Fran\c{c}ois Monin
 and Michel L\'evy for their help.
 
@@ -142,14 +143,14 @@ respectively.  For instance, the \coq{} statement
 % inclusion numero 1
 % traduction numero 1
 \begin{alltt}
-\hide{Open Scope nat_scope. Check (}forall A:Set,(exists x : A, forall (y:A), x <> y) -> 2 = 3\hide{).}
+\hide{Open Scope nat_scope. Check (}forall A:Type,(exists x : A, forall (y:A), x <> y) -> 2 = 3\hide{).}
 \end{alltt}
 is written as follows in this tutorial:
 %V8 A prendre
 % inclusion numero 2
 % traduction numero 2
 \begin{alltt}
-\hide{Check (}{\prodsym}A:Set,(\exsym{}x:A, {\prodsym}y:A, x {\coqdiff} y) \arrow{} 2 = 3\hide{).}
+\hide{Check (}{\prodsym}A:Type,(\exsym{}x:A, {\prodsym}y:A, x {\coqdiff} y) \arrow{} 2 = 3\hide{).}
 \end{alltt}
 
 When a fragment of \coq{} input text appears in the middle of
@@ -242,13 +243,17 @@ Let us now take a look to some other
 recursive types contained in the standard library of {\coq}.
 
 \subsection{Lists}
-Lists are defined in library \citecoq{List}:
+Lists are defined in library \citecoq{List}\footnote{Notice that in versions of 
+{\coq}
+prior to 8.1, the parameter $A$ had sort \citecoq{Set} instead of \citecoq{Type}; 
+the constant \citecoq{list} was thus of type \citecoq{Set\arrow{} Set}.}
+
 
 \begin{alltt}
 Require Import List.
 Print list.
 \it
-Inductive list (A : Set) : Set :=
+Inductive list (A : Type) : Type:=
     nil : list A | cons : A {\arrow} list A {\arrow} list A
 For nil: Argument A is implicit
 For cons: Argument A is implicit
@@ -260,7 +265,7 @@ For cons: Argument scopes are [type_scope _ _]
 In this definition, \citecoq{A} is a \emph{general parameter}, global
 to both constructors.
 This kind of definition allows us to build a whole family of
-inductive types, indexed over the sort \citecoq{Set}.
+inductive types, indexed over the sort \citecoq{Type}.
 This can be observed if we consider the type of identifiers
 \citecoq{list}, \citecoq{cons} and \citecoq{nil}.
 Notice the notation \citecoq{(A := \dots)} which must be used 
@@ -269,7 +274,7 @@ parameter \citecoq{A}.
 \begin{alltt}
 Check list.
 \it list
-     : Set {\arrow} Set
+     : Type {\arrow} Type
 
 \tt Check (nil (A:=nat)).
 \it nil
@@ -279,20 +284,32 @@ Check list.
 \it nil
      : list (nat {\arrow} nat)
 
-\tt Check (fun A: Set {\funarrow} (cons (A:=A))).
-\it fun A : Set {\funarrow} cons (A:=A)
-     : {\prodsym} A : Set, A {\arrow} list A {\arrow} list A
+\tt Check (fun A: Type {\funarrow} (cons (A:=A))).
+\it fun A : Type {\funarrow} cons (A:=A)
+     : {\prodsym} A : Type, A {\arrow} list A {\arrow} list A
 
 \tt Check (cons 3 (cons 2 nil)).
 \it 3 :: 2 :: nil
      : list nat
+
+\tt Check (nat :: bool ::nil).
+\it nat :: bool :: nil
+     : list Set
+
+\tt Check ((3<=4) :: True ::nil).
+\it (3<=4) :: True :: nil
+     : list Prop
+
+\tt Check (Prop::Set::nil).
+\it Prop::Set::nil
+     : list Type
 \end{alltt}
 
 \subsection{Vectors.}
 \label{vectors}
 
 Like \texttt{list}, \citecoq{vector} is a polymorphic type:
-if $A$ is a set, and $n$ a natural number, ``~\citecoq{vector $A$ $n$}~''
+if $A$ is a type, and $n$ a natural number, ``~\citecoq{vector $A$ $n$}~''
 is the type of vectors of elements of $A$ and size $n$.
 
 
@@ -301,7 +318,7 @@ Require Import  Bvector.
 
 Print vector.
 \it
-Inductive vector (A : Set) : nat {\arrow} Set :=
+Inductive vector (A : Type) : nat {\arrow} Type :=
     Vnil : vector A 0
   | Vcons : A {\arrow} {\prodsym} n : nat, vector A n {\arrow} vector A (S n)
 For vector: Argument scopes are [type_scope nat_scope]
@@ -322,9 +339,9 @@ Check (Vnil nat).
 \it Vnil nat
      : vector nat 0
 
-\tt Check (fun (A:Set)(a:A){\funarrow} Vcons _ a _ (Vnil _)).
-\it fun (A : Set) (a : A) {\funarrow} Vcons A a 0 (Vnil A)
-     : {\prodsym} A : Set, A {\arrow} vector A 1
+\tt Check (fun (A:Type)(a:A){\funarrow} Vcons _ a _ (Vnil _)).
+\it fun (A : Type) (a : A) {\funarrow} Vcons A a 0 (Vnil A)
+     : {\prodsym} A : Type, A {\arrow} vector A 1
 
 
 \tt Check (Vcons _ 5 _ (Vcons _ 3 _ (Vnil _))).
@@ -456,7 +473,8 @@ Qed.
 \end{alltt}
 
 Notice that the strict order on \texttt{nat}, called \citecoq{lt}
-is not inductively defined:
+is not inductively defined: the proposition $n<p$ (notation for \citecoq{lt $n$ $p$})
+is reducible to \citecoq{(S $n$) $\leq$ p}.
 
 \begin{alltt}
 Print lt.
@@ -466,17 +484,67 @@ lt = fun n m : nat {\funarrow} S n {\coqle} m
 \tt
 Lemma zero_lt_three : 0 < 3.
 Proof.
- unfold lt.
-\it
-====================
- 1 {\coqle} 3
-\tt
  repeat constructor. 
 Qed.
+
+Print zero_lt_three.
+\it zero_lt_three = le_S 1 2 (le_S 1 1 (le_n 1))
+     : 0 < 3
 \end{alltt}
 
 
 
+\subsection{About general parameters (\coq{} version $\geq$ 8.1)}
+\label{parameterstuff}
+
+Since version $8.1$, it is possible to write more compact inductive definitions
+than in earlier versions.
+
+Consider the following alternative definition of the relation $\leq$ on 
+type \citecoq{nat}:
+
+\begin{alltt}
+Inductive le'(n:nat):nat -> Prop :=
+ | le'_n : le' n n
+ | le'_S : forall p, le' (S n) p -> le' n p.
+
+Hint Constructors le'.
+\end{alltt}
+
+We notice that the type of the second constructor of \citecoq{le'}
+has an argument whose type is \citecoq{le' (S n) p}. 
+This constrasts with earlier versions 
+of {\coq}, in which a general parameter $a$ of an inductive
+type $I$ had to appear only in applications of the form $I\,\dots\,a$.
+
+Since version $8.1$, if $a$ is a general parameter of an inductive 
+type $I$, the type of an argument of a constructor of $I$ may be
+of the form  $I\,\dots\,t_a$ , where $t_a$ is any term.
+Notice that the final type of the constructors must be of the form
+$I\,\dots\,a$, since these constructors describe how to form 
+inhabitants of type $I\,\dots\,a$ (this is the role of parameter $a$).
+
+Another example of this new feature is {\coq}'s definition of accessibility
+(see Section~\ref{WellFoundedRecursion}), which has a general parameter
+$x$; the constructor for the predicate
+``$x$ is accessible'' takes an  argument of type ``$y$ is accessible''.
+
+
+
+In earlier versions of {\coq}, a relation like \citecoq{le'} would have to be
+defined without $n$ being a general parameter.
+
+\begin{alltt}
+Reset le'.
+
+Inductive le': nat-> nat -> Prop :=
+ | le'_n : forall n, le' n n
+ | le'_S : forall n p, le' (S n) p -> le' n p.
+\end{alltt}
+
+
+
+
 \subsection{The propositional equality type.} \label{equality}
 In {\coq}, the propositional equality between two inhabitants $a$ and
 $b$ of
@@ -636,7 +704,9 @@ let max n p =
 \end{alltt}
 
 Another example of use of \citecoq{sumbool} is given  in Section
-\ref{WellFoundedRecursion}.
+\ref{WellFoundedRecursion}: the theorem \citecoq{eq\_nat\_dec} of
+library \citecoq{Coq.Arith.Peano\_dec} is used in an euclidean division
+algorithm.
 
 \subsection{The existential quantifier.}\label{ex-def}
 The existential quantifier is yet another example of a logical
@@ -653,7 +723,7 @@ for \linebreak ``~\citecoq{ex (fun $x$:$A$ \funarrow{} $B$)}~''.
 
 \noindent The former quantifier inhabits the universe of propositions.
 As for the conjunction and disjunction connectives, there is also another
-version of existential quantification inhabiting the universe $\Set$,
+version of existential quantification inhabiting the universes $\Type_i$,
 which is noted \texttt{sig $P$}. The syntax
 ``~\citecoq{\{$x$:$A$ | $B$\}}~'' is an abreviation for ``~\citecoq{sig (fun $x$:$A$ {\funarrow} $B$)}~''.
 
@@ -677,9 +747,9 @@ Mutually dependent definitions of recursive types are also allowed in
 introduction of the trees of unbounded (but finite) width:
 \label{Forest}
 \begin{alltt} 
-Inductive tree(A:Set)   : Set :=
+Inductive tree(A:Type)   : Type :=
     node : A {\arrow} forest A \arrow{} tree A 
-with  forest (A: Set)   : Set := 
+with  forest (A: Set)   : Type := 
     nochild  : forest A |
     addchild : tree A \arrow{} forest A \arrow{} forest A.
 \end{alltt}
@@ -709,7 +779,7 @@ Qed.
 \subsection{Non-dependent Case Analysis}
 An \textsl{elimination rule} for the type $A$ is some way to use an
 object $a:A$ in order to define an object in some  type $B$. 
-A natural elimination for an inductive type is \emph{case analysis}.
+A natural elimination rule for an inductive type is \emph{case analysis}.
 
 
 For instance, any value of type {\nat} is built using either \texttt{O} or \texttt{S}.
@@ -727,7 +797,7 @@ defined, so the ``\texttt{return $B$}'' part can be omitted.
 
 The computing rules associated with this construct are the expected ones 
 (the notation $t_S\{q/\texttt{p}\}$ stands for the substitution of $p$ by
-$q$ in $t_S$:)
+$q$ in $t_S$ :)
 
 \begin{eqnarray*}
 \texttt{match $O$ return $b$ with O {\funarrow} $t_O$ | S p {\funarrow} $t_S$ end} &\Longrightarrow& t_O\\
@@ -792,7 +862,7 @@ For a pattern matching construct of the form
 is obtained considering that the type of the whole expression
 may also depend on \texttt{n}.
   For instance, let us consider some function 
-$Q:\texttt{nat}\arrow{}\texttt{Set}$, and $n:\citecoq{nat}$.
+$Q:\texttt{nat}\arrow{}\texttt{Type}$, and $n:\citecoq{nat}$.
 In order to build a term of type $Q\;n$, we can associate
 to the constructor \texttt{O} some term $t_O: Q\;\texttt{O}$ and to
 the pattern ``~\texttt{S p}~''  some term $t_S : Q\;(S\;p)$.
@@ -806,7 +876,7 @@ which constraint holds on the branches of the pattern matching:
 \label{Prod-sup-rule}
 \[
 \begin{array}[t]{l}
-Q: \texttt{nat}{\arrow}\texttt{Set}\quad{t_O}:{{Q\;\texttt{O}}}  \quad
+Q: \texttt{nat}{\arrow}\texttt{Type}\quad{t_O}:{{Q\;\texttt{O}}}  \quad
 \smalljuge{p:\texttt{nat}}{t_p}{{Q\;(\texttt{S}\;p)}} \quad n:\texttt{nat} \\
 \hline
 {\texttt{match \(n\) as \(n\sb{0}\) return \(Q\;n\sb{0}\) with | O \funarrow \(t\sb{O}\) | S p \funarrow \(t\sb{S}\) end}}:{{Q\;n}}
@@ -815,7 +885,7 @@ Q: \texttt{nat}{\arrow}\texttt{Set}\quad{t_O}:{{Q\;\texttt{O}}}  \quad
 
 
 The interest of this rule of \textsl{dependent} pattern-matching is
-that it can also be read as the following logical principle (replacing \citecoq{Set}
+that it can also be read as the following logical principle (when $Q$ has type \citecoq{nat\arrow{}Prop}
 by \texttt{Prop} in the type of $Q$): in order to prove
 that a property $Q$ holds for all $n$, it is sufficient to prove that
 $Q$ holds for {\Z} and that for all $p:\nat$, $Q$ holds for
@@ -962,6 +1032,7 @@ analysis of it.
 
 \begin{alltt}
 Theorem fromFalse : False \arrow{} 0=1.
+Proof.
  intro H. 
  contradiction.
 Qed.
@@ -1007,7 +1078,7 @@ Let $A:\Type$, $a$, $b$ of type $A$, and $\pi$ a proof of
 $a=b$. Non dependent case analysis of $\pi$ allows us to
 associate to any proof  of ``~$Q\;a$~'' a proof of ``~$Q\;b$~'',
 where $Q:A\arrow{} s$ (where $s\in\{\Prop, \Set, \Type\}$).
-The following term is a proof  of ``~$Q\;a \arrow{} Q\;b$~''.
+The following term is a proof  of ``~$Q\;a\, \arrow{}\, Q\;b$~''.
 
 \begin{alltt}
 fun H : Q a {\funarrow}
@@ -1244,7 +1315,7 @@ The header of the function we want to build is the following:
 
 \begin{verbatim}
 Definition Vtail_total 
-   (A : Set) (n : nat) (v : vector A n) : vector A (pred n):=
+   (A : Type) (n : nat) (v : vector A n) : vector A (pred n):=
 \end{verbatim}
 
 Since the branches will not have the same type
@@ -1266,8 +1337,8 @@ to ``~\citecoq{vector A 0}~''. So, we propose:
 The second branch considers a vector in ``~\citecoq{vector A (S n0)}~''
 of the form
 ``~\citecoq{Vcons A n0 v0}~'', with ``~\citecoq{v0:vector A n0}~'',
-and must return a value in ``~\citecoq{vector A (pred (S n0))}~'',
-convertible to ``~\citecoq{v0:vector A n0}~''.
+and must return a value of type ``~\citecoq{vector A (pred (S n0))}~'',
+which is convertible to ``~\citecoq{vector A n0}~''.
 This second branch is thus :
 \begin{alltt}
 | Vcons _ n0 v0 {\funarrow} v0
@@ -1277,7 +1348,7 @@ Here is the full definition:
 
 \begin{alltt}
 Definition Vtail_total 
-   (A : Set) (n : nat) (v : vector A n) : vector A (pred n):=
+   (A : Type) (n : nat) (v : vector A n) : vector A (pred n):=
 match v in (vector _ n0) return (vector A (pred n0)) with
 | Vnil {\funarrow} Vnil A
 | Vcons _ n0 v0 {\funarrow} v0
@@ -1343,7 +1414,7 @@ Variable lambda : (Lambda {\arrow} False) {\arrow}Lambda.
 
 Since \texttt{Lambda} is not a truely inductive type, we can't use
 the \texttt{match} construct. Nevertheless, we can simulate it by a
-variable \texttt{matchL} such that
+variable \texttt{matchL} such that the term 
 ``~\citecoq{matchL $l$  $Q$ (fun $h$ : Lambda {\arrow} False {\funarrow} $t$)}~''
 should be understood  as 
 ``~\citecoq{match $l$ return $Q$ with | lambda h {\funarrow} $t$)}~''
@@ -1355,7 +1426,7 @@ Variable matchL : Lambda {\arrow}
                   Q.
 \end{alltt}
 
-From these constants, it is possible to define application by case
+>From these constants, it is possible to define application by case
 analysis. Then, through auto-application, the well-known looping term
 $(\lambda x.(x\;x)\;\lambda x.(x\;x))$ provides a proof of falsehood.
 
@@ -1419,7 +1490,7 @@ usually a synonymous of inconsistency.
 %definition above are called \textsl{strictly positive} types.
 
 
-\paragraph{} In this case, the construction of a non-terminating
+\subsubsection*{Remark} In this case, the construction of a non-terminating
 program comes from the so-called \textsl{negative occurrence} of
 \texttt{Lambda} in the argument of the constructor \texttt{lambda}. 
 
@@ -1571,9 +1642,9 @@ adding an extra type to the definition, as was done in Section
 
 \subsubsection{Impredicative Inductive Types}
 
-An inductive type $R$ inhabiting a universe $S$ is \textsl{predicative}
-if the introduction rules of $R$ do not make a universal
-quantification on a universe containing $S$. All the recursive types
+An inductive type $I$ inhabiting a universe $U$ is \textsl{predicative}
+if the introduction rules of $I$ do not make a universal
+quantification on a universe containing $U$. All the recursive types
 previously introduced are examples of predicative types. An example of
 an impredicative one is the following type:
 %\textsl{exT}, the dependent product
@@ -1599,18 +1670,21 @@ Inductive prop : Prop :=
 
 Notice
 that the constructor of this type can be used to inject any
-proposition --even itself!-- into the type. A careless use of such a
+proposition --even itself!-- into the type. 
+
+\begin{alltt}
+Check (prop_intro prop).\it
+prop_intro prop
+     : prop
+\end{alltt}
+
+A careless use of such a
 self-contained objects may lead to a variant of Burali-Forti's
 paradox. The construction of Burali-Forti's paradox is more
 complicated than Russel's one, so we will not describe it here, and
 point the interested reader to \cite{Bar98,Coq86}.
 
 
-\begin{alltt}
-Lemma prop_inject: prop.
-Proof prop_intro prop.
-\end{alltt}
-
 Another example is the second order existential quantifier for propositions:
 
 \begin{alltt}
@@ -1681,9 +1755,9 @@ Inductive  typ : Type :=
 Definition typ_inject: typ.
  split; exact typ.
 \it Proof completed
+
 \tt{}Defined.
-\it
-Error: Universe Inconsistency.
+\it Error: Universe Inconsistency.
 \tt
 Abort.
 \end{alltt}
@@ -1984,7 +2058,7 @@ using the tactic \texttt{trivial}.
 
 \begin{alltt}
 
- Lemma list_inject : {\prodsym} (A:Set)(a b :A)(l l':list A),
+ Lemma list_inject : {\prodsym} (A:Type)(a b :A)(l l':list A),
              a :: b :: l = b :: a :: l' {\arrow} a = b {\coqand} l = l'.
 Proof.
  intros A a b l l' e.
@@ -2008,7 +2082,7 @@ Qed.
 
 In section \ref{DependentCase}, we motivated the rule of dependent case
 analysis as a way of internalizing the informal equalities $n=O$ and
-$n=(\SUCC\;p)$ associated to each case. This internalisation
+$n=\SUCC\;p$ associated to each case. This internalisation
 consisted in instantiating $n$ with the corresponding term in the type
 of each branch. However, sometimes it could be better to internalise
 these equalities as extra hypotheses --for example, in order to use
@@ -2529,23 +2603,23 @@ Fixpoint nat_double_ind (n m:nat)\{struct n\} : P n m :=
 End Principle_of_Double_Induction.
 \end{alltt}
 
-Changing the type of $P$ into $\nat\rightarrow\nat\rightarrow\Set$,
-another combinator \texttt{nat\_double\_rec} for constructing 
+Changing the type of $P$ into $\nat\rightarrow\nat\rightarrow\Type$,
+another combinator \texttt{nat\_double\_rect} for constructing 
 (certified) programs can be defined in exactly the same way.
-This definition is left as an exercise.\label{natdoublerec}
+This definition is left as an exercise.\label{natdoublerect}
 
 \iffalse
 \begin{alltt}
 Section Principle_of_Double_Recursion.
-Variable    P               : nat {\arrow} nat {\arrow} Set.
+Variable    P               : nat {\arrow} nat {\arrow} Type.
 Hypothesis  base_case1      : {\prodsym} x:nat, P 0 x.
 Hypothesis  base_case2      : {\prodsym} x:nat, P (S x) 0.
 Hypothesis  inductive_step   : {\prodsym} n m:nat, P n m {\arrow} P (S n) (S m).
-Fixpoint nat_double_rec (n m:nat)\{struct n\} : P n m := 
+Fixpoint nat_double_rect (n m:nat)\{struct n\} : P n m := 
   match n, m return P n m with 
             0 ,     x   {\funarrow}  base_case1 x 
          |  (S x),    0   {\funarrow} base_case2 x
-         |  (S x), (S y) {\funarrow} inductive_step x y (nat_double_rec x y)
+         |  (S x), (S y) {\funarrow} inductive_step x y (nat_double_rect x y)
      end.
 End Principle_of_Double_Recursion.
 \end{alltt}
@@ -2555,7 +2629,7 @@ numbers can be defined in the following way:
 
 \begin{alltt}
 Definition min : nat {\arrow} nat {\arrow} nat  := 
-  nat_double_rec (fun (x y:nat) {\funarrow} nat)
+  nat_double_rect (fun (x y:nat) {\funarrow} nat)
                  (fun (x:nat) {\funarrow} 0)
                  (fun (y:nat) {\funarrow} 0)
                  (fun (x y r:nat) {\funarrow} S r).
@@ -2624,8 +2698,8 @@ Proof.
  intros n p.
 \end{alltt}
 
-Let us prove this theorem using the combinator \texttt{nat\_double\_rec}
-of section~\ref{natdoublerec}. The example also illustrates how
+Let us prove this theorem using the combinator \texttt{nat\_double\_rect}
+of section~\ref{natdoublerect}. The example also illustrates how
 \texttt{elim} may sometimes fail in finding a suitable abstraction $P$
 of the goal. Note that if ``~\texttt{elim n}~''
  is used directly on the
@@ -2635,7 +2709,7 @@ goal, the result is not the expected one.
 
 %\pagebreak
 \begin{alltt}
- elim n using nat_double_rec.
+ elim n using nat_double_rect.
 \it
 4 subgoals
   
@@ -2746,6 +2820,11 @@ $(from\;n)=0::1\;\ldots\; n::\texttt{nil}$ and prove that it always generates an
 ordered list.
 \end{exercise}
 
+\begin{exercise}
+Prove that \citecoq{le' n p} and \citecoq{n $\leq$ p} are logically equivalent
+for all n and p. (\citecoq{le'} is defined in section \ref{parameterstuff}).
+\end{exercise}
+
 
 \subsection{Well-founded Recursion}
 \label{WellFoundedRecursion}
@@ -2761,7 +2840,7 @@ first to introduce the predicate of accessibility.
 \begin{alltt}
 Print Acc.
 \it
-Inductive Acc (A : Set) (R : A {\arrow} A {\arrow} Prop) (x:A) : Prop :=
+Inductive Acc (A : Type) (R : A {\arrow} A {\arrow} Prop) (x:A) : Prop :=
     Acc_intro : ({\prodsym} y : A, R y x {\arrow} Acc R y) {\arrow} Acc R x
 For Acc: Argument A is implicit
 For Acc_intro: Arguments A, R are implicit
@@ -2769,10 +2848,12 @@ For Acc_intro: Arguments A, R are implicit
 \dots
 \end{alltt}
 
-\noindent This inductive predicate characterize those elements $x$ of
+\noindent This inductive predicate characterizes those elements $x$ of
 $A$ such that any descending $R$-chain $\ldots x_2\;R\;x_1\;R\;x$
 starting from $x$ is finite. A well-founded relation is a relation
 such that all the elements of $A$ are accessible.  
+\emph{Notice the use of parameter $x$ (see Section~\ref{parameterstuff}, page
+\pageref{parameterstuff}).}
 
 Consider now the problem of representing in {\coq} the following ML
 function $\textsl{div}(x,y)$ on natural numbers, which computes
@@ -2997,7 +3078,7 @@ We want to prove a quite trivial property: the only value of type
 Our first naive attempt leads to a \emph{cul-de-sac}.
 \begin{alltt}
 Lemma vector0_is_vnil : 
-  {\prodsym} (A:Set)(v:vector A 0), v = Vnil A.
+  {\prodsym} (A:Type)(v:vector A 0), v = Vnil A.
 Proof.
  intros A v;inversion v.
 \it
@@ -3019,11 +3100,11 @@ Unfortunately, even the statement of our lemma is refused!
 
 \begin{alltt}
  Lemma vector0_is_vnil_aux : 
- {\prodsym} (A:Set)(n:nat)(v:vector A n), n = 0 {\arrow} v = Vnil A.
+ {\prodsym} (A:Type)(n:nat)(v:vector A n), n = 0 {\arrow} v = Vnil A.
 
 \it
 Error: In environment
-A : Set
+A : Type
 n : nat
 v : vector A n
 e : n = 0
@@ -3044,7 +3125,7 @@ heterogeneous equality to a standard one.
 
 \begin{alltt}
 Lemma vector0_is_vnil_aux : 
-   {\prodsym} (A:Set)(n:nat)(v:vector A n), 
+   {\prodsym} (A:Type)(n:nat)(v:vector A n), 
       n= 0 {\arrow} JMeq v (Vnil A).
 Proof.
  destruct v.
@@ -3056,7 +3137,7 @@ Qed.
 Our property of vectors of null length can be easily proven:
 
 \begin{alltt}
-Lemma vector0_is_vnil : {\prodsym} (A:Set)(v:vector A 0), v = Vnil A.
+Lemma vector0_is_vnil : {\prodsym} (A:Type)(v:vector A 0), v = Vnil A.
  intros a v;apply JMeq_eq.
  apply vector0_is_vnil_aux.
  trivial.
@@ -3082,7 +3163,7 @@ Implicit Arguments Vnil [A].
 Implicit Arguments Vhead [A n].
 Implicit Arguments Vtail [A n].
 
-Definition Vid : {\prodsym} (A : Set)(n:nat), vector A n {\arrow} vector A n.
+Definition Vid : {\prodsym} (A : Type)(n:nat), vector A n {\arrow} vector A n.
 Proof.
  destruct n; intro v.
  exact Vnil.
@@ -3094,12 +3175,12 @@ Defined.
 Then we prove that \citecoq{Vid} is the identity on vectors:
 
 \begin{alltt}
-Lemma Vid_eq : {\prodsym} (n:nat) (A:Set)(v:vector A n), v=(Vid _ n v).
+Lemma Vid_eq : {\prodsym} (n:nat) (A:Type)(v:vector A n), v=(Vid _ n v).
 Proof.
  destruct v.
 
 \it
-   A : Set
+   A : Type
   ============================
    Vnil = Vid A 0 Vnil
 
@@ -3116,18 +3197,18 @@ dialogue shows that \citecoq{Vid} has some interesting computational
 properties:
 
 \begin{alltt}
-Eval simpl in (fun (A:Set)(v:vector A 0) {\funarrow} (Vid _ _ v)).
-\it = fun (A : Set) (_ : vector A 0) {\funarrow} Vnil
-     : {\prodsym} A : Set, vector A 0 {\arrow} vector A 0
+Eval simpl in (fun (A:Type)(v:vector A 0) {\funarrow} (Vid _ _ v)).
+\it = fun (A : Type) (_ : vector A 0) {\funarrow} Vnil
+     : {\prodsym} A : Type, vector A 0 {\arrow} vector A 0
 
 \end{alltt}
 
 Notice that the plain identity on vectors doesn't convert \citecoq{v}
 into \citecoq{Vnil}.
 \begin{alltt}
-Eval simpl in (fun (A:Set)(v:vector A 0) {\funarrow} v).
-\it = fun (A : Set) (v : vector A 0) {\funarrow} v
-     : {\prodsym} A : Set, vector A 0 {\arrow} vector A 0
+Eval simpl in (fun (A:Type)(v:vector A 0) {\funarrow} v).
+\it = fun (A : Type) (v : vector A 0) {\funarrow} v
+     : {\prodsym} A : Type, vector A 0 {\arrow} vector A 0
 \end{alltt}
 
 Then we prove easily that any vector of length 0 is \citecoq{Vnil}:
@@ -3140,7 +3221,7 @@ Proof.
 \it
 1 subgoal
   
-  A : Set
+  A : Type
   v : vector A 0
   ============================
    v = Vid A 0 v
@@ -3150,14 +3231,14 @@ Defined.
 \end{alltt}
 
 A similar result can be proven about vectors of strictly positive
-lenght\footnote{As for \citecoq{Vid} and \citecoq{Vid\_eq}, this definition 
+length\footnote{As for \citecoq{Vid} and \citecoq{Vid\_eq}, this definition 
 is from Jean Duprat.}.
 
 \begin{alltt}
 
 
 Theorem decomp :
-  {\prodsym} (A : Set) (n : nat) (v : vector A (S n)),
+  {\prodsym} (A : Type) (n : nat) (v : vector A (S n)),
   v = Vcons (Vhead v) (Vtail v).
 Proof.
  intros.
@@ -3165,7 +3246,7 @@ Proof.
 \it
  1 subgoal
   
-  A : Set
+  A : Type
   n : nat
   v : vector A (S n)
   ============================
@@ -3183,7 +3264,7 @@ on vectors of same length:
 
 \begin{alltt}
 Definition vector_double_rect : 
-    {\prodsym} (A:Set) (P: {\prodsym} (n:nat),(vector A n){\arrow}(vector A n) {\arrow} Type),
+    {\prodsym} (A:Type) (P: {\prodsym} (n:nat),(vector A n){\arrow}(vector A n) {\arrow} Type),
         P 0 Vnil Vnil {\arrow}
         ({\prodsym} n (v1 v2 : vector A n) a b, P n v1 v2 {\arrow}
              P (S n) (Vcons a v1) (Vcons  b v2)) {\arrow}
@@ -3197,7 +3278,7 @@ Defined.
 \end{alltt}
 
 Notice that, due to the conversion rule of {\coq}'s type system,
-this function can be used directly with \citecoq{Prop} or \citecoq{Set}
+this function can be used directly with \citecoq{Prop} or \citecoq{Type}
 instead of type (thus it is useless to build 
 \citecoq{vector\_double\_ind} and \citecoq{vector\_double\_rec}) from scratch.
 
@@ -3221,7 +3302,7 @@ than the length of the vector. Since {\coq} only considers total
 functions, the function returns a value in an \emph{option} type.
 
 \begin{alltt}
-Fixpoint vector_nth (A:Set)(n:nat)(p:nat)(v:vector A p)
+Fixpoint vector_nth (A:Type)(n:nat)(p:nat)(v:vector A p)
                   \{struct v\}
                   : option A :=
   match n,v  with
@@ -3265,7 +3346,7 @@ sequences formed with elements of type $A$, also called streams.  This
 type can be introduced through the following definition:
 
 \begin{alltt}
- CoInductive Stream (A: Set) :Set   := 
+ CoInductive Stream (A: Type) :Type   := 
  | Cons : A\arrow{}Stream A\arrow{}Stream A.
 \end{alltt}
 
@@ -3273,7 +3354,7 @@ If we are interested in finite or infinite sequences, we consider the type
 of \emph{lazy lists}:
 
 \begin{alltt}
-CoInductive LList (A: Set) : Set :=
+CoInductive LList (A: Type) : Type :=
  |  LNil : LList A
  |  LCons : A {\arrow} LList A {\arrow} LList A.
 \end{alltt}
@@ -3289,10 +3370,10 @@ streams is case analysis.  This principle can be used, for example, to
 define the destructors \textsl{head} and \textsl{tail}.
 
 \begin{alltt}
- Definition head (A:Set)(s : Stream A) := 
+ Definition head (A:Type)(s : Stream A) := 
    match s with Cons a s' {\funarrow} a end.
 
- Definition tail (A : Set)(s : Stream A) :=
+ Definition tail (A : Type)(s : Stream A) :=
       match s with Cons a s' {\funarrow} s' end.
 \end{alltt}
 
@@ -3303,7 +3384,7 @@ methods can be defined using the \texttt{CoFixpoint} command
 definition introduces the infinite list $[a,a,a,\ldots]$:
 
 \begin{alltt}
- CoFixpoint repeat (A:Set)(a:A) : Stream A := 
+ CoFixpoint repeat (A:Type)(a:A) : Stream A := 
    Cons a (repeat a).
 \end{alltt}
 
@@ -3317,11 +3398,11 @@ constructor, and only an argument of constructors \cite{EG94a}. The
 following definitions are examples of valid methods of construction:
 
 \begin{alltt}
-CoFixpoint iterate (A: Set)(f: A {\arrow} A)(a : A) : Stream A:=
+CoFixpoint iterate (A: Type)(f: A {\arrow} A)(a : A) : Stream A:=
     Cons a (iterate f (f a)).
 
 CoFixpoint map 
-  (A B:Set)(f: A {\arrow} B)(s : Stream A) : Stream B:=
+  (A B:Type)(f: A {\arrow} B)(s : Stream A) : Stream B:=
   match s with Cons a tl {\funarrow} Cons (f a) (map f tl) end.
 \end{alltt}
 
@@ -3341,13 +3422,13 @@ a case expression. We can check this using the command
 \texttt{Eval}.
 
 \begin{alltt}
-Eval simpl in (fun (A:Set)(a:A) {\funarrow} repeat a).
-\it  = fun (A : Set) (a : A) {\funarrow} repeat a
-     : {\prodsym} A : Set, A {\arrow} Stream A
+Eval simpl in (fun (A:Type)(a:A) {\funarrow} repeat a).
+\it  = fun (A : Type) (a : A) {\funarrow} repeat a
+     : {\prodsym} A : Type, A {\arrow} Stream A
 \tt
-Eval simpl in (fun (A:Set)(a:A) {\funarrow} head (repeat a)).
-\it  = fun (A : Set) (a : A) {\funarrow} a
-     : {\prodsym} A : Set, A {\arrow} A
+Eval simpl in (fun (A:Type)(a:A) {\funarrow} head (repeat a)).
+\it  = fun (A : Type) (a : A) {\funarrow} a
+     : {\prodsym} A : Type, A {\arrow} A
 \end{alltt}
 
 %\begin{exercise}
@@ -3377,7 +3458,7 @@ properties, it is necessary to construct infinite proofs. The type of
 infinite proofs of equality can be introduced as a co-inductive
 predicate, as follows:
 \begin{alltt}
-CoInductive EqSt (A: Set) : Stream A {\arrow} Stream A {\arrow} Prop :=
+CoInductive EqSt (A: Type) : Stream A {\arrow} Stream A {\arrow} Prop :=
   eqst : {\prodsym} s1 s2: Stream A,
       head s1 = head s2 {\arrow}
       EqSt (tail s1) (tail s2) {\arrow}
@@ -3399,7 +3480,7 @@ method for constructing an infinite proof:
 
 \begin{alltt}
 Section Parks_Principle.
-Variable A : Set.
+Variable A : Type.
 Variable    R      : Stream A {\arrow} Stream A {\arrow} Prop.
 Hypothesis  bisim1 : {\prodsym} s1 s2:Stream A, 
                        R s1 s2 {\arrow} head s1 = head s2.
@@ -3420,7 +3501,7 @@ End Parks_Principle.
 Let us use the principle of co-induction to prove the extensional
 equality mentioned above. 
 \begin{alltt}
-Theorem map_iterate : {\prodsym} (a:Set)(f:A{\arrow}A)(x:A),
+Theorem map_iterate : {\prodsym} (A:Type)(f:A{\arrow}A)(x:A),
                        EqSt (iterate f (f x)) 
                             (map f (iterate f x)).
 Proof.
@@ -3464,7 +3545,7 @@ In the example above, this tactic produces a much simpler proof
 that the former one:
 
 \begin{alltt}
-Theorem map_iterate' : {\prodsym} ((A:Set)f:A{\arrow}A)(x:A),
+Theorem map_iterate' : {\prodsym} ((A:Type)f:A{\arrow}A)(x:A),
                        EqSt (iterate f (f x))
                             (map f (iterate f x)).
 Proof.
@@ -3503,13 +3584,13 @@ The following lemmas are straightforward applications
  of \texttt{discriminate} and \citecoq{injection}:
 
 \begin{alltt}
-Lemma Lnil_not_Lcons : {\prodsym} (A:Set)(a:A)(l:LList A),
+Lemma Lnil_not_Lcons : {\prodsym} (A:Type)(a:A)(l:LList A),
                                LNil {\coqdiff} (LCons a l).
 Proof.
  intros;discriminate.
 Qed.
 
-Lemma injection_demo : {\prodsym} (A:Set)(a b : A)(l l': LList A),
+Lemma injection_demo : {\prodsym} (A:Type)(a b : A)(l l': LList A),
                        LCons a (LCons b l) = LCons b (LCons a l') {\arrow}
                        a = b {\coqand} l = l'.
 Proof.
@@ -3522,23 +3603,23 @@ In order to show \citecoq{inversion} at work, let us define
 two predicates on lazy lists:
 
 \begin{alltt}
-Inductive Finite (A:Set) : LList A {\arrow} Prop :=
+Inductive Finite (A:Type) : LList A {\arrow} Prop :=
 |  Lnil_fin : Finite (LNil (A:=A))
 |  Lcons_fin : {\prodsym} a l, Finite l {\arrow} Finite (LCons a l).
 
-CoInductive Infinite  (A:Set) : LList A {\arrow} Prop :=
+CoInductive Infinite  (A:Type) : LList A {\arrow} Prop :=
 | LCons_inf : {\prodsym} a l, Infinite l {\arrow} Infinite (LCons a l).
 \end{alltt}
 
 \noindent
 First, two easy theorems:
 \begin{alltt}
-Lemma LNil_not_Infinite : {\prodsym} (A:Set), ~ Infinite (LNil (A:=A)).
+Lemma LNil_not_Infinite : {\prodsym} (A:Type), ~ Infinite (LNil (A:=A)).
 Proof.
   intros A H;inversion H.
 Qed.
 
-Lemma Finite_not_Infinite : {\prodsym} (A:Set)(l:LList A),
+Lemma Finite_not_Infinite : {\prodsym} (A:Type)(l:LList A),
                                 Finite l {\arrow} ~ Infinite l.
 Proof.
  intros A l H; elim H.
@@ -3555,7 +3636,7 @@ Notice the destructuration of \citecoq{l}, which allows us to
 apply  the constructor \texttt{LCons\_inf}, thus  satisfying
  the guard condition: 
 \begin{alltt}
-Lemma Not_Finite_Infinite : {\prodsym} (A:Set)(l:LList A),
+Lemma Not_Finite_Infinite : {\prodsym} (A:Type)(l:LList A),
                             ~ Finite l {\arrow} Infinite l.
 Proof.
  cofix H.
@@ -3570,8 +3651,8 @@ Proof.
 
 1 subgoal
   
-  H : forall (A : Set) (l : LList A), ~ Finite l -> Infinite l
-  A : Set
+  H : forall (A : Type) (l : LList A), ~ Finite l -> Infinite l
+  A : Type
   a : A
   l : LList A
   H0 : ~ Finite (LCons a l)
diff --git a/doc/RecTutorial/RecTutorial.v b/doc/RecTutorial/RecTutorial.v
index d79b85df..7bede173 100644
--- a/doc/RecTutorial/RecTutorial.v
+++ b/doc/RecTutorial/RecTutorial.v
@@ -1,3 +1,7 @@
+Check (forall A:Type, (exists x:A, forall (y:A), x <> y) -> 2 = 3).
+
+
+
 Inductive nat : Set := 
  | O : nat 
  | S : nat->nat.
@@ -31,10 +35,17 @@ Qed.
 
 Lemma zero_lt_three : 0 < 3.
 Proof.
- unfold lt.
  repeat constructor. 
 Qed.
 
+Print zero_lt_three.
+
+Inductive le'(n:nat):nat -> Prop :=
+ | le'_n : le' n n
+ | le'_S : forall p, le' (S n) p -> le' n p.
+
+Hint Constructors le'.
+
 
 Require Import List.
 
@@ -46,12 +57,15 @@ Check (nil (A:=nat)).
 
 Check (nil (A:= nat -> nat)).
 
-Check (fun A: Set => (cons (A:=A))).
+Check (fun A: Type => (cons (A:=A))).
 
 Check (cons 3 (cons 2 nil)).
 
+Check (nat :: bool ::nil).
 
+Check ((3<=4) :: True ::nil).
 
+Check (Prop::Set::nil).
 
 Require Import Bvector.
 
@@ -59,22 +73,10 @@ Print vector.
 
 Check (Vnil nat).
 
-Check (fun (A:Set)(a:A)=> Vcons _ a _ (Vnil _)).
+Check (fun (A:Type)(a:A)=> Vcons _ a _ (Vnil _)).
 
 Check (Vcons _ 5 _ (Vcons _ 3 _ (Vnil _))).
 
-
-
-
-
-
-
-
-
-
-
-
-
 Lemma eq_3_3 : 2 + 1 = 3.
 Proof.
  reflexivity.
@@ -151,10 +153,10 @@ Extraction max.
 
 
 
-Inductive tree(A:Set)   : Set :=
+Inductive tree(A:Type)   : Type :=
     node : A -> forest A -> tree A 
 with
-  forest (A: Set)    : Set := 
+  forest (A: Type)    : Type := 
     nochild  : forest A |
     addchild : tree A -> forest A -> forest A.
 
@@ -315,13 +317,13 @@ Proof.
 Qed.
 
 Definition Vtail_total 
-   (A : Set) (n : nat) (v : vector A n) : vector A (pred n):=
+   (A : Type) (n : nat) (v : vector A n) : vector A (pred n):=
 match v in (vector _ n0) return (vector A (pred n0)) with
 | Vnil => Vnil A
 | Vcons _ n0 v0 => v0
 end.
 
-Definition Vtail' (A:Set)(n:nat)(v:vector A n) : vector A (pred n).
+Definition Vtail' (A:Type)(n:nat)(v:vector A n) : vector A (pred n).
  intros A n v; case v.  
  simpl.
  exact (Vnil A).
@@ -461,9 +463,7 @@ Inductive ltree  (A:Set) : Set :=
 Inductive prop : Prop :=
  prop_intro : Prop -> prop.
 
-Lemma prop_inject: prop.
-Proof prop_intro prop.
-
+Check (prop_intro prop).
 
 Inductive ex_Prop  (P : Prop -> Prop) : Prop :=
   exP_intro : forall X : Prop, P X -> ex_Prop P.
@@ -492,27 +492,6 @@ because proofs can be eliminated only to build proofs
 
 *)
 
-(*
-Check (match prop_inject with (prop_intro P p) => P end).
-
-Error:
-Incorrect elimination of "prop_inject" in the inductive type  
-"prop", the return type has sort "Type" while it should be 
-"Prop"
-
-Elimination of an inductive object of sort "Prop"
-is not allowed on a predicate in sort "Type"
-because proofs can be eliminated only to build proofs
-
-*)
-Print prop_inject.
-
-(*
-prop_inject = 
-prop_inject = prop_intro prop (fun H : prop => H)
-     : prop
-*)
-
 
 Inductive  typ : Type := 
   typ_intro : Type -> typ. 
@@ -645,7 +624,7 @@ Qed.
  apply inj_pred with (n:= S n) (m := S m); assumption.
 Qed.
 
-Lemma list_inject : forall (A:Set)(a b :A)(l l':list A),
+Lemma list_inject : forall (A:Type)(a b :A)(l l':list A),
                      a :: b :: l = b :: a :: l' -> a = b /\ l = l'.
 Proof.
  intros A a b l l' e.
@@ -812,20 +791,20 @@ Fixpoint nat_double_ind (n m:nat){struct n} : P n m :=
 End Principle_of_Double_Induction.
 
 Section Principle_of_Double_Recursion.
-Variable    P               : nat -> nat -> Set.
+Variable    P               : nat -> nat -> Type.
 Hypothesis  base_case1      : forall x:nat, P 0 x.
 Hypothesis  base_case2      : forall x:nat, P (S x) 0.
 Hypothesis  inductive_step   : forall n m:nat, P n m -> P (S n) (S m).
-Fixpoint nat_double_rec (n m:nat){struct n} : P n m := 
+Fixpoint nat_double_rect (n m:nat){struct n} : P n m := 
   match n, m return P n m with 
          |   0 ,     x    =>  base_case1 x 
          |  (S x),    0   => base_case2 x
-         |  (S x), (S y)  => inductive_step x y (nat_double_rec x y)
+         |  (S x), (S y)  => inductive_step x y (nat_double_rect x y)
      end.
 End Principle_of_Double_Recursion.
 
 Definition min : nat -> nat -> nat  := 
-  nat_double_rec (fun (x y:nat) => nat)
+  nat_double_rect (fun (x y:nat) => nat)
                  (fun (x:nat) => 0)
                  (fun (y:nat) => 0)
                  (fun (x y r:nat) => S r).
@@ -846,10 +825,10 @@ Qed.
 Definition eq_nat_dec : forall n p:nat , {n=p}+{n <> p}.
 Proof.
  intros n p.
- apply nat_double_rec with (P:= fun (n q:nat) => {q=p}+{q <> p}).
+ apply nat_double_rect with (P:= fun (n q:nat) => {q=p}+{q <> p}).
 Undo.
  pattern p,n.
- elim n using nat_double_rec.
+ elim n using nat_double_rect.
  destruct x; auto.
  destruct x; auto.
  intros n0 m H; case H.
@@ -861,6 +840,28 @@ Definition eq_nat_dec' : forall n p:nat, {n=p}+{n <> p}.
  decide equality.
 Defined.
 
+
+
+Require Import Le.
+Lemma le'_le : forall n p, le' n p -> n <= p.
+Proof.
+ induction 1;auto with arith.
+Qed.
+
+Lemma le'_n_Sp : forall n p, le' n p -> le' n (S p).
+Proof.
+ induction 1;auto.
+Qed.
+
+Hint Resolve le'_n_Sp.
+
+ 
+Lemma le_le' : forall n p, n<=p -> le' n p.
+Proof.
+ induction 1;auto with arith.
+Qed. 
+
+
 Print Acc.
 
 
@@ -968,13 +969,13 @@ let rec div_aux x y =
            | Right -> div_aux (minus x y) y)
 *)
 
-Lemma vector0_is_vnil : forall (A:Set)(v:vector A 0), v = Vnil A.
+Lemma vector0_is_vnil : forall (A:Type)(v:vector A 0), v = Vnil A.
 Proof.
  intros A v;inversion v.
 Abort.
 
 (*
- Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:vector A n), 
+ Lemma vector0_is_vnil_aux : forall (A:Type)(n:nat)(v:vector A n), 
                                   n= 0 -> v = Vnil A.
 
 Toplevel input, characters 40281-40287
@@ -990,7 +991,10 @@ The term "Vnil A" has type "vector A 0" while it is expected to have type
 *)
  Require Import JMeq.
 
-Lemma vector0_is_vnil_aux : forall (A:Set)(n:nat)(v:vector A n), 
+
+(* On devrait changer Set en Type ? *)
+
+Lemma vector0_is_vnil_aux : forall (A:Type)(n:nat)(v:vector A n), 
                                   n= 0 -> JMeq v (Vnil A).
 Proof.
  destruct v.
@@ -998,7 +1002,7 @@ Proof.
  intro; discriminate.
 Qed.
 
-Lemma vector0_is_vnil : forall (A:Set)(v:vector A 0), v = Vnil A.
+Lemma vector0_is_vnil : forall (A:Type)(v:vector A 0), v = Vnil A.
 Proof.
  intros a v;apply JMeq_eq.
  apply vector0_is_vnil_aux.
@@ -1011,20 +1015,20 @@ Implicit Arguments Vnil [A].
 Implicit Arguments Vhead [A n].
 Implicit Arguments Vtail [A n].
 
-Definition Vid : forall (A : Set)(n:nat), vector A n -> vector A n.
+Definition Vid : forall (A : Type)(n:nat), vector A n -> vector A n.
 Proof.
  destruct n; intro v.
  exact Vnil.
  exact (Vcons  (Vhead v) (Vtail v)).
 Defined.
 
-Eval simpl in (fun (A:Set)(v:vector A 0) => (Vid _ _ v)).
+Eval simpl in (fun (A:Type)(v:vector A 0) => (Vid _ _ v)).
 
-Eval simpl in (fun (A:Set)(v:vector A 0) => v).
+Eval simpl in (fun (A:Type)(v:vector A 0) => v).
 
 
 
-Lemma Vid_eq : forall (n:nat) (A:Set)(v:vector A n), v=(Vid _ n v).
+Lemma Vid_eq : forall (n:nat) (A:Type)(v:vector A n), v=(Vid _ n v).
 Proof.
  destruct v. 
  reflexivity.
@@ -1040,7 +1044,7 @@ Defined.
 
 
 Theorem decomp :
-  forall (A : Set) (n : nat) (v : vector A (S n)),
+  forall (A : Type) (n : nat) (v : vector A (S n)),
   v = Vcons (Vhead v) (Vtail v).
 Proof.
  intros.
@@ -1051,7 +1055,7 @@ Defined.
 
 
 Definition vector_double_rect : 
-    forall (A:Set) (P: forall (n:nat),(vector A n)->(vector A n) -> Type),
+    forall (A:Type) (P: forall (n:nat),(vector A n)->(vector A n) -> Type),
         P 0 Vnil Vnil ->
         (forall n (v1 v2 : vector A n) a b, P n v1 v2 ->
              P (S n) (Vcons a v1) (Vcons  b v2)) ->
@@ -1071,7 +1075,7 @@ Definition bitwise_or n v1 v2 : vector bool n :=
                         (fun n v1 v2 a b r => Vcons (orb a b) r) n v1 v2.
 
 
-Fixpoint vector_nth (A:Set)(n:nat)(p:nat)(v:vector A p){struct v}
+Fixpoint vector_nth (A:Type)(n:nat)(p:nat)(v:vector A p){struct v}
                   : option A :=
   match n,v  with
     _   , Vnil => None
@@ -1097,10 +1101,10 @@ Qed.
 
  Set Implicit Arguments.
 
- CoInductive Stream (A:Set) : Set   :=
+ CoInductive Stream (A:Type) : Type   :=
  |  Cons : A -> Stream A -> Stream A.
 
- CoInductive LList (A: Set) : Set :=
+ CoInductive LList (A: Type) : Type :=
  |  LNil : LList A
  |  LCons : A -> LList A -> LList A.
 
@@ -1108,25 +1112,25 @@ Qed.
  
 
 
- Definition head (A:Set)(s : Stream A) := match s with Cons a s' => a end.
+ Definition head (A:Type)(s : Stream A) := match s with Cons a s' => a end.
 
- Definition tail (A : Set)(s : Stream A) :=
+ Definition tail (A : Type)(s : Stream A) :=
       match s with Cons a s' => s' end.
 
- CoFixpoint repeat (A:Set)(a:A) : Stream A := Cons a (repeat a).
+ CoFixpoint repeat (A:Type)(a:A) : Stream A := Cons a (repeat a).
 
- CoFixpoint iterate (A: Set)(f: A -> A)(a : A) : Stream A:=
+ CoFixpoint iterate (A: Type)(f: A -> A)(a : A) : Stream A:=
     Cons a (iterate f (f a)).
 
- CoFixpoint map (A B:Set)(f: A -> B)(s : Stream A) : Stream B:=
+ CoFixpoint map (A B:Type)(f: A -> B)(s : Stream A) : Stream B:=
   match s with Cons a tl => Cons (f a) (map f tl) end.
 
-Eval simpl in (fun (A:Set)(a:A) => repeat a).
+Eval simpl in (fun (A:Type)(a:A) => repeat a).
 
-Eval simpl in (fun (A:Set)(a:A) => head (repeat a)).
+Eval simpl in (fun (A:Type)(a:A) => head (repeat a)).
 
 
-CoInductive EqSt (A: Set) : Stream A -> Stream A -> Prop :=
+CoInductive EqSt (A: Type) : Stream A -> Stream A -> Prop :=
   eqst : forall s1 s2: Stream A,
       head s1 = head s2 ->
       EqSt (tail s1) (tail s2) ->
@@ -1134,7 +1138,7 @@ CoInductive EqSt (A: Set) : Stream A -> Stream A -> Prop :=
 
 
 Section Parks_Principle.
-Variable A : Set.
+Variable A : Type.
 Variable    R      : Stream A -> Stream A -> Prop.
 Hypothesis  bisim1 : forall s1 s2:Stream A, R s1 s2 ->
                                           head s1 = head s2.
@@ -1149,7 +1153,7 @@ CoFixpoint park_ppl     : forall s1 s2:Stream A, R s1 s2 ->
 End Parks_Principle.
 
 
-Theorem map_iterate : forall (A:Set)(f:A->A)(x:A),
+Theorem map_iterate : forall (A:Type)(f:A->A)(x:A),
                        EqSt (iterate f (f x)) (map f (iterate f x)).
 Proof.
  intros A f x.
@@ -1167,7 +1171,7 @@ Ltac infiniteproof f :=
   cofix f; constructor; [clear f| simpl; try (apply f; clear f)].
 
 
-Theorem map_iterate' : forall (A:Set)(f:A->A)(x:A),
+Theorem map_iterate' : forall (A:Type)(f:A->A)(x:A),
                        EqSt (iterate f (f x)) (map f (iterate f x)).
 infiniteproof map_iterate'.
  reflexivity.
@@ -1176,12 +1180,12 @@ Qed.
 
 Implicit Arguments LNil [A].
 
-Lemma Lnil_not_Lcons : forall (A:Set)(a:A)(l:LList A),
+Lemma Lnil_not_Lcons : forall (A:Type)(a:A)(l:LList A),
                                LNil <> (LCons a l).
  intros;discriminate.
 Qed.
 
-Lemma injection_demo : forall (A:Set)(a b : A)(l l': LList A),
+Lemma injection_demo : forall (A:Type)(a b : A)(l l': LList A),
                        LCons a (LCons b l) = LCons b (LCons a l') ->
                        a = b /\ l = l'.
 Proof.
@@ -1189,19 +1193,19 @@ Proof.
 Qed.
 
 
-Inductive Finite (A:Set) : LList A -> Prop :=
+Inductive Finite (A:Type) : LList A -> Prop :=
 |  Lnil_fin : Finite (LNil (A:=A))
 |  Lcons_fin : forall a l, Finite l -> Finite (LCons a l).
 
-CoInductive Infinite  (A:Set) : LList A -> Prop :=
+CoInductive Infinite  (A:Type) : LList A -> Prop :=
 | LCons_inf : forall a l, Infinite l -> Infinite (LCons a l).
 
-Lemma LNil_not_Infinite : forall (A:Set), ~ Infinite (LNil (A:=A)).
+Lemma LNil_not_Infinite : forall (A:Type), ~ Infinite (LNil (A:=A)).
 Proof.
   intros A H;inversion H.
 Qed.
 
-Lemma Finite_not_Infinite : forall (A:Set)(l:LList A),
+Lemma Finite_not_Infinite : forall (A:Type)(l:LList A),
                                 Finite l -> ~ Infinite l.
 Proof.
  intros A l H; elim H.
@@ -1211,7 +1215,7 @@ Proof.
  trivial.
 Qed.
 
-Lemma Not_Finite_Infinite : forall (A:Set)(l:LList A),
+Lemma Not_Finite_Infinite : forall (A:Type)(l:LList A),
                             ~ Finite l -> Infinite l.
 Proof.
  cofix H.
@@ -1226,4 +1230,3 @@ Qed.
 
 
 
-
diff --git a/doc/refman/Polynom.tex b/doc/refman/Polynom.tex
index 70889c9d..30dfa93d 100644
--- a/doc/refman/Polynom.tex
+++ b/doc/refman/Polynom.tex
@@ -1,10 +1,13 @@
 \achapter{The \texttt{ring} tactic}
-\aauthor{Patrick Loiseleur and Samuel Boutin}
+\aauthor{Bruno Barras, Benjamin Gr\'egoire and Assia
+  Mahboubi\footnote{based on previous work from
+  Patrick Loiseleur and Samuel Boutin}}
 \label{ring}
 \tacindex{ring}
 
 This chapter presents  the \texttt{ring} tactic.
 
+
 \asection{What does this tactic?}
 
 \texttt{ring} does associative-commutative rewriting in ring and semi-ring
@@ -14,20 +17,21 @@ $\otimes$, and two constants 0 and 1 that are unities for $\oplus$ and
 $\otimes$. A \textit{polynomial} is an expression built on variables $V_0, V_1,
 \dots$ and constants by application of $\oplus$ and $\otimes$.
 
-Let an {\it ordered product} be a product of variables $V_{i_1} \otimes
-\ldots \otimes V_{i_n}$ verifying $i_1 \le i_2 \le \dots \le i_n$. Let a
-\textit{monomial} be the product of a constant (possibly equal to 1, in
-which case we omit it) and an ordered product.  We can order the
-monomials by the lexicographic order on products of variables. Let a
-\textit{canonical sum} be an ordered sum of monomials that are all
-different, i.e. each monomial in the sum is strictly less than the
-following monomial according to the lexicographic order. It is an easy
-theorem to show that every polynomial is equivalent (modulo the ring
-properties) to exactly one canonical sum. This canonical sum is called
-the \textit{normal form} of the polynomial. So what does \texttt{ring}? It
-normalizes polynomials over any ring or semi-ring structure. The basic
-use of \texttt{ring} is to simplify ring expressions, so that the user
-does not have to deal manually with the theorems of associativity and
+Let an {\it ordered product} be a product of variables $V_{i_1}
+\otimes \ldots \otimes V_{i_n}$ verifying $i_1 \le i_2 \le \dots \le
+i_n$. Let a \textit{monomial} be the product of a constant and an
+ordered product.  We can order the monomials by the lexicographic
+order on products of variables. Let a \textit{canonical sum} be an
+ordered sum of monomials that are all different, i.e. each monomial in
+the sum is strictly less than the following monomial according to the
+lexicographic order. It is an easy theorem to show that every
+polynomial is equivalent (modulo the ring properties) to exactly one
+canonical sum. This canonical sum is called the \textit{normal form}
+of the polynomial. In fact, the actual representation shares monomials
+with same prefixes. So what does \texttt{ring}? It normalizes
+polynomials over any ring or semi-ring structure. The basic use of
+\texttt{ring} is to simplify ring expressions, so that the user does
+not have to deal manually with the theorems of associativity and
 commutativity.
 
 \begin{Examples}
@@ -55,7 +59,7 @@ expression in the \gallina\ language. For example in the ring
 \end{verbatim}
 \end{quotation}
 
-\noindent As a ring expression, is has 3 subterms. Give each subterm a
+\noindent As a ring expression, it has 3 subterms. Give each subterm a
 number in an arbitrary order:
 
 \begin{tabular}{ccl}
@@ -90,64 +94,339 @@ this paragraph and use the tactic according to your intuition.
 
 \asection{Concrete usage in \Coq}
 
-Under a session launched by \texttt{coqtop} or \texttt{coqtop -full},
-load the \texttt{ring} files with the command:
+The {\tt ring} tactic solves equations upon polynomial expressions of
+a ring (or semi-ring) structure. It proceeds by normalizing both hand
+sides of the equation (w.r.t. associativity, commutativity and
+distributivity, constant propagation) and comparing syntactically the
+results.
+
+{\tt ring\_simplify} applies the normalization procedure described
+above to the terms given. The tactic then replaces all occurrences of
+the terms given in the conclusion of the goal by their normal
+forms. If no term is given, then the conclusion should be an equation
+and both hand sides are normalized.
+
+The tactic must be loaded by \texttt{Require Import Ring}. The ring
+structures must be declared with the \texttt{Add Ring} command (see
+below). The ring of booleans is predefined; if one wants to use the
+tactic on \texttt{nat} one must first require the module
+\texttt{ArithRing}; for \texttt{Z}, do \texttt{Require Import
+ZArithRing}; for \texttt{N}, do \texttt{Require Import
+NArithRing}.
+
+\Example
+\begin{coq_eval}
+Reset Initial.
+Require Import ZArith.
+Open Scope Z_scope.
+\end{coq_eval}
+\begin{coq_example}
+Require Import ZArithRing.
+Goal forall a b c:Z,
+  (a + b + c) * (a + b + c) =
+  a * a + b * b + c * c + 2 * a * b + 2 * a * c + 2 * b * c.
+\end{coq_example}
+\begin{coq_example}
+intros; ring.
+\end{coq_example}
+\begin{coq_eval}
+Reset Initial.
+\end{coq_eval}
 
-\begin{quotation}
+\Warning \texttt{ring\_simplify $term_1$; ring\_simplify $term_2$} is
+not equivalent to \texttt{ring\_simplify $term_1$ $term_2$}. In the
+latter case the variables map is shared between the two terms, and
+common subterm $t$ of $term_1$ and $term_2$ will have the same
+associated variable number. So the first alternative should be
+avoided for terms belonging to the same ring theory.
+
+\begin{ErrMsgs}
+\item \errindex{not a valid ring equation}
+  The conclusion of the goal is not provable in the corresponding ring
+  theory.
+\item \errindex{arguments of ring\_simplify do not have all the same type}
+  {\tt ring\_simplify} cannot simplify terms of several rings at the
+  same time. Invoke the tactic once per ring structure.
+\item \errindex{cannot find a declared ring structure over {\tt term}}
+  No ring has been declared for the type of the terms to be
+  simplified. Use {\tt Add Ring} first.
+\item \errindex{cannot find a declared ring structure for equality
+  {\tt term}}
+  Same as above is the case of the {\tt ring} tactic.
+\end{ErrMsgs}
+
+\asection{Adding a ring structure}
+
+Declaring a new ring consists in proving that a ring signature (a
+carrier set, an equality, and ring operations: {\tt
+Ring\_theory.ring\_theory} and {\tt Ring\_theory.semi\_ring\_theory})
+satisfies the ring axioms. Semi-rings (rings without $+$ inverse) are
+also supported. The equality can be either Leibniz equality, or any
+relation declared as a setoid (see~\ref{setoidtactics}). The definition
+of ring and semi-rings (see module {\tt Ring\_theory}) is:
 \begin{verbatim}
-Require Ring.
+ Record ring_theory : Prop := mk_rt {
+    Radd_0_l    : forall x, 0 + x == x;
+    Radd_sym    : forall x y, x + y == y + x;
+    Radd_assoc  : forall x y z, x + (y + z) == (x + y) + z;
+    Rmul_1_l    : forall x, 1 * x == x;
+    Rmul_sym    : forall x y, x * y == y * x;
+    Rmul_assoc  : forall x y z, x * (y * z) == (x * y) * z;
+    Rdistr_l    : forall x y z, (x + y) * z == (x * z) + (y * z);
+    Rsub_def    : forall x y, x - y == x + -y;
+    Ropp_def    : forall x, x + (- x) == 0
+ }.
+
+Record semi_ring_theory : Prop := mk_srt {
+    SRadd_0_l   : forall n, 0 + n == n;
+    SRadd_sym   : forall n m, n + m == m + n ;
+    SRadd_assoc : forall n m p, n + (m + p) == (n + m) + p;
+    SRmul_1_l   : forall n, 1*n == n;
+    SRmul_0_l   : forall n, 0*n == 0; 
+    SRmul_sym   : forall n m, n*m == m*n;
+    SRmul_assoc : forall n m p, n*(m*p) == (n*m)*p;
+    SRdistr_l   : forall n m p, (n + m)*p == n*p + m*p
+  }.
 \end{verbatim}
-\end{quotation}
 
-It does not work under \texttt{coqtop -opt} because the compiled ML
-objects used by the tactic are not linked in this binary image, and
-dynamic loading of native code is not possible in \ocaml.
+This implementation of {\tt ring} also features a notion of constant
+that can be parameterized. This can be used to improve the handling of
+closed expressions when operations are effective. It consists in
+introducing a type of \emph{coefficients} and an implementation of the
+ring operations, and a morphism from the coefficient type to the ring
+carrier type. The morphism needs not be injective, nor surjective.  As
+an example, one can consider the real numbers. The set of coefficients
+could be the rational numbers, upon which the ring operations can be
+implemented. The fact that there exists a morphism is defined by the
+following properties:
+\begin{verbatim}
+ Record ring_morph : Prop := mkmorph {
+    morph0    : [cO] == 0;
+    morph1    : [cI] == 1;
+    morph_add : forall x y, [x +! y] == [x]+[y];
+    morph_sub : forall x y, [x -! y] == [x]-[y];
+    morph_mul : forall x y, [x *! y] == [x]*[y];
+    morph_opp : forall x, [-!x] == -[x];
+    morph_eq  : forall x y, x?=!y = true -> [x] == [y] 
+  }.
+
+ Record semi_morph : Prop := mkRmorph {
+    Smorph0 : [cO] == 0;
+    Smorph1 : [cI] == 1;
+    Smorph_add : forall x y, [x +! y] == [x]+[y];
+    Smorph_mul : forall x y, [x *! y] == [x]*[y];
+    Smorph_eq  : forall x y, x?=!y = true -> [x] == [y] 
+  }.
+\end{verbatim}
+where {\tt c0} and {\tt cI} denote the 0 and 1 of the coefficient set,
+{\tt +!}, {\tt *!}, {\tt -!} are the implementations of the ring
+operations, {\tt ==} is the equality of the coefficients, {\tt ?+!} is
+an implementation of this equality, and {\tt [x]} is a notation for
+the image of {\tt x} by the ring morphism.
+
+Since {\tt Z} is an initial ring (and {\tt N} is an initial
+semi-ring), it can always be considered as a set of
+coefficients. There are basically three kinds of (semi-)rings:
+\begin{description}
+\item[abstract rings] to be used when operations are not
+  effective. The set of coefficients is {\tt Z} (or {\tt N} for
+  semi-rings).
+\item[computational rings] to be used when operations are
+  effective. The set of coefficients is the ring itself. The user only
+  has to provide an implementation for the equality.
+\item[customized ring] for other cases. The user has to provide the
+  coefficient set and the morphism.
+\end{description}
+
+The syntax for adding a new ring is {\tt Add Ring $name$ : $ring$
+($mod_1$,\dots,$mod_2$)}.  The name is not relevent. It is just used
+for error messages. $ring$ is a proof that the ring signature
+satisfies the (semi-)ring axioms. The optional list of modifiers is
+used to tailor the behaviour of the tactic. The following list
+describes their syntax and effects:
+\begin{description}
+\item[abstract] declares the ring as abstract. This is the default.
+\item[decidable \term] declares the ring as computational. \term{} is
+  the correctness proof of an equality test {\tt ?=!}. Its type should be of
+  the form {\tt forall x y, x?=!y = true $\rightarrow$ x == y}.
+\item[morphism \term] declares the ring as a customized one. \term{} is
+  a proof that there exists a morphism between a set of coefficient
+  and the ring carrier (see {\tt Ring\_theory.ring\_morph} and {\tt
+  Ring\_theory.semi\_morph}).
+\item[setoid \term$_1$ \term$_2$] forces the use of given
+  setoid. \term$_1$ is a proof that the equality is indeed a setoid
+  (see {\tt Setoid.Setoid\_Theory}), and \term$_2$ a proof that the
+  ring operations are morphisms (see {\tt Ring\_theory.ring\_eq\_ext} and
+  {\tt Ring\_theory.sring\_eq\_ext}). This modifier needs not be used if the
+  setoid and morphisms have been declared.
+\item[constants [\ltac]] specifies a tactic expression that, given a term,
+  returns either an object of the coefficient set that is mapped to
+  the expression via the morphism, or returns {\tt
+  Ring\_tac.NotConstant}. Abstract (semi-)rings need not define this.
+\item[preprocess [\ltac]]
+  specifies a tactic that is applied as a preliminary step for {\tt
+  ring} and {\tt ring\_simplify}. It can be used to transform a goal
+  so that it is better recognized. For instance, {\tt S n} can be
+  changed to {\tt plus 1 n}.
+\item[postprocess [\ltac]] specifies a tactic that is applied as a final step
+  for {\tt ring\_simplify}. For instance, it can be used to undo
+  modifications of the preprocessor.
+\end{description}
 
-In order to use \texttt{ring} on naturals, load \texttt{ArithRing}
-instead; for binary integers, load the module \texttt{ZArithRing}.
 
-Then, to normalize the terms $term_1$, \dots, $term_n$ in
-the current subgoal, use the tactic:
+\begin{ErrMsgs}
+\item \errindex{bad ring structure}
+  The proof of the ring structure provided is not of the expected type.
+\item \errindex{bad lemma for decidability of equality}
+  The equality function provided in the case of a computational ring
+  has not the expected type.
+\item \errindex{ring {\it operation} should be declared as a morphism}
+  A setoid associated to the carrier of the ring structure as been
+  found, but the ring operation should be declared as
+  morphism. See~\ref{setoidtactics}.
+\end{ErrMsgs}
 
-\begin{quotation}
-\texttt{ring} $term_1$ \dots{} $term_n$
-\end{quotation}
-\tacindex{ring}
+\asection{How does it work?}
 
-Then the tactic guesses the type of given terms, the ring theory to
-use, the variables map, and replace each term with its normal form.
-The variables map is common to all terms
+The code of \texttt{ring} is a good example of tactic written using
+\textit{reflection}.  What is reflection? Basically, it is writing
+\Coq{} tactics in \Coq, rather than in \ocaml. From the philosophical
+point of view, it is using the ability of the Calculus of
+Constructions to speak and reason about itself.  For the \texttt{ring}
+tactic we used \Coq\ as a programming language and also as a proof
+environment to build a tactic and to prove it correctness.
 
-\Warning \texttt{ring $term_1$; ring $term_2$} is not equivalent to 
-\texttt{ring $term_1$ $term_2$}. In the latter case the variables map
-is shared between the two terms, and common subterm $t$ of $term_1$
-and $term_2$ will have the same associated variable number.
+The interested reader is strongly advised to have a look at the file
+\texttt{Ring\_polynom.v}. Here a type for polynomials is defined: 
 
-\begin{ErrMsgs}
-\item \errindex{All terms must have the same type}
-\item \errindex{Don't know what to do with this goal}
-\item \errindex{No Declared Ring Theory for \term.}
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Inductive PExpr : Type :=
+  | PEc : C -> PExpr
+  | PEX : positive -> PExpr
+  | PEadd : PExpr -> PExpr -> PExpr
+  | PEsub : PExpr -> PExpr -> PExpr
+  | PEmul : PExpr -> PExpr -> PExpr
+  | PEopp : PExpr -> PExpr.
+\end{verbatim}
+\end{flushleft}
+\end{small}
 
-  \texttt{Use Add [Semi] Ring to declare it}
+Polynomials in normal form are defined as:
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+ Inductive Pol : Type :=
+  | Pc : C -> Pol 
+  | Pinj : positive -> Pol -> Pol                   
+  | PX : Pol -> positive -> Pol -> Pol.
+\end{verbatim}
+\end{flushleft}
+\end{small}
+where {\tt Pinj n P} denotes $P$ in which $V_i$ is replaced by
+$V_{i+n}$, and {\tt PX P n Q} denotes $P \otimes V_1^{n} \oplus Q'$,
+$Q'$ being $Q$ where $V_i$ is replaced by $V_{i+1}$. 
 
-  That happens when all terms have the same type \term, but there is
-  no declared ring theory for this set. See below.
-\end{ErrMsgs}
 
-\begin{Variants}
-\item \texttt{ring}
+Variables maps are represented by list of ring elements, and two
+interpretation functions, one that maps a variables map and a
+polynomial to an element of the concrete ring, and the second one that
+does the same for normal forms:
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Definition PEeval : list R -> PExpr -> R := [...].
+Definition Pphi_dev : list R -> Pol -> R := [...].
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+A function to normalize polynomials is defined, and the big theorem is
+its correctness w.r.t interpretation, that is:
+
+\begin{small}
+\begin{flushleft}
+\begin{verbatim}
+Definition norm : PExpr -> Pol := [...].
+Lemma Pphi_dev_ok :
+   forall l pe npe, norm pe = npe -> PEeval l pe == Pphi_dev l npe.
+\end{verbatim}
+\end{flushleft}
+\end{small}
+
+So now, what is the scheme for a normalization proof? Let \texttt{p}
+be the polynomial expression that the user wants to normalize. First a
+little piece of ML code guesses the type of \texttt{p}, the ring
+theory \texttt{T} to use, an abstract polynomial \texttt{ap} and a
+variables map \texttt{v} such that \texttt{p} is
+$\beta\delta\iota$-equivalent to \verb|(PEeval v ap)|. Then we
+replace it by \verb|(Pphi_dev v (norm ap))|, using the
+main correctness theorem and we reduce it to a concrete expression
+\texttt{p'}, which is the concrete normal form of
+\texttt{p}. This is summarized in this diagram:
+\begin{center}
+\begin{tabular}{rcl}
+\texttt{p} & $\rightarrow_{\beta\delta\iota}$  
+   & \texttt{(PEeval v ap)} \\
+ & & $=_{\mathrm{(by\ the\ main\ correctness\ theorem)}}$ \\
+\texttt{p'} 
+   & $\leftarrow_{\beta\delta\iota}$ 
+   & \texttt{(Pphi\_dev v (norm ap))}
+\end{tabular}
+\end{center}
+The user do not see the right part of the diagram. 
+From outside, the tactic behaves like a
+$\beta\delta\iota$ simplification extended with AC rewriting rules.
+Basically, the proof is only the application of the main
+correctness theorem to well-chosen arguments.
+
+
+\asection{Legacy implementation}
 
-  That works if the current goal is an equality between two
-  polynomials. It will normalize both sides of the
-  equality, solve it if the normal forms are equal and in other cases
-  try to simplify the equality using \texttt{congr\_eqT} and \texttt{refl\_equal}
-  to reduce $x + y = x + z$ to $y = z$ and $x * z = x * y$ to $y = z$.
+\Warning This tactic is the {\tt ring} tactic of previous versions of
+\Coq{} and it should be considered as deprecated. It will probably be
+removed in future releases. It has been kept only for compatibility
+reasons and in order to help moving existing code to the newer
+implementation described above. For more details, please refer to the
+Coq Reference Manual, version 8.0.
 
-  \ErrMsg\errindex{This goal is not an equality}
+
+\subsection{\tt legacy ring \term$_1$ \dots\ \term$_n$
+\tacindex{legacy ring}
+\comindex{Add Legacy Ring}
+\comindex{Add Legacy Semi Ring}}
+
+This tactic, written by Samuel Boutin and Patrick Loiseleur, applies
+associative commutative rewriting on every ring.  The tactic must be
+loaded by \texttt{Require Import LegacyRing}. The ring must be declared in
+the \texttt{Add Ring} command. The ring of booleans
+is predefined; if one wants to use the tactic on \texttt{nat} one must
+first require the module \texttt{LegacyArithRing}; for \texttt{Z}, do
+\texttt{Require Import LegacyZArithRing}; for \texttt{N}, do \texttt{Require
+Import LegacyNArithRing}.
+
+The terms \term$_1$, \dots, \term$_n$ must be subterms of the goal
+conclusion. The tactic \texttt{ring} normalizes these terms
+w.r.t. associativity and commutativity and replace them by their
+normal form.
+
+\begin{Variants}
+\item \texttt{legacy ring} When the goal is an equality $t_1=t_2$, it
+  acts like \texttt{ring\_simplify} $t_1$ $t_2$ and then
+  solves the equality by reflexivity.
+
+\item \texttt{ring\_nat} is a tactic macro for \texttt{repeat rewrite
+    S\_to\_plus\_one; ring}. The theorem \texttt{S\_to\_plus\_one} is a
+  proof that \texttt{forall (n:nat), S n = plus (S O) n}.
 
 \end{Variants}
 
-\asection{Add a ring structure}
+You can have a look at the files \texttt{LegacyRing.v},
+\texttt{ArithRing.v}, \texttt{ZArithRing.v} to see examples of the
+\texttt{Add Ring} command.
+
+\subsection{Add a ring structure}
 
 It can be done in the \Coq toplevel (No ML file to edit and to link
 with \Coq). First, \texttt{ring} can handle two kinds of structure:
@@ -242,9 +521,9 @@ constructor.
 
 Finally to register a ring the syntax is:
 
-\comindex{Add Ring}
+\comindex{Add Legacy Ring}
 \begin{quotation}
-  \texttt{Add Ring} \textit{A Aplus Amult Aone Azero Ainv Aeq T}
+  \texttt{Add Legacy Ring} \textit{A Aplus Amult Aone Azero Ainv Aeq T}
   \texttt{[} \textit{c1 \dots cn} \texttt{].}
 \end{quotation}
 
@@ -267,8 +546,8 @@ and \texttt{O}, and the closed terms are \texttt{O}, \texttt{(S O)},
 \texttt{(S (S O))}, \ldots
 
 \begin{Variants}
-\item \texttt{Add Semi Ring} \textit{A Aplus Amult Aone Azero Aeq T} 
-  \texttt{[} \textit{c1 \dots\ cn} \texttt{].}\comindex{Add Semi
+\item \texttt{Add Legacy Semi Ring} \textit{A Aplus Amult Aone Azero Aeq T} 
+  \texttt{[} \textit{c1 \dots\ cn} \texttt{].}\comindex{Add Legacy Semi
     Ring}
   
   There are two differences with the \texttt{Add Ring} command: there
@@ -276,8 +555,8 @@ and \texttt{O}, and the closed terms are \texttt{O}, \texttt{(S O)},
   \texttt{(Semi\_Ring\_Theory }\textit{A Aplus Amult Aone Azero
     Aeq}\texttt{)}.
 
-\item \texttt{Add Abstract Ring} \textit{A Aplus Amult Aone Azero Ainv 
-    Aeq T}\texttt{.}\comindex{Add Abstract Ring}
+\item \texttt{Add Legacy Abstract Ring} \textit{A Aplus Amult Aone Azero Ainv 
+    Aeq T}\texttt{.}\comindex{Add Legacy Abstract Ring}
   
   This command should be used for when the operations of rings are not
   computable; for example the real numbers of
@@ -286,8 +565,8 @@ and \texttt{O}, and the closed terms are \texttt{O}, \texttt{(S O)},
   axioms. The argument \texttt{Aeq} is not used; a good choice for
   that function is \verb+[x:A]false+.
 
-\item \texttt{Add Abstract Semi Ring} \textit{A Aplus Amult Aone Azero
-    Aeq T}\texttt{.}\comindex{Add Abstract Semi Ring}
+\item \texttt{Add Legacy Abstract Semi Ring} \textit{A Aplus Amult Aone Azero
+    Aeq T}\texttt{.}\comindex{Add Legacy Abstract Semi Ring}
 
 \end{Variants}
 
@@ -318,90 +597,6 @@ booleans.
 load the module \texttt{ArithRing}, and for \texttt{Z},
 load the module \texttt{ZArithRing}.
 
-
-\asection{How does it work?}
-
-The code of \texttt{ring} is a good example of tactic written using
-\textit{reflection} (or \textit{internalization}, it is synonymous).
-What is reflection? Basically, it is writing \Coq{} tactics in \Coq,
-rather than in \ocaml. From the philosophical point of view, it is
-using the ability of the Calculus of Constructions to speak and reason
-about itself.  For the \texttt{ring} tactic we used \Coq\ as a
-programming language and also as a proof environment to build a tactic
-and to prove it correctness.
-
-The interested reader is strongly advised to have a look at the file
-\texttt{Ring\_normalize.v}. Here a type for polynomials is defined: 
-
-\begin{small}
-\begin{flushleft}
-\begin{verbatim}
-Inductive Type polynomial := 
-  Pvar : idx -> polynomial
-| Pconst : A -> polynomial
-| Pplus : polynomial -> polynomial -> polynomial
-| Pmult : polynomial -> polynomial -> polynomial
-| Popp : polynomial -> polynomial.
-\end{verbatim}
-\end{flushleft}
-\end{small}
-
-There is also a type to represent variables maps, and an
-interpretation function, that maps a variables map and a polynomial to an
-element of the concrete ring:
-
-\begin{small}
-\begin{flushleft}
-\begin{verbatim}
-Definition polynomial_simplify := [...]
-Definition interp : (varmap A) -> (polynomial A) -> A := [...]
-\end{verbatim}
-\end{flushleft}
-\end{small}
-
-A function to normalize polynomials is defined, and the big theorem is
-its correctness w.r.t interpretation, that is:
-
-\begin{small}
-\begin{flushleft}
-\begin{verbatim}
-Theorem polynomial_simplify_correct : forall (v:(varmap A))(p:polynomial)
-  (interp v (polynomial_simplify p))
-  =(interp v p).
-\end{verbatim}
-\end{flushleft}
-\end{small}
-
-(The actual code is slightly more complex: for efficiency,
-there is a special datatype to represent normalized polynomials,
-i.e. ``canonical sums''. But the idea is still the same).
-
-So now, what is the scheme for a normalization proof? Let \texttt{p}
-be the polynomial expression that the user wants to normalize. First a
-little piece of ML code guesses the type of \texttt{p}, the ring
-theory \texttt{T} to use, an abstract polynomial \texttt{ap} and a
-variables map \texttt{v} such that \texttt{p} is
-$\beta\delta\iota$-equivalent to \verb|(interp v ap)|. Then we
-replace it by \verb|(interp v (polynomial_simplify ap))|, using the
-main correctness theorem and we reduce it to a concrete expression
-\texttt{p'}, which is the concrete normal form of
-\texttt{p}. This is summarized in this diagram:
-\begin{center}
-\begin{tabular}{rcl}
-\texttt{p} & $\rightarrow_{\beta\delta\iota}$  
-   & \texttt{(interp v ap)} \\
- & & $=_{\mathrm{(by\ the\ main\ correctness\ theorem)}}$ \\
-\texttt{p'} 
-   & $\leftarrow_{\beta\delta\iota}$ 
-   & \texttt{(interp v (polynomial\_simplify ap))}
-\end{tabular}
-\end{center}
-The user do not see the right part of the diagram. 
-From outside, the tactic behaves like a
-$\beta\delta\iota$ simplification extended with AC rewriting rules.
-Basically, the proof is only the application of the main
-correctness theorem to well-chosen arguments.
-
 \asection{History of \texttt{ring}}
 
 First Samuel Boutin designed the tactic \texttt{ACDSimpl}. 
@@ -463,40 +658,26 @@ The tactic \texttt{ring} is not only faster than a classical one:
 using reflection, we get for free integration of computation and
 reasoning that would be very complex to implement in the classic fashion.
 
-Is it the ultimate way to write tactics? 
-The answer is: yes and no. The \texttt{ring} tactic
-uses intensively the conversion
-rule of \CIC, that is replaces proof by computation the most as it is
+Is it the ultimate way to write tactics?  The answer is: yes and
+no. The \texttt{ring} tactic uses intensively the conversion rule of
+\CIC, that is replaces proof by computation the most as it is
 possible. It can be useful in all situations where a classical tactic
-generates huge proof terms. Symbolic Processing and Tautologies are
-in that case. But there are also tactics like \texttt{Auto} or
-\texttt{Linear}: that do many complex computations, using side-effects
-and backtracking, and generate
- a small proof term. Clearly, it would be a non-sense to
-replace them by tactics using reflection.
-
-Another argument against the reflection is that \Coq, as a
-programming language, has many nice features, like dependent types, 
-but is very far from the
-speed and the expressive power of \ocaml. Wait a minute! With \Coq\
-it is possible to extract ML code from \CIC\ terms, right? So, why not
-to link the extracted code with \Coq\ to inherit the benefits of the
-reflection and the speed of ML tactics? That is called \textit{total
-  reflection}, and is still an active research subject. With these
-technologies it will become possible to bootstrap the type-checker of
-\CIC, but there is still some work to achieve that goal.
-
-Another brilliant idea from Benjamin Werner: reflection could be used
-to couple a external tool (a rewriting program or a model checker)
-with \Coq. We define (in \Coq) a type of terms, a type of
-\emph{traces}, and prove a correction theorem that states that
-\emph{replaying traces} is safe w.r.t some interpretation. Then we let 
-the external tool do every computation (using side-effects,
-backtracking, exception, or others features that are not available in
-pure lambda calculus) to produce the trace: now we replay the trace in
-Coq{}, and apply the correction lemma. So internalization seems to be
-the best way to import \dots{} external proofs!
-
+generates huge proof terms. Symbolic Processing and Tautologies are in
+that case. But there are also tactics like \texttt{auto} or
+\texttt{linear} that do many complex computations, using side-effects
+and backtracking, and generate a small proof term. Clearly, it would
+be significantly less efficient to replace them by tactics using
+reflection.
+
+Another idea suggested by Benjamin Werner: reflection could be used to
+couple an external tool (a rewriting program or a model checker) with
+\Coq. We define (in \Coq) a type of terms, a type of \emph{traces},
+and prove a correction theorem that states that \emph{replaying
+traces} is safe w.r.t some interpretation. Then we let the external
+tool do every computation (using side-effects, backtracking,
+exception, or others features that are not available in pure lambda
+calculus) to produce the trace: now we can check in Coq{} that the
+trace has the expected semantic by applying the correction lemma.
  
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/Program.tex b/doc/refman/Program.tex
index 48ce6bd9..4f8f1281 100644
--- a/doc/refman/Program.tex
+++ b/doc/refman/Program.tex
@@ -134,7 +134,7 @@ Program Fixpoint div2 (n : nat) : { x : nat | n = 2 * x \/ n = 2 * x + 1 } :=
 Here we have one obligation for each branch (branches for \verb:0: and \verb:(S 0): are
 automatically generated by the pattern-matching compilation algorithm):
 \begin{coq_example}
-  Show.
+  Obligations.
 \end{coq_example}
 
 \subsection{\tt Program Lemma {\ident} : type.
@@ -145,6 +145,18 @@ The \Russell\ language can also be used to type statements of logical
 properties. It will currently fail if the traduction to \Coq\
 generates obligations though it can be useful to insert automatic coercions.
 
+\subsection{Solving obligations}
+The following commands are available to manipulate obligations:
+
+\begin{itemize}
+\item {\tt Obligations [of \ident]} Displays all remaining
+  obligations.
+\item {\tt Solve Obligation num [of \ident]} Start the proof of
+  obligation {\tt num}.
+\item {\tt Solve Obligations [of \ident] using} {\tacexpr} Tries to solve
+  each obligation using the given tactic.
+\end{itemize}
+  
 
 % \subsection{\tt Program Fixpoint {\ident} {(\ident_$_0$ : \type_$_0$)
 %     \cdots (\ident_$_n$ : \type_$_n$)} {\tt \{wf}
@@ -507,7 +519,7 @@ generates obligations though it can be useful to insert automatic coercions.
 %  After compilation those two examples run nonetheless,
 %  thanks to the correction of the extraction~\cite{Let02}. 
 
-% $Id: Program.tex 8890 2006-06-01 21:33:26Z msozeau $ 
+% $Id: Program.tex 9332 2006-11-02 12:23:24Z msozeau $ 
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-cic.tex b/doc/refman/RefMan-cic.tex
index 0a2f5904..8246e338 100644
--- a/doc/refman/RefMan-cic.tex
+++ b/doc/refman/RefMan-cic.tex
@@ -39,7 +39,8 @@ The remaining sections are concerned with the type-checking of terms.
 The beginner can skip them.
 
 The reader seeking a background on the Calculus of Inductive
-Constructions may read several papers.  Giménez~\cite{Gim98} provides
+Constructions may read several papers. Giménez and Castéran~\cite{GimCas05} 
+provide
 an introduction to inductive and coinductive definitions in Coq. In
 their book~\cite{CoqArt}, Bertot and Castéran give a precise
 description of the \CIC{} based on numerous practical examples.
@@ -117,7 +118,21 @@ indexes can be solved. From the user point of view we consequently
 have {\sf Type :Type}.
 
 We shall make precise in the typing rules the constraints between the
-indexes.
+indexes. 
+
+\paragraph{Implementation issues}
+In practice, the {\Type} hierarchy is implemented using algebraic
+universes. An algebraic universe $u$ is either a variable (a qualified
+identifier with a number) or a successor of an algebraic universe (an
+expression $u+1$), or an upper bound of algebraic universes (an
+expression $max(u_1,...,u_n)$), or the base universe (the expression
+$0$) which corresponds, in the arity of sort-polymorphic inductive
+types, to the predicative sort {\Set}. A graph of constraints between
+the universe variables is maintained globally. To ensure the existence
+of a mapping of the universes to the positive integers, the graph of
+constraints must remain acyclic.  Typing expressions that violate the
+acyclicity of the graph of constraints results in a \errindex{Universe
+inconsistency} error (see also section~\ref{PrintingUniverses}).
 
 \subsection{Constants}
 Besides the sorts, the language also contains constants denoting
@@ -1633,7 +1648,7 @@ using the {\tt Scheme} command described in section~\ref{Scheme}.
 The implementation contains also coinductive definitions, which are
 types inhabited by infinite objects. 
 More information on coinductive definitions can be found
-in~\cite{Gimenez95b,Gim98}.
+in~\cite{Gimenez95b,Gim98,GimCas05}.
 %They are described in chapter~\ref{Coinductives}.
 
 \section{\iCIC : the Calculus of Inductive Construction with
@@ -1684,7 +1699,7 @@ impredicative system for sort \Set{} become~:
      
 
 
-% $Id: RefMan-cic.tex 9001 2006-07-04 13:50:15Z herbelin $ 
+% $Id: RefMan-cic.tex 9306 2006-10-28 18:28:19Z herbelin $ 
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-ext.tex b/doc/refman/RefMan-ext.tex
index 37660aa3..e0acef55 100644
--- a/doc/refman/RefMan-ext.tex
+++ b/doc/refman/RefMan-ext.tex
@@ -980,7 +980,7 @@ argument, use command
 Conversely, use command {\tt Unset Contextual Implicit} to
 unset the contextual implicit mode.
 
-\subsection{Explicit Applications
+\subsection{Explicit applications
 \index{Explicitation of implicit arguments}
 \label{Implicits-explicitation}
 \index{qualid@{\qualid}}}
@@ -1208,6 +1208,35 @@ printing features, use the command
 {\tt Unset Printing All.}
 \end{quote}
 
+\section{Printing universes}
+\label{PrintingUniverses}
+\comindex{Set Printing Universes}
+\comindex{Unset Printing Universes}
+
+The following command:
+\begin{quote}
+{\tt Set Printing Universes}
+\end{quote}
+activates the display of the actual level of each occurrence of
+{\Type}. See section~\ref{Sorts} for details.  This wizard option, in
+combination with \texttt{Set Printing All} (see
+section~\ref{SetPrintingAll}) can help to diagnose failures to unify
+terms apparently identical but internally different in the Calculus of
+Inductive Constructions. To reactivate the display of the actual level
+of the occurrences of {\Type}, use
+\begin{quote}
+{\tt Unset Printing Universes.}
+\end{quote}
+
+\comindex{Print Universes}
+
+The constraints on the internal level of the occurrences of {\Type}
+(see section~\ref{Sorts}) can be printed using the command
+\begin{quote}
+{\tt Print Universes.}
+\end{quote}
+
+
 %%% Local Variables: 
 %%% mode: latex
 %%% TeX-master: "Reference-Manual"
diff --git a/doc/refman/RefMan-gal.tex b/doc/refman/RefMan-gal.tex
index e7b825d7..1c258b20 100644
--- a/doc/refman/RefMan-gal.tex
+++ b/doc/refman/RefMan-gal.tex
@@ -1362,7 +1362,7 @@ can be seen as a generalization of {\tt Fixpoint}.  It is actually a
 wrapper for several ways of defining a function \emph{and other useful
   related objects}, namely: an induction principle that reflects the
 recursive structure of the function (see \ref{FunInduction}), and its
-fixpoint equality (not always, see below).  The meaning of this
+fixpoint equality.  The meaning of this
 declaration is to define a function {\it ident}, similarly to {\tt
   Fixpoint}. Like in {\tt Fixpoint}, the decreasing argument must be
 given (unless the function is not recursive), but it must not
@@ -1406,40 +1406,43 @@ Function plus (n m : nat) {struct n} : nat :=
 \paragraph{Limitations}
 \label{sec:Function-limitations}
 \term$_0$ must be build as a \emph{pure pattern-matching tree}
-(\texttt{match...with}) with $\lambda$-abstractions and applications only
-\emph{at the end} of each branch.  For now dependent cases are not
-treated.
+(\texttt{match...with}) with applications only \emph{at the end} of
+each branch.  For now dependent cases are not treated.
 
-\paragraph{Difference with \texttt{Functional Scheme}} 
-There is a difference between obtaining an induction scheme for a
-function by using \texttt{Function} (section~\ref{Function}) and
-by using \texttt{Functional Scheme} after a usual definition using
-\texttt{Fixpoint} or \texttt{Definition}. Indeed \texttt{Function}
-generally produces smaller principles, closer to the definition
-written by the user. This is because \texttt{Functional Scheme} works
-by analyzing the term \texttt{div2} after the compilation of pattern
-matching into exhaustive expanded ones, whereas \texttt{Function}
-analyzes the pseudo-term \emph{before} pattern matching expansion.
 
 
-\ErrMsg 
+\begin{ErrMsgs}
+\item \errindex{The recursive argument must be specified}
+\item \errindex{No argument name \ident}
+\item \errindex{Cannot use mutual definition with well-founded
+    recursion or measure}
 
-\errindex{while trying to define Inductive R\_\ident ...}
+\item \errindex{Cannot define graph for \ident\dots} (warning)
 
-The generation of the graph relation \texttt{(R\_\ident)} used to
-compute the induction scheme of \ident\ raised a typing error, the
-definition of \ident\ was aborted. You can use \texttt{Fixpoint}
-instead of \texttt{Function}, but the scheme will not be generated.
+  The generation of the graph relation \texttt{(R\_\ident)} used to
+  compute the induction scheme of \ident\ raised a typing error. Only
+  the ident is defined, the induction scheme will not be generated.
 
-This error happens generally when: 
+  This error happens generally when:
 
-\begin{itemize}
-\item the definition uses pattern matching on dependent types, which
-  \texttt{Function} cannot deal with yet.
-\item the definition is not a \emph{pattern-matching tree} as
-  explained above.
-\end{itemize}
+  \begin{itemize}
+  \item the definition uses pattern matching on dependent types, which
+    \texttt{Function} cannot deal with yet.
+  \item the definition is not a \emph{pattern-matching tree} as
+    explained above.
+  \end{itemize}
+
+\item \errindex{Cannot define principle(s) for \ident\dots} (warning)
+
+  The generation of the graph relation \texttt{(R\_\ident)} succeeded
+  but the induction principle could not be built. Only the ident is
+  defined. Please report.
+
+\item \errindex{Cannot built inversion information} (warning)
 
+  \texttt{functional inversion} will not be available for the
+  function.
+\end{ErrMsgs}
 
 
 \SeeAlso{\ref{FunScheme},\ref{FunScheme-examples},\ref{FunInduction}}
@@ -1453,20 +1456,27 @@ given below.
     : type$_0$ := \term$_0$}
 
   Defines the not recursive function \ident\ as if declared with
-  \texttt{Definition}.  Three elimination schemes {\tt\ident\_rect},
-  {\tt\ident\_rec} and {\tt\ident\_ind} are generated (see the
-  documentation of {\tt Inductive} \ref{Inductive}), which reflect the
-  pattern matching structure of \term$_0$.
-
+  \texttt{Definition}.  Moreover the following are defined:
+
+  \begin{itemize}
+  \item {\tt\ident\_rect}, {\tt\ident\_rec} and {\tt\ident\_ind},
+    which reflect the pattern matching structure of \term$_0$ (see the
+    documentation of {\tt Inductive} \ref{Inductive});
+  \item The inductive \texttt{R\_\ident} corresponding to the graph of
+    \ident\ (silently);
+  \item \texttt{\ident\_complete} and \texttt{\ident\_correct} which are
+    inversion information linking the function and its graph.
+  \end{itemize}
 \item \texttt{Function {\ident} {\binder$_1$}\ldots{\binder$_n$}
     {\tt \{}{\tt struct} \ident$_0${\tt\}} : type$_0$ := \term$_0$}
   
   Defines the structural recursive function \ident\ as if declared
-  with \texttt{Fixpoint}.  Three induction schemes {\tt\ident\_rect},
-  {\tt\ident\_rec} and {\tt\ident\_ind} are generated (see the
-  documentation of {\tt Inductive} \ref{Inductive}), which reflect the
-  recursive structure of \term$_0$. When there is only one parameter,
-  {\tt \{struct} \ident$_0${\tt\}} can be omitted.
+  with \texttt{Fixpoint}.  Moreover the following are defined:
+
+  \begin{itemize}
+  \item The same objects as above;
+  \item The fixpoint equation of \ident: \texttt{\ident\_equation}.
+  \end{itemize}
   
 \item \texttt{Function {\ident} {\binder$_1$}\ldots{\binder$_n$} {\tt
       \{}{\tt measure \term$_1$} \ident$_0${\tt\}} : type$_0$ :=
@@ -1502,18 +1512,22 @@ proof that the ordering relation is well founded.
 
 %Completer sur measure et wf
 
-The fixpoint equality  \texttt{\ident\_equation}, which is not trivial
-to prove in this case, is automatically generated and proved, together
-with three  induction schemes {\tt\ident\_rect},  {\tt\ident\_rec} and
-{\tt\ident\_ind} as explained above  (see  the   documentation  of  {\tt
-  Inductive} \ref{Inductive}), which  reflect the recursive structure
-of \term$_0$.
+Once proof obligations are discharged, the following objects are
+defined:
+
+\begin{itemize}
+\item The same objects as with the \texttt{struct};
+\item The lemma \texttt{\ident\_tcc} which collects all proof
+  obligations in one property;
+\item The lemmas \texttt{\ident\_terminate} and \texttt{\ident\_F}
+  which is needed to be inlined during extraction of \ident.
+\end{itemize}
 
 
 
 %Complete!!
 The way this recursive function is defined is the subject of several
-papers by Yves Bertot, Julien Forest, David Pichardie.
+papers by Yves Bertot and Antonia Balaa on one hand and  Gilles Barthe, Julien Forest, David Pichardie and Vlad Rusu on the other hand.
 
 %Exemples ok ici
 
@@ -1706,4 +1720,4 @@ To be able to unfold a proof, you should end the proof by {\tt Defined}
 % TeX-master: "Reference-Manual"
 % End: 
 
-% $Id: RefMan-gal.tex 9040 2006-07-11 18:06:49Z notin $ 
+% $Id: RefMan-gal.tex 9127 2006-09-07 15:47:14Z courtieu $ 
diff --git a/doc/refman/RefMan-lib.tex b/doc/refman/RefMan-lib.tex
index f9a5f975..f4cd9a6f 100644
--- a/doc/refman/RefMan-lib.tex
+++ b/doc/refman/RefMan-lib.tex
@@ -16,9 +16,9 @@ The \Coq\ library is structured into three parts:
   (see section~\ref{Require});
 
 \item[User contributions:] Other specification and proof developments
-  coming from the \Coq\ users' community. These libraries are no
-  longer distributed with the system.  They are available by anonymous
-  FTP (see section~\ref{Contributions}).
+  coming from the \Coq\ users' community. These libraries are
+  available for download at \texttt{http://coq.inria.fr} (see
+  section~\ref{Contributions}).
 \end{description}
 
 This chapter briefly reviews these libraries.
@@ -27,8 +27,8 @@ This chapter briefly reviews these libraries.
 \label{Prelude}
 
 This section lists the basic notions and results which are directly
-available in the standard \Coq\ system
-\footnote{Most of these constructions are defined in the
+available in the standard \Coq\ system\footnote{Most 
+of these constructions are defined in the
 {\tt Prelude} module in directory {\tt theories/Init} at the {\Coq}
 root directory; this includes the modules
 {\tt Notations},
@@ -155,6 +155,7 @@ Section Projections.
 Variables A B : Prop.
 Theorem proj1 : A /\ B -> A.
 Theorem proj2 : A /\ B -> B.
+End Projections.
 \end{coq_example*}
 \begin{coq_eval}
 Abort All.
@@ -165,7 +166,6 @@ Abort All.
 \ttindex{iff}
 \ttindex{IF\_then\_else}
 \begin{coq_example*}
-End Projections.
 Inductive or (A B:Prop) : Prop :=
   | or_introl (_:A)
   | or_intror (_:B).
@@ -800,21 +800,24 @@ subdirectories:
 \begin{tabular}{lp{12cm}}
   {\bf Logic}   & Classical logic and dependent equality \\
   {\bf Arith}   & Basic Peano arithmetic \\
-  {\bf ZArith}  & Basic integer arithmetic \\
-  {\bf Bool}    &  Booleans (basic functions and results) \\
+  {\bf NArith}  & Basic positive integer arithmetic \\
+  {\bf ZArith}  & Basic relative integer arithmetic \\
+  {\bf Bool}    & Booleans (basic functions and results) \\
   {\bf Lists}   & Monomorphic and polymorphic lists (basic functions and
             results), Streams (infinite sequences defined with co-inductive
             types) \\
   {\bf Sets}    & Sets (classical, constructive, finite, infinite, power set,
             etc.) \\
-  {\bf IntMap}    & Representation of finite sets by an efficient
-  structure of map (trees indexed by binary integers).\\
- {\bf Reals}   & Axiomatization of Real Numbers (classical, basic functions, 
-                 integer part, fractional part, limit, derivative, Cauchy 
-                 series, power series and results,... Requires the 
-                 \textbf{ZArith} library).\\
+  {\bf FSets}   & Specification and implementations of finite sets and finite
+                  maps (by lists and by AVL trees)\\
+  {\bf IntMap}  & Representation of finite sets by an efficient
+                  structure of map (trees indexed by binary integers).\\
+ {\bf Reals}    & Axiomatization of real numbers (classical, basic functions, 
+                  integer part, fractional part, limit, derivative, Cauchy 
+                  series, power series and results,...)\\
  {\bf Relations} & Relations (definitions and basic results). \\
- {\bf Sorting} & Sorted list (basic definitions and heapsort correctness). \\
+ {\bf Sorting}  & Sorted list (basic definitions and heapsort correctness). \\
+ {\bf Strings}  & 8-bits characters and strings\\
  {\bf Wellfounded} & Well-founded relations (basic results). \\
 
 \end{tabular}
@@ -1094,7 +1097,7 @@ The users' contributions may also be obtained by anonymous FTP from site
 \verb:ftp.inria.fr:, in directory \verb:INRIA/coq/: and
 searchable on-line at \url{http://coq.inria.fr/contribs-eng.html}
 
-% $Id: RefMan-lib.tex 8609 2006-02-24 13:32:57Z notin,no-port-forwarding,no-agent-forwarding,no-X11-forwarding,no-pty $ 
+% $Id: RefMan-lib.tex 9312 2006-10-28 21:08:35Z herbelin $ 
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-ltac.tex b/doc/refman/RefMan-ltac.tex
index e7400232..ad2ffdc6 100644
--- a/doc/refman/RefMan-ltac.tex
+++ b/doc/refman/RefMan-ltac.tex
@@ -660,14 +660,17 @@ replaces the hole of the value of {\ident} by the value of
 Tactics sometimes have to generate new names for hypothesis. Letting
 the system decide a name with the {\tt intro} tactic is not so good
 since it is very awkward to retrieve the name the system gave.
-
-As before, the following expression returns a term:
+The following expression returns an identifier:
 \begin{quote}
-{\tt fresh} {\qstring}
+{\tt fresh} \nelist{\textrm{\textsl{component}}}{}
 \end{quote}
-It evaluates to an identifier unbound in the goal, which is obtained
-by padding {\qstring} with a number if necessary. If no name is given,
-the prefix is {\tt H}.
+It evaluates to an identifier unbound in the goal. This fresh
+identifier is obtained by concatenating the value of the
+\textrm{\textsl{component}}'s (each of them is, either an {\ident} which
+has to refer to a name, or directly a name denoted by a
+{\qstring}). If the resulting name is already used, it is padded
+with a number so that it becomes fresh. If no component is
+given, the name is a fresh derivative of the name {\tt H}.
 
 \subsubsection{Computing in a constr}
 \index{Ltac!eval}
diff --git a/doc/refman/RefMan-pre.tex b/doc/refman/RefMan-pre.tex
index 43216ed0..8b6e29b5 100644
--- a/doc/refman/RefMan-pre.tex
+++ b/doc/refman/RefMan-pre.tex
@@ -379,6 +379,9 @@ Mathematics (HELM cf \url{http://www.cs.unibo.it/helm}).
 A library for efficient representation of finite maps using binary trees
 contributed by Jean Goubault was integrated in the basic theories.
 
+Pierre Courtieu developed a command and a tactic to reason on the
+inductive structure of recursively defined functions.
+
 Jacek Chrz\k{a}szcz designed and implemented the module system of
 {\Coq} whose foundations are in Judicaël Courant's PhD thesis.
 
@@ -388,12 +391,12 @@ The development was coordinated by C. Paulin.
 
 Many discussions within the Démons team and the LogiCal project
 influenced significantly the design of {\Coq} especially with 
-%J. Chrz\k{a}szcz, 
-J. Courant, P. Courtieu, J. Duprat, J. Goubault, A. Miquel,
+%J. Chrz\k{a}szcz, P. Courtieu, 
+J. Courant, J. Duprat, J. Goubault, A. Miquel,
 C. Marché, B. Monate and B. Werner.
 
 Intensive users suggested improvements of the system : 
-Y. Bertot, L. Pottier, L. Théry , P. Zimmerman from INRIA, 
+Y. Bertot, L. Pottier, L. Théry, P. Zimmerman from INRIA, 
 C. Alvarado, P. Crégut, J.-F. Monin from France Telecom R \& D.
 \begin{flushright}
 Orsay, May. 2002\\
@@ -536,6 +539,9 @@ Benjamin Grégoire, Assia Mahboubi and Bruno Barras developed a new
 more efficient and more general simplification algorithm on rings and
 semi-rings.
 
+Laurent Théry and Bruno Barras developed a new significantly more efficient
+simplification algorithm on fields.
+
 Hugo Herbelin, Pierre Letouzey, Julien Forest, Julien Narboux and
 Claudio Sacerdoti Coen added new tactic features.
 
@@ -564,9 +570,23 @@ Pierre Corbineau extended his tactic for solving first-order
 statements. He wrote a reflection-based intuitionistic tautology
 solver.
 
+Pierre Courtieu, Julien Forest and Yves Bertot added extra support to
+reason on the inductive structure of recursively defined functions.
+
 Jean-Marc Notin significantly contributed to the general maintenance
 of the system. He also took care of {\textsf{coqdoc}}.
 
+Pierre Castéran contributed to the documentation of (co-)inductive
+types and suggested improvements to the libraries.
+
+Pierre Corbineau implemented a declarative mathematical proof
+language, usable in combination with the tactic-based style of proof.
+
+Finally, many users suggested improvements of the system through the
+Coq-Club mailing list and bug-tracker systems, especially user groups
+from INRIA Rocquencourt, Radbout University, University of
+Pennsylvania and Yale University.
+
 \begin{flushright}
 Palaiseau, July 2006\\
 Hugo Herbelin
@@ -577,7 +597,7 @@ Hugo Herbelin
 % Integration of ZArith lemmas from Sophia and Nijmegen.
 
 
-% $Id: RefMan-pre.tex 9030 2006-07-07 15:37:23Z herbelin $ 
+% $Id: RefMan-pre.tex 9283 2006-10-26 08:13:51Z herbelin $ 
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-pro.tex b/doc/refman/RefMan-pro.tex
index 8c1a7824..208a014a 100644
--- a/doc/refman/RefMan-pro.tex
+++ b/doc/refman/RefMan-pro.tex
@@ -374,7 +374,18 @@ All the hypotheses remains usable in the proof development.
 This command goes back to the default mode which is to print all
 available hypotheses.
 
-% $Id: RefMan-pro.tex 9030 2006-07-07 15:37:23Z herbelin $
+\section{$DPL$ : A Declarative proof language for Coq \emph{(experimental)} }
+
+An implementation of the $DPL$ declarative proof language by Pierre Corbineau at the Radboud University Nijmegen (The Netherlands) is included in Coq.
+
+ Due to the experimental nature and hence the potentially unstable semantics of the language, its documentation is not included here. However, it can be found at :
+
+\url{http://www.cs.ru.nl/~corbineau/mmode.html}
+
+
+
+
+% $Id: RefMan-pro.tex 9286 2006-10-26 17:43:00Z corbinea $
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-tac.tex b/doc/refman/RefMan-tac.tex
index 24699873..24ea78c0 100644
--- a/doc/refman/RefMan-tac.tex
+++ b/doc/refman/RefMan-tac.tex
@@ -120,6 +120,7 @@ subgoal is proved. Otherwise, it fails.
 \end{ErrMsgs}
 
 \begin{Variants}
+\tacindex{eassumption}
   \item \texttt{eassumption}
 
     This tactic behaves like \texttt{assumption} but is able to handle
@@ -576,6 +577,45 @@ in the list of subgoals remaining to prove.
 %  \term\ will be kept.
 %\end{Variants}
 
+\subsection{{\tt apply {\term} in {\ident}}
+\tacindex{apply {\ldots} in}}
+
+This tactic applies to any goal.  The argument {\term} is a term
+well-formed in the local context and the argument {\ident} is an
+hypothesis of the context.  The tactic {\tt apply {\term} in {\ident}}
+tries to match the conclusion of the type of {\ident} against a non
+dependent premisses of the type of {\term}, trying them from right to
+left.  If it succeeds, the statement of hypothesis {\ident} is
+replaced by the conclusion of the type of {\ident}. The tactic also
+returns as many subgoals as the number of other non dependent premises
+in the type of {\term} and of the non dependent premises of the type
+of {\ident}.  The tactic {\tt apply} relies on first-order
+pattern-matching with dependent types.
+
+\begin{ErrMsgs}
+\item \errindex{Statement without assumptions}
+
+This happens if the type of {\term} has no non dependent premise.
+
+\item \errindex{Unable to apply}
+
+This happens if the conclusion of {\ident} does not match any of the
+non dependent premises of the type of {\term}.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt apply \nelist{\term}{,} in {\ident}}
+
+This applies each of {\term} in sequence in {\ident}.
+
+\item {\tt apply \nelist{{\term} {\bindinglist}}{,} in {\ident}}
+
+This does the same but uses the bindings in each {\bindinglist} to 
+instanciate the parameters of the corresponding type of {\term}
+(see syntax of bindings in Section~\ref{Binding-list}).
+
+\end{Variants}
+
 \subsection{\tt generalize \term
 \tacindex{generalize}
 \label{generalize}}
@@ -725,11 +765,12 @@ can be either the conclusion, or an hypothesis. In the case of a
 defined hypothesis it is possible to specify if the conversion should
 occur on the type part, the body part or both (default).
 
-\index{Clauses}
-Clauses are written after a conversion tactic (tactic
-\texttt{set}~\ref{tactic:set} also uses clauses) and are introduced by
-the keyword \texttt{in}. If no clause is provided, the default is to
-perform the conversion only in the conclusion.
+\index{Clauses} Clauses are written after a conversion tactic (tactics
+\texttt{set}~\ref{tactic:set},          \texttt{rewrite}~\ref{rewrite},
+\texttt{replace}~\ref{tactic:replace}                               and
+\texttt{autorewrite}~\ref{tactic:autorewrite}  also  use clauses)  and
+are introduced by  the keyword \texttt{in}. If no  clause is provided,
+the default is to perform the conversion only in the conclusion.
 
 The syntax and description of the various clauses follows:
 \begin{description}
@@ -754,7 +795,8 @@ performs the conversion in hypotheses $H_1\ldots H_n$.
 \dots\ \flag$_n$} and {\tt compute}
 \tacindex{cbv}
 \tacindex{lazy}
-\tacindex{compute}}
+\tacindex{compute}
+\tacindex{vm\_compute}}
 \label{vmcompute}
 
 These parameterized reduction tactics apply to any goal and perform
@@ -773,9 +815,7 @@ followed by {\tt [\qualid$_1$\ldots\qualid$_k$]} or {\tt
   -[\qualid$_1$\ldots\qualid$_k$]}), the {\tt delta} flag means that all constants must be unfolded.
 However, the {\tt delta} flag does not apply to variables bound by a
 let-in construction whose unfolding is controlled by the {\tt
-  zeta} flag only.  In addition, there is a flag {\tt Evar} to perform
-instantiation of existential variables (``?'') when an instantiation
-actually exists. 
+  zeta} flag only.
 
 The goal may be normalized with two strategies: {\em lazy} ({\tt lazy}
 tactic), or {\em call-by-value} ({\tt cbv} tactic). The lazy strategy
@@ -798,7 +838,7 @@ computational expressions (i.e. with few dead code).
 \begin{Variants}
 \item {\tt compute} \tacindex{compute} 
   
-  This tactic is an alias for {\tt cbv beta delta evar iota zeta}.
+  This tactic is an alias for {\tt cbv beta delta iota zeta}.
 
 \item {\tt vm\_compute} \tacindex{vm\_compute}
 
@@ -1453,7 +1493,7 @@ Qed.
 \end{Variants}
 
 
-\subsection{\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$).
+\subsection{\tt functional induction (\qualid\ \term$_1$ \dots\ \term$_n$).
 \tacindex{functional induction}
 \label{FunInduction}}
 
@@ -1461,8 +1501,7 @@ The \emph{experimental} tactic \texttt{functional induction} performs
 case analysis and induction following the definition of a function. It
 makes use of a principle generated by \texttt{Function}
 (section~\ref{Function}) or \texttt{Functional Scheme}
-(section~\ref{FunScheme}). This principle is named \ident\_ind by
-default but you can give it explicitly, see variants below.
+(section~\ref{FunScheme}).
 
 \begin{coq_eval}
 Reset Initial.
@@ -1478,22 +1517,22 @@ functional induction (minus n m); simpl; auto.
 Qed.
 \end{coq_example*}
 
-\Rem \texttt{(\ident\ \term$_1$ \dots\ \term$_n$)} must be a correct
-full application of \ident. In particular, the rules for implicit
-arguments are the same as usual. For example use \texttt{@\ident} if
+\Rem \texttt{(\qualid\ \term$_1$ \dots\ \term$_n$)} must be a correct
+full application of \qualid. In particular, the rules for implicit
+arguments are the same as usual. For example use \texttt{@\qualid} if
 you want to write implicit arguments explicitly.
 
-\Rem Parenthesis over \ident \dots \term$_n$ are not mandatory, but if
-there are not written then implicit arguments must be given.
+\Rem Parenthesis over \qualid \dots \term$_n$ are mandatory.
 
-\Rem \texttt{functional induction (f x1 x2 x3)} is actually a
-shorthand for \texttt{induction x1 x2 x3 (f x1 x2 x3) using f\_ind}.
-\texttt{f\_ind} being an induction scheme computed by the
-\texttt{Function} (section~\ref{Function}) or \texttt{Functional
-  Scheme} (section~\ref{FunScheme}) command . Therefore
-\texttt{functional induction} may fail if the induction scheme
-(\texttt{f\_ind}) is not defined. See also section~\ref{Function} for
-the function terms accepted by \texttt{Function}.
+\Rem \texttt{functional induction (f x1 x2 x3)} is actually a wrapper
+for \texttt{induction x1 x2 x3 (f x1 x2 x3) using \qualid} followed by
+a cleaning phase, where $\qualid$ is the induction principle
+registered for $f$ (by the \texttt{Function} (section~\ref{Function})
+or \texttt{Functional Scheme} (section~\ref{FunScheme}) command)
+corresponding to the sort of the goal.  Therefore \texttt{functional
+  induction} may fail if the induction scheme (\texttt{\qualid}) is
+not defined. See also section~\ref{Function} for the function terms
+accepted by \texttt{Function}.
 
 \Rem There is a difference between obtaining an induction scheme for a
 function by using \texttt{Function} (section~\ref{Function}) and by
@@ -1501,36 +1540,42 @@ using \texttt{Functional Scheme} after a normal definition using
 \texttt{Fixpoint} or \texttt{Definition}. See \ref{Function} for
 details.
 
-\SeeAlso{\ref{Function},\ref{FunScheme},\ref{FunScheme-examples}}
+\SeeAlso{\ref{Function},\ref{FunScheme},\ref{FunScheme-examples},
+  \ref{sec:functional-inversion}}
 
-\ErrMsg 
-
-\errindex{The reference \ident\_ind was not found in the current
-environment}
+\begin{ErrMsgs}
+\item \errindex{Cannot find induction information on \qualid}
 
-~
+  ~
 
-\errindex{Not the right number of induction arguments}
- 
+\item \errindex{Not the right number of induction arguments}
+\end{ErrMsgs}
 
 \begin{Variants}
-\item {\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$)
+\item {\tt functional induction (\qualid\ \term$_1$ \dots\ \term$_n$)
    using \term$_{m+1}$ with {\term$_{n+1}$} \dots {\term$_m$}}
 
  Similar to \texttt{Induction} and \texttt{elim}
  (section~\ref{Tac-induction}), allows to give explicitly the
  induction principle and the values of dependent premises of the
  elimination scheme, including \emph{predicates} for mutual induction
- when \ident is mutually recursive.
+ when \qualid is mutually recursive.
 
-\item {\tt functional induction (\ident\ \term$_1$ \dots\ \term$_n$)
+\item {\tt functional induction (\qualid\ \term$_1$ \dots\ \term$_n$)
     using \term$_{m+1}$ with {\vref$_1$} := {\term$_{n+1}$} \dots\
     {\vref$_m$} := {\term$_n$}}
 
   Similar to \texttt{induction} and \texttt{elim}
   (section~\ref{Tac-induction}).
+
+\item All previous variants can be extended by the usual \texttt{as
+    \intropattern} construction, similarly for example to
+  \texttt{induction} and \texttt{elim} (section~\ref{Tac-induction}).
+    
 \end{Variants}
 
+
+
 \section{Equality}
 
 These tactics use the equality {\tt eq:forall A:Type, A->A->Prop}
@@ -1578,20 +1623,30 @@ This happens if \term$_1$ does not occur in the goal.
 \item {\tt rewrite {\term} in \textit{clause}}
   \tacindex{rewrite \dots\ in}\\
   Analogous to {\tt rewrite {\term}} but rewriting is done following
-  \textit{clause} (similarly to \ref{Conversion-tactics}). For instance:
-  \texttt{rewrite H in H1,H2 |- *} means \texttt{rewrite H in H1;
-    rewrite H in H2; rewrite H} and \texttt{rewrite H in * |-} will do
-  \texttt{try rewrite H in H$_i$} for all hypothesis \texttt{H$_i$ <>
-    H}.
-
-\item {\tt rewrite -> {\term} in {\ident}}
+  \textit{clause} (similarly to \ref{Conversion-tactics}). For
+  instance:
+  \begin{itemize}
+  \item \texttt{rewrite H in H1} will rewrites \texttt{H} in the hypothesis
+    \texttt{H1} instead of the current goal.
+  \item \texttt{rewrite H in H1,H2 |- *} means \texttt{rewrite H; rewrite H in H1;
+      rewrite H in H2}. In particular a failure will happen if any of
+    these three simplier tactics fails. 
+  \item \texttt{rewrite H in * |- } will do \texttt{rewrite H in
+      H$_i$} for all hypothesis \texttt{H$_i$ <> H}. A success will happen
+    as soon as at least one of these simplier tactics succeeds.
+  \item \texttt{rewrite H in *} is a combination of \texttt{rewrite H} 
+    and \texttt{rewrite H in * |-} that succeeds if at
+    least one of these two tactics succeeds. 
+  \end{itemize}
+
+\item {\tt rewrite -> {\term} in \textit{clause}}
   \tacindex{rewrite -> \dots\ in}\\
-  Behaves as {\tt rewrite {\term} in {\ident}}.
+  Behaves as {\tt rewrite {\term} in \textit{clause}}.
  
-\item {\tt rewrite <- {\term} in {\ident}}\\
+\item {\tt rewrite <- {\term} in \textit{clause}}\\
   \tacindex{rewrite <- \dots\ in}
   Uses the equality \term$_1${\tt=}\term$_2$ from right to left to
-  rewrite in the hypothesis named {\ident}.
+  rewrite in \textit{clause} as explained above.
 \end{Variants}
 
 
@@ -1603,6 +1658,7 @@ This tactic acts like {\tt replace {\term$_1$} with {\term$_2$}}
 (see below).
 
 \subsection{\tt replace {\term$_1$} with {\term$_2$}
+\label{tactic:replace}
 \tacindex{replace \dots\ with}}
 
 This tactic applies to any goal. It replaces all free occurrences of
@@ -1618,21 +1674,23 @@ n}| assumption || symmetry; try assumption]}.
 \end{ErrMsgs}
 
 \begin{Variants}
-  
-\item {\tt replace {\term$_1$} with {\term$_2$} in \ident}\\
-  This replaces {\term$_1$} with {\term$_2$} in the hypothesis named
-  {\ident}, and generates the subgoal {\term$_2$}{\tt =}{\term$_1$}. 
-
-%   \begin{ErrMsgs}
-%   \item \errindex{No such hypothesis} : {\ident}
-%   \item \errindex{Nothing to rewrite in {\ident}}
-%   \end{ErrMsgs}
-
-\item {\tt replace {\term$_1$} with  {\term$_2$} by \tac}\\ This acts as
-  {\tt  replace {\term$_1$}  with {\term$_2$}}  but try  to  solve the
+\item {\tt replace {\term$_1$} with {\term$_2$} by \tac}\\ This acts
+  as {\tt replace {\term$_1$} with {\term$_2$}} but try to solve the
   generated subgoal {\tt \term$_2$=\term$_1$} using {\tt \tac}.
-\item {\tt replace {\term$_1$} with {\term$_2$} in \ident by \tac}\\
-  This acts as {\tt replace {\term$_1$} with {\term$_2$} in \ident} but try to solve the generated subgoal {\tt \term$_2$=\term$_1$} using {\tt \tac}.
+\item {\tt replace {\term}}\\ Replace {\term} with {\term'} using the
+  first assumption which type has the form {\tt \term=\term'} or {\tt
+    \term'=\term}
+\item {\tt replace -> {\term}}\\ Replace {\term} with {\term'} using the
+  first assumption which type has the form {\tt \term=\term'}
+\item {\tt replace <- {\term}}\\ Replace {\term} with {\term'} using the
+  first assumption which type has the form {\tt \term'=\term}
+\item {\tt replace {\term$_1$} with {\term$_2$} \textit{clause} }\\
+    {\tt replace {\term$_1$} with {\term$_2$} \textit{clause} by \tac }\\ 
+    {\tt replace {\term} \textit{clause}}\\ 
+    {\tt replace -> {\term} \textit{clause}}\\ 
+    {\tt replace -> {\term} \textit{clause}}\\ 
+    Act as before but the replacements take place in \textit{clause}~\ref{Conversion-tactics} an not only in the conclusion of the goal.\\
+    The  \textit{clause} arg must  not contain  any \texttt{type  of} nor  \texttt{value  of}.
 \end{Variants}
 
 \subsection{\tt reflexivity
@@ -1709,7 +1767,7 @@ accepted as regular setoids for {\tt rewrite} and {\tt
 \tacindex{stepr}
 \comindex{Declare Right Step}
 \begin{Variants}
-\item{\tt stepl {\term} by {\tac}}\\
+\item{\tt stepl {\term}{\sl n} by {\tac}}\\
 This applies {\tt stepl {\term}} then applies {\tac} to the second goal.
 
 \item{\tt stepr {\term}}\\
@@ -1884,6 +1942,14 @@ introduced hypothesis.
   {\ident}}.
   
   \ErrMsg \errindex{goal does not satisfy the expected preconditions}
+
+\item \texttt{injection} \ident{} \texttt{as} \nelist{\intropattern}{}\\
+\texttt{injection} \num{} \texttt{as} {\intropattern} {\ldots} {\intropattern}\\
+\texttt{injection} \texttt{as} {\intropattern} {\ldots} {\intropattern}\\
+\tacindex{injection \ldots{} as}
+ 
+These variants apply \texttt{intros} \nelist{\intropattern}{} after the call to \texttt{injection}.
+
 \end{Variants}
 
 \subsection{\tt simplify\_eq {\ident}
@@ -2165,6 +2231,42 @@ the instance with the tactic {\tt inversion}.
 
 \SeeAlso \ref{inversion-examples} for examples
 
+
+
+\subsection{\tt functional inversion \ident}
+\label{sec:functional-inversion}
+
+\texttt{functional inversion} is a \emph{highly} experimental tactic
+which performs inversion on hypothesis \ident\ of the form
+\texttt{\qualid\ \term$_1$\dots\term$_n$\ = \term} or \texttt{\term\ =
+  \qualid\ \term$_1$\dots\term$_n$} where \qualid\ must have been
+defined using \texttt{Function} (section~\ref{Function}).
+
+\begin{ErrMsgs}
+\item \errindex{Hypothesis \ident must contain at least one Function}
+\item \errindex{Cannot find inversion information for hypothesis \ident}
+  This error may be raised when  some inversion lemma failed to be
+  generated by Function.
+\end{ErrMsgs}
+
+\begin{Variants}
+\item {\tt functional inversion \num}
+
+  This does the same thing as \texttt{intros until \num} then
+  \texttt{functional inversion \ident} where {\ident} is the
+  identifier for the last introduced hypothesis.
+\item {\tt functional inversion \ident\ \qualid}\\
+  {\tt functional inversion \num\ \qualid}
+
+  In case the hypothesis \ident (or \num) has a type of the form
+  \texttt{\qualid$_1$\ \term$_1$\dots\term$_n$\ =\qualid$_2$\
+    \term$_{n+1}$\dots\term$_{n+m}$} where \qualid$_1$ and \qualid$_2$
+  are valid candidates to functional inversion, this variant allows to
+  chose which must be inverted.
+\end{Variants}
+
+
+
 \subsection{\tt quote \ident
 \tacindex{quote}
 \index{2-level approach}}
@@ -2557,6 +2659,8 @@ If the goal is a non-quantified equality, {\tt congruence} tries to
 prove it with non-quantified equalities in the context. Otherwise it
 tries to infer a discriminable equality from those in the context. Alternatively, congruence tries to prove that an hypothesis is equal to the goal or to the negation of another hypothesis.
 
+{\tt congruence} is also able to take advantage of hypotheses stating quantified equalities, you have to provide a bound for the number of extra equalities generated that way. Please note that one of the memebers of the equality must contain all the quantified variables in order for {\tt congruence} to match against it. 
+
 \begin{coq_eval}
 Reset Initial.
 Variable A:Set.
@@ -2586,6 +2690,12 @@ congruence.
 \end{coq_example}
 
 \begin{Variants}
+ \item {\tt congruence {\sl n}}\\
+  Tries to add at most {\tt \sl n} instances of hypotheses satting quantifiesd equalities to the problem in order to solve it. A bigger value of {\tt \sl n} does not make success slower, only failure. You might consider adding some lemmata as hypotheses using {\tt assert} in order for congruence to use them.
+
+\end{Variants}
+
+\begin{Variants}
 \item {\tt congruence with \term$_1$ \dots\ \term$_n$}\\
   Adds {\tt \term$_1$ \dots\ \term$_n$} to the pool of terms used by
   {\tt congruence}. This helps in case you have partially applied
@@ -2623,70 +2733,29 @@ integers. This tactic must be loaded by the command \texttt{Require Import
   Omega}. See the additional documentation about \texttt{omega}
 (chapter~\ref{OmegaChapter}).
 
-\subsection{\tt ring \term$_1$ \dots\ \term$_n$
+\subsection{{\tt ring} and {\tt ring\_simplify \term$_1$ \dots\ \term$_n$}
 \tacindex{ring}
-\comindex{Add Ring}
-\comindex{Add Semi Ring}}
-
-This tactic, written by Samuel Boutin and Patrick Loiseleur, applies
-associative commutative rewriting on every ring.  The tactic must be
-loaded by \texttt{Require Import Ring}. The ring must be declared in
-the \texttt{Add Ring} command (see \ref{ring}). The ring of booleans
-is predefined; if one wants to use the tactic on \texttt{nat} one must
-first require the module \texttt{ArithRing}; for \texttt{Z}, do
-\texttt{Require Import ZArithRing}; for \texttt{N}, do \texttt{Require
-Import NArithRing}.
-
-The terms \term$_1$, \dots, \term$_n$ must be subterms of the goal
-conclusion. The tactic \texttt{ring} normalizes these terms
-w.r.t. associativity and commutativity and replace them by their
-normal form.
+\tacindex{ring\_simplify}
+\comindex{Add Ring}}
 
-\begin{Variants}
-\item \texttt{ring} When the goal is an equality $t_1=t_2$, it
-  acts like \texttt{ring} $t_1$ $t_2$ and then simplifies or solves
-  the equality.
+The {\tt ring} tactic solves equations upon polynomial expressions of
+a ring (or semi-ring) structure. It proceeds by normalizing both hand
+sides of the equation (w.r.t. associativity, commutativity and
+distributivity, constant propagation) and comparing syntactically the
+results.
 
-\item \texttt{ring\_nat} is a tactic macro for \texttt{repeat rewrite
-    S\_to\_plus\_one; ring}. The theorem \texttt{S\_to\_plus\_one} is a
-  proof that \texttt{forall (n:nat), S n = plus (S O) n}.
+{\tt ring\_simplify} applies the normalization procedure described
+above to the terms given. The tactic then replaces all occurrences of
+the terms given in the conclusion of the goal by their normal
+forms. If no term is given, then the conclusion should be an equation
+and both hand sides are normalized.
 
-\end{Variants}
-
-\Example
-\begin{coq_eval}
-Reset Initial.
-Require Import ZArith.
-Open Scope Z_scope.
-\end{coq_eval}
-\begin{coq_example}
-Require Import ZArithRing.
-Goal forall a b c:Z,
-  (a + b + c) * (a + b + c) =
-  a * a + b * b + c * c + 2 * a * b + 2 * a * c + 2 * b * c.
-\end{coq_example}
-\begin{coq_example}
-intros; ring.
-\end{coq_example}
-\begin{coq_eval}
-Reset Initial.
-\end{coq_eval}
-
-You can have a look at the files \texttt{Ring.v},
-\texttt{ArithRing.v}, \texttt{ZArithRing.v} to see examples of the
-\texttt{Add Ring} command.
-
-\SeeAlso Chapter~\ref{ring} for more detailed explanations about this tactic.
+See chapter~\ref{ring} for more information on the tactic and how to
+declare new ring structures.
 
 \subsection{\tt field
-\tacindex{field}}
-
-This tactic written by David~Delahaye and Micaela~Mayero solves equalities
-using commutative field theory. Denominators have to be non equal to zero and,
-as this is not decidable in general, this tactic may generate side conditions
-requiring some expressions to be non equal to zero. This tactic must be loaded
-by {\tt Require Import Field}. Field theories are declared (as for {\tt ring}) with
-the {\tt Add Field} command.
+\tacindex{field}
+\comindex{Add Field}}
 
 \Example
 \begin{coq_example*}
@@ -2705,13 +2774,28 @@ intros; field.
 Reset Initial.
 \end{coq_eval}
 
-\subsection{\tt Add Field
-\comindex{Add Field}}
+\SeeAlso file {\tt theories/Reals/Rbase.v} for an example of instantiation,\\
+\phantom{\SeeAlso}theory {\tt theories/Reals} for many examples of use of {\tt
+field}.
+
+\subsection{\tt legacy field
+\tacindex{legacy field}}
+
+This tactic written by David~Delahaye and Micaela~Mayero solves equalities
+using commutative field theory. Denominators have to be non equal to zero and,
+as this is not decidable in general, this tactic may generate side conditions
+requiring some expressions to be non equal to zero. This tactic must be loaded
+by {\tt Require Import LegacyField}. Field theories are declared (as for
+{\tt legacy ring}) with
+the {\tt Add Legacy Field} command.
+
+\subsection{\tt Add Legacy Field
+\comindex{Add Legacy Field}}
 
 This vernacular command adds a commutative field theory to the database for the
 tactic {\tt field}. You must provide this theory as follows:
 \begin{flushleft}
-{\tt Add Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero} {\it
+{\tt Add Legacy Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero} {\it
 Aopp} {\it Aeq} {\it Ainv} {\it Rth} {\it Tinvl}}
 \end{flushleft}
 where {\tt {\it A}} is a term of type {\tt Type}, {\tt {\it Aplus}} is
@@ -2734,28 +2818,24 @@ Require Import Ring} if you want to call the {\tt ring} tactic.
 
 \begin{Variants}
 
-\item {\tt Add Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero}
+\item {\tt Add Legacy Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero}
 {\it Aopp} {\it Aeq} {\it Ainv} {\it Rth} {\it Tinvl}}\\
 {\tt \phantom{Add Field }with minus:={\it Aminus}}
 
 Adds also the term {\it Aminus} which must be a constant expressed by
 means of {\it Aopp}.
 
-\item {\tt Add Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero}
+\item {\tt Add Legacy Field {\it A} {\it Aplus} {\it Amult} {\it Aone} {\it Azero}
 {\it Aopp} {\it Aeq} {\it Ainv} {\it Rth} {\it Tinvl}}\\
-{\tt \phantom{Add Field }with div:={\it Adiv}}
+{\tt \phantom{Add Legacy Field }with div:={\it Adiv}}
 
 Adds also the term {\it Adiv} which must be a constant expressed by
 means of {\it Ainv}.
 
 \end{Variants}
 
-\SeeAlso file {\tt theories/Reals/Rbase.v} for an example of instantiation,\\
-\phantom{\SeeAlso}theory {\tt theories/Reals} for many examples of use of {\tt
-field}.
-
 \SeeAlso \cite{DelMay01} for more details regarding the implementation of {\tt
-field}.
+legacy field}.
 
 \subsection{\tt fourier
 \tacindex{fourier}}
@@ -2780,6 +2860,7 @@ Reset Initial.
 \end{coq_eval}
 
 \subsection{\tt autorewrite with \ident$_1$ \dots \ident$_n$.
+\label{tactic:autorewrite}
 \tacindex{autorewrite}}
 
 This tactic \footnote{The behavior of this tactic has much changed compared to
@@ -2806,9 +2887,17 @@ command.
 Performs, in the same way, all the rewritings of the bases {\tt $ident_1$ $...$
 $ident_n$} applying {\tt \tac} to the main subgoal after each rewriting step.
 
-\item \texttt{autorewrite with {\ident} in {\qualid}}
+\item \texttt{autorewrite with {\ident$_1$} \dots \ident$_n$ in {\qualid}}
 
   Performs all the rewritings in hypothesis {\qualid}.
+\item \texttt{autorewrite with {\ident$_1$} \dots \ident$_n$ in {\qualid}}
+
+  Performs all  the rewritings  in hypothesis {\qualid}  applying {\tt
+    \tac} to the main subgoal after each rewriting step.
+
+\item \texttt{autorewrite with {\ident$_1$} \dots \ident$_n$ in \textit{clause}}
+  Performs all  the rewritings  in the clause \textit{clause}. \\
+  The  \textit{clause} arg must  not contain  any \texttt{type  of} nor  \texttt{value  of}.
 
 \end{Variant}
 
@@ -3243,27 +3332,25 @@ tool for generating automatically induction principles
 corresponding to (possibly mutually recursive) functions.  Its
 syntax follows the schema:
 \begin{tabbing}
-{\tt Functional Scheme {\ident$_i$} := Induction for
-    \ident'$_i$ with \ident'$_1$ \dots\ \ident'$_m$.}
+{\tt Functional Scheme {\ident$_1$} := Induction for \ident'$_1$ Sort {\sort$_1$} \\
+  with\\
+  \mbox{}\hspace{0.1cm} \dots\ \\
+        with {\ident$_m$} := Induction for {\ident'$_m$} Sort
+        {\sort$_m$}}
 \end{tabbing}  
-\ident'$_1$ \dots\ \ident'$_m$ are the names of mutually recursive
-functions (they must be in the same order as when they were defined),
-\ident'$_i$ being one of them. This command generates the induction
-principle \ident$_i$, following the recursive structure and case
-analyses of the functions \ident'$_1$ \dots\ \ident'$_m$, and having
-\ident'$_i$ as entry point.
+\ident'$_1$ \dots\ \ident'$_m$ are different mutually defined function
+names (they must be in the same order as when they were defined).
+This command generates the induction principles
+\ident$_1$\dots\ident$_m$, following the recursive structure and case
+analyses of the functions \ident'$_1$ \dots\ \ident'$_m$.
 
-\begin{Variants}
-\item {\tt Functional Scheme {\ident$_1$} := Induction for \ident'$_1$.}
-  
-  This command is a shortcut for:
-  \begin{tabbing} 
-  {\tt Functional Scheme {\ident$_1$} := Induction for
-    \ident'$_1$ with \ident'$_1$.}
-\end{tabbing}
 
-This variant can be used for non mutually recursive functions only.
-\end{Variants}
+\paragraph{\texttt{Functional Scheme}} 
+There is a difference between obtaining an induction scheme by using
+\texttt{Functional Scheme} on a function defined by \texttt{Function}
+or not. Indeed \texttt{Function} generally produces smaller
+principles, closer to the definition written by the user.
+
 
 \SeeAlso Section~\ref{FunScheme-examples}
 
@@ -3292,7 +3379,7 @@ The chapter~\ref{TacticLanguage} gives examples of more complex
 user-defined tactics.
 
 
-% $Id: RefMan-tac.tex 9044 2006-07-12 13:22:17Z herbelin $ 
+% $Id: RefMan-tac.tex 9283 2006-10-26 08:13:51Z herbelin $ 
 
 %%% Local Variables: 
 %%% mode: latex
diff --git a/doc/refman/RefMan-tacex.tex b/doc/refman/RefMan-tacex.tex
index 57155d21..0aee4317 100644
--- a/doc/refman/RefMan-tacex.tex
+++ b/doc/refman/RefMan-tacex.tex
@@ -373,10 +373,11 @@ with forest : Set :=
 \end{coq_example*}
 
 We define the function \texttt{tree\_size} that computes the size
-of a tree or a forest.
+of a tree or a forest. Note that we use \texttt{Function} which
+generally produces better principles.
 
 \begin{coq_example*}                
-Fixpoint tree_size (t:tree) : nat :=
+Function tree_size (t:tree) : nat :=
   match t with
   | node A f => S (forest_size f)
   end
@@ -387,23 +388,31 @@ Fixpoint tree_size (t:tree) : nat :=
   end.
 \end{coq_example*}
 
-The definition of principle of mutual induction following the
-recursive structure of \texttt{tree\_size} is defined by the
-command:
+Remark: \texttt{Function} generates itself non mutual induction
+principles {\tt tree\_size\_ind} and {\tt forest\_size\_ind}:
+
+\begin{coq_example}
+Check tree_size_ind.
+\end{coq_example}
+
+The definition of mutual induction principles following the recursive
+structure of \texttt{tree\_size} and \texttt{forest\_size} is defined
+by the command:
 
 \begin{coq_example*}
-Functional Scheme tree_size_ind := Induction for tree_size Sort Prop
-with forest_size_ind := Induction for forest_size Sort Prop.
+Functional Scheme tree_size_ind2 := Induction for tree_size Sort Prop
+with forest_size_ind2 := Induction for forest_size Sort Prop.
 \end{coq_example*}
 
-You may now look at the type of {\tt tree\_size\_ind}:
+You may now look at the type of {\tt tree\_size\_ind2}:
 
 \begin{coq_example}
-Check tree_size_ind.
+Check tree_size_ind2.
 \end{coq_example}
 
 
 
+
 \section{{\tt inversion}}
 \tacindex{inversion}
 \label{inversion-examples}
diff --git a/doc/refman/Setoid.tex b/doc/refman/Setoid.tex
index 10cd5b3e..030400e5 100644
--- a/doc/refman/Setoid.tex
+++ b/doc/refman/Setoid.tex
@@ -493,12 +493,14 @@ unprefixed form.
   ~\zeroone{\texttt{using relation} \textit{term}}\\
   ~\zeroone{\texttt{generate side conditions}
   \textit{term}$_1$ \ldots \textit{term}$_n$}\\
+  ~\zeroone{\texttt{by} \textit{tactic}}
 \end{verse}
 
-The \texttt{generate side conditions} and \texttt{using relation} arguments cannot be
-passed to the unprefixed form. The latter argument tells the tactic what
-parametric relation should be used to replace the first tactic argument
-with the second one. If omitted, it defaults to Leibniz equality.
+The  \texttt{generate  side  conditions} and  \texttt{using  relation}
+arguments cannot be passed to the unprefixed form. The latter argument
+tells the  tactic what parametric  relation should be used  to replace
+the first tactic argument with the second one. If omitted, it defaults
+to Leibniz equality.
 
 Every derived tactic that is based on the unprefixed forms of the tactics
 considered above will also work up to user defined relations. For instance,
diff --git a/doc/refman/biblio.bib b/doc/refman/biblio.bib
index b9a3a2c5..d16c82c5 100644
--- a/doc/refman/biblio.bib
+++ b/doc/refman/biblio.bib
@@ -100,26 +100,25 @@ Computer Architecture},
         YEAR               = {1992}
 }
 
-@inproceedings{Bou97,
-   title = {Using reflection to build efficient and certified decision procedure
+@INPROCEEDINGS{Bou97,
+   TITLE       = {Using reflection to build efficient and certified decision procedure
 s},
-   author = {S. Boutin},
-   booktitle = {TACS'97},
-   editor = {Martin Abadi and Takahashi Ito},
-   publisher = SV,
-   series = lncs,
-   volume=1281, 
-   PS={http://pauillac.inria.fr/~boutin/public_w/submitTACS97.ps.gz}, 
-   year = {1997}
+   AUTHOR      = {S. Boutin},
+   BOOKTITLE   = {TACS'97},
+   EDITOR      = {Martin Abadi and Takahashi Ito},
+   PUBLISHER   = SV,
+   SERIES      = lncs,
+   VOLUME      = 1281, 
+   YEAR        = {1997}
 }
 
-@PhdThesis{Bou97These,
-  author =       {S. Boutin},
-  title =        {R\'eflexions sur les quotients},
-  school =       {Paris 7},
-  year =         1997,
-  type =         {th\`ese d'Universit\'e},
-  month =        apr
+@PHDTHESIS{Bou97These,
+  AUTHOR       = {S. Boutin},
+  TITLE        = {R\'eflexions sur les quotients},
+  SCHOOL       = {Paris 7},
+  YEAR         = 1997,
+  TYPE         = {th\`ese d'Universit\'e},
+  MONTH        = apr
 }
 
 @ARTICLE{Bru72,
@@ -297,6 +296,15 @@ s},
         crossref = {Nijmegen93}
 }
 
+@PHDTHESIS{Cor97,
+        AUTHOR             = {C. Cornes},
+        MONTH              = nov,
+        SCHOOL             = {{Universit\'e Paris 7}},
+        TITLE              = {Conception d'un langage de haut niveau de représentation de preuves},
+        TYPE               = {Th\`ese de Doctorat},
+        YEAR               = {1997}
+}
+
 @MASTERSTHESIS{Cou94a,
         AUTHOR             = {J. Courant},
         MONTH              = sep,
@@ -525,14 +533,23 @@ s},
         YEAR               = {1994}
 }
 
-@TechReport{Gim98,
-  author = 	 {E. Gim\'enez},
-  title = 	 {A Tutorial on Recursive Types in Coq},
-  institution =  {INRIA},
-  year = 	 1998,
-  month =	 mar
+@TECHREPORT{Gim98,
+  AUTHOR       = {E. Gim\'enez},
+  TITLE        = {A Tutorial on Recursive Types in Coq},
+  INSTITUTION  = {INRIA},
+  YEAR         = 1998,
+  MONTH        = mar
 }
 
+@UNPUBLISHED{GimCas05,
+  AUTHOR       = {E. Gim\'enez and P. Cast\'eran},
+  TITLE        = {A Tutorial on [Co-]Inductive Types in Coq},
+  INSTITUTION  = {INRIA},
+  YEAR         = 2005,
+  MONTH        = jan,
+  NOTE         = {available at \url{http://coq.inria.fr/doc}}
+} 
+
 @INPROCEEDINGS{Gimenez95b,
         AUTHOR             = {E. Gim\'enez},
         BOOKTITLE          = {Workshop on Types for Proofs and Programs},
@@ -607,8 +624,6 @@ s},
         YEAR               = {1980}
 }
 
-
-
 @InProceedings{Hue87tapsoft,
   author = 	 {G. Huet},
   title = 	 {Programming of Future Generation Computers},
@@ -630,8 +645,6 @@ s},
         YEAR               = {1988}
 }
 
-
-
 @INPROCEEDINGS{Hue88,
         AUTHOR             = {G. Huet},
         BOOKTITLE          = {A perspective in Theoretical Computer Science. Commemorative Volume for Gift Siromoney},
@@ -1115,15 +1128,16 @@ Decomposition}},
   note =	 {\url{http://proofgeneral.inf.ed.ac.uk/}}
 }
 
+@Book{CoqArt,
+   title = "Interactive Theorem Proving and Program Development.
+    Coq'Art: The Calculus of Inductive Constructions",
+   author = "Yves Bertot and Pierre Castéran",
+   publisher = "Springer Verlag",
+   series = "Texts in Theoretical Computer Science. An EATCS series", 
+ year = 2004
+  }
 
 
-@Book{CoqArt,
-  author =	 {Yves bertot and Pierre Castéran},
-  title = 	 {Coq'Art},
-  publisher = 	 {Springer-Verlag},
-  year = 	 2004,
-  note =	 {To appear}
-}
 
 @INCOLLECTION{wadler87,
         AUTHOR             = {P. Wadler},
diff --git a/doc/stdlib/Library.tex b/doc/stdlib/Library.tex
index 97748af6..598943a4 100755
--- a/doc/stdlib/Library.tex
+++ b/doc/stdlib/Library.tex
@@ -1,4 +1,4 @@
-\documentclass[11pt]{article}
+\documentclass[11pt]{report}
 
 \usepackage[latin1]{inputenc}
 \usepackage[T1]{fontenc}
@@ -19,7 +19,7 @@ General Public License Version 2.1.}
 \tableofcontents
 
 \newpage
-\section*{The \Coq\ standard library}
+% \section*{The \Coq\ standard library}
 
 This document is a short description of the \Coq\ standard library.
 This library comes with the system as a complement of the core library
@@ -59,4 +59,4 @@ you can access from the \Coq\ home page at
 
 \end{document}
 
-% $Id: Library.tex 8626 2006-03-14 15:01:00Z notin $ 
+% $Id: Library.tex 9245 2006-10-17 12:53:34Z notin $ 
diff --git a/ide/command_windows.ml b/ide/command_windows.ml
index 1f40e057..768d125c 100644
--- a/ide/command_windows.ml
+++ b/ide/command_windows.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: command_windows.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: command_windows.ml 9189 2006-09-29 12:39:24Z notin $ *)
 
 class command_window () = 
   let window = GWindow.window 
@@ -15,7 +15,7 @@ class command_window () =
 		 ~position:`CENTER
 		 ~title:"CoqIde queries" ~show:false ()
   in
-  let accel_group = GtkData.AccelGroup.create () in
+  let _ = GtkData.AccelGroup.create () in
   let vbox = GPack.vbox ~homogeneous:false ~packing:window#add () in
   let toolbar = GButton.toolbar 
 		  ~orientation:`HORIZONTAL 
@@ -52,7 +52,7 @@ class command_window () =
       ()
   in
 
-  let kill_page_menu = 
+  let _ = 
     toolbar#insert_button
       ~tooltip:"Kill Page"
       ~text:"Kill Page"
diff --git a/ide/coq.ml b/ide/coq.ml
index 32e8a02e..fae34ef2 100644
--- a/ide/coq.ml
+++ b/ide/coq.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coq.ml 9024 2006-07-06 10:38:15Z herbelin $ *)
+(* $Id: coq.ml 9263 2006-10-23 12:08:08Z barras $ *)
 
 open Vernac
 open Vernacexpr
@@ -19,6 +19,7 @@ open Printer
 open Environ
 open Evarutil
 open Evd
+open Decl_mode
 open Hipattern
 open Tacmach
 open Reductionops
@@ -53,43 +54,41 @@ let version () =
   let date =
     if Glib.Utf8.validate Coq_config.date
     then Coq_config.date
-    else "<date not printable>"
-  in
-  Printf.sprintf 
-    "The Coq Proof Assistant, version %s (%s)\
-   \nConfigured on %s\
-   \nArchitecture %s running %s operating system\
-   \nGtk version is %s\
-   \nThis is the %s version (%s is the best one for this architecture and OS)\
-   \n"
-    Coq_config.version date Coq_config.compile_date
-    Coq_config.arch Sys.os_type
-    (let x,y,z = GMain.Main.version in Printf.sprintf "%d.%d.%d" x y z)
+    else "<date not printable>" in
+  let get_version_date () =
+    try
+      let ch = open_in (Coq_config.coqtop^"/revision") in
+      let ver = input_line ch in
+      let rev = input_line ch in
+	(ver,rev)
+    with _ -> (Coq_config.version,date) in
+  let (rev,ver) = get_version_date () in
+    Printf.sprintf 
+      "The Coq Proof Assistant, version %s (%s)\
+       \nArchitecture %s running %s operating system\
+       \nGtk version is %s\
+       \nThis is the %s version (%s is the best one for this architecture and OS)\
+       \n"
+      rev ver
+      Coq_config.arch Sys.os_type
+      (let x,y,z = GMain.Main.version in Printf.sprintf "%d.%d.%d" x y z)
     (if Mltop.get () = Mltop.Native then "native" else "bytecode") 
     (if Coq_config.best="opt" then "native" else "bytecode") 
 
 let is_in_coq_lib dir = 
   prerr_endline ("Is it a coq theory ? : "^dir);
-  try
-    let stat = Unix.stat dir in
-      List.exists 
-	(fun s -> 
-	   try
-	     let fdir = Filename.concat 
-	       Coq_config.coqlib 
-	       (Filename.concat "theories" s) 
-	     in
-	       prerr_endline (" Comparing to: "^fdir);
-	       let fstat = Unix.stat fdir in 
-		 (fstat.Unix.st_dev = stat.Unix.st_dev) &&
-		   (fstat.Unix.st_ino = stat.Unix.st_ino) && 
-		   (prerr_endline " YES";true)
-	   with _ -> prerr_endline " No(because of a local exn)";false
-	)
-	Coq_config.theories_dirs
-  with _ -> prerr_endline " No(because of a global exn)";false
-
-let is_in_loadpath dir = Library.is_in_load_paths (System.physical_path_of_string dir)
+  let is_same_file = same_file dir in
+  List.exists 
+    (fun s -> 
+      let fdir =
+        Filename.concat Coq_config.coqlib (Filename.concat "theories" s) in
+      prerr_endline (" Comparing to: "^fdir);
+      if is_same_file fdir then (prerr_endline " YES";true)
+      else (prerr_endline"NO";false))
+    Coq_config.theories_dirs
+
+let is_in_loadpath dir =
+  Library.is_in_load_paths (System.physical_path_of_string dir)
 
 let is_in_coq_path f = 
   try 
@@ -104,7 +103,9 @@ let is_in_coq_path f =
     false  
 
 let is_in_proof_mode () = 
-  try ignore (get_pftreestate ()); true with _ -> false
+  match Decl_mode.get_current_mode () with
+      Decl_mode.Mode_none -> false
+    | _ -> true
 
 let user_error_loc l s =
   raise (Stdpp.Exc_located (l, Util.UserError ("CoqIde", s)))
@@ -246,12 +247,13 @@ type hyp = env * evar_map *
            ((identifier * string) * constr option * constr) * 
            (string * string)
 type concl = env * evar_map * constr * string
+type meta = env * evar_map * string
 type goal = hyp list * concl
 
 let prepare_hyp sigma env ((i,c,d) as a) =
   env, sigma,
   ((i,string_of_id i),c,d), 
-  (msg (pr_var_decl env a), msg (pr_lconstr_env_at_top env d))
+  (msg (pr_var_decl env a), msg (pr_ltype_env env d))
 
 let prepare_hyps sigma env =
   assert (rel_context env = []);
@@ -265,7 +267,38 @@ let prepare_hyps sigma env =
 let prepare_goal sigma g =
   let env = evar_env g in
   (prepare_hyps sigma env,
-   (env, sigma, g.evar_concl, msg (pr_lconstr_env_at_top env g.evar_concl)))
+   (env, sigma, g.evar_concl, msg (pr_ltype_env_at_top env g.evar_concl)))
+
+let prepare_hyps_filter info sigma env =
+  assert (rel_context env = []);
+  let hyps =
+    fold_named_context
+      (fun env ((id,_,_) as d) acc ->
+	 if true || Idset.mem id info.pm_hyps then
+	   let hyp = prepare_hyp sigma env d in hyp :: acc
+	 else acc)
+      env ~init:[] 
+  in
+  List.rev hyps
+
+let prepare_meta sigma env (m,typ)  =
+  env, sigma, 
+  (msg (str " ?" ++ int m ++ str " : " ++ pr_ltype_env_at_top env typ))
+
+let prepare_metas info sigma env =
+  List.fold_right 
+    (fun cpl acc ->  
+      let meta = prepare_meta sigma env cpl in meta :: acc)
+    info.pm_subgoals [] 
+
+let get_current_pm_goal () =
+  let pfts = get_pftreestate ()  in
+  let gls = try nth_goal_of_pftreestate 1 pfts with _ -> raise Not_found in
+  let info = Decl_mode.get_info gls.it in
+  let env = pf_env gls in
+  let sigma= sig_sig gls in
+    (prepare_hyps_filter info sigma env,
+     prepare_metas info sigma env)
 
 let get_current_goals () = 
     let pfts = get_pftreestate () in
@@ -275,14 +308,13 @@ let get_current_goals () =
 
 let get_current_goals_nb () = 
   try List.length (get_current_goals ()) with _ -> 0
-
   
 let print_no_goal () =
     let pfts = get_pftreestate () in
     let gls = fst (Refiner.frontier (Tacmach.proof_of_pftreestate pfts)) in 
     assert (gls = []);
     let sigma = Tacmach.project (Tacmach.top_goal_of_pftreestate pfts) in
-    msg (Printer.pr_subgoals sigma gls)
+    msg (Printer.pr_subgoals (Decl_mode.get_end_command pfts) sigma gls)
 
 
 type word_class = Normal | Kwd | Reserved
@@ -335,7 +367,7 @@ let compute_reset_info = function
   | VernacDeclareModule (_,(_,id), _, _)
   | VernacDeclareModuleType ((_,id), _, _)
   | VernacAssumption (_, (_,((_,id)::_,_))::_)
-  | VernacInductive (_, ((_,id),_,_,_,_) :: _) ->
+  | VernacInductive (_, (((_,id),_,_,_),_) :: _) ->
       Reset (id, ref true)
   | VernacDefinition (_, (_,id), ProveBody _, _)
   | VernacStartTheoremProof (_, (_,id), _, _, _) ->
diff --git a/ide/coq.mli b/ide/coq.mli
index 666a5397..4b4c3267 100644
--- a/ide/coq.mli
+++ b/ide/coq.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: coq.mli 8877 2006-05-30 16:37:04Z notin $ i*)
+(*i $Id: coq.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 open Names
 open Term
@@ -27,11 +27,14 @@ val is_state_preserving : Vernacexpr.vernac_expr -> bool
 
 type hyp = env * evar_map * 
            ((identifier*string) * constr option * constr) * (string * string)
+type meta = env * evar_map * string
 type concl = env * evar_map * constr * string
 type goal = hyp list * concl
 
 val get_current_goals : unit -> goal list
 
+val get_current_pm_goal : unit -> hyp list * meta list
+
 val get_current_goals_nb : unit -> int
 
 val print_no_goal : unit -> string
diff --git a/ide/coqide.ml b/ide/coqide.ml
index cfde925d..fb650cbf 100644
--- a/ide/coqide.ml
+++ b/ide/coqide.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqide.ml 8932 2006-06-09 09:29:03Z notin $ *)
+(* $Id: coqide.ml 9307 2006-10-28 18:48:48Z herbelin $ *)
 
 open Preferences
 open Vernacexpr
@@ -175,8 +175,9 @@ object('self)
   method reset_initial : unit
   method send_to_coq :
     bool -> bool -> string ->
-    bool -> bool -> bool -> (Util.loc * Vernacexpr.vernac_expr) option
+    bool -> bool -> bool -> (bool*(Util.loc * Vernacexpr.vernac_expr)) option
   method set_message : string -> unit
+  method show_pm_goal : unit
   method show_goals : unit
   method show_goals_full : unit
   method undo_last_step : unit
@@ -327,10 +328,10 @@ let remove_current_view_page () =
     kill_input_view c;
     ((notebook ())#get_nth_page c)#misc#hide ()
 
+let is_word_char c =
+  (* TODO: avoid num and prime at the head of a word *)
+  Glib.Unichar.isalnum c || c = underscore || c = prime
 
-let is_word_char c = 
-  Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase
-  
 let starts_word it = 
   prerr_endline ("Starts word ? '"^(Glib.Utf8.from_unichar it#char)^"'");
   (not it#copy#nocopy#backward_char ||
@@ -340,14 +341,14 @@ let starts_word it =
 let ends_word it = 
   (not it#copy#nocopy#forward_char ||
      let c = it#forward_char#char in
-       not (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase)
+       not (is_word_char c)
   )
 
 let inside_word it = 
   let c = it#char in
     not (starts_word it) &&
       not (ends_word it) &&
-      (Glib.Unichar.isalnum c || c = underscore || c = prime || c = arobase)
+      is_word_char c
 
 let is_on_word_limit it = inside_word it || ends_word it 
 
@@ -789,50 +790,88 @@ object(self)
 		  (String.make previous_line_spaces ' ')
 	end
 
+  method show_pm_goal = 
+      proof_buffer#insert 
+	(Printf.sprintf "    *** Declarative Mode ***\n");
+      try 
+	let (hyps,metas) = get_current_pm_goal () in
+	List.iter
+	  (fun ((_,_,_,(s,_)) as _hyp) -> 
+	     proof_buffer#insert (s^"\n"))
+	  hyps;
+	proof_buffer#insert 
+	  (String.make 38 '_' ^ "\n");
+	List.iter
+	  (fun (_,_,m) -> 
+	     proof_buffer#insert (m^"\n"))
+	  metas;
+	let my_mark = `NAME "end_of_conclusion" in
+	  proof_buffer#move_mark
+	    ~where:((proof_buffer#get_iter_at_mark `INSERT)) 
+	    my_mark;
+	  ignore (proof_view#scroll_to_mark my_mark) 
+    with Not_found ->  
+      match Decl_mode.get_end_command (Pfedit.get_pftreestate ()) with
+	  Some endc ->
+	    proof_buffer#insert 
+	      ("Subproof completed, now type "^endc^".") 
+	| None ->
+	    proof_buffer#insert "Proof completed."
 
   method show_goals = 
     try
       proof_view#buffer#set_text "";
-      let s = Coq.get_current_goals () in
-	match s with 
-	  | [] -> proof_buffer#insert (Coq.print_no_goal ())
-	  | (hyps,concl)::r -> 
-	      let goal_nb = List.length s in
-		proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" 
-				       goal_nb
-				       (if goal_nb<=1 then "" else "s"));
-		List.iter
-		  (fun ((_,_,_,(s,_)) as _hyp) -> 
-		     proof_buffer#insert (s^"\n"))
-		  hyps;
-		proof_buffer#insert (String.make 38 '_' ^ "(1/"^
-				       (string_of_int goal_nb)^
-				       ")\n") 
-		;
-		let _,_,_,sconcl = concl in
-		  proof_buffer#insert sconcl;
-		  proof_buffer#insert "\n";
-		  let my_mark = `NAME "end_of_conclusion" in
-		    proof_buffer#move_mark
-		      ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark;
-		    proof_buffer#insert "\n\n";
-		    let i = ref 1 in
-		      List.iter 
-			(function (_,(_,_,_,concl)) -> 
-			   incr i;
-			   proof_buffer#insert (String.make 38 '_' ^"("^
-						  (string_of_int !i)^
-						  "/"^
-						  (string_of_int goal_nb)^
-						  ")\n");
-			   proof_buffer#insert concl;
-			   proof_buffer#insert "\n\n";
-			)
-			r;
-		      ignore (proof_view#scroll_to_mark my_mark) 
-    with e -> prerr_endline ("Don't worry be happy despite: "^Printexc.to_string e)
-      
-
+      match Decl_mode.get_current_mode () with
+	  Decl_mode.Mode_none ->  proof_buffer#insert (Coq.print_no_goal ())
+	| Decl_mode.Mode_tactic ->   
+	    begin
+	      let s = Coq.get_current_goals () in
+		match s with 
+		  | [] -> proof_buffer#insert (Coq.print_no_goal ())
+		  | (hyps,concl)::r -> 
+		      let goal_nb = List.length s in
+			proof_buffer#insert 
+			  (Printf.sprintf "%d subgoal%s\n" 
+			     goal_nb
+			     (if goal_nb<=1 then "" else "s"));
+			List.iter
+			  (fun ((_,_,_,(s,_)) as _hyp) -> 
+			     proof_buffer#insert (s^"\n"))
+			  hyps;
+			proof_buffer#insert 
+			  (String.make 38 '_' ^ "(1/"^
+			     (string_of_int goal_nb)^
+			     ")\n") ;
+			let _,_,_,sconcl = concl in
+			  proof_buffer#insert sconcl;
+			  proof_buffer#insert "\n";
+			  let my_mark = `NAME "end_of_conclusion" in
+			    proof_buffer#move_mark
+			      ~where:((proof_buffer#get_iter_at_mark `INSERT)) 
+			      my_mark;
+			    proof_buffer#insert "\n\n";
+			    let i = ref 1 in
+			      List.iter 
+				(function (_,(_,_,_,concl)) -> 
+				   incr i;
+				   proof_buffer#insert 
+				     (String.make 38 '_' ^"("^
+					(string_of_int !i)^
+					"/"^
+					(string_of_int goal_nb)^
+					")\n");
+				   proof_buffer#insert concl;
+				   proof_buffer#insert "\n\n";
+				)
+				r;
+			      ignore (proof_view#scroll_to_mark my_mark) 
+	    end
+	| Decl_mode.Mode_proof -> 
+	    self#show_pm_goal
+    with e -> 
+      prerr_endline ("Don't worry be happy despite: "^Printexc.to_string e)
+	
+	      
   val mutable full_goal_done = true
 
   method show_goals_full = 
@@ -840,148 +879,160 @@ object(self)
       begin
 	try
 	  proof_view#buffer#set_text "";
-	  let s = Coq.get_current_goals () in
-	  let last_shown_area = proof_buffer#create_tag [`BACKGROUND "light green"]
-	  in
-	    match s with 
-	      | [] -> proof_buffer#insert (Coq.print_no_goal ())
-	      | (hyps,concl)::r -> 
-		  let goal_nb = List.length s in
-		    proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" 
-					   goal_nb
-					   (if goal_nb<=1 then "" else "s"));
-		    let coq_menu commands = 
-		      let tag = proof_buffer#create_tag []
-		      in 
-			ignore
-			  (tag#connect#event ~callback:
-			     (fun ~origin ev it ->
-				begin match GdkEvent.get_type ev with 
-				  | `BUTTON_PRESS -> 
-				      let ev = (GdkEvent.Button.cast ev) in
-					if (GdkEvent.Button.button ev) = 3
-					then begin 
-					    let loc_menu = GMenu.menu () in
-					    let factory = new GMenu.factory loc_menu in
-					    let add_coq_command (cp,ip) = 
-					      ignore 
-						(factory#add_item cp 
-						   ~callback:
-						   (fun () -> ignore
-						      (self#insert_this_phrase_on_success 
-							 true
-							 true 
-							 false 
-							 ("progress "^ip^"\n") 
-							 (ip^"\n"))
-						   )
-						)
-					    in
-					      List.iter add_coq_command commands;
-					      loc_menu#popup 
-						~button:3
-						~time:(GdkEvent.Button.time ev);
-					  end
-				  | `MOTION_NOTIFY -> 
-				      proof_buffer#remove_tag
-					~start:proof_buffer#start_iter
-					~stop:proof_buffer#end_iter
-					last_shown_area;
-				      prerr_endline "Before find_tag_limits";
-				      
-				      let s,e = find_tag_limits tag 
+	  match Decl_mode.get_current_mode () with
+	      Decl_mode.Mode_none ->  
+		proof_buffer#insert (Coq.print_no_goal ())
+	    | Decl_mode.Mode_tactic ->   
+		begin
+		  match Coq.get_current_goals () with 
+		      [] -> Util.anomaly "show_goals_full"
+		  | ((hyps,concl)::r) as s ->
+		      let last_shown_area = 
+			proof_buffer#create_tag [`BACKGROUND "light green"]
+		      in
+		      let goal_nb = List.length s in
+			proof_buffer#insert (Printf.sprintf "%d subgoal%s\n" 
+					 goal_nb
+					 (if goal_nb<=1 then "" else "s"));
+		  let coq_menu commands = 
+		    let tag = proof_buffer#create_tag []
+		    in 
+		      ignore
+			(tag#connect#event ~callback:
+			   (fun ~origin ev it ->
+			      begin match GdkEvent.get_type ev with 
+				| `BUTTON_PRESS -> 
+				    let ev = (GdkEvent.Button.cast ev) in
+				      if (GdkEvent.Button.button ev) = 3
+				      then begin 
+					let loc_menu = GMenu.menu () in
+					let factory = 
+					  new GMenu.factory loc_menu in
+					let add_coq_command (cp,ip) = 
+					  ignore 
+					    (factory#add_item cp 
+					       ~callback:
+				     (fun () -> ignore
+					(self#insert_this_phrase_on_success 
+					   true
+					   true 
+					   false 
+					   ("progress "^ip^"\n") 
+					   (ip^"\n"))
+				     )
+				  )
+			      in
+			      List.iter add_coq_command commands;
+			      loc_menu#popup 
+				~button:3
+				~time:(GdkEvent.Button.time ev);
+			    end
+			| `MOTION_NOTIFY -> 
+			    proof_buffer#remove_tag
+			    ~start:proof_buffer#start_iter
+			    ~stop:proof_buffer#end_iter
+			    last_shown_area;
+			    prerr_endline "Before find_tag_limits";
+			    
+			    let s,e = find_tag_limits tag 
 					(new GText.iter it) 
-				      in
-					prerr_endline "After find_tag_limits";
-					proof_buffer#apply_tag 
-					  ~start:s 
-					  ~stop:e 
-					  last_shown_area;
-					
-					prerr_endline "Applied tag";
-					()
-				  | _ -> ()
-				end;false
-			     )
-			  );
-			tag
-		    in
-		      List.iter
-			(fun ((_,_,_,(s,_)) as hyp) -> 
-			   let tag = coq_menu (hyp_menu hyp) in
-			     proof_buffer#insert ~tags:[tag] (s^"\n"))
-			hyps;
-		      proof_buffer#insert 
-			(String.make 38 '_' ^"(1/"^
-			   (string_of_int goal_nb)^
-			   ")\n") 
-		      ;
-		      let tag = coq_menu (concl_menu concl) in
-		      let _,_,_,sconcl = concl in
-			proof_buffer#insert ~tags:[tag] sconcl;
-			proof_buffer#insert "\n";
-			let my_mark = `NAME "end_of_conclusion" in
-			  proof_buffer#move_mark
-			    ~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark;
-			  proof_buffer#insert "\n\n";
-			  let i = ref 1 in
-			    List.iter 
-			      (function (_,(_,_,_,concl)) -> 
-				 incr i;
-				 proof_buffer#insert 
-				   (String.make 38 '_' ^"("^
-				      (string_of_int !i)^
-				      "/"^
-				      (string_of_int goal_nb)^
-				      ")\n");
-				 proof_buffer#insert concl;
-				 proof_buffer#insert "\n\n";
-			      )
-			      r;
-			    ignore (proof_view#scroll_to_mark my_mark) ;
-			    full_goal_done <- true;
-	with e -> prerr_endline (Printexc.to_string e)
+			    in
+			    prerr_endline "After find_tag_limits";
+			    proof_buffer#apply_tag 
+			      ~start:s 
+			      ~stop:e 
+			      last_shown_area;
+			    
+			    prerr_endline "Applied tag";
+			    ()
+			| _ -> ()
+			end;false
+		     )
+		  );
+		tag
+	      in
+	      List.iter
+		(fun ((_,_,_,(s,_)) as hyp) -> 
+		   let tag = coq_menu (hyp_menu hyp) in
+		   proof_buffer#insert ~tags:[tag] (s^"\n"))
+		hyps;
+	      proof_buffer#insert 
+		(String.make 38 '_' ^"(1/"^
+		 (string_of_int goal_nb)^
+		 ")\n") 
+	      ;
+	      let tag = coq_menu (concl_menu concl) in
+	      let _,_,_,sconcl = concl in
+	      proof_buffer#insert ~tags:[tag] sconcl;
+	      proof_buffer#insert "\n";
+	      let my_mark = `NAME "end_of_conclusion" in
+	      proof_buffer#move_mark
+		~where:((proof_buffer#get_iter_at_mark `INSERT)) my_mark;
+	      proof_buffer#insert "\n\n";
+	      let i = ref 1 in
+	      List.iter 
+		(function (_,(_,_,_,concl)) -> 
+		   incr i;
+		   proof_buffer#insert 
+		     (String.make 38 '_' ^"("^
+		      (string_of_int !i)^
+		      "/"^
+		      (string_of_int goal_nb)^
+		      ")\n");
+		   proof_buffer#insert concl;
+		   proof_buffer#insert "\n\n";
+		)
+		r;
+		ignore (proof_view#scroll_to_mark my_mark) ;
+		full_goal_done <- true
+		end
+	    | Decl_mode.Mode_proof ->
+		self#show_pm_goal
+	  with e -> prerr_endline (Printexc.to_string e)
       end
-	
+      
   method send_to_coq verbosely replace phrase show_output show_error localize =
     let display_output msg =
       self#insert_message (if show_output then msg else "") in
     let display_error e =
       let (s,loc) = Coq.process_exn e in
-	assert (Glib.Utf8.validate s);
-	self#insert_message s;
-	message_view#misc#draw None;
-	if localize then 
-	  (match Util.option_map Util.unloc loc with 
-	     | None -> ()
-	     | Some (start,stop) ->
-		 let convert_pos = byte_offset_to_char_offset phrase in
-		 let start = convert_pos start in
-		 let stop = convert_pos stop in
-		 let i = self#get_start_of_input in 
-		 let starti = i#forward_chars start in
-		 let stopi = i#forward_chars stop in
-		   input_buffer#apply_tag_by_name "error"
-   		     ~start:starti
-		     ~stop:stopi;
-		   input_buffer#place_cursor starti) in
-      try 
-	full_goal_done <- false;
-	prerr_endline "Send_to_coq starting now";
-	if replace then begin
-	    let r,info = Coq.interp_and_replace ("info " ^ phrase) in
-	    let msg = read_stdout () in
-              sync display_output msg;
-	      Some r	
-	  end else begin
-	      let r = Coq.interp verbosely phrase in
-	      let msg = read_stdout () in
-		sync display_output msg;
-		Some r
-	    end
-      with e ->
-	if show_error then sync display_error e;
-	None
+      assert (Glib.Utf8.validate s);
+      self#insert_message s;
+      message_view#misc#draw None;
+      if localize then 
+	(match Util.option_map Util.unloc loc with 
+	  | None -> ()
+	  | Some (start,stop) ->
+	      let convert_pos = byte_offset_to_char_offset phrase in
+	      let start = convert_pos start in
+	      let stop = convert_pos stop in
+	      let i = self#get_start_of_input in 
+	      let starti = i#forward_chars start in
+	      let stopi = i#forward_chars stop in
+	      input_buffer#apply_tag_by_name "error"
+   		~start:starti
+		~stop:stopi;
+	      input_buffer#place_cursor starti) in
+    try 
+      full_goal_done <- false;
+      prerr_endline "Send_to_coq starting now";
+      Decl_mode.clear_daimon_flag ();
+      if replace then begin
+	let r,info = Coq.interp_and_replace ("info " ^ phrase) in
+	let complete = not (Decl_mode.get_daimon_flag ()) in 
+	let msg = read_stdout () in
+        sync display_output msg;
+	Some (complete,r)	
+      end else begin
+	let r = Coq.interp verbosely phrase in
+	let complete = not (Decl_mode.get_daimon_flag ()) in 
+	let msg = read_stdout () in
+        sync display_output msg;
+        Some (complete,r)
+      end
+    with e ->
+      if show_error then sync display_error e;
+      None
 
   method find_phrase_starting_at (start:GText.iter) = 
     prerr_endline "find_phrase_starting_at starting now";
@@ -1018,7 +1069,7 @@ object(self)
     in
       try
 	trash_bytes := "";
-	let phrase = Find_phrase.get (Lexing.from_function lexbuf_function) 
+	let _ = Find_phrase.get (Lexing.from_function lexbuf_function) 
 	in
 	  end_iter#nocopy#set_offset (start#offset + !Find_phrase.length);
 	  Some (start,end_iter)
@@ -1089,10 +1140,11 @@ object(self)
 	  input_view#set_editable true;
 	  !pop_info ();
 	end in
-    let mark_processed (start,stop) ast =
-      let b = input_buffer in
+      let mark_processed complete (start,stop) ast =
+        let b = input_buffer in
 	b#move_mark ~where:stop (`NAME "start_of_input");
-	b#apply_tag_by_name "processed" ~start ~stop;
+	b#apply_tag_by_name 
+	  (if complete then "processed" else "unjustified") ~start ~stop;
 	if (self#get_insert#compare) stop <= 0 then 
 	  begin
 	    b#place_cursor stop;
@@ -1100,67 +1152,69 @@ object(self)
 	  end;
 	let start_of_phrase_mark = `MARK (b#create_mark start) in
 	let end_of_phrase_mark = `MARK (b#create_mark stop) in
-	  push_phrase 
-	    start_of_phrase_mark 
-	    end_of_phrase_mark ast;
-	  if display_goals then self#show_goals;
-          remove_tag (start,stop) in
+	push_phrase 
+	  start_of_phrase_mark 
+	  end_of_phrase_mark ast;
+	if display_goals then self#show_goals;
+        remove_tag (start,stop) in
       begin
         match sync get_next_phrase () with
             None -> false
           | Some (loc,phrase) ->
-              (match self#send_to_coq verbosely false phrase true true true with
-		 | Some ast -> sync (mark_processed loc) ast; true
-		 | None -> sync remove_tag loc; false)
+            (match self#send_to_coq verbosely false phrase true true true with
+	      | Some (complete,ast) -> 
+		  sync (mark_processed complete) loc ast; true
+	      | None -> sync remove_tag loc; false)
       end
-	
+    
   method insert_this_phrase_on_success 
     show_output show_msg localize coqphrase insertphrase = 
-    let mark_processed ast =
+    let mark_processed complete ast =
       let stop = self#get_start_of_input in
-	if stop#starts_line then
-	  input_buffer#insert ~iter:stop insertphrase
-	else input_buffer#insert ~iter:stop ("\n"^insertphrase); 
-	let start = self#get_start_of_input in
-	  input_buffer#move_mark ~where:stop (`NAME "start_of_input");
-	  input_buffer#apply_tag_by_name "processed" ~start ~stop;
-	  if (self#get_insert#compare) stop <= 0 then 
-	    input_buffer#place_cursor stop;
-	  let start_of_phrase_mark = `MARK (input_buffer#create_mark start) in
-	  let end_of_phrase_mark = `MARK (input_buffer#create_mark stop) in
-	    push_phrase start_of_phrase_mark end_of_phrase_mark ast;
-	    self#show_goals;
-	    (*Auto insert save on success... 
-	      try (match Coq.get_current_goals () with 
-	      | [] ->  
-	      (match self#send_to_coq "Save.\n" true true true with
+      if stop#starts_line then
+	input_buffer#insert ~iter:stop insertphrase
+      else input_buffer#insert ~iter:stop ("\n"^insertphrase); 
+      let start = self#get_start_of_input in
+      input_buffer#move_mark ~where:stop (`NAME "start_of_input");
+      input_buffer#apply_tag_by_name 
+	(if complete then "processed" else "unjustified") ~start ~stop;
+      if (self#get_insert#compare) stop <= 0 then 
+	input_buffer#place_cursor stop;
+      let start_of_phrase_mark = `MARK (input_buffer#create_mark start) in
+      let end_of_phrase_mark = `MARK (input_buffer#create_mark stop) in
+      push_phrase start_of_phrase_mark end_of_phrase_mark ast;
+      self#show_goals;
+      (*Auto insert save on success... 
+      try (match Coq.get_current_goals () with 
+	| [] ->  
+	    (match self#send_to_coq "Save.\n" true true true with
 	      | Some ast -> 
-	      begin
-              let stop = self#get_start_of_input in
-	      if stop#starts_line then
-	      input_buffer#insert ~iter:stop "Save.\n"
-	      else input_buffer#insert ~iter:stop "\nSave.\n"; 
-	      let start = self#get_start_of_input in
-	      input_buffer#move_mark ~where:stop (`NAME"start_of_input");
-	      input_buffer#apply_tag_by_name "processed" ~start ~stop;
-	      if (self#get_insert#compare) stop <= 0 then 
-	      input_buffer#place_cursor stop;
-	      let start_of_phrase_mark =
-              `MARK (input_buffer#create_mark start) in
-	      let end_of_phrase_mark =
-              `MARK (input_buffer#create_mark stop) in
-	      push_phrase start_of_phrase_mark end_of_phrase_mark ast
-	      end
+	          begin
+                    let stop = self#get_start_of_input in
+	            if stop#starts_line then
+	              input_buffer#insert ~iter:stop "Save.\n"
+	            else input_buffer#insert ~iter:stop "\nSave.\n"; 
+	            let start = self#get_start_of_input in
+	            input_buffer#move_mark ~where:stop (`NAME"start_of_input");
+	            input_buffer#apply_tag_by_name "processed" ~start ~stop;
+	            if (self#get_insert#compare) stop <= 0 then 
+	              input_buffer#place_cursor stop;
+	            let start_of_phrase_mark =
+                      `MARK (input_buffer#create_mark start) in
+	            let end_of_phrase_mark =
+                      `MARK (input_buffer#create_mark stop) in
+	            push_phrase start_of_phrase_mark end_of_phrase_mark ast
+	          end
 	      | None -> ())
-	      | _ -> ())
-	      with _ -> ()*) in
-      match self#send_to_coq false false coqphrase show_output show_msg localize with
-	| Some ast -> sync mark_processed ast; true
-	| None ->
-            sync
-              (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase))
-              ();
-	    false
+	| _ -> ())
+      with _ -> ()*) in
+    match self#send_to_coq false false coqphrase show_output show_msg localize with
+      | Some (complete,ast) -> sync (mark_processed complete) ast; true
+      | None ->
+          sync
+            (fun _ -> self#insert_message ("Unsuccessfully tried: "^coqphrase))
+            ();
+	  false
 
   method process_until_iter_or_error stop =
     let stop' = `OFFSET stop#offset in
@@ -1170,20 +1224,29 @@ object(self)
 	      input_buffer#apply_tag_by_name ~start ~stop "to_process";
 	      input_view#set_editable false) ();
       !push_info "Coq is computing";
-      (try 
-	   while ((stop#compare self#get_start_of_input>=0) 
-		  && (self#process_next_phrase false false false))
-	   do Util.check_for_interrupt () done
-       with Sys.Break -> 
-	 prerr_endline "Interrupted during process_until_iter_or_error");
-      sync (fun _ ->
-	      self#show_goals;
-	      (* Start and stop might be invalid if an eol was added at eof *)
-	      let start = input_buffer#get_iter start' in
-	      let stop =  input_buffer#get_iter stop' in
-		input_buffer#remove_tag_by_name ~start ~stop "to_process" ;
-		input_view#set_editable true) ();
-      !pop_info()
+      let get_current () =
+	if !current.stop_before then
+          match self#find_phrase_starting_at self#get_start_of_input with
+            | None -> self#get_start_of_input
+            | Some (_, stop2) -> stop2
+	else begin
+            self#get_start_of_input
+	  end
+      in   
+	(try 
+	    while ((stop#compare (get_current())>=0) 
+		    && (self#process_next_phrase false false false))
+	    do Util.check_for_interrupt () done
+	  with Sys.Break -> 
+	    prerr_endline "Interrupted during process_until_iter_or_error");
+	sync (fun _ ->
+	  self#show_goals;
+	  (* Start and stop might be invalid if an eol was added at eof *)
+	  let start = input_buffer#get_iter start' in
+	  let stop =  input_buffer#get_iter stop' in
+	    input_buffer#remove_tag_by_name ~start ~stop "to_process" ;
+	    input_view#set_editable true) ();
+	!pop_info()
 
   method process_until_end_or_error = 
     self#process_until_iter_or_error input_buffer#end_iter
@@ -1196,6 +1259,7 @@ object(self)
 		 let stop = input_buffer#get_iter_at_mark inf.stop in
 		   input_buffer#move_mark ~where:start (`NAME "start_of_input");
 		   input_buffer#remove_tag_by_name "processed" ~start ~stop;
+		   input_buffer#remove_tag_by_name "unjustified" ~start ~stop;
 		   input_buffer#delete_mark inf.start;
 		   input_buffer#delete_mark inf.stop;
               ) 
@@ -1260,6 +1324,10 @@ object(self)
 			~start 
 			~stop:self#get_start_of_input
 			"processed";
+		      input_buffer#remove_tag_by_name 
+			~start 
+			~stop:self#get_start_of_input
+			"unjustified";
 		      prerr_endline "Moving (long) start_of_input...";
 		      input_buffer#move_mark ~where:start (`NAME "start_of_input");
 		      self#show_goals;
@@ -1269,9 +1337,9 @@ object(self)
 	  with _ -> 
 	    !push_info "WARNING: undo failed badly -> Coq might be in an inconsistent state.
 Please restart and report NOW.";
-	end
-      else prerr_endline "backtrack_to : discarded (...)"
-	
+      end
+    else prerr_endline "backtrack_to : discarded (...)"
+      
   method backtrack_to i = 
     if Mutex.try_lock coq_may_stop then 
       (!push_info "Undoing...";self#backtrack_to_no_lock i ; Mutex.unlock coq_may_stop;
@@ -1296,6 +1364,10 @@ Please restart and report NOW.";
 		~start
 		~stop:(input_buffer#get_iter_at_mark last_command.stop) 
 		"processed";
+	      input_buffer#remove_tag_by_name 
+	        ~start
+	        ~stop:(input_buffer#get_iter_at_mark last_command.stop) 
+	      "unjustified";
 	      prerr_endline "Moving start_of_input";
 	      input_buffer#move_mark
 		~where:start
@@ -1356,6 +1428,7 @@ Please restart and report NOW.";
 		 let c = Blaster_window.present_blaster_window () in
 		   if Mutex.try_lock c#lock then begin
 		       c#clear ();
+                      Decl_mode.check_not_proof_mode "No blaster in Proof mode";
 		       let current_gls = try get_current_goals () with _ -> [] in
 			 
 		       let set_goal i (s,t) = 
@@ -1555,10 +1628,16 @@ Please restart and report NOW.";
 	      ~callback:(fun tag ~start ~stop ->
 			   if (start#compare self#get_start_of_input)>=0
 			   then 
-			     input_buffer#remove_tag_by_name 
-			       ~start
-			       ~stop
-			       "processed"
+			     begin
+			       input_buffer#remove_tag_by_name 
+				 ~start
+				 ~stop
+				 "processed";
+			       input_buffer#remove_tag_by_name 
+				 ~start
+				 ~stop
+				 "unjustified"
+			     end
 			)
 	   );
     ignore (input_buffer#connect#after#insert_text
@@ -1636,10 +1715,10 @@ end
 
 let create_input_tab filename =
   let b = GText.buffer () in 
-  let tablabel = GMisc.label () in 
+  let _ = GMisc.label () in 
   let v_box = GPack.hbox ~homogeneous:false () in
-  let image = GMisc.image ~packing:v_box#pack () in
-  let label = GMisc.label ~text:filename ~packing:v_box#pack () in
+  let _ = GMisc.image ~packing:v_box#pack () in
+  let _ = GMisc.label ~text:filename ~packing:v_box#pack () in
   let fr1 = GBin.frame ~shadow_type:`ETCHED_OUT
     ~packing:((notebook ())#append_page
 		~tab_label:v_box#coerce) () 
@@ -1694,6 +1773,10 @@ let create_input_tab filename =
       ignore (tv1#buffer#create_tag 
 		~name:"processed" 
 		[`BACKGROUND "light green" ;`EDITABLE false]);
+      ignore (tv1#buffer#create_tag (* Proof mode *)
+	        ~name:"unjustified" 
+               [`UNDERLINE `SINGLE ; `FOREGROUND "red";
+	         `BACKGROUND "gold" ;`EDITABLE false]);
       ignore (tv1#buffer#create_tag 
 		~name:"found" 
 		[`BACKGROUND "blue"; `FOREGROUND "white"]);
@@ -1933,7 +2016,8 @@ let main files =
 		ignore (revert_m#connect#activate revert_f);
 		
 		(* File/Close Menu *)
-		let close_m = file_factory#add_item "_Close Buffer" in
+		let close_m =
+                  file_factory#add_item "_Close Buffer" ~key:GdkKeysyms._W in
 		let close_f () = 
 		  let v = out_some !active_view in
 		  let act = get_current_view_page () in
@@ -1958,7 +2042,9 @@ let main files =
 			    let s,_ = run_command av#insert_message cmd in
 			      !flash_info (cmd ^ if s = Unix.WEXITED 0 then " succeeded" else " failed")
 		  in
-		  let print_m = file_factory#add_item "_Print" ~callback:print_f in
+		  let _ = file_factory#add_item "_Print"
+	            ~key:GdkKeysyms._P
+                    ~callback:print_f in
 
 		  (* File/Export to Menu *)
 		  let export_f kind () =
@@ -1989,16 +2075,16 @@ let main files =
 		  let file_export_m =  file_factory#add_submenu "E_xport to" in
 
 		  let file_export_factory = new GMenu.factory ~accel_path:"<CoqIde MenuBar>/Export/" file_export_m ~accel_group in
-		  let export_html_m = 
+		  let _ = 
 		    file_export_factory#add_item "_Html" ~callback:(export_f "html") 
 		  in
-		  let export_latex_m = 
+		  let _ = 
 		    file_export_factory#add_item "_LaTeX" ~callback:(export_f "latex")
 		  in
-		  let export_dvi_m = 
+		  let _ = 
 		    file_export_factory#add_item "_Dvi" ~callback:(export_f "dvi") 
 		  in
-		  let export_ps_m = 
+		  let _ = 
 		    file_export_factory#add_item "_Ps" ~callback:(export_f "ps") 
 		  in
 
@@ -2031,7 +2117,7 @@ let main files =
 			  | _ -> ()
 		      else exit 0
 		    in
-		    let quit_m = file_factory#add_item "_Quit" ~key:GdkKeysyms._Q 
+		    let _ = file_factory#add_item "_Quit" ~key:GdkKeysyms._Q 
 		      ~callback:quit_f
 		    in
 		      ignore (w#event#connect#delete (fun _ -> quit_f (); true));
@@ -2096,7 +2182,7 @@ let main files =
 			  ~col_spacings:10 ~row_spacings:10 ~border_width:10
 			  ~homogeneous:false ~packing:find_w#add () in
 			  
-			let find_lbl = 
+			let _ = 
 			  GMisc.label ~text:"Find:"
 			    ~xalign:1.0
 			    ~packing:(find_box#attach ~left:0 ~top:0 ~fill:`X) () 
@@ -2106,7 +2192,7 @@ let main files =
 			  ~packing: (find_box#attach ~left:1 ~top:0 ~expand:`X)
 			  ()
 			in
-			let replace_lbl = 
+			let _ = 
 			  GMisc.label ~text:"Replace with:"
 			    ~xalign:1.0
 			    ~packing:(find_box#attach ~left:0 ~top:1 ~fill:`X) () 
@@ -2116,7 +2202,7 @@ let main files =
 			  ~packing: (find_box#attach ~left:1 ~top:1 ~expand:`X)
 			  ()
 			in
-			let case_sensitive_check = 
+			let _ = 
 			  GButton.check_button
 			    ~label:"case sensitive"
 			    ~active:true
@@ -2268,11 +2354,11 @@ let main files =
 			    find_w#present ();
 			    find_entry#misc#grab_focus ()
 			  in
-			  let find_i = edit_f#add_item "_Find in buffer"
+			  let _ = edit_f#add_item "_Find in buffer"
 			    ~key:GdkKeysyms._F
 			    ~callback:(find_f ~backward:false)
 			  in
-			  let find_back_i = edit_f#add_item "Find _backwards"
+			  let _ = edit_f#add_item "Find _backwards"
 			    ~key:GdkKeysyms._B
 			    ~callback:(find_f ~backward:true)
 			  in
@@ -2365,7 +2451,7 @@ let main files =
 			      in reset_auto_save_timer (); (* to enable statup preferences timer *)
 
 
-				let edit_prefs_m =
+				let _ =
 				  edit_f#add_item "_Preferences"
 				    ~callback:(fun () -> configure ();reset_revert_timer ())
 				in
@@ -2417,10 +2503,14 @@ let main files =
 				  add_to_menu_toolbar 
 				    "_Save" 
 				    ~tooltip:"Save current buffer" 
-				    (* ~key:GdkKeysyms._Down *)
 				    ~callback:save_f
 				    `SAVE;
 				  add_to_menu_toolbar 
+				    "_Close" 
+				    ~tooltip:"Close current buffer" 
+				    ~callback:close_f
+				    `CLOSE;
+				  add_to_menu_toolbar 
 				    "_Forward" 
 				    ~tooltip:"Forward one command" 
 				    ~key:GdkKeysyms._Down 
@@ -2779,7 +2869,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 							  av#insert_message res
 							end
 					  in
-					  let compile_m = 
+					  let _ = 
 					    externals_factory#add_item "_Compile Buffer" ~callback:compile_f 
 					  in
 
@@ -2796,7 +2886,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 						last_make_index := 0;
 						!flash_info (!current.cmd_make ^ if s = Unix.WEXITED 0 then " succeeded" else " failed")
 					  in
-					  let make_m = externals_factory#add_item "_Make" 
+					  let _ = externals_factory#add_item "_Make" 
 					    ~key:GdkKeysyms._F6
 					    ~callback:make_f 
 					  in
@@ -2837,7 +2927,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 					      let av = out_some v.analyzed_view in
 						av#set_message "No more errors.\n"
 					  in
-					  let next_error_m = 
+					  let _ = 
 					    externals_factory#add_item "_Next error" 
 					      ~key:GdkKeysyms._F7
 					      ~callback:next_error in
@@ -2857,7 +2947,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 					  let configuration_menu = factory#add_submenu "_Windows" in
 					  let configuration_factory = new GMenu.factory configuration_menu ~accel_path:"<CoqIde MenuBar>/Windows" ~accel_group
 					  in
-					  let queries_show_m = 
+					  let _ = 
 					    configuration_factory#add_item 
 					      "Show _Query Window"
 					      (*
@@ -2865,14 +2955,14 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 					      *)
 					      ~callback:(Command_windows.command_window ())#window#present
 					  in  
-					  let toolbar_show_m = 
+					  let _ = 
 					    configuration_factory#add_item 
 					      "Show/Hide _Toolbar"	       
 					      ~callback:(fun () ->  
 							   !current.show_toolbar <- not !current.show_toolbar; 
 							   !show_toolbar !current.show_toolbar) 
 					  in
-					  let detach_menu = configuration_factory#add_item 
+					  let _ = configuration_factory#add_item 
 					    "Detach _Script Window"
 					    ~callback:
 					    (do_if_not_computing "detach script window" (sync
@@ -2890,7 +2980,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 												  end	      
 											   )))
 					  in
-					  let detach_current_view = 
+					  let _ = 
 					    configuration_factory#add_item 
 					      "Detach _View"
 					      ~callback:
@@ -3177,7 +3267,7 @@ with _ := Induction for _ Sort _.\n",61,10, Some GdkKeysyms._S);
 						      let tv2 = GText.view ~packing:(sw2#add) () in
 							tv2#misc#set_name "GoalWindow";
 							let _ = tv2#set_editable false in
-							let tb2 = tv2#buffer in
+							let _ = tv2#buffer in
 							let tv3 = GText.view ~packing:(sw3#add) () in
 							  tv2#misc#set_name "MessageWindow";
 							  let _ = tv2#set_wrap_mode `CHAR in
diff --git a/ide/find_phrase.mll b/ide/find_phrase.mll
index 1621e313..23019185 100644
--- a/ide/find_phrase.mll
+++ b/ide/find_phrase.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: find_phrase.mll 6218 2004-10-15 14:27:04Z coq $ *)
+(* $Id: find_phrase.mll 9240 2006-10-13 17:51:11Z notin $ *)
 
 {
   exception Lex_error of string
@@ -28,7 +28,11 @@ rule next_phrase = parse
 		 next_phrase lexbuf
 	       }
   | phrase_sep[' ''\n''\t''\r'] {
-      length := !length + 2; 
+	begin 
+	  if !Preferences.current.Preferences.lax_syntax 
+	  then length := !length + 1
+	  else length := !length + 2
+	end;
       Buffer.add_string buff (Lexing.lexeme lexbuf);
       Buffer.contents buff}
 
diff --git a/ide/ideutils.ml b/ide/ideutils.ml
index 65aef17f..df4594a7 100644
--- a/ide/ideutils.ml
+++ b/ide/ideutils.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ideutils.ml 8912 2006-06-07 11:20:58Z notin $ *)
+(* $Id: ideutils.ml 9263 2006-10-23 12:08:08Z barras $ *)
 
 
 open Preferences
@@ -267,7 +267,7 @@ let run_command f c =
 
 let browse f url =
   let l,r = !current.cmd_browse in
-  let (s,res) = run_command f (l ^ url ^ r) in
+  let (_s,_res) = run_command f (l ^ url ^ r) in
   ()
 
 let url_for_keyword =
@@ -306,18 +306,27 @@ let tab = Glib.Utf8.to_unichar "\t" (ref 0)
 
 
 (*
-  checks if two file names refer to the same (existing) file
-*)
+  checks if two file names refer to the same (existing) file by
+  comparing their device and inode. 
+  It seems that under Windows, inode is always 0, so we cannot
+  accurately check if 
 
-let same_file f1 f2 =
+*)
+(* Optimised for partial application (in case many candidates must be
+   compared to f1). *)
+let same_file f1 =
   try
-    let s1 = Unix.stat f1
-    and s2 = Unix.stat f2 
-    in
-      (s1.Unix.st_dev = s2.Unix.st_dev) &&
-	(s1.Unix.st_ino = s2.Unix.st_ino) 
+    let s1 = Unix.stat f1 in
+    (fun f2 ->
+      try
+        let s2 = Unix.stat f2 in
+        s1.Unix.st_dev = s2.Unix.st_dev &&
+          if Sys.os_type = "Win32" then f1 = f2 
+          else s1.Unix.st_ino = s2.Unix.st_ino
+      with
+          Unix.Unix_error _ -> false)
   with
-      Unix.Unix_error _ -> false
+      Unix.Unix_error _ -> (fun _ -> false)
 
 let absolute_filename f =
   if Filename.is_relative f then 
diff --git a/ide/preferences.ml b/ide/preferences.ml
index 4cf9627c..c01fa602 100644
--- a/ide/preferences.ml
+++ b/ide/preferences.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: preferences.ml 8920 2006-06-08 09:12:48Z notin $ *)
+(* $Id: preferences.ml 9350 2006-11-07 15:04:42Z notin $ *)
 
 open Configwin
 open Printf
@@ -93,7 +93,9 @@ type pref =
       mutable use_utf8_notation : bool;
 *)
       mutable auto_complete : bool;
-    }
+      mutable stop_before : bool;
+      mutable lax_syntax : bool;
+}
 
 let (current:pref ref) = 
   ref {
@@ -118,9 +120,9 @@ let (current:pref ref) =
 			 "auto with *"; "intuition" ];
     
     modifier_for_navigation = [`CONTROL; `MOD1];
-    modifier_for_templates = [`MOD4];
+    modifier_for_templates = [`CONTROL; `SHIFT];
     modifier_for_tactics = [`CONTROL; `MOD1];
-    modifiers_valid = [`SHIFT; `CONTROL; `MOD1; `MOD4];
+    modifiers_valid = [`SHIFT; `CONTROL; `MOD1];
 
     
     cmd_browse = Options.browser_cmd_fmt;
@@ -143,7 +145,9 @@ let (current:pref ref) =
 (*
     use_utf8_notation = false;
 *)
-    auto_complete = false
+    auto_complete = false;
+    stop_before = true;
+    lax_syntax = true
   }
 
 
@@ -205,9 +209,11 @@ let save_pref () =
     add "query_window_height" [string_of_int p.query_window_height] ++
     add "query_window_width" [string_of_int p.query_window_width] ++
     add "auto_complete" [string_of_bool p.auto_complete] ++
+    add "stop_before" [string_of_bool p.stop_before] ++
+    add "lax_syntax" [string_of_bool p.lax_syntax] ++
     Config_lexer.print_file pref_file
   with _ -> prerr_endline "Could not save preferences."
-  
+ 
 
 let load_pref () =
   (try GtkData.AccelMap.load accel_file with _ -> ());
@@ -257,6 +263,8 @@ let load_pref () =
     set_int "query_window_width" (fun v -> np.query_window_width <- v);
     set_int "query_window_height" (fun v -> np.query_window_height <- v);
     set_bool "auto_complete" (fun v -> np.auto_complete <- v);
+    set_bool "stop_before" (fun v -> np.stop_before <- v);
+    set_bool "lax_syntax" (fun v -> np.lax_syntax <- v);
     current := np;
 (*
     Format.printf "in laod_pref: current.text_font = %s@." (Pango.Font.to_string !current.text_font);
@@ -385,6 +393,18 @@ let configure () =
       (string_of_int !current.auto_save_delay)
   in  
 
+  let stop_before =
+    bool
+      ~f:(fun s -> !current.stop_before <- s)
+      "Stop interpreting before the current point" !current.stop_before
+  in
+    
+  let lax_syntax =
+    bool
+      ~f:(fun s -> !current.lax_syntax <- s)
+      "Relax read-only constraint at end of command" !current.lax_syntax
+  in
+
   let encodings = 
     combo 
       "File charset encoding "
@@ -476,7 +496,7 @@ let configure () =
       "Contextual menus on goal" !current.contextual_menus_on_goal
   in 
 
-  let misc = [contextual_menus_on_goal;auto_complete] in
+  let misc = [contextual_menus_on_goal;auto_complete;stop_before;lax_syntax] in
    
 (* ATTENTION !!!!! L'onglet Fonts doit etre en premier pour eviter un bug !!!!
    (shame on Benjamin) *)
diff --git a/ide/preferences.mli b/ide/preferences.mli
index 25535aa4..c3e26f50 100644
--- a/ide/preferences.mli
+++ b/ide/preferences.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: preferences.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
+(*i $Id: preferences.mli 9240 2006-10-13 17:51:11Z notin $ i*)
 
 type pref =
     {
@@ -52,6 +52,8 @@ type pref =
       mutable use_utf8_notation : bool;
 *)
       mutable auto_complete : bool;
+      mutable stop_before : bool;
+      mutable lax_syntax : bool;
     }
 
 val save_pref : unit -> unit
diff --git a/ide/utils/editable_cells.ml b/ide/utils/editable_cells.ml
index e6d2f4d4..5441f4ab 100644
--- a/ide/utils/editable_cells.ml
+++ b/ide/utils/editable_cells.ml
@@ -85,7 +85,7 @@ let create l =
 			   | [] -> ()
 			   | path::_ ->
 			       let iter = store#get_iter path in
-			       GtkTree.TreePath.prev path;
+			       ignore (GtkTree.TreePath.prev path);
 			       let upiter = store#get_iter path in
 			       ignore (store#swap iter upiter);
 		      ));
diff --git a/interp/constrextern.ml b/interp/constrextern.ml
index 570d113d..ffedcfff 100644
--- a/interp/constrextern.ml
+++ b/interp/constrextern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: constrextern.ml 8997 2006-07-03 16:40:20Z herbelin $ *)
+(* $Id: constrextern.ml 9226 2006-10-09 16:11:01Z herbelin $ *)
 
 (*i*)
 open Pp
@@ -295,9 +295,6 @@ let same_rawconstr c d =
 (**********************************************************************)
 (* mapping patterns to cases_pattern_expr                                *)
 
-let make_current_scopes (scopt,scopes) = 
-  option_fold_right push_scope scopt scopes
-
 let has_curly_brackets ntn =
   String.length ntn >= 6 & (String.sub ntn 0 6 = "{ _ } " or
     String.sub ntn (String.length ntn - 6) 6 = " { _ }" or
@@ -401,14 +398,14 @@ let match_aconstr_cases_pattern c (metas_scl,pat) =
   List.map (fun (x,scl) -> (find x subst,scl)) metas_scl
 
  (* Better to use extern_rawconstr composed with injection/retraction ?? *)
-let rec extern_cases_pattern_in_scope scopes vars pat =
+let rec extern_cases_pattern_in_scope (scopes:local_scopes) vars pat =
   try 
     if !Options.raw_print or !print_no_symbol then raise No_match;
     let (na,sc,p) = uninterp_prim_token_cases_pattern pat in
-    match availability_of_prim_token sc (make_current_scopes scopes) with
+    match availability_of_prim_token sc scopes with
     | None -> raise No_match
     | Some key ->
-      let loc = pattern_loc pat in
+      let loc = cases_pattern_loc pat in
       insert_pat_alias loc (insert_pat_delimiters loc (CPatPrim(loc,p)) key) na
   with No_match ->
   try 
@@ -440,17 +437,15 @@ and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
 	(* Try availability of interpretation ... *)
         match keyrule with
           | NotationRule (sc,ntn) ->
-	      let scopes' = make_current_scopes (tmp_scope, scopes) in
-	      (match availability_of_notation (sc,ntn) scopes' with
+	      (match availability_of_notation (sc,ntn) allscopes with
                   (* Uninterpretation is not allowed in current context *)
               | None -> raise No_match
                   (* Uninterpretation is allowed in current context *)
 	      | Some (scopt,key) ->
-	          let scopes = make_current_scopes (scopt, scopes) in
+	          let scopes' = option_cons scopt scopes in
 	          let l =
 		    List.map (fun (c,(scopt,scl)) ->
-		      extern_cases_pattern_in_scope 
-		        (scopt,List.fold_right push_scope scl scopes) vars c)
+		      extern_cases_pattern_in_scope (scopt,scl@scopes') vars c)
                       subst in
 		  insert_pat_delimiters loc (make_pat_notation loc ntn l) key)
           | SynDefRule kn ->
@@ -460,7 +455,7 @@ and extern_symbol_pattern (tmp_scope,scopes as allscopes) vars t = function
 	  No_match -> extern_symbol_pattern allscopes vars t rules
 
 let extern_cases_pattern vars p = 
-  extern_cases_pattern_in_scope (None,Notation.current_scopes()) vars p
+  extern_cases_pattern_in_scope (None,[]) vars p
 
 (**********************************************************************)
 (* Externalising applications *)
@@ -607,7 +602,7 @@ let rec share_fix_binders n rbl ty def =
 let extern_possible_prim_token scopes r =
   try
     let (sc,n) = uninterp_prim_token r in
-    match availability_of_prim_token sc (make_current_scopes scopes) with
+    match availability_of_prim_token sc scopes with
     | None -> None
     | Some key -> Some (insert_delimiters (CPrim (loc_of_rawconstr r,n)) key)
   with No_match ->
@@ -754,11 +749,16 @@ let rec extern inctx scopes vars r =
 
   | RDynamic (loc,d) -> CDynamic (loc,d)
 
-and extern_typ (_,scopes) = extern true (Some Notation.type_scope,scopes)
+and extern_typ (_,scopes) = 
+  extern true (Some Notation.type_scope,scopes)
 
 and sub_extern inctx (_,scopes) = extern inctx (None,scopes)
 
-and factorize_prod scopes vars aty = function
+and factorize_prod scopes vars aty c =
+  try 
+    if !Options.raw_print or !print_no_symbol then raise No_match;
+    ([],extern_symbol scopes vars c (uninterp_notations c))
+  with No_match -> match c with
   | RProd (loc,(Name id as na),ty,c)
       when same aty (extern_typ scopes vars (anonymize_if_reserved na ty))
 	& not (occur_var_constr_expr id aty) (* avoid na in ty escapes scope *)
@@ -766,7 +766,11 @@ and factorize_prod scopes vars aty = function
            ((loc,Name id)::nal,c)
   | c -> ([],extern_typ scopes vars c)
 
-and factorize_lambda inctx scopes vars aty = function
+and factorize_lambda inctx scopes vars aty c =
+  try 
+    if !Options.raw_print or !print_no_symbol then raise No_match;
+    ([],extern_symbol scopes vars c (uninterp_notations c))
+  with No_match -> match c with
   | RLambda (loc,na,ty,c)
       when same aty (extern_typ scopes vars (anonymize_if_reserved na ty))
 	& not (occur_name na aty) (* To avoid na in ty' escapes scope *)
@@ -817,17 +821,16 @@ and extern_symbol (tmp_scope,scopes as allscopes) vars t = function
         let e =
           match keyrule with
           | NotationRule (sc,ntn) ->
-	      let scopes' = make_current_scopes (tmp_scope, scopes) in
-	      (match availability_of_notation (sc,ntn) scopes' with
+	      (match availability_of_notation (sc,ntn) allscopes with
                   (* Uninterpretation is not allowed in current context *)
               | None -> raise No_match
                   (* Uninterpretation is allowed in current context *)
 	      | Some (scopt,key) ->
-	          let scopes = make_current_scopes (scopt, scopes) in
+	          let scopes' = option_cons scopt scopes in
 	          let l =
 		    List.map (fun (c,(scopt,scl)) ->
 		      extern (* assuming no overloading: *) true
-		        (scopt,List.fold_right push_scope scl scopes) vars c)
+		        (scopt,scl@scopes') vars c)
                       subst in
 	          insert_delimiters (make_notation loc ntn l) key)
           | SynDefRule kn ->
@@ -847,10 +850,10 @@ and extern_recursion_order scopes vars = function
 
 
 let extern_rawconstr vars c =
-  extern false (None,Notation.current_scopes()) vars c
+  extern false (None,[]) vars c
 
 let extern_rawtype vars c =
-  extern_typ (None,Notation.current_scopes()) vars c
+  extern_typ (None,[]) vars c
 
 (******************************************************************)
 (* Main translation function from constr -> constr_expr *)
@@ -861,7 +864,7 @@ let extern_constr_gen at_top scopt env t =
   let avoid = if at_top then ids_of_context env else [] in
   let r = Detyping.detype at_top avoid (names_of_rel_context env) t in
   let vars = vars_of_env env in
-  extern (not at_top) (scopt,Notation.current_scopes()) vars r
+  extern (not at_top) (scopt,[]) vars r
 
 let extern_constr_in_scope at_top scope env t =
   extern_constr_gen at_top (Some scope) env t
@@ -962,5 +965,4 @@ and raw_of_eqn env constr construct_nargs branch =
   buildrec [] [] env construct_nargs branch
 
 let extern_constr_pattern env pat =
-  extern true (None,Notation.current_scopes()) Idset.empty
-    (raw_of_pat env pat)
+  extern true (None,[]) Idset.empty (raw_of_pat env pat)
diff --git a/interp/constrintern.ml b/interp/constrintern.ml
index 355bac1d..d09430dc 100644
--- a/interp/constrintern.ml
+++ b/interp/constrintern.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: constrintern.ml 8997 2006-07-03 16:40:20Z herbelin $ *)
+(* $Id: constrintern.ml 9226 2006-10-09 16:11:01Z herbelin $ *)
 
 open Pp
 open Util
@@ -118,6 +118,11 @@ let error_bad_inductive_type loc =
   user_err_loc (loc,"",str 
     "This should be an inductive type applied to names or \"_\"")
 
+let error_inductive_parameter_not_implicit loc =
+  user_err_loc (loc,"", str
+   ("The parameters of inductive types do not bind in\n"^
+    "the 'return' clauses; they must be replaced by '_' in the 'in' clauses."))
+
 (**********************************************************************)
 (* Dump of globalization (to be used by coqdoc)                       *)
 let token_number = ref 0
@@ -151,7 +156,7 @@ let loc_of_notation f loc args ntn =
   else snd (unloc (f (List.hd args)))
 
 let ntn_loc = loc_of_notation constr_loc
-let patntn_loc = loc_of_notation cases_pattern_loc
+let patntn_loc = loc_of_notation cases_pattern_expr_loc
 
 let dump_notation_location pos ((path,df),sc) =
   let rec next growing =
@@ -216,7 +221,7 @@ let contract_pat_notation ntn l =
 (**********************************************************************)
 (* Remembering the parsing scope of variables in notations            *)
 
-let make_current_scope (scopt,scopes) = option_cons scopt scopes
+let make_current_scope (tmp_scope,scopes) = option_cons tmp_scope scopes
 
 let set_var_scope loc id (_,scopt,scopes) varscopes =
   let idscopes = List.assoc id varscopes in
@@ -356,8 +361,8 @@ let rec has_duplicate = function
   | x::l -> if List.mem x l then (Some x) else has_duplicate l
 
 let loc_of_lhs lhs = 
- join_loc (cases_pattern_loc (List.hd (List.hd lhs)))
-          (cases_pattern_loc (list_last (list_last lhs)))
+ join_loc (cases_pattern_expr_loc (List.hd (List.hd lhs)))
+          (cases_pattern_expr_loc (list_last (list_last lhs)))
 
 let check_linearity lhs ids =
   match has_duplicate ids with
@@ -553,16 +558,15 @@ let rec intern_cases_pattern genv scopes (ids,subst as aliases) tmp_scope =
       intern_cases_pattern genv scopes aliases tmp_scope a
   | CPatNotation (loc, ntn, args) ->
       let ntn,args = contract_pat_notation ntn args in
-      let scopes = option_cons tmp_scope scopes in
-      let ((ids,c),df) = Notation.interp_notation loc ntn scopes in
+      let ((ids,c),df) = Notation.interp_notation loc ntn (tmp_scope,scopes) in
       if !dump then dump_notation_location (patntn_loc loc args ntn) df;
       let subst = List.map2 (fun (id,scl) a -> (id,(a,scl))) ids args in
       subst_cases_pattern loc aliases (intern_cases_pattern genv) subst scopes 
 	c
   | CPatPrim (loc, p) ->
-      let scopes = option_cons tmp_scope scopes in
       let a = alias_of aliases in
-      let (c,df) = Notation.interp_prim_token_cases_pattern loc p a scopes in
+      let (c,df) = Notation.interp_prim_token_cases_pattern loc p a 
+	(tmp_scope,scopes) in
       if !dump then dump_notation_location (fst (unloc loc)) df;
       (ids,[subst,c])
   | CPatDelimiters (loc, key, e) ->
@@ -689,15 +693,20 @@ let extract_explicit_arg imps args =
 (**********************************************************************)
 (* Syntax extensions                                                  *)
 
-let traverse_binder subst id (ids,tmpsc,scopes as env) =
+let traverse_binder subst (renaming,(ids,tmpsc,scopes as env)) id =
   try
-    (* Binders bound in the notation are consider first-order object *)
-    (* and binders not bound in the notation do not capture variables *)
-    (* outside the notation *)
+    (* Binders bound in the notation are considered first-order objects *)
     let _,id' = coerce_to_id (fst (List.assoc id subst)) in
-    id', (Idset.add id' ids,tmpsc,scopes)
+    (renaming,(Idset.add id' ids,tmpsc,scopes)), id'
   with Not_found ->
-    id, env
+    (* Binders not bound in the notation do not capture variables *)
+    (* outside the notation (i.e. in the substitution) *)
+    let fvs1 = List.map (fun (_,(c,_)) -> free_vars_of_constr_expr c) subst in
+    let fvs2 = List.map snd renaming in
+    let fvs = List.flatten (List.map Idset.elements fvs1) @ fvs2 in
+    let id' = next_ident_away id fvs in
+    let renaming' = if id=id' then renaming else (id,id')::renaming in
+    (renaming',env), id'
 
 let decode_constrlist_value = function
   | CAppExpl (_,_,l) -> l
@@ -707,7 +716,7 @@ let rec subst_iterator y t = function
   | RVar (_,id) as x -> if id = y then t else x
   | x -> map_rawconstr (subst_iterator y t) x
 
-let rec subst_aconstr_in_rawconstr loc interp subst (ids,_,scopes as _env) =
+let rec subst_aconstr_in_rawconstr loc interp subst (renaming,(ids,_,scopes)) =
   function
   | AVar id ->
       begin
@@ -717,6 +726,9 @@ let rec subst_aconstr_in_rawconstr loc interp subst (ids,_,scopes as _env) =
 	  let (a,(scopt,subscopes)) = List.assoc id subst in
 	  interp (ids,scopt,subscopes@scopes) a
 	with Not_found -> 
+	try 
+	  RVar (loc,List.assoc id renaming)
+	with Not_found -> 
 	  (* Happens for local notation joint with inductive/fixpoint defs *)
 	  RVar (loc,id)
       end
@@ -725,28 +737,28 @@ let rec subst_aconstr_in_rawconstr loc interp subst (ids,_,scopes as _env) =
         (* All elements of the list are in scopes (scopt,subscopes) *)
 	let (a,(scopt,subscopes)) = List.assoc x subst in
         let termin = 
-          subst_aconstr_in_rawconstr loc interp subst (ids,None,scopes) 
-            terminator in
+          subst_aconstr_in_rawconstr loc interp subst 
+	    (renaming,(ids,None,scopes)) terminator in
         let l = decode_constrlist_value a in
 	List.fold_right (fun a t -> 
           subst_iterator ldots_var t
             (subst_aconstr_in_rawconstr loc interp 
               ((x,(a,(scopt,subscopes)))::subst)
-              (ids,None,scopes) iter))
+	      (renaming,(ids,None,scopes)) iter))
             (if lassoc then List.rev l else l) termin
       with Not_found -> 
           anomaly "Inconsistent substitution of recursive notation")
   | t ->
       rawconstr_of_aconstr_with_binders loc (traverse_binder subst)
-      (subst_aconstr_in_rawconstr loc interp subst) (ids,None,scopes) t
+      (subst_aconstr_in_rawconstr loc interp subst)
+      (renaming,(ids,None,scopes)) t
 
 let intern_notation intern (_,tmp_scope,scopes as env) loc ntn args =
   let ntn,args = contract_notation ntn args in
-  let scopes = option_cons tmp_scope scopes in
-  let ((ids,c),df) = Notation.interp_notation loc ntn scopes in
+  let ((ids,c),df) = Notation.interp_notation loc ntn (tmp_scope,scopes) in
   if !dump then dump_notation_location (ntn_loc loc args ntn) df;
   let subst = List.map2 (fun (id,scl) a -> (id,(a,scl))) ids args in
-  subst_aconstr_in_rawconstr loc intern subst env c
+  subst_aconstr_in_rawconstr loc intern subst ([],env) c
 
 let set_type_scope (ids,tmp_scope,scopes) =
   (ids,Some Notation.type_scope,scopes)
@@ -844,8 +856,7 @@ let internalise sigma globalenv env allow_soapp lvar c =
     | CNotation (loc,ntn,args) ->
         intern_notation intern env loc ntn args
     | CPrim (loc, p) ->
-	let scopes = option_cons tmp_scope scopes in
-	let c,df = Notation.interp_prim_token loc p scopes in
+	let c,df = Notation.interp_prim_token loc p (tmp_scope,scopes) in
 	if !dump then dump_notation_location (fst (unloc loc)) df;
 	c
     | CDelimiters (loc, key, e) ->
@@ -913,8 +924,7 @@ let internalise sigma globalenv env allow_soapp lvar c =
 
     | CDynamic (loc,d) -> RDynamic (loc,d)
 
-  and intern_type (ids,_,scopes) =
-    intern (ids,Some Notation.type_scope,scopes)
+  and intern_type env = intern (set_type_scope env)
 
   and intern_local_binder ((ids,ts,sc as env),bl) = function
     | LocalRawAssum(nal,ty) ->
@@ -961,29 +971,25 @@ let internalise sigma globalenv env allow_soapp lvar c =
     let tm' = intern env tm in
     let ids,typ = match t with
     | Some t -> 
-	let tids = names_of_cases_indtype t in
+	let tids = ids_of_cases_indtype t in
 	let tids = List.fold_right Idset.add tids Idset.empty in
 	let t = intern_type (tids,None,scopes) t in
-	let (_,_,_,nal as indsign) =
-	  match t with
-	  | RRef (loc,IndRef ind) -> (loc,ind,0,[])
-	  | RApp (loc,RRef (_,IndRef ind),l) ->
-	      let nparams, nrealargs = inductive_nargs globalenv ind in
-	      let nindargs = nparams + nrealargs in
-	      if List.length l <> nindargs then
-		error_wrong_numarg_inductive_loc loc globalenv ind nindargs;
-	      let nal = List.map (function
-		| RHole _ -> Anonymous
-		| RVar (_,id) -> Name id
-		| c ->
-		    user_err_loc (loc_of_rawconstr c,"",str "Not a name")) l in
-	      let parnal,realnal = list_chop nparams nal in
-	      if List.exists ((<>) Anonymous) parnal then
-		user_err_loc (loc,"",
-		  str "The parameters of inductive type must be implicit");
-	      (loc,ind,nparams,realnal)
-	  | _ -> error_bad_inductive_type (loc_of_rawconstr t) in
-	nal, Some indsign
+	let loc,ind,l = match t with
+	    | RRef (loc,IndRef ind) -> (loc,ind,[])
+	    | RApp (loc,RRef (_,IndRef ind),l) -> (loc,ind,l)
+	    | _ -> error_bad_inductive_type (loc_of_rawconstr t) in
+	let nparams, nrealargs = inductive_nargs globalenv ind in
+	let nindargs = nparams + nrealargs in
+	if List.length l <> nindargs then
+	  error_wrong_numarg_inductive_loc loc globalenv ind nindargs;
+	let nal = List.map (function
+	  | RHole loc -> Anonymous
+	  | RVar (_,id) -> Name id
+	  | c -> user_err_loc (loc_of_rawconstr c,"",str "Not a name")) l in
+	let parnal,realnal = list_chop nparams nal in
+	if List.exists ((<>) Anonymous) parnal then
+	  error_inductive_parameter_not_implicit loc;
+	realnal, Some (loc,ind,nparams,realnal)
     | None -> 
 	[], None in
     let na = match tm', na with
@@ -1067,12 +1073,21 @@ let extract_ids env =
 let intern_gen isarity sigma env
                ?(impls=([],[])) ?(allow_soapp=false) ?(ltacvars=([],[]))
                c =
-  let tmp_scope = if isarity then Some Notation.type_scope else None in
+  let tmp_scope = 
+    if isarity then Some Notation.type_scope else None in
   internalise sigma env (extract_ids env, tmp_scope,[])
     allow_soapp (ltacvars,Environ.named_context env, [], impls) c
 
 let intern_constr sigma env c = intern_gen false sigma env c 
 
+let intern_pattern env patt =
+  try
+    intern_cases_pattern env [] ([],[]) None patt 
+  with 
+      InternalisationError (loc,e) ->
+	user_err_loc (loc,"internalize",explain_internalisation_error e)
+
+
 let intern_ltac isarity ltacvars sigma env c =
   intern_gen isarity sigma env ~ltacvars:ltacvars c
 
@@ -1100,6 +1115,21 @@ let interp_open_constr sigma env c =
 let interp_constr_judgment sigma env c =
   Default.understand_judgment sigma env (intern_constr sigma env c)
 
+
+let interp_constr_evars_gen isevars env ?(impls=([],[])) kind c =
+  Default.understand_tcc_evars isevars env kind
+    (intern_gen (kind=IsType) ~impls (Evd.evars_of !isevars) env c)
+
+let interp_casted_constr_evars isevars env ?(impls=([],[])) c typ =
+  interp_constr_evars_gen isevars env ~impls (OfType (Some typ)) c
+
+let interp_type_evars isevars env ?(impls=([],[])) c =
+  interp_constr_evars_gen isevars env IsType ~impls c
+
+let interp_constr_judgment_evars isevars env c =
+  Default.understand_judgment_tcc isevars env
+    (intern_constr (Evd.evars_of !isevars) env c)
+
 type ltac_sign = identifier list * unbound_ltac_var_map
 
 let interp_constrpattern sigma env c =
@@ -1123,7 +1153,13 @@ let interp_aconstr impls vars a =
 
 let interp_binder sigma env na t =
   let t = intern_gen true sigma env t in
-  Default.understand_type sigma env (locate_if_isevar (loc_of_rawconstr t) na t)
+  let t' = locate_if_isevar (loc_of_rawconstr t) na t in
+  Default.understand_type sigma env t'
+
+let interp_binder_evars isevars env na t =
+  let t = intern_gen true (Evd.evars_of !isevars) env t in
+  let t' = locate_if_isevar (loc_of_rawconstr t) na t in
+  Default.understand_tcc_evars isevars env IsType t'
 
 open Environ
 open Term
@@ -1146,6 +1182,24 @@ let interp_context sigma env params =
 	  (push_rel d env,d::params))
     (env,[]) params
 
+let interp_context_evars isevars env params =
+  List.fold_left
+    (fun (env,params) d -> match d with
+      | LocalRawAssum ([_,na],(CHole _ as t)) ->
+	  let t = interp_binder_evars isevars env na t in
+	  let d = (na,None,t) in
+	  (push_rel d env, d::params)
+      | LocalRawAssum (nal,t) ->
+	  let t = interp_type_evars isevars env t in
+	  let ctx = list_map_i (fun i (_,na) -> (na,None,lift i t)) 0 nal in
+	  let ctx = List.rev ctx in
+	  (push_rel_context ctx env, ctx@params)
+      | LocalRawDef ((_,na),c) ->
+	  let c = interp_constr_judgment_evars isevars env c in
+	  let d = (na, Some c.uj_val, c.uj_type) in
+	  (push_rel d env,d::params))
+    (env,[]) params
+
 (**********************************************************************)
 (* Locating reference, possibly via an abbreviation *)
 
diff --git a/interp/constrintern.mli b/interp/constrintern.mli
index cdd87a7c..d88a058d 100644
--- a/interp/constrintern.mli
+++ b/interp/constrintern.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: constrintern.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
+(*i $Id: constrintern.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Names
@@ -55,6 +55,14 @@ val intern_gen : bool -> evar_map -> env ->
   ?impls:full_implicits_env -> ?allow_soapp:bool -> ?ltacvars:ltac_sign ->
   constr_expr -> rawconstr
 
+val intern_pattern : env -> cases_pattern_expr ->
+  Names.identifier list *
+    ((Names.identifier * Names.identifier) list * Rawterm.cases_pattern) list
+
+val intern_pattern : env -> cases_pattern_expr ->
+  Names.identifier list *
+    ((Names.identifier * Names.identifier) list * Rawterm.cases_pattern) list
+
 (*s Composing internalisation with pretyping *)
 
 (* Main interpretation function *)
@@ -76,6 +84,12 @@ val interp_type : evar_map -> env -> ?impls:full_implicits_env ->
 
 val interp_open_constr   : evar_map -> env -> constr_expr -> evar_map * constr
 
+val interp_casted_constr_evars : evar_defs ref -> env -> 
+  ?impls:full_implicits_env -> constr_expr -> types -> constr
+
+val interp_type_evars : evar_defs ref -> env -> ?impls:full_implicits_env ->
+  constr_expr -> types
+
 (*s Build a judgment  *)
 
 val interp_constr_judgment : evar_map -> env -> constr_expr -> unsafe_judgment
@@ -95,6 +109,9 @@ val interp_binder  : evar_map -> env -> name -> constr_expr -> types
 
 val interp_context : evar_map -> env -> local_binder list -> env * rel_context
 
+val interp_context_evars : 
+  evar_defs ref -> env -> local_binder list -> env * rel_context
+
 (* Locating references of constructions, possibly via a syntactic definition *)
 
 val locate_reference : qualid -> global_reference
diff --git a/interp/notation.ml b/interp/notation.ml
index 7e101784..5b6692e9 100644
--- a/interp/notation.ml
+++ b/interp/notation.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: notation.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: notation.ml 9258 2006-10-23 07:15:04Z courtieu $ *)
 
 (*i*)
 open Util
@@ -130,6 +130,11 @@ let push_scope sc scopes = Scope sc :: scopes
 
 let push_scopes = List.fold_right push_scope
 
+type local_scopes = tmp_scope_name option * scope_name list
+
+let make_current_scopes (tmp_scope,scopes) =
+  option_fold_right push_scope tmp_scope (push_scopes scopes !scope_stack)
+
 (**********************************************************************)
 (* Delimiters *)
 
@@ -146,7 +151,7 @@ let declare_delimiters scope key =
   scope_map := Gmap.add scope sc !scope_map;
   if Gmap.mem key !delimiters_map then begin
     let oldsc = Gmap.find key !delimiters_map in
-    Options.if_verbose warning ("Hidding binding of key "^key^" to "^oldsc)
+    Options.if_verbose warning ("Hiding binding of key "^key^" to "^oldsc)
   end;
   delimiters_map := Gmap.add key scope !delimiters_map
 
@@ -295,8 +300,8 @@ let declare_notation_interpretation ntn scopt pat df =
   let scope = match scopt with Some s -> s | None -> default_scope in
   let sc = find_scope scope in
   if Gmap.mem ntn sc.notations && Options.is_verbose () then
-    warning ("Notation "^ntn^" was already used"^
-    (if scopt = None then "" else " in scope "^scope));
+    msg_warning (str ("Notation "^ntn^" was already used"^
+    (if scopt = None then "" else " in scope "^scope)));
   let sc = { sc with notations = Gmap.add ntn (pat,df) sc.notations } in
   scope_map := Gmap.add scope sc !scope_map;
   if scopt = None then scope_stack := SingleNotation ntn :: !scope_stack
@@ -336,9 +341,9 @@ let find_prim_token g loc p sc =
   check_required_module loc sc spdir;
   g (interp ()), (dirpath (fst spdir),"")
 
-let interp_prim_token_gen g loc p scopes =
-  let all_scopes = push_scopes scopes !scope_stack in
-  try find_interpretation (find_prim_token g loc p) all_scopes
+let interp_prim_token_gen g loc p local_scopes =
+  let scopes = make_current_scopes local_scopes in
+  try find_interpretation (find_prim_token g loc p) scopes
   with Not_found ->
     user_err_loc (loc,"interp_prim_token",
     (match p with
@@ -351,8 +356,9 @@ let interp_prim_token =
 let interp_prim_token_cases_pattern loc p name =
   interp_prim_token_gen (cases_pattern_of_rawconstr name) loc p
 
-let rec interp_notation loc ntn scopes =
-  try find_interpretation (find_notation ntn) (push_scopes scopes !scope_stack) 
+let rec interp_notation loc ntn local_scopes =
+  let scopes = make_current_scopes local_scopes in
+  try find_interpretation (find_notation ntn) scopes
   with Not_found ->
     user_err_loc
     (loc,"",str ("Unknown interpretation for notation \""^ntn^"\""))
@@ -366,7 +372,7 @@ let uninterp_cases_pattern_notations c =
 let availability_of_notation (ntn_scope,ntn) scopes =
   let f scope =
     Gmap.mem ntn (Gmap.find scope !scope_map).notations in
-  find_without_delimiters f (ntn_scope,Some ntn) scopes
+  find_without_delimiters f (ntn_scope,Some ntn) (make_current_scopes scopes)
 
 let uninterp_prim_token c =
   try 
@@ -387,8 +393,9 @@ let uninterp_prim_token_cases_pattern c =
       | Some n -> (na,sc,n)
   with Not_found -> raise No_match
 
-let availability_of_prim_token printer_scope scopes =
+let availability_of_prim_token printer_scope local_scopes =
   let f scope = Hashtbl.mem prim_token_interpreter_tab scope in
+  let scopes = make_current_scopes local_scopes in
   option_map snd (find_without_delimiters f (Some printer_scope,None) scopes)
 
 (* Miscellaneous *)
@@ -494,7 +501,7 @@ let make_notation_key symbols =
 let decompose_notation_key s =
   let len = String.length s in
   let rec decomp_ntn dirs n =
-    if n>=len then dirs else
+    if n>=len then List.rev dirs else
     let pos =
       try
 	String.index_from s n ' ' 
diff --git a/interp/notation.mli b/interp/notation.mli
index 32ec7a96..840274c5 100644
--- a/interp/notation.mli
+++ b/interp/notation.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: notation.mli 7984 2006-02-04 20:14:55Z herbelin $ i*)
+(*i $Id: notation.mli 9208 2006-10-05 07:45:01Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -32,12 +32,15 @@ type delimiters = string
 type scope
 type scopes (* = [scope_name list] *)
 
+type local_scopes = tmp_scope_name option * scope_name list
+
 val type_scope : scope_name
 val declare_scope : scope_name -> unit
 
+val current_scopes : unit -> scopes
+
 (* Open scope *)
 
-val current_scopes : unit -> scopes
 val open_close_scope : 
   (* locality *) bool * (* open *) bool * scope_name -> unit
 
@@ -76,10 +79,10 @@ val declare_string_interpreter : scope_name -> required_module ->
 (* Return the [term]/[cases_pattern] bound to a primitive token in a
    given scope context*)
 
-val interp_prim_token : loc -> prim_token -> scope_name list -> 
+val interp_prim_token : loc -> prim_token -> local_scopes ->
   rawconstr * (notation_location * scope_name option)
 val interp_prim_token_cases_pattern : loc -> prim_token -> name -> 
-  scope_name list -> cases_pattern * (notation_location * scope_name option)
+  local_scopes -> cases_pattern * (notation_location * scope_name option)
 
 (* Return the primitive token associated to a [term]/[cases_pattern];
    raise [No_match] if no such token *)
@@ -90,7 +93,7 @@ val uninterp_prim_token_cases_pattern :
   cases_pattern -> name * scope_name * prim_token
 
 val availability_of_prim_token : 
-  scope_name -> scopes -> delimiters option option
+  scope_name -> local_scopes -> delimiters option option
 
 (*s Declare and interpret back and forth a notation *)
 
@@ -105,7 +108,7 @@ val declare_notation_interpretation : notation -> scope_name option ->
 val declare_uninterpretation : interp_rule -> interpretation -> unit
 
 (* Return the interpretation bound to a notation *)
-val interp_notation : loc -> notation -> scope_name list -> 
+val interp_notation : loc -> notation -> local_scopes ->
       interpretation * (notation_location * scope_name option)
 
 (* Return the possible notations for a given term *)
@@ -117,7 +120,7 @@ val uninterp_cases_pattern_notations : cases_pattern ->
 (* Test if a notation is available in the scopes *)
 (* context [scopes]; if available, the result is not None; the first *)
 (* argument is itself not None if a delimiters is needed *)
-val availability_of_notation : scope_name option * notation -> scopes -> 
+val availability_of_notation : scope_name option * notation -> local_scopes -> 
   (scope_name option * delimiters option) option
 
 (*s Declare and test the level of a (possibly uninterpreted) notation *)
diff --git a/interp/topconstr.ml b/interp/topconstr.ml
index f3099346..936b6830 100644
--- a/interp/topconstr.ml
+++ b/interp/topconstr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: topconstr.ml 9032 2006-07-07 16:30:34Z herbelin $ *)
+(* $Id: topconstr.ml 9226 2006-10-09 16:11:01Z herbelin $ *)
 
 (*i*)
 open Pp
@@ -39,17 +39,24 @@ type aconstr =
   | ALetIn of name * aconstr * aconstr
   | ACases of aconstr option *
       (aconstr * (name * (inductive * int * name list) option)) list *
-      (identifier list * cases_pattern list * aconstr) list
+      (cases_pattern list * aconstr) list
   | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
   | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
   | ASort of rawsort
   | AHole of Evd.hole_kind
   | APatVar of patvar
   | ACast of aconstr * cast_type * aconstr
-  
-let name_app f e = function
-  | Name id -> let (id, e) = f id e in (e, Name id)
-  | Anonymous -> e,Anonymous
+
+(**********************************************************************)
+(* Re-interpret a notation as a rawconstr, taking care of binders     *)
+
+let rec cases_pattern_fold_map loc g e = function
+  | PatVar (_,na) ->
+      let e',na' = name_fold_map g e na in e', PatVar (loc,na')
+  | PatCstr (_,cstr,patl,na) ->
+      let e',na' = name_fold_map g e na in
+      let e',patl' = list_fold_map (cases_pattern_fold_map loc g) e patl in
+      e', PatCstr (loc,cstr,patl',na')
 
 let rec subst_rawvars l = function
   | RVar (_,id) as r -> (try List.assoc id l with Not_found -> r)
@@ -67,32 +74,33 @@ let rawconstr_of_aconstr_with_binders loc g f e = function
       let outerl = (ldots_var,inner)::(if swap then [x,RVar(loc,y)] else []) in
       subst_rawvars outerl it
   | ALambda (na,ty,c) ->
-      let e,na = name_app g e na in RLambda (loc,na,f e ty,f e c)
+      let e,na = name_fold_map g e na in RLambda (loc,na,f e ty,f e c)
   | AProd (na,ty,c) ->
-      let e,na = name_app g e na in RProd (loc,na,f e ty,f e c)
+      let e,na = name_fold_map g e na in RProd (loc,na,f e ty,f e c)
   | ALetIn (na,b,c) ->
-      let e,na = name_app g e na in RLetIn (loc,na,f e b,f e c)
+      let e,na = name_fold_map g e na in RLetIn (loc,na,f e b,f e c)
   | ACases (rtntypopt,tml,eqnl) ->
       let e',tml' = List.fold_right (fun (tm,(na,t)) (e',tml') ->
 	let e',t' = match t with
 	| None -> e',None
 	| Some (ind,npar,nal) -> 
 	  let e',nal' = List.fold_right (fun na (e',nal) -> 
-	      let e',na' = name_app g e' na in e',na'::nal) nal (e',[]) in
+	      let e',na' = name_fold_map g e' na in e',na'::nal) nal (e',[]) in
 	  e',Some (loc,ind,npar,nal') in
-	let e',na' = name_app g e' na in
+	let e',na' = name_fold_map g e' na in
 	(e',(f e tm,(na',t'))::tml')) tml (e,[]) in
-      let fold id (idl,e) = let (id,e) = g id e in (id::idl,e) in
-      let eqnl' = List.map (fun (idl,pat,rhs) ->
-        let (idl,e) = List.fold_right fold idl ([],e) in
-	(loc,idl,pat,f e rhs)) eqnl in
+      let fold (idl,e) id = let (e,id) = g e id in ((id::idl,e),id) in
+      let eqnl' = List.map (fun (patl,rhs) ->
+	let ((idl,e),patl) =
+	  list_fold_map (cases_pattern_fold_map loc fold) ([],e) patl in
+	(loc,idl,patl,f e rhs)) eqnl in
       RCases (loc,option_map (f e') rtntypopt,tml',eqnl')
   | ALetTuple (nal,(na,po),b,c) ->
-      let e,nal = list_fold_map (name_app g) e nal in 
-      let e,na = name_app g e na in
+      let e,nal = list_fold_map (name_fold_map g) e nal in 
+      let e,na = name_fold_map g e na in
       RLetTuple (loc,nal,(na,option_map (f e) po),f e b,f e c)
   | AIf (c,(na,po),b1,b2) ->
-      let e,na = name_app g e na in
+      let e,na = name_fold_map g e na in
       RIf (loc,f e c,(na,option_map (f e) po),f e b1,f e b2)
   | ACast (c,k,t) -> RCast (loc,f e c, k,f e t)
   | ASort x -> RSort (loc,x)
@@ -102,17 +110,11 @@ let rawconstr_of_aconstr_with_binders loc g f e = function
 
 let rec rawconstr_of_aconstr loc x =
   let rec aux () x = 
-    rawconstr_of_aconstr_with_binders loc (fun id () -> (id,())) aux () x
+    rawconstr_of_aconstr_with_binders loc (fun () id -> ((),id)) aux () x
   in aux () x
 
-let rec subst_pat subst pat = 
-  match pat with
-  | PatVar _ -> pat
-  | PatCstr (loc,((kn,i),j),cpl,n) -> 
-      let kn' = subst_kn subst kn 
-      and cpl' = list_smartmap (subst_pat subst) cpl in
-        if kn' == kn && cpl' == cpl then pat else
-          PatCstr (loc,((kn',i),j),cpl',n)
+(****************************************************************************)
+(* Translating a rawconstr into a notation, interpreting recursive patterns *)
 
 let add_name r = function
   | Anonymous -> ()
@@ -179,9 +181,7 @@ let aconstr_and_vars_of_rawconstr a =
   | RProd (_,na,ty,c) -> add_name found na; AProd (na,aux ty,aux c)
   | RLetIn (_,na,b,c) -> add_name found na; ALetIn (na,aux b,aux c)
   | RCases (_,rtntypopt,tml,eqnl) ->
-      let f (_,idl,pat,rhs) =
-        found := idl@(!found);
-        (idl,pat,aux rhs) in
+      let f (_,idl,pat,rhs) = found := idl@(!found); (pat,aux rhs) in
       ACases (option_map aux rtntypopt,
         List.map (fun (tm,(na,x)) ->
 	  add_name found na;
@@ -246,9 +246,20 @@ let aconstr_of_rawconstr vars a =
   List.iter check_type vars;
   a
 
+(* Substitution of kernel names, avoiding a list of bound identifiers *)
+
 let aconstr_of_constr avoiding t =
  aconstr_of_rawconstr [] (Detyping.detype false avoiding [] t)
 
+let rec subst_pat subst pat = 
+  match pat with
+  | PatVar _ -> pat
+  | PatCstr (loc,((kn,i),j),cpl,n) -> 
+      let kn' = subst_kn subst kn 
+      and cpl' = list_smartmap (subst_pat subst) cpl in
+        if kn' == kn && cpl' == cpl then pat else
+          PatCstr (loc,((kn',i),j),cpl',n)
+
 let rec subst_aconstr subst bound raw =
   match raw with
   | ARef ref -> 
@@ -265,22 +276,26 @@ let rec subst_aconstr subst bound raw =
 	  AApp(r',rl')
 
   | AList (id1,id2,r1,r2,b) -> 
-      let r1' = subst_aconstr subst bound r1 and r2' = subst_aconstr subst bound r2 in
+      let r1' = subst_aconstr subst bound r1
+      and r2' = subst_aconstr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  AList (id1,id2,r1',r2',b)
 
   | ALambda (n,r1,r2) -> 
-      let r1' = subst_aconstr subst bound r1 and r2' = subst_aconstr subst bound r2 in
+      let r1' = subst_aconstr subst bound r1
+      and r2' = subst_aconstr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  ALambda (n,r1',r2')
 
   | AProd (n,r1,r2) -> 
-      let r1' = subst_aconstr subst bound r1 and r2' = subst_aconstr subst bound r2 in
+      let r1' = subst_aconstr subst bound r1
+      and r2' = subst_aconstr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  AProd (n,r1',r2')
 
   | ALetIn (n,r1,r2) -> 
-      let r1' = subst_aconstr subst bound r1 and r2' = subst_aconstr subst bound r2 in
+      let r1' = subst_aconstr subst bound r1 
+      and r2' = subst_aconstr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  ALetIn (n,r1',r2')
 
@@ -295,11 +310,11 @@ let rec subst_aconstr subst bound raw =
 	  if a' == a && signopt' == signopt then x else (a',(n,signopt')))
         rl
       and branches' = list_smartmap 
-                        (fun (idl,cpl,r as branch) ->
+                        (fun (cpl,r as branch) ->
                            let cpl' = list_smartmap (subst_pat subst) cpl
                            and r' = subst_aconstr subst bound r in
                              if cpl' == cpl && r' == r then branch else
-                               (idl,cpl',r'))
+                               (cpl',r'))
                         branches
       in
         if rtntypopt' == rtntypopt && rtntypopt == rtntypopt' &
@@ -331,7 +346,8 @@ let rec subst_aconstr subst bound raw =
       Evd.InternalHole | Evd.TomatchTypeParameter _) -> raw
 
   | ACast (r1,k,r2) -> 
-      let r1' = subst_aconstr subst bound r1 and r2' = subst_aconstr subst bound r2 in
+      let r1' = subst_aconstr subst bound r1 
+      and r2' = subst_aconstr subst bound r2 in
 	if r1' == r1 && r2' == r2 then raw else
 	  ACast (r1',k,r2')
 
@@ -394,6 +410,15 @@ let match_names metas (alp,sigma) na1 na2 = match (na1,na2) with
   | (Anonymous,Anonymous) -> alp,sigma
   | _ -> raise No_match
 
+let rec match_cases_pattern metas acc pat1 pat2 =
+  match (pat1,pat2) with
+  | PatVar (_,na1), PatVar (_,na2) -> match_names metas acc na1 na2
+  | PatCstr (_,c1,patl1,na1), PatCstr (_,c2,patl2,na2)
+      when c1 = c2 & List.length patl1 = List.length patl2 ->
+      List.fold_left2 (match_cases_pattern metas)
+	(match_names metas acc na1 na2) patl1 patl2
+  | _ -> raise No_match
+
 let rec match_ alp metas sigma a1 a2 = match (a1,a2) with
   | r1, AVar id2 when List.mem id2 metas -> bind_env alp sigma id2 r1
   | RVar (_,id1), AVar id2 when alpha_var id1 id2 alp -> sigma
@@ -411,7 +436,8 @@ let rec match_ alp metas sigma a1 a2 = match (a1,a2) with
   | RLetIn (_,na1,t1,b1), ALetIn (na2,t2,b2) ->
      match_binders alp metas na1 na2 (match_ alp metas sigma t1 t2) b1 b2
   | RCases (_,rtno1,tml1,eqnl1), ACases (rtno2,tml2,eqnl2) 
-      when List.length tml1 = List.length tml2 ->
+      when List.length tml1 = List.length tml2
+	 & List.length eqnl1 = List.length eqnl2 ->
       let rtno1' = abstract_return_type_context_rawconstr tml1 rtno1 in
       let rtno2' = abstract_return_type_context_aconstr tml2 rtno2 in
       let sigma = option_fold_left2 (match_ alp metas) sigma rtno1' rtno2' in
@@ -461,15 +487,19 @@ and match_binders alp metas na1 na2 sigma b1 b2 =
   let (alp,sigma) = match_names metas (alp,sigma) na1 na2 in
   match_ alp metas sigma b1 b2
 
-and match_equations alp metas sigma (_,idl1,pat1,rhs1) (idl2,pat2,rhs2) =
-  if idl1 = idl2 & pat1 = pat2 (* Useful to reason up to alpha ?? *) then
-    match_ alp metas sigma rhs1 rhs2
-  else raise No_match
+and match_equations alp metas sigma (_,_,patl1,rhs1) (patl2,rhs2) =
+  (* patl1 and patl2 have the same length because they respectively
+     correspond to some tml1 and tml2 that have the same length *)
+  let (alp,sigma) = 
+    List.fold_left2 (match_cases_pattern metas) (alp,sigma) patl1 patl2 in
+  match_ alp metas sigma rhs1 rhs2
 
 type scope_name = string
 
+type tmp_scope_name = scope_name
+
 type interpretation = 
-    (identifier * (scope_name option * scope_name list)) list * aconstr
+    (identifier * (tmp_scope_name option * scope_name list)) list * aconstr
 
 let match_aconstr c (metas_scl,pat) =
   let subst = match_ [] (List.map fst metas_scl) [] c pat in
@@ -592,7 +622,7 @@ let constr_loc = function
   | CDelimiters (loc,_,_) -> loc
   | CDynamic _ -> dummy_loc
 
-let cases_pattern_loc = function
+let cases_pattern_expr_loc = function
   | CPatAlias (loc,_,_) -> loc
   | CPatCstr (loc,_,_) -> loc
   | CPatAtom (loc,_) -> loc
@@ -605,35 +635,98 @@ let occur_var_constr_ref id = function
   | Ident (loc,id') -> id = id'
   | Qualid _ -> false
 
-let rec occur_var_constr_expr id = function
-  | CRef r -> occur_var_constr_ref id r
-  | CArrow (loc,a,b) -> occur_var_constr_expr id a or occur_var_constr_expr id b
-  | CAppExpl (loc,(_,r),l) ->
-      occur_var_constr_ref id r or List.exists (occur_var_constr_expr id) l
-  | CApp (loc,(_,f),l) ->
-      occur_var_constr_expr id f or
-      List.exists (fun (a,_) -> occur_var_constr_expr id a) l
-  | CProdN (_,l,b) -> occur_var_binders id b l
-  | CLambdaN (_,l,b) -> occur_var_binders id b l
-  | CLetIn (_,na,a,b) -> occur_var_binders id b [[na],a]
-  | CCast (loc,a,_,b) -> 
-    occur_var_constr_expr id a or occur_var_constr_expr id b
-  | CNotation (_,_,l) -> List.exists (occur_var_constr_expr id) l
-  | CDelimiters (loc,_,a) -> occur_var_constr_expr id a
-  | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CDynamic _ -> false
-  | CCases (loc,_,_,_) 
-  | CLetTuple (loc,_,_,_,_) 
-  | CIf (loc,_,_,_,_) 
-  | CFix (loc,_,_) 
+let ids_of_cases_indtype =
+  let add_var ids = function CRef (Ident (_,id)) -> id::ids | _ -> ids in
+  let rec vars_of = function
+    (* We deal only with the regular cases *)
+    | CApp (_,_,l) -> List.fold_left add_var [] (List.map fst l)
+    | CNotation (_,_,l)
+    (* assume the ntn is applicative and does not instantiate the head !! *)
+    | CAppExpl (_,_,l) -> List.fold_left add_var [] l
+    | CDelimiters(_,_,c) -> vars_of c
+    | _ -> [] in
+  vars_of
+
+let ids_of_cases_tomatch tms =
+  List.fold_right
+    (fun (_,(ona,indnal)) l ->
+      option_fold_right (fun t -> (@) (ids_of_cases_indtype t))
+      indnal (option_fold_right name_cons ona l))
+    tms []
+
+let is_constructor id =
+  try ignore (Nametab.extended_locate (make_short_qualid id)); true
+  with Not_found -> true
+ 
+let rec cases_pattern_fold_names f a = function
+  | CPatAlias (_,pat,id) -> f id a
+  | CPatCstr (_,_,patl) | CPatOr (_,patl) | CPatNotation (_,_,patl) ->
+      List.fold_left (cases_pattern_fold_names f) a patl
+  | CPatDelimiters (_,_,pat) -> cases_pattern_fold_names f a pat
+  | CPatAtom (_,Some (Ident (_,id))) when not (is_constructor id) -> f id a
+  | CPatPrim _ | CPatAtom _ -> a
+
+let ids_of_pattern_list =
+  List.fold_left (List.fold_left (cases_pattern_fold_names Idset.add))
+    Idset.empty
+
+let rec fold_constr_expr_binders g f n acc b = function
+  | (nal,t)::l ->
+      let nal = snd (List.split nal) in
+      let n' = List.fold_right (name_fold g) nal n in
+      f n (fold_constr_expr_binders g f n' acc b l) t
+  | [] ->
+      f n acc b
+
+let rec fold_local_binders g f n acc b = function
+  | LocalRawAssum (nal,t)::l ->
+      let nal = snd (List.split nal) in
+      let n' = List.fold_right (name_fold g) nal n in
+      f n (fold_local_binders g f n' acc b l) t
+  | LocalRawDef ((_,na),t)::l ->
+      f n (fold_local_binders g f (name_fold g na n) acc b l) t
+  | _ ->
+      f n acc b
+
+let fold_constr_expr_with_binders g f n acc = function
+  | CArrow (loc,a,b) -> f n (f n acc a) b
+  | CAppExpl (loc,(_,_),l) -> List.fold_left (f n) acc l
+  | CApp (loc,(_,t),l) -> List.fold_left (f n) (f n acc t) (List.map fst l)
+  | CProdN (_,l,b) | CLambdaN (_,l,b) -> fold_constr_expr_binders g f n acc b l
+  | CLetIn (_,na,a,b) -> fold_constr_expr_binders g f n acc b [[na],a]
+  | CCast (loc,a,_,b) -> f n (f n acc a) b
+  | CNotation (_,_,l) -> List.fold_left (f n) acc l
+  | CDelimiters (loc,_,a) -> f n acc a
+  | CHole _ | CEvar _ | CPatVar _ | CSort _ | CPrim _ | CDynamic _  | CRef _ ->
+      acc
+  | CCases (loc,rtnpo,al,bl) ->
+      let ids = ids_of_cases_tomatch al in
+      let acc = option_fold_left (f (List.fold_right g ids n)) acc rtnpo in
+      let acc = List.fold_left (f n) acc (List.map fst al) in
+      List.fold_right (fun (loc,patl,rhs) acc ->
+	let ids = ids_of_pattern_list patl in
+	f (Idset.fold g ids n) acc rhs) bl acc
+  | CLetTuple (loc,nal,(ona,po),b,c) ->
+      let n' = List.fold_right (name_fold g) nal n in
+      f (option_fold_right (name_fold g) ona n') (f n acc b) c
+  | CIf (_,c,(ona,po),b1,b2) ->
+      let acc = f n (f n (f n acc b1) b2) c in
+      option_fold_left (f (option_fold_right (name_fold g) ona n)) acc po
+  | CFix (loc,_,l) ->
+      let n' = List.fold_right (fun (id,_,_,_,_) -> g id) l n in
+      List.fold_right (fun (_,(_,o),lb,t,c) acc ->
+	fold_local_binders g f n' 
+	  (fold_local_binders g f n acc t lb) c lb) l acc
   | CCoFix (loc,_,_) -> 
-      Pp.warning "Capture check in multiple binders not done"; false
+      Pp.warning "Capture check in multiple binders not done"; acc
+
+let free_vars_of_constr_expr c = 
+  let rec aux bdvars l = function
+  | CRef (Ident (_,id)) -> if List.mem id bdvars then l else Idset.add id l
+  | c -> fold_constr_expr_with_binders (fun a l -> a::l) aux bdvars l c
+  in aux [] Idset.empty c
 
-and occur_var_binders id b = function
-  | (idl,a)::l -> 
-      occur_var_constr_expr id a or
-      (not (List.mem (Name id) (snd (List.split idl)))
-      & occur_var_binders id b l)
-  | [] -> occur_var_constr_expr id b
+let occur_var_constr_expr id c = Idset.mem id (free_vars_of_constr_expr c)
 
 let mkIdentC id  = CRef (Ident (dummy_loc, id))
 let mkRefC r     = CRef r
@@ -665,19 +758,6 @@ let coerce_to_id = function
 
 (* Used in correctness and interface *)
 
-
-let names_of_cases_indtype =
-  let add_var ids = function CRef (Ident (_,id)) -> id::ids | _ -> ids in
-  let rec vars_of = function
-    (* We deal only with the regular cases *)
-    | CApp (_,_,l) -> List.fold_left add_var [] (List.map fst l)
-    | CNotation (_,_,l)
-    (* assume the ntn is applicative and does not instantiate the head !! *)
-    | CAppExpl (_,_,l) -> List.fold_left add_var [] l
-    | CDelimiters(_,_,c) -> vars_of c
-    | _ -> [] in
-  vars_of
-
 let map_binder g e nal = List.fold_right (fun (_,na) -> name_fold g na) nal e
 
 let map_binders f g e bl =
@@ -696,7 +776,7 @@ let map_local_binders f g e bl =
   let (e,rbl) = List.fold_left h (e,[]) bl in
   (e, List.rev rbl)
 
-let map_constr_expr_with_binders f g e = function
+let map_constr_expr_with_binders g f e = function
   | CArrow (loc,a,b) -> CArrow (loc,f e a,f e b)
   | CAppExpl (loc,r,l) -> CAppExpl (loc,r,List.map (f e) l) 
   | CApp (loc,(p,a),l) -> 
@@ -714,18 +794,9 @@ let map_constr_expr_with_binders f g e = function
   | CCases (loc,rtnpo,a,bl) ->
       (* TODO: apply g on the binding variables in pat... *)
       let bl = List.map (fun (loc,pat,rhs) -> (loc,pat,f e rhs)) bl in
-      let e' = 
-	List.fold_right
-	  (fun (tm,(na,indnal)) e ->
-	    option_fold_right
-	      (fun t ->
-		let ids = names_of_cases_indtype t in
-		List.fold_right g ids)
-            indnal (option_fold_right (name_fold g) na e))
-	  a e
-      in
-      CCases (loc,option_map (f e') rtnpo,
-         List.map (fun (tm,x) -> (f e tm,x)) a,bl)
+      let ids = ids_of_cases_tomatch a in
+      let po = option_map (f (List.fold_right g ids e)) rtnpo in
+      CCases (loc, po, List.map (fun (tm,x) -> (f e tm,x)) a,bl)
   | CLetTuple (loc,nal,(ona,po),b,c) ->
       let e' = List.fold_right (name_fold g) nal e in
       let e'' = option_fold_right (name_fold g) ona e in
@@ -753,8 +824,8 @@ let map_constr_expr_with_binders f g e = function
 let rec replace_vars_constr_expr l = function
   | CRef (Ident (loc,id)) as x ->
       (try CRef (Ident (loc,List.assoc id l)) with Not_found -> x)
-  | c -> map_constr_expr_with_binders replace_vars_constr_expr 
-      (fun id l -> List.remove_assoc id l) l c
+  | c -> map_constr_expr_with_binders List.remove_assoc 
+           replace_vars_constr_expr l c
 
 (**********************************************************************)
 (* Concrete syntax for modules and modules types *)
diff --git a/interp/topconstr.mli b/interp/topconstr.mli
index 51853089..131e4170 100644
--- a/interp/topconstr.mli
+++ b/interp/topconstr.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: topconstr.mli 9032 2006-07-07 16:30:34Z herbelin $ i*)
+(*i $Id: topconstr.mli 9226 2006-10-09 16:11:01Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -35,7 +35,7 @@ type aconstr =
   | ALetIn of name * aconstr * aconstr
   | ACases of aconstr option *
       (aconstr * (name * (inductive * int * name list) option)) list *
-      (identifier list * cases_pattern list * aconstr) list
+      (cases_pattern list * aconstr) list
   | ALetTuple of name list * (name * aconstr option) * aconstr * aconstr
   | AIf of aconstr * (name * aconstr option) * aconstr * aconstr
   | ASort of rawsort
@@ -43,30 +43,50 @@ type aconstr =
   | APatVar of patvar
   | ACast of aconstr * cast_type * aconstr
 
+(**********************************************************************)
+(* Translate a rawconstr into a notation given the list of variables  *)
+(* bound by the notation; also interpret recursive patterns           *) 
+
+val aconstr_of_rawconstr : identifier list -> rawconstr -> aconstr
+
+(* Name of the special identifier used to encode recursive notations  *)
+val ldots_var : identifier
+
+(* Equality of rawconstr (warning: only partially implemented) *)
+val eq_rawconstr : rawconstr -> rawconstr -> bool
+
+(**********************************************************************)
+(* Re-interpret a notation as a rawconstr, taking care of binders     *)
+
 val rawconstr_of_aconstr_with_binders : loc -> 
-  (identifier -> 'a -> identifier * 'a) ->
+  ('a -> identifier -> 'a * identifier) ->
   ('a -> aconstr -> rawconstr) -> 'a -> aconstr -> rawconstr
 
 val rawconstr_of_aconstr : loc -> aconstr -> rawconstr
 
-val subst_aconstr : substitution -> Names.identifier list -> aconstr -> aconstr
+(**********************************************************************)
+(* Substitution of kernel names, avoiding a list of bound identifiers *)
 
-val aconstr_of_rawconstr : identifier list -> rawconstr -> aconstr
+val subst_aconstr : substitution -> identifier list -> aconstr -> aconstr
 
-val eq_rawconstr : rawconstr -> rawconstr -> bool
+(**********************************************************************)
+(* [match_aconstr metas] matches a rawconstr against an aconstr with  *)
+(* metavariables in [metas]; raise [No_match] if the matching fails   *)
 
-(* [match_aconstr metas] match a rawconstr against an aconstr with
-   metavariables in [metas]; it raises [No_match] if the matching fails *)
 exception No_match
 
 type scope_name = string
+
+type tmp_scope_name = scope_name
+
 type interpretation = 
-    (identifier * (scope_name option * scope_name list)) list * aconstr
+    (identifier * (tmp_scope_name option * scope_name list)) list * aconstr
 
 val match_aconstr : rawconstr -> interpretation ->
-      (rawconstr * (scope_name option * scope_name list)) list
+      (rawconstr * (tmp_scope_name option * scope_name list)) list
 
-(*s Concrete syntax for terms *)
+(**********************************************************************)
+(*s Concrete syntax for terms                                         *)
 
 type notation = string
 
@@ -128,18 +148,21 @@ and local_binder =
   | LocalRawDef of name located * constr_expr
   | LocalRawAssum of name located list * constr_expr
 
+(**********************************************************************)
+(* Utilities on constr_expr                                           *)
 
 val constr_loc : constr_expr -> loc
 
-val cases_pattern_loc : cases_pattern_expr -> loc
+val cases_pattern_expr_loc : cases_pattern_expr -> loc
 
 val replace_vars_constr_expr :
   (identifier * identifier) list -> constr_expr -> constr_expr
 
+val free_vars_of_constr_expr : constr_expr -> Idset.t
 val occur_var_constr_expr : identifier -> constr_expr -> bool
 
 (* Specific function for interning "in indtype" syntax of "match" *)
-val names_of_cases_indtype : constr_expr -> identifier list
+val ids_of_cases_indtype : constr_expr -> identifier list
 
 val mkIdentC : identifier -> constr_expr
 val mkRefC : reference -> constr_expr
@@ -172,10 +195,11 @@ val names_of_local_binders : local_binder list -> name located list
 (* in pattern-matching clauses and in binders of the form [x,y:T(x)] *)
 
 val map_constr_expr_with_binders :
-  ('a -> constr_expr -> constr_expr) ->
-      (identifier -> 'a -> 'a) -> 'a -> constr_expr -> constr_expr
+  (identifier -> 'a -> 'a) -> ('a -> constr_expr -> constr_expr) ->
+      'a -> constr_expr -> constr_expr
 
-(* Concrete syntax for modules and modules types *)
+(**********************************************************************)
+(* Concrete syntax for modules and module types                       *)
 
 type with_declaration_ast = 
   | CWith_Module of identifier list located * qualid located
@@ -188,6 +212,3 @@ type module_type_ast =
 type module_ast = 
   | CMEident of qualid located
   | CMEapply of module_ast * module_ast
-
-(* Special identifier to encode recursive notations *)
-val ldots_var : identifier
diff --git a/kernel/byterun/coq_fix_code.c b/kernel/byterun/coq_fix_code.c
index 4616580d..70648b44 100644
--- a/kernel/byterun/coq_fix_code.c
+++ b/kernel/byterun/coq_fix_code.c
@@ -27,31 +27,31 @@ void init_arity () {
   /* instruction with zero operand */
   arity[ACC0]=arity[ACC1]=arity[ACC2]=arity[ACC3]=arity[ACC4]=arity[ACC5]=
     arity[ACC6]=arity[ACC7]=arity[PUSH]=arity[PUSHACC0]=arity[PUSHACC1]=
-    arity[PUSHACC2]=arity[PUSHACC3]=arity[PUSHACC4]=arity[PUSHACC5]=arity[PUSHACC6]=
-    arity[PUSHACC7]=arity[ENVACC1]=arity[ENVACC2]=arity[ENVACC3]=arity[ENVACC4]=
-    arity[PUSHENVACC1]=arity[PUSHENVACC2]=arity[PUSHENVACC3]=arity[PUSHENVACC4]=
-    arity[APPLY1]=arity[APPLY2]=arity[APPLY3]=arity[RESTART]=arity[OFFSETCLOSUREM2]=
+    arity[PUSHACC2]=arity[PUSHACC3]=arity[PUSHACC4]=arity[PUSHACC5]=
+    arity[PUSHACC6]=arity[PUSHACC7]=arity[ENVACC1]=arity[ENVACC2]=
+    arity[ENVACC3]=arity[ENVACC4]=arity[PUSHENVACC1]=arity[PUSHENVACC2]=
+    arity[PUSHENVACC3]=arity[PUSHENVACC4]=arity[APPLY1]=arity[APPLY2]=
+    arity[APPLY3]=arity[RESTART]=arity[OFFSETCLOSUREM2]=
     arity[OFFSETCLOSURE0]=arity[OFFSETCLOSURE2]=arity[PUSHOFFSETCLOSUREM2]=
     arity[PUSHOFFSETCLOSURE0]=arity[PUSHOFFSETCLOSURE2]=
+    arity[GETFIELD0]=arity[GETFIELD1]=arity[SETFIELD0]=arity[SETFIELD1]=
     arity[CONST0]=arity[CONST1]=arity[CONST2]=arity[CONST3]=
     arity[PUSHCONST0]=arity[PUSHCONST1]=arity[PUSHCONST2]=arity[PUSHCONST3]=
-    arity[ACCUMULATE]=arity[STOP]=arity[FORCE]=arity[MAKEPROD]= 0;
+    arity[ACCUMULATE]=arity[STOP]=arity[MAKEPROD]= 0;
   /* instruction with one operand */
   arity[ACC]=arity[PUSHACC]=arity[POP]=arity[ENVACC]=arity[PUSHENVACC]=
-    arity[PUSH_RETADDR]=
-    arity[APPLY]=arity[APPTERM1]=arity[APPTERM2]=arity[APPTERM3]=arity[RETURN]=
-    arity[GRAB]=arity[COGRAB]=
-    arity[OFFSETCLOSURE]=arity[PUSHOFFSETCLOSURE]=
-    arity[GETGLOBAL]=arity[PUSHGETGLOBAL]=
-    arity[MAKEBLOCK1]=arity[MAKEBLOCK2]=arity[MAKEBLOCK3]=arity[MAKEACCU]=
-    arity[CONSTINT]=arity[PUSHCONSTINT]=arity[GRABREC]=arity[PUSHFIELD]=
-    arity[ACCUMULATECOND]= 1;
+    arity[PUSH_RETADDR]=arity[APPLY]=arity[APPTERM1]=arity[APPTERM2]=
+    arity[APPTERM3]=arity[RETURN]=arity[GRAB]=arity[OFFSETCLOSURE]=
+    arity[PUSHOFFSETCLOSURE]=arity[GETGLOBAL]=arity[PUSHGETGLOBAL]=
+    arity[MAKEBLOCK1]=arity[MAKEBLOCK2]=arity[MAKEBLOCK3]=arity[MAKEBLOCK4]=
+    arity[MAKEACCU]=arity[CONSTINT]=arity[PUSHCONSTINT]=arity[GRABREC]=
+    arity[PUSHFIELDS]=arity[GETFIELD]=arity[SETFIELD]=arity[ACCUMULATECOND]= 1;
   /* instruction with two operands */
   arity[APPTERM]=arity[MAKEBLOCK]=arity[CLOSURE]=2;
   /* instruction with four operands */ 
   arity[MAKESWITCHBLOCK]=4;
   /* instruction with arbitrary operands */
-  arity[CLOSUREREC]=arity[SWITCH]=0;
+  arity[CLOSUREREC]=arity[CLOSURECOFIX]=arity[SWITCH]=0;
 }
 
 #endif /*  THREADED_CODE */
@@ -150,7 +150,7 @@ value coq_tcode_of_code (value code, value size) {
       block_size = sizes >> 16;
       sizes = const_size + block_size;
       for(i=0; i<sizes; i++) { COPY32(q,p); p++; q++; };
-    } else if (instr == CLOSUREREC) {
+    } else if (instr == CLOSUREREC || instr==CLOSURECOFIX) {
       uint32 i, n;
       COPY32(q,p); p++; /* ndefs */
       n = 3 + 2*(*q);  /* ndefs, nvars, start, typlbls,lbls*/
diff --git a/kernel/byterun/coq_instruct.h b/kernel/byterun/coq_instruct.h
index d3b07526..89616c5f 100644
--- a/kernel/byterun/coq_instruct.h
+++ b/kernel/byterun/coq_instruct.h
@@ -22,18 +22,20 @@ enum instructions {
   PUSH_RETADDR,
   APPLY, APPLY1, APPLY2, APPLY3,
   APPTERM, APPTERM1, APPTERM2, APPTERM3,
-  RETURN, RESTART, GRAB, GRABREC, COGRAB, 
-  CLOSURE, CLOSUREREC, 
+  RETURN, RESTART, GRAB, GRABREC, 
+  CLOSURE, CLOSUREREC, CLOSURECOFIX,
   OFFSETCLOSUREM2, OFFSETCLOSURE0, OFFSETCLOSURE2, OFFSETCLOSURE,
   PUSHOFFSETCLOSUREM2, PUSHOFFSETCLOSURE0, PUSHOFFSETCLOSURE2, 
   PUSHOFFSETCLOSURE,
   GETGLOBAL, PUSHGETGLOBAL,
-  MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, 
-  MAKESWITCHBLOCK, MAKEACCU, MAKEPROD,
-  FORCE, SWITCH, PUSHFIELD,
+  MAKEBLOCK, MAKEBLOCK1, MAKEBLOCK2, MAKEBLOCK3, MAKEBLOCK4,
+  SWITCH, PUSHFIELDS, 
+  GETFIELD0, GETFIELD1, GETFIELD, 
+  SETFIELD0, SETFIELD1, SETFIELD,
   CONST0, CONST1, CONST2, CONST3, CONSTINT,
   PUSHCONST0, PUSHCONST1, PUSHCONST2, PUSHCONST3, PUSHCONSTINT,
-  ACCUMULATE, ACCUMULATECOND, STOP
+  ACCUMULATE, ACCUMULATECOND, 
+  MAKESWITCHBLOCK, MAKEACCU, MAKEPROD, STOP
 };
 
 #endif /* _COQ_INSTRUCT_ */
diff --git a/kernel/byterun/coq_interp.c b/kernel/byterun/coq_interp.c
index 8bfe78eb..0f91a7e3 100644
--- a/kernel/byterun/coq_interp.c
+++ b/kernel/byterun/coq_interp.c
@@ -65,6 +65,13 @@ sp is a local copy of the global variable extern_sp. */
 #   define print_int(i) 
 #endif
 
+/* Wrapper pour caml_modify */
+#ifdef OCAML_307
+#define CAML_MODIFY(a,b) modify(a,b)
+#else
+#define CAML_MODIFY(a,b) caml_modify(a,b)
+#endif
+
 /* GC interface */
 #define Setup_for_gc { sp -= 2; sp[0] = accu; sp[1] = coq_env; coq_sp = sp; }
 #define Restore_after_gc { accu = sp[0]; coq_env = sp[1]; sp += 2; }
@@ -164,7 +171,7 @@ value coq_interprete
 #else 
   opcode_t curr_instr;
 #endif
-    print_instr("Enter Interpreter");
+  print_instr("Enter Interpreter");
   if (coq_pc == NULL) {           /* Interpreter is initializing */
     print_instr("Interpreter is initializing");
 #ifdef THREADED_CODE
@@ -383,6 +390,17 @@ value coq_interprete
 	coq_extra_args = 2;
 	goto check_stacks;
       }
+      /* Stack checks */
+      
+    check_stacks:
+      print_instr("check_stacks");
+      if (sp < coq_stack_threshold) {
+	coq_sp = sp;
+	realloc_coq_stack(Coq_stack_threshold);
+	sp = coq_sp;
+      }
+      Next;
+      /* Fall through CHECK_SIGNALS */
 
       Instruct(APPTERM) {
 	int nargs = *pc++;
@@ -438,6 +456,7 @@ value coq_interprete
       
       Instruct(RETURN) {
 	print_instr("RETURN");
+	print_int(*pc);
 	sp += *pc++;
 	if (coq_extra_args > 0) {
 	  coq_extra_args--;
@@ -485,30 +504,6 @@ value coq_interprete
 	Next;
       }
 
-      Instruct(COGRAB){
-	int required = *pc++;
-	print_instr("COGRAB");
-	if(forcable == Val_true) {
-	  print_instr("true");
-	  /* L'instruction précédante est FORCE */
-	  if (coq_extra_args > 0) coq_extra_args--;
-	  pc++;
-	  forcable = Val_false;
-	} else { /* L'instruction précédante est APPLY */
-	  mlsize_t num_args, i;
-	  num_args = 1 + coq_extra_args; /* arg1 + extra args */
-	  Alloc_small(accu, num_args + 2, Closure_tag); 
-	  Field(accu, 1) = coq_env;
-	  for (i = 0; i < num_args; i++) Field(accu, i + 2) = sp[i];
-	  Code_val(accu) = pc - 3; /* Point to the preceding RESTART instr. */
-	  sp += num_args;
-	  pc = (code_t)(sp[0]);
-	  coq_env = sp[1];
-	  coq_extra_args = Long_val(sp[2]);
-	  sp += 3;
-	}
-	Next;
-      }
       Instruct(GRABREC) { 
 	int rec_pos = *pc++; /* commence a zero */
 	print_instr("GRABREC");
@@ -607,7 +602,59 @@ value coq_interprete
 	accu = accu + 2 * start * sizeof(value);
 	Next;
       }
-     
+
+      Instruct(CLOSURECOFIX){ 
+	int nfunc = *pc++;
+	int nvars = *pc++;
+	int start = *pc++;
+	int i, j , size;
+	value * p;
+	print_instr("CLOSURECOFIX");
+	if (nvars > 0) *--sp = accu;
+	/* construction du vecteur de type */
+	Alloc_small(accu, nfunc, 0);
+	for(i = 0; i < nfunc; i++) {
+	  Field(accu,i) = (value)(pc+pc[i]);
+	}
+	pc += nfunc;
+	*--sp=accu;
+
+        /* Creation des blocks accumulate */
+        for(i=0; i < nfunc; i++) {
+	  Alloc_small(accu, 2, Accu_tag);
+	  Code_val(accu) = accumulate;
+	  Field(accu,1) = Val_int(1);
+	  *--sp=accu;
+	}
+	/* creation des fonction cofix */
+
+        p = sp;
+	size = nfunc + nvars + 2;
+	for (i=0; i < nfunc; i++) {
+
+	  Alloc_small(accu, size, Closure_tag);
+	  Code_val(accu) = pc+pc[i];
+	  for (j = 0; j < nfunc; j++) Field(accu, j+1) = p[j];
+	  Field(accu, size - 1) = p[nfunc];
+	  for (j = nfunc+1; j <= nfunc+nvars; j++) Field(accu, j) = p[j];
+	  *--sp = accu;
+          /* creation du block contenant le cofix */
+
+	  Alloc_small(accu,1, ATOM_COFIX_TAG);
+	  Field(accu, 0) = sp[0];
+	  *sp = accu;
+	  /* mise a jour du block accumulate */
+	  CAML_MODIFY(&Field(p[i], 1),*sp);
+	  sp++;
+	}
+	pc += nfunc;
+	accu = p[start];
+        sp = p + nfunc + 1 + nvars;
+	print_instr("ici4");
+	Next;
+      }
+
+    
       Instruct(PUSHOFFSETCLOSURE) {
 	print_instr("PUSHOFFSETCLOSURE");
 	*--sp = accu;
@@ -644,7 +691,7 @@ value coq_interprete
 /* Access to global variables */
 
       Instruct(PUSHGETGLOBAL) {
-	print_instr("PUSHGETGLOBAL");
+	print_instr("PUSH");
 	*--sp = accu;
       }
       /* Fallthrough */
@@ -703,38 +750,27 @@ value coq_interprete
 	accu = block;
 	Next;
       }
+      Instruct(MAKEBLOCK4) {
+	tag_t tag = *pc++;
+	value block;
+	print_instr("MAKEBLOCK4");
+	Alloc_small(block, 4, tag);
+	Field(block, 0) = accu;
+	Field(block, 1) = sp[0];
+	Field(block, 2) = sp[1];
+	Field(block, 3) = sp[2];
+	sp += 3;
+	accu = block;
+	Next;
+      }
 
   
 /* Access to components of blocks */
         
-	
-/* Branches and conditional branches */
-      Instruct(FORCE) {
-	print_instr("FORCE");
-	if (Is_block(accu) && Tag_val(accu) == Closure_tag) {
-	  forcable = Val_true;
-	  /* On pousse l'addresse de retour et l'argument */
-	  sp -= 3;
-	  sp[0] = (value) (pc - 1);
-	  sp[1] = coq_env;
-	  sp[2] = Val_long(coq_extra_args);
-	  /* On evalue le cofix */
-	  coq_extra_args = 0;
-	  pc = Code_val(accu);
-	  coq_env = accu;
-	  goto check_stacks;
-	} else {
-	  if (Is_block(accu)) print_int(Tag_val(accu));
-	  else print_instr("Not a block");
-	}
-	Next;
-      }
-           
-    
       Instruct(SWITCH) {
 	uint32 sizes = *pc++;
 	print_instr("SWITCH");
-	print_int(sizes);
+	print_int(sizes & 0xFFFF);
 	if (Is_block(accu)) {
 	  long index = Tag_val(accu);
 	  print_instr("block");
@@ -748,68 +784,79 @@ value coq_interprete
 	}
 	  Next;
       }
-      Instruct(PUSHFIELD){
+
+      Instruct(PUSHFIELDS){
 	int i;
 	int size = *pc++;
-	print_instr("PUSHFIELD");
+	print_instr("PUSHFIELDS");
 	sp -= size;
 	for(i=0;i<size;i++)sp[i] = Field(accu,i);
 	Next;
       }
-	
-      Instruct(MAKESWITCHBLOCK) {
-	mlsize_t sz;
-	int i, annot;
-	code_t typlbl,swlbl;
-	print_instr("MAKESWITCHBLOCK");
-	typlbl = (code_t)pc + *pc; 
-	pc++;
-	swlbl = (code_t)pc + *pc; 
-	pc++;
-	annot = *pc++;
-	sz = *pc++;
-	*--sp = accu;
-	*--sp=Field(coq_global_data, annot);
-	/* On sauve la pile */
-	if (sz == 0) accu = Atom(0);
-	else {
-	  Alloc_small(accu, sz, Default_tag);
-	  if (Field(*sp, 2) == Val_true) {
-	    for (i = 0; i < sz; i++) Field(accu, i) = sp[i+2];
-	  }else{
-	    for (i = 0; i < sz; i++) Field(accu, i) = sp[i+5];
-	  }
-	}
-	*--sp = accu;
-	/* On cree le zipper switch */
-	Alloc_small(accu, 5, Default_tag);
-	Field(accu, 0) =  (value)typlbl; Field(accu, 1) = (value)swlbl; 
-	Field(accu, 2) = sp[1]; Field(accu, 3) = sp[0]; 
-	Field(accu, 4) = coq_env;
-	sp++;sp[0] = accu;
-	/* On cree l'atome */
-	Alloc_small(accu, 2, ATOM_SWITCH_TAG);
-	Field(accu, 0) = sp[1]; Field(accu, 1) = sp[0];
-	sp++;sp[0] = accu;
-	/* On cree l'accumulateur */
-	Alloc_small(accu, 2, Accu_tag);
-	Code_val(accu) = accumulate; 
-	Field(accu,1) = *sp++;
+      
+      Instruct(GETFIELD0){
+	print_instr("GETFIELD0");
+	accu = Field(accu, 0); 
 	Next;
       }
 
-      /* Stack checks */
-      
-    check_stacks:
-      print_instr("check_stacks");
-      if (sp < coq_stack_threshold) {
-	coq_sp = sp;
-	realloc_coq_stack(Coq_stack_threshold);
-	sp = coq_sp;
+      Instruct(GETFIELD1){
+	print_instr("GETFIELD1");
+	accu = Field(accu, 1);
+	Next;
       }
-      Next;
-      /* Fall through CHECK_SIGNALS */
 
+      Instruct(GETFIELD){
+	print_instr("GETFIELD");
+	accu = Field(accu, *pc); 
+	pc++; 
+	Next;
+      }
+      
+      Instruct(SETFIELD0){
+	print_instr("SETFIELD0");
+	CAML_MODIFY(&Field(accu, 0),*sp);
+	sp++;
+	Next;
+      }
+	
+      Instruct(SETFIELD1){
+        int i, j, size, size_aux;
+	print_instr("SETFIELD1");
+	CAML_MODIFY(&Field(accu, 1),*sp);
+       	sp++;
+	Next; 
+      }
+  
+      /* *sp = accu;
+	* Netoyage des cofix *
+        size = Wosize_val(accu);
+        for (i = 2; i < size; i++) {
+ 	  accu = Field(*sp, i);
+          if (IS_EVALUATED_COFIX(accu)) {
+            size_aux = Wosize_val(accu);
+            *--sp = accu;
+	    Alloc_small(accu, size_aux, Accu_tag);
+	    for(j = 0; j < size_aux; j++) Field(accu, j) = Field(*sp, j);
+	    *sp = accu;
+	    Alloc_small(accu, 1, ATOM_COFIX_TAG);
+	    Field(accu, 0) = Field(Field(*sp, 1), 0);
+	    CAML_MODIFY(&Field(*sp, 1), accu);
+	    accu = *sp; sp++;
+            CAML_MODIFY(&Field(*sp, i), accu);
+	  }
+	}
+	sp++;
+	Next; 
+	} */
+      
+      Instruct(SETFIELD){
+	print_instr("SETFIELD");
+	CAML_MODIFY(&Field(accu, *pc),*sp);
+	sp++; pc++;
+	Next;
+      }	
+   
 /* Integer constants */
 
       Instruct(CONST0){
@@ -854,14 +901,7 @@ value coq_interprete
 	Next;
       }
 
-/* Debugging and machine control */
-
-      Instruct(STOP){
-	print_instr("STOP");
-	coq_sp = sp;
-	return accu;
-      }
-      
+      /* Special operations for reduction of open term */
       Instruct(ACCUMULATECOND) {
 	int i, num;
 	print_instr("ACCUMULATECOND");
@@ -869,7 +909,7 @@ value coq_interprete
 	pc++;
 	if (Field(coq_global_boxed, num) == Val_false || coq_all_transp) {
 	  /*	  printf ("false\n");
-	    printf ("tag = %d", Tag_val(Field(accu,1))); */
+		  printf ("tag = %d", Tag_val(Field(accu,1))); */
 	  num = Wosize_val(coq_env);
 	  for(i = 2; i < num; i++) *--sp = Field(accu,i);
 	  coq_extra_args = coq_extra_args + (num - 2);
@@ -881,7 +921,7 @@ value coq_interprete
 	};
 	/*	printf ("true\n"); */
       }
-
+      
       Instruct(ACCUMULATE) {
 	mlsize_t i, size;
 	print_instr("ACCUMULATE");
@@ -896,7 +936,86 @@ value coq_interprete
 	sp += 3;
 	Next;
       }  
-            
+      Instruct(MAKESWITCHBLOCK) {
+	print_instr("MAKESWITCHBLOCK");
+	*--sp = accu;
+	accu = Field(accu,1);
+	switch (Tag_val(accu)) {
+	case ATOM_COFIX_TAG: 
+	  {
+	    mlsize_t i, nargs;
+	    print_instr("COFIX_TAG");
+	    sp-=2;
+	    pc++;
+	    sp[0] = (value) (pc + *pc);
+	    sp[1] = coq_env;
+	    coq_env = Field(accu,0);
+	    accu = sp[2];
+	    sp[2] = Val_long(coq_extra_args);
+	    nargs = Wosize_val(accu) - 2;
+	    sp -= nargs;
+	    for (i = 0; i < nargs; i++) sp[i] = Field(accu, i + 2);
+	    *--sp = accu;
+	    print_int(nargs);
+	    coq_extra_args = nargs;
+	    pc = Code_val(coq_env);
+	    goto check_stacks;
+	  }
+	case ATOM_COFIXEVALUATED_TAG: 
+	  {
+	    print_instr("COFIX_EVAL_TAG");
+	    accu = Field(accu,1);
+	    pc++;
+	    pc = pc + *pc;
+	    sp++;
+	    Next;
+	  }
+	default: 
+	  {  
+	    mlsize_t sz;
+	    int i, annot;
+	    code_t typlbl,swlbl;
+	    print_instr("MAKESWITCHBLOCK");
+	    
+	    typlbl = (code_t)pc + *pc; 
+	    pc++;
+	    swlbl = (code_t)pc + *pc; 
+	    pc++;
+	    annot = *pc++;
+	    sz = *pc++;
+	    *--sp=Field(coq_global_data, annot);
+	    /* On sauve la pile */
+	    if (sz == 0) accu = Atom(0);
+	    else {
+	      Alloc_small(accu, sz, Default_tag);
+	      if (Field(*sp, 2) == Val_true) {
+		for (i = 0; i < sz; i++) Field(accu, i) = sp[i+2];
+	      }else{
+		for (i = 0; i < sz; i++) Field(accu, i) = sp[i+5];
+	      }
+	    }
+	    *--sp = accu;
+	    /* On cree le zipper switch */
+	    Alloc_small(accu, 5, Default_tag);
+	    Field(accu, 0) =  (value)typlbl; Field(accu, 1) = (value)swlbl; 
+	    Field(accu, 2) = sp[1]; Field(accu, 3) = sp[0]; 
+	    Field(accu, 4) = coq_env;
+	    sp++;sp[0] = accu;
+	    /* On cree l'atome */
+	    Alloc_small(accu, 2, ATOM_SWITCH_TAG);
+	    Field(accu, 0) = sp[1]; Field(accu, 1) = sp[0];
+	    sp++;sp[0] = accu;
+	    /* On cree l'accumulateur */
+	    Alloc_small(accu, 2, Accu_tag);
+	    Code_val(accu) = accumulate; 
+	    Field(accu,1) = *sp++;
+	  }
+	}
+	Next;
+      }
+
+	
+         
       Instruct(MAKEACCU) {
 	int i;
 	print_instr("MAKEACCU");
@@ -921,6 +1040,15 @@ value coq_interprete
 	Next;
       }
       
+/* Debugging and machine control */
+
+      Instruct(STOP){
+	print_instr("STOP");
+	coq_sp = sp;
+	return accu;
+      }
+      
+  
 #ifndef THREADED_CODE
     default:
       /*fprintf(stderr, "%d\n", *pc);*/
diff --git a/kernel/byterun/coq_memory.c b/kernel/byterun/coq_memory.c
index db6aacb9..bfcb6812 100644
--- a/kernel/byterun/coq_memory.c
+++ b/kernel/byterun/coq_memory.c
@@ -34,7 +34,6 @@ int drawinstr;
 
 long coq_saved_sp_offset;
 value * coq_sp;
-value forcable;
 /* Some predefined pointer code */ 
 code_t accumulate;
 
@@ -135,7 +134,6 @@ value init_coq_vm(value unit) /* ML */
     init_coq_atom_tbl(40);
     /* Initialing the interpreter */
     coq_all_transp = 0;
-    forcable = Val_false;
     init_coq_interpreter();
     
     /* Some predefined pointer code */
@@ -266,8 +264,9 @@ value coq_set_drawinstr(value unit)
   return Val_unit;
 }
 
-value coq_set_forcable (value unit)
+
+value coq_print_pointer(value p)
 {
-  forcable = Val_true;
+  printf("pointer = %X\n", p);
   return Val_unit;
 }
diff --git a/kernel/byterun/coq_memory.h b/kernel/byterun/coq_memory.h
index 7c96e684..0d866dc7 100644
--- a/kernel/byterun/coq_memory.h
+++ b/kernel/byterun/coq_memory.h
@@ -43,7 +43,6 @@ extern int drawinstr;
 /* interp state */
 
 extern value * coq_sp;
-extern value forcable;
 /* Some predefined pointer code */ 
 extern code_t accumulate;
 
diff --git a/kernel/byterun/coq_values.c b/kernel/byterun/coq_values.c
index baf3ab09..34b885e8 100644
--- a/kernel/byterun/coq_values.c
+++ b/kernel/byterun/coq_values.c
@@ -27,8 +27,7 @@ value coq_kind_of_closure(value v) {
   if (Is_instruction(c, GRAB)) return Val_int(0);
   if (Is_instruction(c, RESTART)) {is_app = 1; c++;}
   if (Is_instruction(c, GRABREC)) return Val_int(1+is_app);
-  if (Is_instruction(c, COGRAB)) return Val_int(3+is_app);
-  if (Is_instruction(c, MAKEACCU)) return Val_int(5);
+  if (Is_instruction(c, MAKEACCU)) return Val_int(3);
   return Val_int(0);
 }
 
diff --git a/kernel/byterun/coq_values.h b/kernel/byterun/coq_values.h
index a186d62a..a5176f3f 100644
--- a/kernel/byterun/coq_values.h
+++ b/kernel/byterun/coq_values.h
@@ -14,15 +14,25 @@
 #include "alloc.h"
 #include "mlvalues.h"
 
+#define Default_tag 0
+#define Accu_tag 0
+
+
+
+#define ATOM_ID_TAG 0
+#define ATOM_IDDEF_TAG 1
+#define ATOM_INDUCTIVE_TAG 2
 #define ATOM_FIX_TAG 3
 #define ATOM_SWITCH_TAG 4
+#define ATOM_COFIX_TAG 5
+#define ATOM_COFIXEVALUATED_TAG 6
+
 
-#define Accu_tag 0
-#define Default_tag 0
 
 /* Les blocs accumulate */
 #define Is_accu(v) (Is_block(v) && (Tag_val(v) == Accu_tag))
 
+#define IS_EVALUATED_COFIX(v) (Is_accu(v) && Is_block(Field(v,1)) && (Tag_val(Field(v,1)) == ATOM_COFIXEVALUATED_TAG))
 #endif /* _COQ_VALUES_ */
 
 
diff --git a/kernel/cbytecodes.ml b/kernel/cbytecodes.ml
index 49955474..a9b16f29 100644
--- a/kernel/cbytecodes.ml
+++ b/kernel/cbytecodes.ml
@@ -3,6 +3,14 @@ open Term
 
 type tag = int 
 
+let id_tag = 0
+let iddef_tag = 1
+let ind_tag = 2
+let fix_tag = 3
+let switch_tag = 4
+let cofix_tag = 5
+let cofix_evaluated_tag = 6
+
 type structured_constant =
   | Const_sorts of sorts
   | Const_ind of inductive
@@ -39,18 +47,20 @@ type instruction =
   | Krestart
   | Kgrab of int                        (* number of arguments *)
   | Kgrabrec of int                     (* rec arg *)
-  | Kcograb of int                      (* number of arguments *)
   | Kclosure of Label.t * int           (* label, number of free variables *)
   | Kclosurerec of int * int * Label.t array * Label.t array 
                    (* nb fv, init, lbl types, lbl bodies *)
+  | Kclosurecofix of int * int * Label.t array * Label.t array 
+                   (* nb fv, init, lbl types, lbl bodies *)
   | Kgetglobal of constant
   | Kconst of structured_constant
   | Kmakeblock of int * tag             (* size, tag *)
   | Kmakeprod 
   | Kmakeswitchblock of Label.t * Label.t * annot_switch * int
-  | Kforce
   | Kswitch of Label.t array * Label.t array (* consts,blocks *)
-  | Kpushfield of int 
+  | Kpushfields of int 
+  | Kfield of int
+  | Ksetfield of int
   | Kstop
   | Ksequence of bytecodes * bytecodes
 
@@ -79,7 +89,6 @@ let rec instruction ppf = function
   | Krestart -> fprintf ppf "\trestart"
   | Kgrab n -> fprintf ppf "\tgrab %i" n
   | Kgrabrec n -> fprintf ppf "\tgrabrec %i" n
-  | Kcograb n -> fprintf ppf "\tcograb %i" n
   | Kclosure(lbl, n) ->
       fprintf ppf "\tclosure L%i, %i" lbl n
   | Kclosurerec(fv,init,lblt,lblb) ->
@@ -89,7 +98,13 @@ let rec instruction ppf = function
       Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblt;
       print_string " bodies = ";
       Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblb;
-                   (* nb fv, init, lbl types, lbl bodies *)
+  | Kclosurecofix (fv,init,lblt,lblb) ->
+      fprintf ppf "\tclosurecofix";
+      fprintf ppf " %i , %i, " fv init;
+      print_string "types = ";
+      Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblt;
+      print_string " bodies = ";
+      Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblb;
   | Kgetglobal id -> fprintf ppf "\tgetglobal %s" (Names.string_of_con id)
   | Kconst cst ->
       fprintf ppf "\tconst"
@@ -98,13 +113,13 @@ let rec instruction ppf = function
   | Kmakeprod -> fprintf ppf "\tmakeprod"
   | Kmakeswitchblock(lblt,lbls,_,sz) ->
       fprintf ppf "\tmakeswitchblock %i, %i, %i" lblt lbls sz
-  | Kforce -> fprintf ppf "\tforce"
   | Kswitch(lblc,lblb) -> 
       fprintf ppf "\tswitch";
       Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblc;
       Array.iter (fun lbl -> fprintf ppf " %i" lbl) lblb;
-  | Kpushfield n -> 
-      fprintf ppf "\tpushfield %i" n
+  | Kpushfields n -> fprintf ppf "\tpushfields %i" n
+  | Ksetfield n -> fprintf ppf "\tsetfield %i" n
+  | Kfield  n -> fprintf ppf "\tgetfield %i" n
   | Kstop -> fprintf ppf "\tstop"
   | Ksequence (c1,c2) ->
       fprintf ppf "%a@ %a" instruction_list c1 instruction_list c2 
diff --git a/kernel/cbytecodes.mli b/kernel/cbytecodes.mli
index a996f750..215b6ad4 100644
--- a/kernel/cbytecodes.mli
+++ b/kernel/cbytecodes.mli
@@ -3,6 +3,14 @@ open Term
 
 type tag = int 
 
+val id_tag : tag
+val iddef_tag : tag
+val ind_tag : tag
+val fix_tag : tag
+val switch_tag : tag
+val cofix_tag : tag
+val cofix_evaluated_tag : tag
+
 type structured_constant =
   | Const_sorts of sorts
   | Const_ind of inductive
@@ -37,21 +45,24 @@ type instruction =
   | Krestart
   | Kgrab of int                        (* number of arguments *)
   | Kgrabrec of int                     (* rec arg *)
-  | Kcograb of int                      (* number of arguments *)
   | Kclosure of Label.t * int           (* label, number of free variables *)
   | Kclosurerec of int * int * Label.t array * Label.t array 
                    (* nb fv, init, lbl types, lbl bodies *)
+  | Kclosurecofix of int * int * Label.t array * Label.t array 
+                   (* nb fv, init, lbl types, lbl bodies *)
   | Kgetglobal of constant
   | Kconst of structured_constant
   | Kmakeblock of int * tag             (* size, tag *)
   | Kmakeprod 
   | Kmakeswitchblock of Label.t * Label.t * annot_switch * int
-  | Kforce
   | Kswitch of Label.t array * Label.t array (* consts,blocks *)
-  | Kpushfield of int 
+  | Kpushfields of int 
+  | Kfield of int
+  | Ksetfield of int
   | Kstop
   | Ksequence of bytecodes * bytecodes
 
+
 and bytecodes = instruction list
 
 type fv_elem = FVnamed of identifier | FVrel of int
@@ -59,3 +70,4 @@ type fv_elem = FVnamed of identifier | FVrel of int
 type fv = fv_elem array
 
 val draw_instr : bytecodes -> unit
+
diff --git a/kernel/cbytegen.ml b/kernel/cbytegen.ml
index 041e0795..e1f89fad 100644
--- a/kernel/cbytegen.ml
+++ b/kernel/cbytegen.ml
@@ -6,35 +6,161 @@ open Term
 open Declarations
 open Pre_env
 
-(*i Compilation des variables + calcul des variables libres *)
 
-(* Representation des environnements machines :                       *)
-(*[t0|C0| ... |tc|Cc| ... |t(nbr-1)|C(nbr-1)| fv1 | fv1 | .... | fvn] *)
-(*               ^<----------offset--------->                         *)
-
-
-type fv = fv_elem list
-
-type vm_env = {size : int; fv_rev : fv}
-    (* size = n;   fv_rev = [fvn; ... ;fv1] *)
-         
-type t = {
-    nb_stack : int;        (* nbre de variables sur la pile *)
-    in_stack : int list;   (* position dans la pile *)
-    nb_rec : int;          (* nbre de fonctions mutuellement recursives = 
-			                                              nbr *)
-    pos_rec : int;         (* position de la fonction courante = c *)
-    offset : int;          
-    in_env : vm_env ref
-  }	
-
-let empty_fv = {size= 0; fv_rev = []}
+(* Compilation des variables + calcul des variables libres               *)
+
+(* Dans la machine virtuel il n'y a pas de difference entre les           *)
+(* fonctions et leur environnement                                        *)
+
+(* Representation de l'environnements des fonctions :                     *)
+(*        [clos_t | code | fv1 | fv2 | ... | fvn ]                        *)
+(*                ^                                                       *)
+(*  l'offset pour l'acces au variable libre est 1 (il faut passer le      *)
+(*  pointeur de code).                                                    *)
+(*  Lors de la compilation, les variables libres sont stock'ees dans      *)
+(*  [in_env] dans l'ordre inverse de la representation machine, ceci      *)
+(* permet de rajouter des nouvelles variables dans l'environnememt        *)
+(* facilement.                                                            *)
+(* Les arguments de la fonction arrive sur la pile dans l'ordre de        *)
+(* l'application :  f arg1 ... argn                                       *)
+(*   - la pile est alors :                                                *)
+(*        arg1 : ... argn : extra args : return addr : ...                *)
+(* Dans le corps de la fonction [arg1] est repr'esent'e par le de Bruijn  *)
+(*  [n], [argn] par le de Bruijn [1]                                      *)
+
+(* Representation des environnements des points fix mutuels :             *)
+(* [t1|C1| ... |tc|Cc| ... |t(nbr)|C(nbr)| fv1 | fv2 | .... | fvn | type] *)
+(*                ^<----------offset--------->                            *)
+(* type = [Ct1 | .... | Ctn]                                              *)
+(* Ci est le code correspondant au corps du ieme point fix                *)
+(* Lors de l'evaluation d'un point fix l'environnement est un pointeur    *)
+(* sur la position correspondante a son code.                             *)
+(* Dans le corps de chaque point fix le de Bruijn [nbr] represente,       *)
+(* le 1er point fix de la declaration mutuelle, le de Bruijn [1] le       *)
+(* nbr-ieme.                                                              *)
+(* L'acces a ces variables se fait par l'instruction [Koffsetclosure]     *)
+(*  (decalage de l'environnement)                                         *)
+
+(* Ceci permet de representer tout les point fix mutuels en un seul bloc  *)
+(* [Ct1 | ... | Ctn] est un tableau contant le code d'evaluation des      *)
+(* types des points fixes, ils sont utilises pour tester la conversion    *)
+(* Leur environnement d'execution est celui du dernier point fix :        *)
+(* [t1|C1| ... |tc|Cc| ... |t(nbr)|C(nbr)| fv1 | fv2 | .... | fvn | type] *)
+(*                                ^                                       *)
+
+
+(* Representation des cofix mutuels :                                     *)
+(*  a1 =   [A_t | accumulate | [Cfx_t | fcofix1 ] ]                       *)
+(*                ...                                                     *)
+(*  anbr = [A_t | accumulate | [Cfx_t | fcofixnbr ] ]                     *)
+(*                                                                        *)
+(*  fcofix1 = [clos_t   | code1   | a1 |...| anbr | fv1 |...| fvn | type] *)
+(*                      ^                                                 *)
+(*                ...                                                     *)
+(*  fcofixnbr = [clos_t | codenbr | a1 |...| anbr | fv1 |...| fvn | type] *)
+(*                      ^                                                 *)
+(*  Les block [ai] sont des fonctions qui accumulent leurs arguments :    *)
+(*           ai arg1  argp --->                                           *)
+(*    ai' = [A_t | accumulate | [Cfx_t | fcofixi] | arg1 | ... | argp ]   *)
+(* Si un tel bloc arrive sur un [match] il faut forcer l'evaluation,      *)
+(* la fonction [fcofixi] est alors appliqu'ee a [ai'] [arg1] ... [argp]   *)
+(* A la fin de l'evaluation [ai'] est mis a jour avec le resultat de      *)
+(* l'evaluation :                                                         *)
+(*  ai' <--                                                               *)
+(*   [A_t | accumulate | [Cfxe_t |fcofixi|result] | arg1 | ... | argp ]   *)
+(* L'avantage de cette representation est qu'elle permet d'evaluer qu'une *)
+(* fois l'application d'un cofix (evaluation lazy)                        *)
+(* De plus elle permet de creer facilement des cycles quand les cofix ne  *)
+(* n'ont pas d'aruments, ex:                                              *)
+(*   cofix one := cons 1 one                                              *)
+(*   a1 = [A_t | accumulate | [Cfx_t|fcofix1] ]                           *)
+(*   fcofix1 = [clos_t | code | a1]                                       *)
+(*  Quand on force l'evaluation de [a1] le resultat est                   *)
+(*    [cons_t | 1 | a1]                                                   *)
+(*  [a1] est mis a jour :                                                 *)
+(*  a1 = [A_t | accumulate | [Cfxe_t | fcofix1 | [cons_t | 1 | a1]] ]     *)
+(* Le cycle est cree ...                                                  *)
+   
+(* On conserve la fct de cofix pour la conversion                         *)
+   
+type vm_env = {
+    size : int;              (* longueur de la liste [n] *)
+    fv_rev : fv_elem list    (* [fvn; ... ;fv1] *)
+  }    
+   
+let empty_fv = { size= 0;  fv_rev = [] }
+   
+type comp_env = { 
+    nb_stack : int;              (* nbre de variables sur la pile          *)
+    in_stack : int list;         (* position dans la pile                  *)
+    nb_rec : int;                (* nbre de fonctions mutuellement         *)
+                                 (* recursives =  nbr                      *)
+    pos_rec  : instruction list; (* instruction d'acces pour les variables *)
+                                 (*  de point fix ou de cofix              *)
+    offset : int;                 
+    in_env : vm_env ref 
+  } 
 
 let fv r = !(r.in_env)
+   
+let empty_comp_env ()= 
+  { nb_stack = 0; 
+    in_stack = [];
+    nb_rec = 0;
+    pos_rec = [];
+    offset = 0; 
+    in_env = ref empty_fv;
+  } 
+
+(*i Creation functions for comp_env *)
 
-(* [add_param n] rend la liste [sz+1;sz+2;...;sz+n] *)
 let rec add_param n sz l =
   if n = 0 then l else add_param (n - 1) sz (n+sz::l) 
+   
+let comp_env_fun arity = 
+  { nb_stack = arity; 
+    in_stack = add_param arity 0 [];
+    nb_rec = 0;
+    pos_rec = [];
+    offset = 1; 
+    in_env = ref empty_fv 
+  } 
+    
+
+let comp_env_type rfv = 
+  { nb_stack = 0; 
+    in_stack = [];
+    nb_rec = 0;
+    pos_rec = [];
+    offset = 1; 
+    in_env = rfv 
+  }
+   
+let comp_env_fix ndef curr_pos arity rfv =
+   let prec = ref [] in
+   for i = ndef downto 1 do
+     prec := Koffsetclosure (2 * (ndef - curr_pos - i)) :: !prec 
+   done;
+   { nb_stack = arity; 
+     in_stack = add_param arity 0 [];
+     nb_rec = ndef; 
+     pos_rec = !prec;
+     offset = 2 * (ndef - curr_pos - 1)+1;
+     in_env = rfv 
+   } 
+
+let comp_env_cofix ndef arity rfv =
+   let prec = ref [] in
+   for i = 1 to ndef do
+     prec := Kenvacc i :: !prec
+   done;
+   { nb_stack = arity; 
+     in_stack = add_param arity 0 [];
+     nb_rec = ndef; 
+     pos_rec = !prec;
+     offset = ndef+1;
+     in_env = rfv 
+   }
 
 (* [push_param ] ajoute les parametres de fonction dans la pile *)
 let push_param n sz r =
@@ -42,33 +168,16 @@ let push_param n sz r =
     nb_stack = r.nb_stack + n;
     in_stack = add_param n sz r.in_stack }
 
-(* [push_local e sz] ajoute une nouvelle variable dans la pile a la position *)
+(* [push_local e sz] ajoute une nouvelle variable dans la pile a la *)
+(* position [sz]                                                    *)
 let push_local sz r = 
   { r with 
     nb_stack = r.nb_stack + 1;
     in_stack = (sz + 1) :: r.in_stack }
 
-(* Table de relocation initiale *)
-let empty () = 
-  { nb_stack = 0; in_stack = [];
-    nb_rec = 0;pos_rec = 0;
-    offset = 0; in_env = ref empty_fv }
 
-let init_fun arity = 
-  { nb_stack = arity; in_stack = add_param arity 0 [];
-    nb_rec = 0; pos_rec = 0;
-    offset = 1; in_env = ref empty_fv } 
-
-let init_type ndef rfv =
-  { nb_stack = 0; in_stack = [];
-    nb_rec = 0; pos_rec = 0;
-    offset = 2*(ndef-1)+1; in_env = rfv }
-
-let init_fix ndef pos_rec arity rfv =
-  { nb_stack = arity; in_stack = add_param arity 0 [];
-    nb_rec = ndef; pos_rec = pos_rec;
-    offset = 2 * (ndef - pos_rec - 1)+1; in_env = rfv} 
 
+(*i Compilation of variables *)
 let find_at el l = 
   let rec aux n = function
     | [] -> raise Not_found
@@ -87,24 +196,27 @@ let pos_named id r =
 let pos_rel i r sz = 
   if i <= r.nb_stack then
     Kacc(sz - (List.nth r.in_stack (i-1)))
-  else if i <= r.nb_stack + r.nb_rec 
-  then Koffsetclosure (2 * (r.nb_rec + r.nb_stack - r.pos_rec - i))
-  else 
-    let db = FVrel(i - r.nb_stack - r.nb_rec) in
-    let env = !(r.in_env) in
-    try Kenvacc(r.offset + env.size - (find_at db env.fv_rev))
-    with Not_found ->
-      let pos = env.size in
-      r.in_env := { size = pos+1; fv_rev =  db:: env.fv_rev};
-      Kenvacc(r.offset + pos)
-
+  else
+    let i = i - r.nb_stack in
+    if i <= r.nb_rec then 
+      try List.nth r.pos_rec (i-1)
+      with _ -> assert false
+    else
+      let i = i - r.nb_rec in
+      let db = FVrel(i) in
+      let env = !(r.in_env) in
+      try Kenvacc(r.offset + env.size - (find_at db env.fv_rev))
+      with Not_found ->
+	let pos = env.size in
+	r.in_env := { size = pos+1; fv_rev =  db:: env.fv_rev};
+	Kenvacc(r.offset + pos)
 
 (*i  Examination of the continuation *)
 
-(* Discard all instructions up to the next label.
-   This function is to be applied to the continuation before adding a
-   non-terminating instruction (branch, raise, return, appterm)
-   in front of it. *)
+(* Discard all instructions up to the next label.                        *)
+(* This function is to be applied to the continuation before adding a    *)
+(* non-terminating instruction (branch, raise, return, appterm)          *)
+(* in front of it.                                                       *)
 
 let rec discard_dead_code cont = cont
 (*function
@@ -113,9 +225,9 @@ let rec discard_dead_code cont = cont
   | _ :: cont -> discard_dead_code cont
 *)
 
-(* Return a label to the beginning of the given continuation.
-   If the sequence starts with a branch, use the target of that branch
-   as the label, thus avoiding a jump to a jump. *)
+(* Return a label to the beginning of the given continuation.            *)
+(*   If the sequence starts with a branch, use the target of that branch *)
+(*   as the label, thus avoiding a jump to a jump.                       *)
 
 let label_code = function
   | Klabel lbl :: _ as cont -> (lbl, cont)
@@ -138,7 +250,7 @@ let rec is_tailcall = function
   | Klabel _ :: c -> is_tailcall c
   | _ -> None
 
-(* Extention of the continuation ****)
+(* Extention of the continuation *)
 	
 (* Add a Kpop n instruction in front of a continuation *)
 let rec add_pop n = function
@@ -150,15 +262,41 @@ let add_grab arity lbl cont =
   if arity = 1 then Klabel lbl :: cont
   else Krestart :: Klabel lbl :: Kgrab (arity - 1) :: cont
  
-
-(* Environnement global *****)
+let add_grabrec rec_arg arity lbl cont =
+  if arity = 1 then 
+    Klabel lbl :: Kgrabrec 0 :: Krestart :: cont
+  else
+    Krestart :: Klabel lbl :: Kgrabrec rec_arg ::
+    Krestart :: Kgrab (arity - 1) :: cont
+
+(* continuation of a cofix *)
+
+let cont_cofix arity =
+    (* accu = res                                                         *)
+    (* stk  = ai::args::ra::...                                           *)
+    (* ai   = [At|accumulate|[Cfx_t|fcofix]|args]                         *)
+  [ Kpush;
+    Kpush;        (*                 stk = res::res::ai::args::ra::...    *)
+    Kacc 2;
+    Kfield 1;
+    Kfield 0;
+    Kmakeblock(2, cofix_evaluated_tag); 
+    Kpush;        (*  stk = [Cfxe_t|fcofix|res]::res::ai::args::ra::...*)
+    Kacc 2;
+    Ksetfield 1;  (*   ai = [At|accumulate|[Cfxe_t|fcofix|res]|args]      *)
+                  (*  stk = res::ai::args::ra::...                        *)   
+    Kacc 0;       (* accu = res                                           *)
+    Kreturn (arity+2) ]
+
+
+(*i Global environment global *)
 
 let global_env = ref empty_env
 
 let set_global_env env = global_env := env
 
 
-(* Code des fermetures ****)
+(* Code des fermetures *)
 let fun_code = ref []
 
 let init_fun_code () = fun_code := []
@@ -259,6 +397,14 @@ let compile_fv_elem reloc fv sz cont =
   | FVrel i -> pos_rel i reloc sz :: cont
   | FVnamed id -> pos_named id reloc :: cont
 
+let rec compile_fv reloc l sz cont =
+  match l with
+  | [] -> cont
+  | [fvn] -> compile_fv_elem reloc fvn sz cont
+  | fvn :: tl ->
+      compile_fv_elem reloc fvn sz 
+	(Kpush :: compile_fv reloc tl (sz + 1) cont)
+
 (* compilation des constantes *)
 
 let rec get_allias env kn =
@@ -271,8 +417,8 @@ let rec get_allias env kn =
  
 let rec compile_constr reloc c sz cont =
   match kind_of_term c with
-  | Meta _ -> raise (Invalid_argument "Cbytegen.gen_lam : Meta")
-  | Evar _ -> raise (Invalid_argument "Cbytegen.gen_lam : Evar")
+  | Meta _ -> raise (Invalid_argument "Cbytegen.compile_constr : Meta")
+  | Evar _ -> raise (Invalid_argument "Cbytegen.compile_constr : Evar")
  
   | Cast(c,_,_) -> compile_constr reloc c sz cont
 
@@ -294,7 +440,7 @@ let rec compile_constr reloc c sz cont =
   | Lambda _ ->
       let params, body = decompose_lam c in
       let arity = List.length params in
-      let r_fun = init_fun arity in
+      let r_fun = comp_env_fun arity in
       let lbl_fun = Label.create() in
       let cont_fun = 
 	compile_constr r_fun body arity [Kreturn arity] in
@@ -314,11 +460,11 @@ let rec compile_constr reloc c sz cont =
       let lbl_types = Array.create ndef Label.no in
       let lbl_bodies = Array.create ndef Label.no in
       (* Compilation des types *)
-      let rtype = init_type ndef rfv in
+      let env_type = comp_env_type rfv in
       for i = 0 to ndef - 1 do
 	let lbl,fcode = 
 	  label_code 
-	    (compile_constr rtype type_bodies.(i) 0 [Kstop]) in 
+	    (compile_constr env_type type_bodies.(i) 0 [Kstop]) in 
 	lbl_types.(i) <- lbl; 
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
@@ -326,18 +472,12 @@ let rec compile_constr reloc c sz cont =
       for i = 0 to ndef - 1 do
 	let params,body = decompose_lam rec_bodies.(i) in
 	let arity = List.length params in
-	let rbody = init_fix ndef i arity rfv in
+	let env_body = comp_env_fix ndef i arity rfv in
 	let cont1 = 
-	  compile_constr rbody body arity [Kreturn arity] in
+	  compile_constr env_body body arity [Kreturn arity] in
 	let lbl = Label.create () in
 	lbl_bodies.(i) <- lbl;
-	let fcode =  
-	  if arity = 1 then 
-	    Klabel lbl :: Kgrabrec 0 :: Krestart :: cont1
-	  else
-	    Krestart :: Klabel lbl :: Kgrabrec rec_args.(i) ::
-	    Krestart :: Kgrab (arity - 1) :: cont1
-	in
+	let fcode =  add_grabrec rec_args.(i) arity lbl cont1 in
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
       let fv = !rfv in
@@ -346,15 +486,15 @@ let rec compile_constr reloc c sz cont =
   
   | CoFix(init,(_,type_bodies,rec_bodies)) ->
       let ndef = Array.length type_bodies in
-      let rfv = ref empty_fv in
       let lbl_types = Array.create ndef Label.no in
       let lbl_bodies = Array.create ndef Label.no in
       (* Compilation des types *)
-      let rtype = init_type ndef rfv in
+      let rfv = ref empty_fv in
+      let env_type = comp_env_type rfv in
       for i = 0 to ndef - 1 do
 	let lbl,fcode = 
 	  label_code 
-	    (compile_constr rtype type_bodies.(i) 0 [Kstop]) in
+	    (compile_constr env_type type_bodies.(i) 0 [Kstop]) in
 	lbl_types.(i) <- lbl; 
 	fun_code := [Ksequence(fcode,!fun_code)]
       done;
@@ -362,21 +502,18 @@ let rec compile_constr reloc c sz cont =
       for i = 0 to ndef - 1 do
 	let params,body = decompose_lam rec_bodies.(i) in
 	let arity = List.length params in
-	let rbody = init_fix ndef i arity rfv in
+	let env_body = comp_env_cofix ndef arity rfv in
 	let lbl = Label.create () in
-
 	let cont1 = 
-	  compile_constr rbody body arity [Kreturn(arity)] in
+	  compile_constr env_body body (arity+1) (cont_cofix arity) in
 	let cont2 = 
-	  if arity <= 1 then cont1 else Kgrab (arity - 1) :: cont1 in
-	let cont3 = 
-	  Krestart :: Klabel lbl :: Kcograb arity :: Krestart :: cont2 in
-	fun_code := [Ksequence(cont3,!fun_code)];
-	lbl_bodies.(i) <- lbl
+	  add_grab (arity+1) lbl cont1 in
+	lbl_bodies.(i) <- lbl;
+	fun_code := [Ksequence(cont2,!fun_code)];
       done;
       let fv = !rfv in
       compile_fv reloc fv.fv_rev sz 
-	(Kclosurerec(fv.size,init,lbl_types,lbl_bodies) :: cont)
+	(Kclosurecofix(fv.size, init, lbl_types, lbl_bodies) :: cont)
   
   | Case(ci,t,a,branchs) ->
       let ind = ci.ci_ind in
@@ -418,12 +555,12 @@ let rec compile_constr reloc c sz cont =
 	  let lbl_b,code_b = 
 	    label_code(
 	    if nargs = arity then
-	      Kpushfield arity ::
+	      Kpushfields arity ::
 	      compile_constr (push_param arity sz_b reloc)
 		body (sz_b+arity) (add_pop arity (branch :: !c))
 	    else
 	      let sz_appterm = if is_tailcall then sz_b + arity else arity in
-	      Kpushfield arity :: 
+	      Kpushfields arity :: 
 	      compile_constr reloc branchs.(i) (sz_b+arity)
 		(Kappterm(arity,sz_appterm) :: !c))
 	  in
@@ -436,17 +573,8 @@ let rec compile_constr reloc c sz cont =
 	| Klabel lbl -> Kpush_retaddr lbl ::  !c
 	| _ -> !c 
       in
-      let cont_a = if mib.mind_finite then code_sw else Kforce :: code_sw in
-      compile_constr reloc a sz cont_a 
- 
-and compile_fv reloc l sz cont =
-  match l with
-  | [] -> cont
-  | [fvn] -> compile_fv_elem reloc fvn sz cont
-  | fvn :: tl ->
-      compile_fv_elem reloc fvn sz 
-	(Kpush :: compile_fv reloc tl (sz + 1) cont)
-      
+      compile_constr reloc a sz code_sw
+       
 and compile_str_cst reloc sc sz cont =
   match sc with
   | Bconstr c -> compile_constr reloc c sz cont
@@ -465,9 +593,18 @@ let compile env c =
   set_global_env env;
   init_fun_code ();
   Label.reset_label_counter ();
-  let reloc = empty () in
+  let reloc = empty_comp_env () in
   let init_code = compile_constr reloc c 0 [Kstop] in
   let fv = List.rev (!(reloc.in_env).fv_rev) in
+(*  draw_instr init_code;
+  draw_instr !fun_code;
+  Format.print_string "fv = ";
+  List.iter (fun v ->
+    match v with
+    | FVnamed id -> Format.print_string ((string_of_id id)^"; ")
+    | FVrel i -> Format.print_string ((string_of_int i)^"; ")) fv;  Format
+    .print_string "\n";
+  Format.print_flush();  *)
   init_code,!fun_code, Array.of_list fv
 
 let compile_constant_body env body opaque boxed =
diff --git a/kernel/cemitcodes.ml b/kernel/cemitcodes.ml
index cccb1844..71a9aa0e 100644
--- a/kernel/cemitcodes.ml
+++ b/kernel/cemitcodes.ml
@@ -149,8 +149,6 @@ let emit_instr = function
       out opGRAB; out_int n
   | Kgrabrec(rec_arg) -> 
       out opGRABREC; out_int rec_arg
-  | Kcograb n -> 
-      out opCOGRAB; out_int n
   | Kclosure(lbl, n) -> 
       out opCLOSURE; out_int n; out_label lbl
   | Kclosurerec(nfv,init,lbl_types,lbl_bodies) ->
@@ -160,6 +158,13 @@ let emit_instr = function
       Array.iter (out_label_with_orig org) lbl_types;
       let org = !out_position in
       Array.iter (out_label_with_orig org) lbl_bodies
+  | Kclosurecofix(nfv,init,lbl_types,lbl_bodies) ->
+      out opCLOSURECOFIX;out_int (Array.length lbl_bodies);
+      out_int nfv; out_int init;
+      let org = !out_position in
+      Array.iter (out_label_with_orig org) lbl_types;
+      let org = !out_position in
+      Array.iter (out_label_with_orig org) lbl_bodies
   | Kgetglobal q -> 
       out opGETGLOBAL; slot_for_getglobal q
   | Kconst((Const_b0 i)) -> 
@@ -178,16 +183,20 @@ let emit_instr = function
       out opMAKESWITCHBLOCK;
       out_label typlbl; out_label swlbl;
       slot_for_annot annot;out_int sz
-  | Kforce -> 
-      out opFORCE
   | Kswitch (tbl_const, tbl_block) ->
       out opSWITCH;
       out_int (Array.length tbl_const + (Array.length tbl_block lsl 16));
       let org = !out_position in
       Array.iter (out_label_with_orig org) tbl_const;
       Array.iter (out_label_with_orig org) tbl_block
-  | Kpushfield n ->
-      out opPUSHFIELD;out_int n
+  | Kpushfields n ->
+      out opPUSHFIELDS;out_int n
+  | Kfield n ->
+      if n <= 1 then out (opGETFIELD0+n)
+      else (out opGETFIELD;out_int n)
+  | Ksetfield n ->
+      if n <= 1 then out (opSETFIELD0+n) 
+      else (out opSETFIELD;out_int n)
   | Kstop -> 
       out opSTOP
   | Ksequence _ -> raise (Invalid_argument "Cemitcodes.emit_instr")
diff --git a/kernel/closure.ml b/kernel/closure.ml
index 617611bf..41fe8750 100644
--- a/kernel/closure.ml
+++ b/kernel/closure.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: closure.ml 8802 2006-05-10 20:47:28Z barras $ *)
+(* $Id: closure.ml 9215 2006-10-05 15:40:31Z herbelin $ *)
 
 open Util
 open Pp
@@ -375,14 +375,17 @@ let defined_rels flags env =
       (rel_context env) ~init:(0,[])
 (*  else (0,[])*)
 
-
-let rec mind_equiv info kn1 kn2 = 
-  kn1 = kn2 ||
-	match (lookup_mind kn1 info.i_env).mind_equiv with
-	    Some kn1' -> mind_equiv info kn2 kn1'
-	  | None -> match (lookup_mind kn2 info.i_env).mind_equiv with
-		Some kn2' -> mind_equiv info kn2' kn1
-	      | None -> false
+let rec mind_equiv env (kn1,i1) (kn2,i2) =
+  let rec equiv kn1 kn2 =
+    kn1 = kn2 ||
+      match (lookup_mind kn1 env).mind_equiv with
+	  Some kn1' -> equiv kn2 kn1'
+	| None -> match (lookup_mind kn2 env).mind_equiv with
+	      Some kn2' -> equiv kn2' kn1
+	    | None -> false in
+  i1 = i2 && equiv kn1 kn2
+
+let mind_equiv_infos info = mind_equiv info.i_env
 
 let create mk_cl flgs env =
   { i_flags = flgs;
diff --git a/kernel/closure.mli b/kernel/closure.mli
index feec8395..924da0a5 100644
--- a/kernel/closure.mli
+++ b/kernel/closure.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: closure.mli 8793 2006-05-05 17:41:41Z barras $ i*)
+(*i $Id: closure.mli 9215 2006-10-05 15:40:31Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -179,8 +179,9 @@ val whd_stack :
 (* [unfold_reference] unfolds references in a [fconstr] *)
 val unfold_reference : clos_infos -> table_key -> fconstr option
 
-(* [mind_equiv] checks whether two mutual inductives are intentionally equal *)
-val mind_equiv : clos_infos -> mutual_inductive -> mutual_inductive -> bool
+(* [mind_equiv] checks whether two inductive types are intentionally equal *)
+val mind_equiv : env -> inductive -> inductive -> bool
+val mind_equiv_infos : clos_infos -> inductive -> inductive -> bool
 
 (************************************************************************)
 (*i This is for lazy debug *)
diff --git a/kernel/cooking.ml b/kernel/cooking.ml
index 58c21d9f..6b2a6245 100644
--- a/kernel/cooking.ml
+++ b/kernel/cooking.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: cooking.ml 8752 2006-04-27 19:37:33Z herbelin $ i*)
+(*i $Id: cooking.ml 9320 2006-10-30 16:53:43Z barras $ i*)
 
 open Pp
 open Util
@@ -122,7 +122,13 @@ let cook_constant env r =
     on_body (fun c ->
       abstract_constant_body (expmod_constr r.d_modlist c) hyps) 
       cb.const_body in
-  let typ =
-    abstract_constant_type (expmod_constr r.d_modlist cb.const_type) hyps in
+  let typ = match cb.const_type with
+    | NonPolymorphicType t ->
+	let typ = abstract_constant_type (expmod_constr r.d_modlist t) hyps in
+	NonPolymorphicType typ
+    | PolymorphicArity (ctx,s) ->
+	let t = mkArity (ctx,Type s.poly_level) in
+	let typ = abstract_constant_type (expmod_constr r.d_modlist t) hyps in
+	Typeops.make_polymorphic_if_arity env typ in
   let boxed = Cemitcodes.is_boxed cb.const_body_code in
   (body, typ, cb.const_constraints, cb.const_opaque, boxed)
diff --git a/kernel/cooking.mli b/kernel/cooking.mli
index 7b51ac0c..93c2ccc9 100644
--- a/kernel/cooking.mli
+++ b/kernel/cooking.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: cooking.mli 6748 2005-02-18 22:17:50Z herbelin $ i*)
+(*i $Id: cooking.mli 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 open Names
 open Term
@@ -25,7 +25,7 @@ type recipe = {
 
 val cook_constant :
   env -> recipe -> 
-    constr_substituted option * constr * constraints * bool * bool
+    constr_substituted option * constant_type * constraints * bool * bool
 
 (*s Utility functions used in module [Discharge]. *)
 
diff --git a/kernel/declarations.ml b/kernel/declarations.ml
index c52b5c48..e5e05eb3 100644
--- a/kernel/declarations.ml
+++ b/kernel/declarations.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declarations.ml 8845 2006-05-23 07:41:58Z herbelin $ i*)
+(*i $Id: declarations.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -25,6 +25,15 @@ type engagement = ImpredicativeSet
 
 (*s Constants (internal representation) (Definition/Axiom) *)
 
+type polymorphic_arity = {
+  poly_param_levels : universe option list;
+  poly_level : universe;
+}
+
+type constant_type =
+  | NonPolymorphicType of types
+  | PolymorphicArity of rel_context * polymorphic_arity
+
 type constr_substituted = constr substituted
 
 let from_val = from_val
@@ -36,7 +45,7 @@ let subst_constr_subst = subst_substituted
 type constant_body = {
     const_hyps : section_context; (* New: younger hyp at top *)
     const_body : constr_substituted option;
-    const_type : types;  
+    const_type : constant_type;
     const_body_code : Cemitcodes.to_patch_substituted;
    (* const_type_code : Cemitcodes.to_patch; *)
     const_constraints : constraints;
@@ -90,11 +99,6 @@ let subst_wf_paths sub p = Rtree.smartmap (subst_recarg sub) p
    with      In (params) : Un := cn1 : Tn1 | ... | cnpn : Tnpn
 *)
 
-type polymorphic_inductive_arity = {
-  mind_param_levels : universe option list;
-  mind_level : universe;
-}
-
 type monomorphic_inductive_arity = {
   mind_user_arity : constr;
   mind_sort : sorts;
@@ -102,7 +106,7 @@ type monomorphic_inductive_arity = {
 
 type inductive_arity = 
 | Monomorphic of monomorphic_inductive_arity
-| Polymorphic of polymorphic_inductive_arity
+| Polymorphic of polymorphic_arity
 
 type one_inductive_body = {
 
@@ -186,11 +190,15 @@ type mutual_inductive_body = {
     mind_equiv : kernel_name option
   }
 
+let subst_arity sub = function
+| NonPolymorphicType s -> NonPolymorphicType (subst_mps sub s)
+| PolymorphicArity (ctx,s) -> PolymorphicArity (subst_rel_context sub ctx,s)
+
 (* TODO: should be changed to non-coping after Term.subst_mps *)
 let subst_const_body sub cb = {
     const_hyps = (assert (cb.const_hyps=[]); []);
     const_body = option_map (subst_constr_subst sub) cb.const_body;
-    const_type = subst_mps sub cb.const_type;
+    const_type = subst_arity sub cb.const_type;
     const_body_code = Cemitcodes.subst_to_patch_subst sub cb.const_body_code;
     (*const_type_code = Cemitcodes.subst_to_patch sub cb.const_type_code;*)
     const_constraints = cb.const_constraints;
diff --git a/kernel/declarations.mli b/kernel/declarations.mli
index c96d2131..1eaeecb9 100644
--- a/kernel/declarations.mli
+++ b/kernel/declarations.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: declarations.mli 8845 2006-05-23 07:41:58Z herbelin $ i*)
+(*i $Id: declarations.mli 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -26,6 +26,15 @@ type engagement = ImpredicativeSet
 (**********************************************************************)
 (*s Representation of constants (Definition/Axiom)                    *)
 
+type polymorphic_arity = {
+  poly_param_levels : universe option list;
+  poly_level : universe;
+}
+
+type constant_type =
+  | NonPolymorphicType of types
+  | PolymorphicArity of rel_context * polymorphic_arity
+
 type constr_substituted
 
 val from_val : constr -> constr_substituted
@@ -34,7 +43,7 @@ val force : constr_substituted -> constr
 type constant_body = {
     const_hyps : section_context; (* New: younger hyp at top *)
     const_body : constr_substituted option;
-    const_type : types;  
+    const_type : constant_type;
     const_body_code : to_patch_substituted;
    (*i const_type_code : to_patch;i*)
     const_constraints : constraints;
@@ -70,11 +79,6 @@ val subst_wf_paths : substitution -> wf_paths -> wf_paths
 \end{verbatim}
 *)
 
-type polymorphic_inductive_arity = {
-  mind_param_levels : universe option list;
-  mind_level : universe;
-}
-
 type monomorphic_inductive_arity = {
   mind_user_arity : constr;
   mind_sort : sorts;
@@ -82,7 +86,7 @@ type monomorphic_inductive_arity = {
 
 type inductive_arity = 
 | Monomorphic of monomorphic_inductive_arity
-| Polymorphic of polymorphic_inductive_arity
+| Polymorphic of polymorphic_arity
 
 type one_inductive_body = {
 
diff --git a/kernel/environ.ml b/kernel/environ.ml
index a1e19815..e73f5848 100644
--- a/kernel/environ.ml
+++ b/kernel/environ.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: environ.ml 8810 2006-05-12 18:50:21Z barras $ *)
+(* $Id: environ.ml 9201 2006-10-03 16:47:40Z notin $ *)
 
 open Util
 open Names
@@ -245,6 +245,31 @@ let global_vars_set env constr =
   in 
   filtrec Idset.empty constr
 
+(* like [global_vars] but don't get through evars *)
+let global_vars_set_drop_evar env constr = 
+  let fold_constr_drop_evar f acc c = match kind_of_term c with
+    | (Rel _ | Meta _ | Var _   | Sort _ | Const _ | Ind _
+      | Construct _) -> acc
+    | Cast (c,_,t) -> f (f acc c) t
+    | Prod (_,t,c) -> f (f acc t) c
+    | Lambda (_,t,c) -> f (f acc t) c
+    | LetIn (_,b,t,c) -> f (f (f acc b) t) c
+    | App (c,l) -> Array.fold_left f (f acc c) l
+    | Evar (_,l) -> acc
+    | Case (_,p,c,bl) -> Array.fold_left f (f (f acc p) c) bl
+    | Fix (_,(lna,tl,bl)) ->
+	let fd = array_map3 (fun na t b -> (na,t,b)) lna tl bl in
+	  Array.fold_left (fun acc (na,t,b) -> f (f acc t) b) acc fd
+    | CoFix (_,(lna,tl,bl)) ->
+	let fd = array_map3 (fun na t b -> (na,t,b)) lna tl bl in
+	  Array.fold_left (fun acc (na,t,b) -> f (f acc t) b) acc fd in
+  let rec filtrec acc c =
+    let vl = vars_of_global env c in
+    let acc = List.fold_right Idset.add vl acc in
+      fold_constr_drop_evar filtrec acc c
+  in 
+    filtrec Idset.empty constr
+
 (* [keep_hyps env ids] keeps the part of the section context of [env] which 
    contains the variables of the set [ids], and recursively the variables 
    contained in the types of the needed variables. *)
diff --git a/kernel/environ.mli b/kernel/environ.mli
index cfc23651..3728eea3 100644
--- a/kernel/environ.mli
+++ b/kernel/environ.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: environ.mli 8810 2006-05-12 18:50:21Z barras $ i*)
+(*i $Id: environ.mli 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -129,7 +129,7 @@ type const_evaluation_result = NoBody | Opaque
 exception NotEvaluableConst of const_evaluation_result
 
 val constant_value     : env -> constant -> constr
-val constant_type      : env -> constant -> types
+val constant_type      : env -> constant -> constant_type
 val constant_opt_value : env -> constant -> constr option
 
 (************************************************************************)
@@ -165,6 +165,7 @@ val set_engagement : engagement -> env -> env
 (* [global_vars_set env c] returns the list of [id]'s occurring as
    [VAR id] in [c] *)
 val global_vars_set : env -> constr -> Idset.t
+val global_vars_set_drop_evar : env -> constr -> Idset.t
 (* the constr must be an atomic construction *)
 val vars_of_global : env -> constr -> identifier list
 
diff --git a/kernel/indtypes.ml b/kernel/indtypes.ml
index e7dc09ee..1520e009 100644
--- a/kernel/indtypes.ml
+++ b/kernel/indtypes.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: indtypes.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: indtypes.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -163,9 +163,13 @@ let small_unit constrsinfos =
    w1,w2,w3 <= u3
 *)   
 
+let extract_level (_,_,_,lc,lev) =
+  (* Enforce that the level is not in Prop if more than two constructors *)
+  if Array.length lc >= 2 then sup base_univ lev else lev
+
 let inductive_levels arities inds =
   let levels = Array.map pi3 arities in
-  let cstrs_levels = Array.map (fun (_,_,_,_,lev) -> lev) inds in
+  let cstrs_levels = Array.map extract_level inds in
   (* Take the transitive closure of the system of constructors *)
   (* level constraints and remove the recursive dependencies *)
   solve_constraints_system levels cstrs_levels
@@ -388,7 +392,7 @@ let ienv_push_inductive (env, n, ntypes, ra_env) (mi,lpar) =
   let specif = lookup_mind_specif env mi in
   let env' =
     push_rel (Anonymous,None,
-              hnf_prod_applist env (type_of_inductive specif) lpar) env in
+              hnf_prod_applist env (type_of_inductive env specif) lpar) env in
   let ra_env' = 
     (Imbr mi,Rtree.mk_param 0) ::
     List.map (fun (r,t) -> (r,Rtree.lift 1 t)) ra_env in
@@ -597,8 +601,8 @@ let build_inductive env env_ar params isrecord isfinite inds nmr recargs cst =
     let arkind,kelim = match ar_kind with
     | Inr (param_levels,lev) ->
 	Polymorphic {
-	  mind_param_levels = param_levels;
-	  mind_level = lev; 
+	  poly_param_levels = param_levels;
+	  poly_level = lev; 
 	}, all_sorts
     | Inl ((issmall,isunit),ar,s) ->
 	let isunit = isunit && ntypes = 1 && not (is_recursive recargs.(0)) in
diff --git a/kernel/inductive.ml b/kernel/inductive.ml
index 76553237..b7265e8c 100644
--- a/kernel/inductive.ml
+++ b/kernel/inductive.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inductive.ml 8972 2006-06-22 22:17:43Z herbelin $ *)
+(* $Id: inductive.ml 9323 2006-10-30 23:05:29Z herbelin $ *)
 
 open Util
 open Names
@@ -30,8 +30,8 @@ let lookup_mind_specif env (kn,tyi) =
 let find_rectype env c =
   let (t, l) = decompose_app (whd_betadeltaiota env c) in
   match kind_of_term t with
-    | Ind ind -> (ind, l)
-    | _ -> raise Not_found
+  | Ind ind -> (ind, l)
+  | _ -> raise Not_found
 
 let find_inductive env c =
   let (t, l) = decompose_app (whd_betadeltaiota env c) in
@@ -122,14 +122,6 @@ where
 Remark: Set (predicative) is encoded as Type(0)
 *)
 
-let set_inductive_level env s t = 
-  let sign,s' = dest_prod_assum env t in
-  if family_of_sort s <> family_of_sort (destSort s') then
-    (* This induces reductions if user_arity <> nf_arity *)
-    mkArity (sign,s)
-  else
-    t
-
 let sort_as_univ = function
 | Type u -> u
 | Prop Null -> neutral_univ
@@ -139,44 +131,71 @@ let cons_subst u su subst =
   try (u, sup su (List.assoc u subst)) :: List.remove_assoc u subst
   with Not_found -> (u, su) :: subst
 
-let rec make_subst env exp act =
-  match exp, act with
-  (* Bind expected levels of parameters to actual levels *)
-  | None :: exp, _ :: act ->
-      make_subst env exp act
-  | Some u :: exp, t :: act ->
-      let su = sort_as_univ (snd (dest_arity env t)) in
-      cons_subst u su (make_subst env exp act)
-  (* Not enough parameters, create a fresh univ *)
-  | Some u :: exp, [] ->
-      let su = fresh_local_univ () in
-      cons_subst u su (make_subst env exp [])
-  | None :: exp, [] ->
-      make_subst env exp []
-  (* Uniform parameters are exhausted *)
-  | [], _ -> []
-
-let sort_of_instantiated_universe mip subst level =
-  let level = subst_large_constraints subst level in
-  let nci = number_of_constructors mip in
-  if nci = 0 then mk_Prop
-  else
-    if is_empty_univ level then if nci = 1 then mk_Prop else mk_Set 
-    else if is_base_univ level then mk_Set
-    else Type level
-
-let instantiate_inductive_with_param_levels env ar mip paramtyps =
-  let args = Array.to_list paramtyps in
-  let subst = make_subst env ar.mind_param_levels args in
-  sort_of_instantiated_universe mip subst ar.mind_level
+let actualize_decl_level env lev t =
+  let sign,s = dest_arity env t in
+  mkArity (sign,lev)
+
+let polymorphism_on_non_applied_parameters = false
+
+(* Bind expected levels of parameters to actual levels *)
+(* Propagate the new levels in the signature *)
+let rec make_subst env = function
+  | (_,Some _,_ as t)::sign, exp, args ->
+      let ctx,subst = make_subst env (sign, exp, args) in
+      t::ctx, subst
+  | d::sign, None::exp, args ->
+      let args = match args with _::args -> args | [] -> [] in
+      let ctx,subst = make_subst env (sign, exp, args) in
+      d::ctx, subst
+  | d::sign, Some u::exp, a::args ->
+      (* We recover the level of the argument, but we don't change the *)
+      (* level in the corresponding type in the arity; this level in the *)
+      (* arity is a global level which, at typing time, will be enforce *)
+      (* to be greater than the level of the argument; this is probably *)
+      (* a useless extra constraint *)
+      let s = sort_as_univ (snd (dest_arity env a)) in
+      let ctx,subst = make_subst env (sign, exp, args) in
+      d::ctx, cons_subst u s subst
+  | (na,None,t as d)::sign, Some u::exp, [] ->
+      (* No more argument here: we instantiate the type with a fresh level *)
+      (* which is first propagated to the corresponding premise in the arity *)
+      (* (actualize_decl_level), then to the conclusion of the arity (via *)
+      (* the substitution) *)
+      let ctx,subst = make_subst env (sign, exp, []) in
+      if polymorphism_on_non_applied_parameters then
+	let s = fresh_local_univ () in
+	let t = actualize_decl_level env (Type s) t in
+	(na,None,t)::ctx, cons_subst u s subst
+      else
+	d::ctx, subst
+  | sign, [], _ ->
+      (* Uniform parameters are exhausted *)
+      sign,[]
+  | [], _, _ ->
+      assert false
+
+let instantiate_universes env ctx ar argsorts =
+  let args = Array.to_list argsorts in
+  let ctx,subst = make_subst env (ctx,ar.poly_param_levels,args) in
+  let level = subst_large_constraints subst ar.poly_level in
+  ctx,
+  if is_empty_univ level then mk_Prop
+  else if is_base_univ level then mk_Set
+  else Type level
 
 let type_of_inductive_knowing_parameters env mip paramtyps =
   match mip.mind_arity with
   | Monomorphic s ->
       s.mind_user_arity
   | Polymorphic ar ->
-      let s = instantiate_inductive_with_param_levels env ar mip paramtyps in
-      mkArity (mip.mind_arity_ctxt,s)
+      let ctx = List.rev mip.mind_arity_ctxt in
+      let ctx,s = instantiate_universes env ctx ar paramtyps in
+      mkArity (List.rev ctx,s)
+
+(* Type of a (non applied) inductive type *)
+
+let type_of_inductive env (_,mip) =
+  type_of_inductive_knowing_parameters env mip [||]
 
 (* The max of an array of universes *)
 
@@ -188,18 +207,6 @@ let cumulate_constructor_univ u = function
 let max_inductive_sort =
   Array.fold_left cumulate_constructor_univ neutral_univ
 
-(* Type of a (non applied) inductive type *)
-
-let type_of_inductive (_,mip) =
-  match mip.mind_arity with
-  | Monomorphic s -> s.mind_user_arity
-  | Polymorphic s ->
-      let subst = map_succeed (function
-	| Some u -> (u, fresh_local_univ ())
-	| None -> failwith "") s.mind_param_levels in
-      let s = mkSort (sort_of_instantiated_universe mip subst s.mind_level) in
-      it_mkProd_or_LetIn s mip.mind_arity_ctxt
-
 (************************************************************************)
 (* Type of a constructor *)
 
@@ -364,7 +371,7 @@ let inductive_equiv env (kn1,i1) (kn2,i2) =
 let check_case_info env indsp ci =
   let (mib,mip) = lookup_mind_specif env indsp in
   if
-    (indsp <> ci.ci_ind) or
+    not (Closure.mind_equiv env indsp ci.ci_ind) or
     (mib.mind_nparams <> ci.ci_npar) or
     (mip.mind_consnrealdecls <> ci.ci_cstr_nargs)
   then raise (TypeError(env,WrongCaseInfo(indsp,ci)))
diff --git a/kernel/inductive.mli b/kernel/inductive.mli
index d81904cc..b9d0f984 100644
--- a/kernel/inductive.mli
+++ b/kernel/inductive.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: inductive.mli 8871 2006-05-28 16:46:48Z herbelin $ i*)
+(*i $Id: inductive.mli 9314 2006-10-29 20:11:08Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -35,8 +35,9 @@ type mind_specif = mutual_inductive_body * one_inductive_body
 val lookup_mind_specif : env -> inductive -> mind_specif
 
 (*s Functions to build standard types related to inductive *)
+val ind_subst : mutual_inductive -> mutual_inductive_body -> constr list
 
-val type_of_inductive : mind_specif -> types
+val type_of_inductive : env -> mind_specif -> types
 
 val elim_sorts : mind_specif -> sorts_family list
 
@@ -49,6 +50,7 @@ val arities_of_constructors : inductive -> mind_specif -> types array
 (* Transforms inductive specification into types (in nf) *)
 val arities_of_specif : mutual_inductive -> mind_specif -> types array 
 
+
 (* [type_case_branches env (I,args) (p:A) c] computes useful types
    about the following Cases expression:
       <p>Cases (c :: (I args)) of b1..bn end
@@ -78,10 +80,11 @@ val check_cofix : env -> cofixpoint -> unit
 val type_of_inductive_knowing_parameters :
   env -> one_inductive_body -> types array -> types
 
-val set_inductive_level : env -> sorts -> types -> types
-
 val max_inductive_sort : sorts array -> universe
 
+val instantiate_universes : env -> Sign.rel_context ->
+    polymorphic_arity -> types array -> Sign.rel_context * sorts
+
 (***************************************************************)
 (* Debug *)
 
diff --git a/kernel/mod_typing.ml b/kernel/mod_typing.ml
index a8aff184..663434ec 100644
--- a/kernel/mod_typing.ml
+++ b/kernel/mod_typing.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: mod_typing.ml 7639 2005-12-02 10:01:15Z gregoire $ i*)
+(*i $Id: mod_typing.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 open Util
 open Names
@@ -87,8 +87,8 @@ and merge_with env mtb with_decl =
 		match cb.const_body with
 		  | None -> 
 		      let (j,cst1) = Typeops.infer env' c in
-		      let cst2 = 
-			Reduction.conv_leq env' j.uj_type cb.const_type in
+		      let typ = Typeops.type_of_constant_type env' cb.const_type in
+		      let cst2 = Reduction.conv_leq env' j.uj_type typ in
 		      let cst = 
 			Constraint.union 
 			  (Constraint.union cb.const_constraints cst1)
diff --git a/kernel/modops.ml b/kernel/modops.ml
index b2f02a5f..5cc2a84d 100644
--- a/kernel/modops.ml
+++ b/kernel/modops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: modops.ml 8879 2006-05-30 21:32:10Z letouzey $ i*)
+(*i $Id: modops.ml 9138 2006-09-14 15:20:45Z jforest $ i*)
 
 (*i*)
 open Util
@@ -170,34 +170,6 @@ and subst_module sub mb =
 let subst_signature_msid msid mp = 
   subst_signature (map_msid msid mp)
 
-let rec constants_of_specification env mp sign =
- let aux res (l,elem) =
-  match elem with
-   | SPBconst cb -> ((make_con mp empty_dirpath l),cb)::res
-   | SPBmind _ -> res
-   | SPBmodule mb ->
-      (constants_of_modtype env (MPdot (mp,l))
-        (module_body_of_spec mb).mod_type) @ res
-   | SPBmodtype mtb -> res (* ???? *)
- in
-  List.fold_left aux [] sign
-
-and constants_of_modtype env mp modtype =
- match scrape_modtype env modtype with
-    MTBident _ -> anomaly "scrape_modtype does not work!"
-  | MTBsig (msid,sign) ->
-     constants_of_specification env mp
-      (subst_signature_msid msid mp sign)
-  | MTBfunsig _ -> []
-
-(* returns a resolver for kn that maps mbid to mp *)
-(* Nota: Some delta-expansions used to happen here. 
-    Browse SVN if you want to know more. *)
-let resolver_of_environment mbid modtype mp env =
- let constants = constants_of_modtype env (MPbound mbid) modtype in
- let resolve = List.map (fun (con,_) -> con,None) constants in 
- Mod_subst.make_resolver resolve
-
 (* we assume that the substitution of "mp" into "msid" is already done
 (or unnecessary) *)
 let rec add_signature mp sign env = 
@@ -224,6 +196,53 @@ and add_module mp mb env =
       | MTBfunsig _ -> env
 
 
+let rec constants_of_specification env mp sign =
+ let aux (env,res) (l,elem) =
+  match elem with
+   | SPBconst cb -> env,((make_con mp empty_dirpath l),cb)::res
+   | SPBmind _ -> env,res
+   | SPBmodule mb ->
+       let new_env =  add_module (MPdot (mp,l)) (module_body_of_spec mb) env in 
+       new_env,(constants_of_modtype env (MPdot (mp,l))
+		  (module_body_of_spec mb).mod_type) @ res
+   | SPBmodtype mtb -> 
+       (* module type dans un module type. 
+	  Il faut au moins mettre mtb dans l'environnement (avec le bon 
+	  kn pour pouvoir continuer aller deplier les modules utilisant ce 
+	  mtb
+	  ex: 
+	  Module Type T1. 
+	  Module Type T2.
+	     ....
+    	    End T2.
+	  .....
+            Declare Module M : T2.
+         End T2 
+	  si on ne rajoute pas T2 dans l'environement de typage 
+	  on va exploser au moment du Declare Module
+       *)
+       let new_env = Environ.add_modtype (make_kn mp empty_dirpath l) mtb env in 
+       new_env, constants_of_modtype env (MPdot(mp,l)) mtb @ res
+ in
+ snd (List.fold_left aux (env,[]) sign)
+
+and constants_of_modtype env mp modtype =
+ match scrape_modtype env modtype with
+    MTBident _ -> anomaly "scrape_modtype does not work!"
+  | MTBsig (msid,sign) ->
+     constants_of_specification env mp
+      (subst_signature_msid msid mp sign)
+  | MTBfunsig _ -> []
+
+(* returns a resolver for kn that maps mbid to mp *)
+(* Nota: Some delta-expansions used to happen here. 
+    Browse SVN if you want to know more. *)
+let resolver_of_environment mbid modtype mp env =
+ let constants = constants_of_modtype env (MPbound mbid) modtype in
+ let resolve = List.map (fun (con,_) -> con,None) constants in 
+ Mod_subst.make_resolver resolve
+
+
 let strengthen_const env mp l cb = 
   match cb.const_opaque, cb.const_body with
   | false, Some _ -> cb
diff --git a/kernel/reduction.ml b/kernel/reduction.ml
index bd849dad..701020d0 100644
--- a/kernel/reduction.ml
+++ b/kernel/reduction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: reduction.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: reduction.ml 9215 2006-10-05 15:40:31Z herbelin $ *)
 
 open Util
 open Names
@@ -257,14 +257,14 @@ and eqappr cv_pb infos appr1 appr2 cuniv =
 
     (* Inductive types:  MutInd MutConstruct Fix Cofix *)
 
-     | (FInd (kn1,i1), FInd (kn2,i2)) ->
-         if i1 = i2 && mind_equiv infos kn1 kn2
+     | (FInd ind1, FInd ind2) ->
+         if mind_equiv_infos infos ind1 ind2
 	 then
            convert_stacks infos lft1 lft2 v1 v2 cuniv
          else raise NotConvertible
 
-     | (FConstruct ((kn1,i1),j1), FConstruct ((kn2,i2),j2)) ->
-	 if i1 = i2 && j1 = j2 && mind_equiv infos kn1 kn2
+     | (FConstruct (ind1,j1), FConstruct (ind2,j2)) ->
+	 if j1 = j2 && mind_equiv_infos infos ind1 ind2
 	 then
            convert_stacks infos lft1 lft2 v1 v2 cuniv
          else raise NotConvertible
@@ -317,7 +317,7 @@ and eqappr cv_pb infos appr1 appr2 cuniv =
 and convert_stacks infos lft1 lft2 stk1 stk2 cuniv =
   compare_stacks
     (fun (l1,t1) (l2,t2) c -> ccnv CONV infos l1 l2 t1 t2 c)
-    (fun (mind1,i1) (mind2,i2) -> i1=i2 && mind_equiv infos mind1 mind2)
+    (mind_equiv_infos infos)
     lft1 stk1 lft2 stk2 cuniv
 
 and convert_vect infos lft1 lft2 v1 v2 cuniv =
diff --git a/kernel/safe_typing.ml b/kernel/safe_typing.ml
index 95092814..c4d9c991 100644
--- a/kernel/safe_typing.ml
+++ b/kernel/safe_typing.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: safe_typing.ml 8898 2006-06-05 23:15:51Z letouzey $ *)
+(* $Id: safe_typing.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -119,6 +119,12 @@ type global_declaration =
   | ConstantEntry of constant_entry
   | GlobalRecipe of Cooking.recipe
 
+let hcons_constant_type = function
+  | NonPolymorphicType t ->
+      NonPolymorphicType (hcons1_constr t)
+  | PolymorphicArity (ctx,s) ->
+      PolymorphicArity (map_rel_context hcons1_constr ctx,s)
+
 let hcons_constant_body cb =
   let body = match cb.const_body with
       None -> None
@@ -127,28 +133,28 @@ let hcons_constant_body cb =
   in
     { cb with
 	const_body = body;
-	const_type = hcons1_constr cb.const_type }
+	const_type = hcons_constant_type cb.const_type }
 
 let add_constant dir l decl senv =
   check_label l senv.labset;
-  let kn = make_con senv.modinfo.modpath dir l in 
+  let kn = make_con senv.modinfo.modpath dir l in
   let cb = 
     match decl with 
-    | ConstantEntry ce -> translate_constant senv.env kn ce
-    | GlobalRecipe r ->
-	let cb = translate_recipe senv.env kn r in
-	if dir = empty_dirpath then hcons_constant_body cb else cb
+      | ConstantEntry ce -> translate_constant senv.env kn ce
+      | GlobalRecipe r ->
+	  let cb = translate_recipe senv.env kn r in
+	    if dir = empty_dirpath then hcons_constant_body cb else cb
   in
   let env' = Environ.add_constraints cb.const_constraints senv.env in
   let env'' = Environ.add_constant kn cb env' in
-  kn, { old = senv.old;
-	env = env'';
-	modinfo = senv.modinfo;
-	labset = Labset.add l senv.labset;
-	revsign = (l,SPBconst cb)::senv.revsign;
-	revstruct = (l,SEBconst cb)::senv.revstruct;
-	imports = senv.imports;
-	loads = senv.loads }
+    kn, { old = senv.old;
+	  env = env'';
+	  modinfo = senv.modinfo;
+	  labset = Labset.add l senv.labset;
+	  revsign = (l,SPBconst cb)::senv.revsign;
+	  revstruct = (l,SEBconst cb)::senv.revstruct;
+	  imports = senv.imports;
+	  loads = senv.loads }
     
 
 (* Insertion of inductive types. *)
diff --git a/kernel/sign.ml b/kernel/sign.ml
index 75342f2c..b42ca581 100644
--- a/kernel/sign.ml
+++ b/kernel/sign.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: sign.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: sign.ml 9103 2006-09-01 11:02:52Z herbelin $ *)
 
 open Names
 open Util
@@ -83,6 +83,9 @@ let map_context f l =
 let map_rel_context = map_context
 let map_named_context = map_context
 
+let iter_rel_context f = List.iter (fun (_,b,t) -> f t; option_iter f b)
+let iter_named_context f = List.iter (fun (_,b,t) -> f t; option_iter f b)
+
 (* Push named declarations on top of a rel context *)
 (* Bizarre. Should be avoided. *)
 let push_named_to_rel_context hyps ctxt =
diff --git a/kernel/sign.mli b/kernel/sign.mli
index 4a90302b..88e9dbf0 100644
--- a/kernel/sign.mli
+++ b/kernel/sign.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: sign.mli 6737 2005-02-18 20:49:43Z herbelin $ i*)
+(*i $Id: sign.mli 9103 2006-09-01 11:02:52Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -65,6 +65,12 @@ val map_rel_context : (constr -> constr) -> rel_context -> rel_context
 (*s Map function of [named_context] *)
 val map_named_context : (constr -> constr) -> named_context -> named_context
 
+(*s Map function of [rel_context] *)
+val iter_rel_context : (constr -> unit) -> rel_context -> unit
+
+(*s Map function of [named_context] *)
+val iter_named_context : (constr -> unit) -> named_context -> unit
+
 (*s Term constructors *)
 
 val it_mkLambda_or_LetIn : constr -> rel_context -> constr
diff --git a/kernel/subtyping.ml b/kernel/subtyping.ml
index bbc89e39..9a8de5a9 100644
--- a/kernel/subtyping.ml
+++ b/kernel/subtyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: subtyping.ml 8845 2006-05-23 07:41:58Z herbelin $ i*)
+(*i $Id: subtyping.ml 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -94,9 +94,9 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
       (* listrec ignored *)
       (* finite done *)
       (* nparams done *)
-      (* params_ctxt done *)
+      (* params_ctxt done because part of the inductive types *)
       (* Don't check the sort of the type if polymorphic *)
-      let cst = check_conv cst conv env (type_of_inductive (mib1,p1)) (type_of_inductive (mib2,p2))
+      let cst = check_conv cst conv env (type_of_inductive env (mib1,p1)) (type_of_inductive env (mib2,p2))
       in
 	cst
   in
@@ -114,9 +114,12 @@ let check_inductive cst env msid1 l info1 mib2 spec2 =
   assert (Array.length mib1.mind_packets >= 1 
 	    && Array.length mib2.mind_packets >= 1);
 
-       (* TODO: we should allow renaming of parameters at least ! *)
+  (* Check that the expected numbers of uniform parameters are the same *)
+  (* No need to check the contexts of parameters: it is checked *)
+  (* at the time of checking the inductive arities in check_packet. *)
+  (* Notice that we don't expect the local definitions to match: only *)
+  (* the inductive types and constructors types have to be convertible *)
   check (fun mib -> mib.mind_nparams);
-  check (fun mib -> mib.mind_params_ctxt); 
 
   begin 
     match mib2.mind_equiv with
@@ -161,7 +164,9 @@ let check_constant cst env msid1 l info1 cb2 spec2 =
    | Constant cb1 ->
       assert (cb1.const_hyps=[] && cb2.const_hyps=[]) ;
       (*Start by checking types*)
-      let cst = check_conv cst conv_leq env cb1.const_type cb2.const_type in
+      let typ1 = Typeops.type_of_constant_type env cb1.const_type in
+      let typ2 = Typeops.type_of_constant_type env cb2.const_type in
+      let cst = check_conv cst conv_leq env typ1 typ2 in
       let con = make_con (MPself msid1) empty_dirpath l in
       let cst =
        match cb2.const_body with
@@ -176,23 +181,27 @@ let check_constant cst env msid1 l info1 cb2 spec2 =
       in
        cst
    | IndType ((kn,i),mind1) ->
-      Util.error ("The kernel does not recognize yet that a parameter can be " ^
+      ignore (Util.error (
+       "The kernel does not recognize yet that a parameter can be " ^
        "instantiated by an inductive type. Hint: you can rename the " ^
        "inductive type and give a definition to map the old name to the new " ^
-       "name.") ;
+       "name."));
       assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ;
       if cb2.const_body <> None then error () ;
-      let arity1 = type_of_inductive (mind1,mind1.mind_packets.(i)) in
-       check_conv cst conv_leq env arity1 cb2.const_type
+      let arity1 = type_of_inductive env (mind1,mind1.mind_packets.(i)) in
+      let typ2 = Typeops.type_of_constant_type env cb2.const_type in
+       check_conv cst conv_leq env arity1 typ2
    | IndConstr (((kn,i),j) as cstr,mind1) ->
-      Util.error ("The kernel does not recognize yet that a parameter can be " ^
+      ignore (Util.error (
+       "The kernel does not recognize yet that a parameter can be " ^
        "instantiated by a constructor. Hint: you can rename the " ^
        "constructor and give a definition to map the old name to the new " ^
-       "name.") ;
+       "name."));
       assert (mind1.mind_hyps=[] && cb2.const_hyps=[]) ;
       if cb2.const_body <> None then error () ;
       let ty1 = type_of_constructor cstr (mind1,mind1.mind_packets.(i)) in
-       check_conv cst conv env ty1 cb2.const_type
+      let ty2 = Typeops.type_of_constant_type env cb2.const_type in
+       check_conv cst conv env ty1 ty2
    | _ -> error ()
 	      
 let rec check_modules cst env msid1 l msb1 msb2 =
diff --git a/kernel/term.ml b/kernel/term.ml
index 228ae48a..456a29e4 100644
--- a/kernel/term.ml
+++ b/kernel/term.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: term.ml 8850 2006-05-23 16:11:31Z herbelin $ *)
+(* $Id: term.ml 9303 2006-10-27 21:50:17Z herbelin $ *)
 
 (* This module instantiates the structure of generic deBruijn terms to Coq *)
 
@@ -646,6 +646,9 @@ type rel_declaration = name * constr option * types
 let map_named_declaration f (id, v, ty) = (id, option_map f v, f ty)
 let map_rel_declaration = map_named_declaration
 
+let fold_named_declaration f (_, v, ty) a = f ty (option_fold_right f v a)
+let fold_rel_declaration = fold_named_declaration
+
 (****************************************************************************)
 (*              Functions for dealing with constr terms                     *)
 (****************************************************************************)
@@ -659,17 +662,16 @@ exception LocalOccur
 (* (closedn n M) raises FreeVar if a variable of height greater than n
    occurs in M, returns () otherwise *)
 
-let closedn = 
+let closedn n c = 
   let rec closed_rec n c = match kind_of_term c with
     | Rel m -> if m>n then raise LocalOccur
     | _ -> iter_constr_with_binders succ closed_rec n c
   in 
-  closed_rec
+  try closed_rec n c; true with LocalOccur -> false
 
 (* [closed0 M] is true iff [M] is a (deBruijn) closed term *)
 
-let closed0 term =
-  try closedn 0 term; true with LocalOccur -> false
+let closed0 = closedn 0
 
 (* (noccurn n M) returns true iff (Rel n) does NOT occur in term M  *)
 
diff --git a/kernel/term.mli b/kernel/term.mli
index 8d72e0d8..d6244f5b 100644
--- a/kernel/term.mli
+++ b/kernel/term.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: term.mli 8850 2006-05-23 16:11:31Z herbelin $ i*)
+(*i $Id: term.mli 9303 2006-10-27 21:50:17Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -327,6 +327,11 @@ val map_named_declaration :
 val map_rel_declaration :
   (constr -> constr) -> rel_declaration -> rel_declaration
 
+val fold_named_declaration :
+  (constr -> 'a -> 'a) -> named_declaration -> 'a -> 'a
+val fold_rel_declaration :
+  (constr -> 'a -> 'a) -> rel_declaration -> 'a -> 'a
+
 (* Constructs either [(x:t)c] or [[x=b:t]c] *)
 val mkProd_or_LetIn : rel_declaration -> types -> types
 val mkNamedProd_or_LetIn : named_declaration -> types -> types
@@ -426,6 +431,9 @@ val under_outer_cast : (constr -> constr) -> constr -> constr
 
 (*s Occur checks *)
 
+(* [closedn n M] is true iff [M] is a (deBruijn) closed term under n binders *)
+val closedn : int -> constr -> bool
+
 (* [closed0 M] is true iff [M] is a (deBruijn) closed term *)
 val closed0 : constr -> bool
 
diff --git a/kernel/term_typing.ml b/kernel/term_typing.ml
index fde5fa25..575330a4 100644
--- a/kernel/term_typing.ml
+++ b/kernel/term_typing.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: term_typing.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+(* $Id: term_typing.ml 9323 2006-10-30 23:05:29Z herbelin $ *)
 
 open Util
 open Names
@@ -23,7 +23,20 @@ open Indtypes
 open Typeops
 
 let constrain_type env j cst1 = function
-  | None -> j.uj_type, cst1
+  | None ->
+(* To have definitions in Type polymorphic
+      make_polymorphic_if_arity env j.uj_type, cst1
+*) 
+      NonPolymorphicType j.uj_type, cst1
+  | Some t -> 
+      let (tj,cst2) = infer_type env t in
+      let (_,cst3) = judge_of_cast env j DEFAULTcast tj in
+      assert (t = tj.utj_val);
+      NonPolymorphicType t, Constraint.union (Constraint.union cst1 cst2) cst3
+
+let local_constrain_type env j cst1 = function
+  | None ->
+      j.uj_type, cst1
   | Some t -> 
       let (tj,cst2) = infer_type env t in
       let (_,cst3) = judge_of_cast env j DEFAULTcast tj in
@@ -32,7 +45,7 @@ let constrain_type env j cst1 = function
 
 let translate_local_def env (b,topt) =
   let (j,cst) = infer env b in
-  let (typ,cst) = constrain_type env j cst topt in
+  let (typ,cst) = local_constrain_type env j cst topt in
     (j.uj_val,typ,cst)
 
 let translate_local_assum env t =
@@ -83,16 +96,25 @@ let infer_declaration env dcl =
         c.const_entry_opaque, c.const_entry_boxed
   | ParameterEntry t ->
       let (j,cst) = infer env t in
-      None, Typeops.assumption_of_judgment env j, cst, false, false
+      None, NonPolymorphicType (Typeops.assumption_of_judgment env j), cst,
+        false, false
+
+let global_vars_set_constant_type env = function
+  | NonPolymorphicType t -> global_vars_set env t
+  | PolymorphicArity (ctx,_) ->
+      Sign.fold_rel_context 
+        (fold_rel_declaration
+	  (fun t c -> Idset.union (global_vars_set env t) c))
+      ctx ~init:Idset.empty
 
 let build_constant_declaration env kn (body,typ,cst,op,boxed) =
   let ids =
     match body with 
-    | None -> global_vars_set env typ
+    | None -> global_vars_set_constant_type env typ
     | Some b ->
         Idset.union 
 	  (global_vars_set env (Declarations.force b)) 
-	  (global_vars_set env typ)
+	  (global_vars_set_constant_type env typ)
   in
   let tps = Cemitcodes.from_val (compile_constant_body env body op boxed) in
   let hyps = keep_hyps env ids in
diff --git a/kernel/term_typing.mli b/kernel/term_typing.mli
index cf111b6b..c102d01b 100644
--- a/kernel/term_typing.mli
+++ b/kernel/term_typing.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: term_typing.mli 6245 2004-10-20 13:50:08Z barras $ i*)
+(*i $Id: term_typing.mli 9310 2006-10-28 19:35:09Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -24,7 +24,14 @@ val translate_local_def : env -> constr * types option ->
 
 val translate_local_assum : env -> types ->
   types * Univ.constraints
- 
+
+val infer_declaration : env -> constant_entry -> 
+   constr_substituted option * constant_type * constraints * bool * bool
+
+val build_constant_declaration : env -> 'a ->
+    constr_substituted option * constant_type * constraints * bool * bool ->
+      constant_body
+
 val translate_constant : env -> constant -> constant_entry -> constant_body
 
 val translate_mind : 
diff --git a/kernel/typeops.ml b/kernel/typeops.ml
index 8299a3c9..2a0dd526 100644
--- a/kernel/typeops.ml
+++ b/kernel/typeops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: typeops.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: typeops.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
 
 open Util
 open Names
@@ -49,8 +49,6 @@ let assumption_of_judgment env j =
 
 let sort_judgment env j = (type_judgment env j).utj_type
 
-let on_judgment_type f j = { j with uj_type = f j.uj_type }
-
 (************************************************)
 (* Incremental typing rules: builds a typing judgement given the *)
 (* judgements for the subterms. *)
@@ -127,13 +125,52 @@ let check_hyps id env hyps =
 *)
 (* Instantiation of terms on real arguments. *)
 
+(* Make a type polymorphic if an arity *)
+
+let extract_level env p =
+  let _,c = dest_prod_assum env p in
+  match kind_of_term c with Sort (Type u) -> Some u | _ -> None
+
+let extract_context_levels env =
+  List.fold_left
+    (fun l (_,b,p) -> if b=None then extract_level env p::l else l) []
+
+let make_polymorphic_if_arity env t =
+  let params, ccl = dest_prod_assum env t in
+  match kind_of_term ccl with
+  | Sort (Type u) -> 
+      let param_ccls = extract_context_levels env params in
+      let s = { poly_param_levels = param_ccls; poly_level = u} in
+      PolymorphicArity (params,s)
+  | _ ->
+      NonPolymorphicType t
+
 (* Type of constants *)
+
+let type_of_constant_knowing_parameters env t paramtyps =
+  match t with
+  | NonPolymorphicType t -> t
+  | PolymorphicArity (sign,ar) ->
+      let ctx = List.rev sign in
+      let ctx,s = instantiate_universes env ctx ar paramtyps in
+      mkArity (List.rev ctx,s)
+
+let type_of_constant_type env t =
+  type_of_constant_knowing_parameters env t [||]
+
+let type_of_constant env cst =
+  type_of_constant_type env (constant_type env cst)
+
+let judge_of_constant_knowing_parameters env cst jl =
+  let c = mkConst cst in
+  let cb = lookup_constant cst env in
+  let _ = check_args env c cb.const_hyps in 
+  let paramstyp = Array.map (fun j -> j.uj_type) jl in
+  let t = type_of_constant_knowing_parameters env cb.const_type paramstyp in
+  make_judge c t
+
 let judge_of_constant env cst =
-  let constr = mkConst cst in
-  let _ =
-    let ce = lookup_constant cst env in
-    check_args env constr ce.const_hyps in 
-  make_judge constr (constant_type env cst)
+  judge_of_constant_knowing_parameters env cst [||]
 
 (* Type of a lambda-abstraction. *)
 
@@ -350,11 +387,16 @@ let rec execute env cstr cu =
     | App (f,args) ->
         let (jl,cu1) = execute_array env args cu in
 	let (j,cu2) =
-	  if isInd f then
-	    (* Sort-polymorphism of inductive types *)
-	    judge_of_inductive_knowing_parameters env (destInd f) jl, cu1
-	  else
-	    execute env f cu1
+	  match kind_of_term f with
+	    | Ind ind ->
+		(* Sort-polymorphism of inductive types *)
+		judge_of_inductive_knowing_parameters env ind jl, cu1
+	    | Const cst -> 
+		(* Sort-polymorphism of constant *)
+		judge_of_constant_knowing_parameters env cst jl, cu1
+	    | _ -> 
+		(* No sort-polymorphism *)
+		execute env f cu1
 	in
 	univ_combinator cu2 (judge_of_apply env j jl)
 	    
diff --git a/kernel/typeops.mli b/kernel/typeops.mli
index 86a795b5..64a2f650 100644
--- a/kernel/typeops.mli
+++ b/kernel/typeops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: typeops.mli 8871 2006-05-28 16:46:48Z herbelin $ i*)
+(*i $Id: typeops.mli 9314 2006-10-29 20:11:08Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -14,6 +14,7 @@ open Univ
 open Term
 open Environ
 open Entries
+open Declarations
 (*i*)
 
 (*s Typing functions (not yet tagged as safe) *)
@@ -33,8 +34,6 @@ val infer_local_decls :
 
 val assumption_of_judgment :  env -> unsafe_judgment -> types
 val type_judgment          :  env -> unsafe_judgment -> unsafe_type_judgment
-val on_judgment_type       :  
-  (types -> types) -> unsafe_judgment -> unsafe_judgment
 
 (*s Type of sorts. *)
 val judge_of_prop_contents : contents -> unsafe_judgment
@@ -49,6 +48,9 @@ val judge_of_variable : env -> variable -> unsafe_judgment
 (*s type of a constant *)
 val judge_of_constant : env -> constant -> unsafe_judgment
 
+val judge_of_constant_knowing_parameters :
+  env -> constant -> unsafe_judgment array -> unsafe_judgment
+
 (*s Type of application. *)
 val judge_of_apply : 
   env -> unsafe_judgment -> unsafe_judgment array
@@ -95,3 +97,12 @@ val type_fixpoint : env -> name array -> types array
 (* Kernel safe typing but applicable to partial proofs *)
 val typing : env -> constr -> unsafe_judgment
 
+val type_of_constant : env -> constant -> types
+
+val type_of_constant_type : env -> constant_type -> types
+
+val type_of_constant_knowing_parameters : 
+  env -> constant_type -> constr array -> types
+
+(* Make a type polymorphic if an arity *)
+val make_polymorphic_if_arity : env -> types -> constant_type
diff --git a/kernel/univ.ml b/kernel/univ.ml
index e76b7b02..775e505f 100644
--- a/kernel/univ.ml
+++ b/kernel/univ.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: univ.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: univ.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
 
 (* Initial Caml version originates from CoC 4.8 [Dec 1988] *)
 (* Extension with algebraic universes by HH [Sep 2001] *)
@@ -63,8 +63,8 @@ let pr_uni_level u = str (string_of_univ_level u)
 let pr_uni = function
   | Atom u -> 
       pr_uni_level u
-  | Max ([],[Base]) ->
-      int 1
+  | Max ([],[u]) ->
+      str "(" ++ pr_uni_level u ++ str ")+1"
   | Max (gel,gtl) ->
       str "max(" ++ hov 0
        (prlist_with_sep pr_coma pr_uni_level gel ++
diff --git a/kernel/vconv.ml b/kernel/vconv.ml
index 653f8978..7c515735 100644
--- a/kernel/vconv.ml
+++ b/kernel/vconv.ml
@@ -17,7 +17,7 @@ let val_of_constr env c =
 let compare_zipper z1 z2 =
   match z1, z2 with
   | Zapp args1, Zapp args2 -> nargs args1 = nargs args2
-  | Zfix _, Zfix _ -> true 
+  | Zfix(f1,args1), Zfix(f2,args2) ->  nargs args1 = nargs args2
   | Zswitch _, Zswitch _ -> true
   | _ , _ -> false
 
@@ -42,8 +42,9 @@ let conv_vect fconv vect1 vect2 cu =
 
 let infos = ref (create_clos_infos betaiotazeta Environ.empty_env)
 
-let rec conv_val pb k v1 v2 cu =
-  if v1 == v2 then cu else conv_whd pb k (whd_val v1) (whd_val v2) cu 
+let rec conv_val pb k v1 v2 cu = 
+  if v1 == v2 then cu 
+  else conv_whd pb k (whd_val v1) (whd_val v2) cu
     
 and conv_whd pb k whd1 whd2 cu =  
   match whd1, whd2 with
@@ -52,21 +53,14 @@ and conv_whd pb k whd1 whd2 cu =
       let cu = conv_val CONV k (dom p1) (dom p2) cu in
       conv_fun pb k (codom p1) (codom p2) cu
   | Vfun f1, Vfun f2 -> conv_fun CONV k f1 f2 cu
-  | Vfix f1, Vfix f2 -> conv_fix k f1 f2 cu
-  | Vfix_app fa1, Vfix_app fa2 ->
-      let f1 = fix fa1 in
-      let args1 = args_of_fix fa1 in
-      let f2 = fix fa2 in
-      let args2 = args_of_fix fa2 in
-      conv_arguments k args1 args2 (conv_fix k f1 f2 cu)
-  | Vcofix cf1, Vcofix cf2 -> 
-      conv_cofix k cf1 cf2 cu
-  | Vcofix_app cfa1, Vcofix_app cfa2 ->	
-      let cf1 = cofix cfa1 in
-      let args1 = args_of_cofix cfa1 in
-      let cf2 = cofix cfa2 in
-      let args2 = args_of_cofix cfa2 in
-      conv_arguments k args1 args2 (conv_cofix k cf1 cf2 cu)
+  | Vfix (f1,None), Vfix (f2,None) -> conv_fix k f1 f2 cu
+  | Vfix (f1,Some args1), Vfix(f2,Some args2) ->
+      if nargs args1 <> nargs args2 then raise NotConvertible
+      else conv_arguments k args1 args2 (conv_fix k f1 f2 cu)
+  | Vcofix (cf1,_,None), Vcofix (cf2,_,None) -> conv_cofix k cf1 cf2 cu
+  | Vcofix (cf1,_,Some args1), Vcofix (cf2,_,Some args2) ->	
+      if nargs args1 <> nargs args2 then raise NotConvertible
+      else conv_arguments k args1 args2 (conv_cofix k cf1 cf2 cu)
   | Vconstr_const i1, Vconstr_const i2 -> 
       if i1 = i2 then cu else raise NotConvertible 
   | Vconstr_block b1, Vconstr_block b2 ->
@@ -89,7 +83,8 @@ and conv_whd pb k whd1 whd2 cu =
 and conv_atom pb k a1 stk1 a2 stk2 cu =
   match a1, a2 with
   | Aind (kn1,i1), Aind(kn2,i2) ->
-      if i1 = i2 && mind_equiv !infos kn1 kn2 && compare_stack stk1 stk2 then
+      if mind_equiv_infos !infos (kn1,i1) (kn2,i2) && compare_stack stk1 stk2
+      then
 	conv_stack k stk1 stk2 cu
       else raise NotConvertible
   | Aid ik1, Aid ik2 -> 
@@ -111,8 +106,6 @@ and conv_atom pb k a1 stk1 a2 stk2 cu =
       conv_whd pb k (force_whd v1 stk1) (Vatom_stk(a2,stk2)) cu
   | _, Aiddef(ik2,v2) ->
       conv_whd pb k (Vatom_stk(a1,stk1)) (force_whd v2 stk2) cu
-  | Afix_app _, _ | _, Afix_app _ | Aswitch _, _ | _, Aswitch _ -> 
-      Util.anomaly "Vconv.conv_atom : Vm.whd_val doesn't work"
   | _, _ -> raise NotConvertible 
 	
 and conv_stack k stk1 stk2 cu =
@@ -120,22 +113,17 @@ and conv_stack k stk1 stk2 cu =
   | [], [] -> cu
   | Zapp args1 :: stk1, Zapp args2 :: stk2 ->
       conv_stack k stk1 stk2 (conv_arguments k args1 args2 cu) 
-  | Zfix fa1 :: stk1, Zfix fa2 :: stk2 ->
-      let f1 = fix fa1 in
-      let args1 = args_of_fix fa1 in
-      let f2 = fix fa2 in
-      let args2 = args_of_fix fa2 in
+  | Zfix(f1,args1) :: stk1, Zfix(f2,args2) :: stk2 ->
       conv_stack k stk1 stk2 
 	(conv_arguments k args1 args2 (conv_fix k f1 f2 cu))
   | Zswitch sw1 :: stk1, Zswitch sw2 :: stk2 ->
-      if eq_tbl sw1 sw2 then
+      if check_switch sw1 sw2 then
 	let vt1,vt2 = type_of_switch sw1, type_of_switch sw2 in
 	let rcu = ref (conv_val CONV k vt1 vt2 cu) in
 	let b1, b2 = branch_of_switch k sw1, branch_of_switch k sw2 in
 	for i = 0 to Array.length b1 - 1 do
 	  rcu := 
-	    conv_val CONV (k + fst b1.(i)) 
-	      (snd b1.(i)) (snd b2.(i)) !rcu
+	    conv_val CONV (k + fst b1.(i)) (snd b1.(i)) (snd b2.(i)) !rcu
 	done;
 	conv_stack k stk1 stk2 !rcu
       else raise NotConvertible
@@ -151,24 +139,20 @@ and conv_fix k f1 f2 cu =
   if f1 == f2 then cu 
   else
     if check_fix f1 f2 then
-      let tf1 = types_of_fix f1 in
-      let tf2 = types_of_fix f2 in
+      let bf1, tf1 = reduce_fix k f1 in
+      let bf2, tf2 = reduce_fix k f2 in
       let cu = conv_vect (conv_val CONV k) tf1 tf2 cu in
-      let bf1 = bodies_of_fix k f1 in
-      let bf2 = bodies_of_fix k f2 in
-      conv_vect (conv_fun CONV (k + (fix_ndef f1))) bf1 bf2 cu
+      conv_vect (conv_fun CONV (k + Array.length tf1)) bf1 bf2 cu
     else raise NotConvertible
 
 and conv_cofix k cf1 cf2 cu =
   if cf1 == cf2 then cu
   else
     if check_cofix cf1 cf2 then
-      let tcf1 = types_of_cofix cf1 in
-      let tcf2 = types_of_cofix cf2 in
+      let bcf1, tcf1 = reduce_cofix k cf1 in
+      let bcf2, tcf2 = reduce_cofix k cf2 in
       let cu = conv_vect (conv_val CONV k) tcf1 tcf2 cu in
-      let bcf1 = bodies_of_cofix k cf1 in
-      let bcf2 = bodies_of_cofix k cf2 in
-      conv_vect (conv_val CONV (k + (cofix_ndef cf1))) bcf1 bcf2 cu
+      conv_vect (conv_val CONV (k + Array.length tcf1)) bcf1 bcf2 cu
     else raise NotConvertible
 
 and conv_arguments k args1 args2 cu =
@@ -255,302 +239,4 @@ let set_use_vm b =
       
 let use_vm _ = !use_vm
 
-(*******************************************)
-(* Calcul de la forme normal d'un terme    *)
-(*******************************************)
-
-let crazy_type = mkSet 
-
-let decompose_prod env t =
-  let (name,dom,codom as res) = destProd (whd_betadeltaiota env t) in
-  if name = Anonymous then (Name (id_of_string "x"),dom,codom)
-  else res
-
-exception Find_at of int
-
-(* rend le numero du constructeur correspondant au tag [tag],
-   [cst] = true si c'est un constructeur constant *)
-
-let invert_tag cst tag reloc_tbl =
-  try 
-    for j = 0 to Array.length reloc_tbl - 1 do
-      let tagj,arity = reloc_tbl.(j) in
-      if tag = tagj && (cst && arity = 0 || not(cst || arity = 0)) then
-	raise (Find_at j)
-      else ()
-    done;raise Not_found 
-  with Find_at j -> (j+1)   
-             (* Argggg, ces constructeurs de ... qui commencent a 1*)
-
-(* Build the substitution that replaces Rels by the appropriate 
-  inductives *)
-let ind_subst mind mib =
-  let ntypes = mib.mind_ntypes in
-  let make_Ik k = mkInd (mind,ntypes-k-1) in 
-  Util.list_tabulate make_Ik ntypes
-
-(* Instantiate inductives and parameters in constructor type
-   in normal form *)
-let constructor_instantiate mind mib params ctyp =
-  let si = ind_subst mind mib in
-  let ctyp1 = substl si ctyp in
-  let nparams = Array.length params in
-  if nparams = 0 then ctyp1
-  else
-    let _,ctyp2 = decompose_prod_n nparams ctyp1 in
-    let sp = List.rev (Array.to_list params) in substl sp ctyp2
-  
-let destApplication t =
-  try destApp t 
-  with _ -> t,[||]
-
-let construct_of_constr_const env tag typ =
-  let cind,params = destApplication (whd_betadeltaiota env typ) in
-  let ind = destInd cind in
-  let (_,mip) = Inductive.lookup_mind_specif env ind in
-  let rtbl = mip.mind_reloc_tbl in
-  let i = invert_tag true tag rtbl in
-  mkApp(mkConstruct(ind,i), params)
-
-let find_rectype typ =
-  let cind,args = destApplication typ in
-  let ind = destInd cind in
-  ind, args
-
-let construct_of_constr_block env tag typ =
-  let (mind,_ as ind),allargs = find_rectype (whd_betadeltaiota env typ) in
-  let (mib,mip) = Inductive.lookup_mind_specif env ind in
-  let nparams = mib.mind_nparams in
-  let rtbl = mip.mind_reloc_tbl in
-  let i = invert_tag false tag rtbl in
-  let params = Array.sub allargs 0 nparams in
-  let specif = mip.mind_nf_lc in
-  let ctyp = constructor_instantiate mind mib params specif.(i-1) in
-  (mkApp(mkConstruct(ind,i), params), ctyp)
-  	
-let constr_type_of_idkey env idkey =
-  match idkey with
-  | ConstKey cst ->
-      let ty = (lookup_constant cst env).const_type in
-      mkConst cst, ty
-  | VarKey id -> 
-      let (_,_,ty) = lookup_named id env in 
-      mkVar id, ty
-  | RelKey i -> 
-      let n = (nb_rel env - i) in
-      let (_,_,ty) = lookup_rel n env in
-      mkRel n, lift n ty
-
-let type_of_ind env ind = 
-  let specif = Inductive.lookup_mind_specif env ind in
-  Inductive.type_of_inductive specif
-
-let build_branches_type (mind,_ as _ind) mib mip params dep p rtbl =
-  (* [build_one_branch i cty] construit le type de la ieme branche (commence
-     a 0) et les lambda correspondant aux realargs *)
-  let build_one_branch i cty =
-    let typi = constructor_instantiate mind mib params cty in
-    let decl,indapp = Term.decompose_prod typi in
-    let ind,cargs = find_rectype indapp in
-    let nparams = Array.length params in
-    let carity = snd (rtbl.(i)) in
-    let crealargs = Array.sub cargs nparams (Array.length cargs - nparams) in
-    let codom = 
-      let papp = mkApp(p,crealargs) in
-      if dep then
-	let cstr = ith_constructor_of_inductive ind (i+1) in
-        let relargs = Array.init carity (fun i -> mkRel (carity-i)) in
-	let dep_cstr = mkApp(mkApp(mkConstruct cstr,params),relargs) in
-	mkApp(papp,[|dep_cstr|])
-      else papp
-    in 
-    decl, codom
-  in Array.mapi build_one_branch mip.mind_nf_lc
-
-(* La fonction de normalisation *)
-
-let rec nf_val env v t = nf_whd env (whd_val v) t 
-
-and nf_whd env whd typ =
-  match whd with
-  | Vsort s -> mkSort s
-  | Vprod p ->
-      let dom = nf_val env (dom p) crazy_type in
-      let name = Name (id_of_string "x") in
-      let vc = body_of_vfun (nb_rel env) (codom p) in
-      let codom = nf_val (push_rel (name,None,dom) env) vc crazy_type in      
-      mkProd(name,dom,codom)	  
-  | Vfun f -> nf_fun env f typ
-  | Vfix f -> nf_fix env f
-  | Vfix_app fa ->
-      let f = fix fa in
-      let vargs = args_of_fix fa in
-      let fd = nf_fix env f in
-      let (_,i),(_,ta,_) = destFix fd in
-      let t = ta.(i) in
-      let _, args = nf_args  env vargs t in
-      mkApp(fd,args)
-  | Vcofix cf -> nf_cofix env cf 
-  | Vcofix_app cfa -> 
-      let cf = cofix cfa in
-      let vargs = args_of_cofix cfa in
-      let cfd = nf_cofix env cf in
-      let i,(_,ta,_) = destCoFix cfd in
-      let t = ta.(i) in
-      let _, args = nf_args env vargs t in
-      mkApp(cfd,args) 
-  | Vconstr_const n -> construct_of_constr_const env n typ
-  | Vconstr_block b ->
-      let capp,ctyp = construct_of_constr_block env (btag b) typ in
-      let args = nf_bargs env b ctyp in
-      mkApp(capp,args)
-  | Vatom_stk(Aid idkey, stk) ->
-      let c,typ = constr_type_of_idkey env idkey in
-      nf_stk env c typ stk
-  | Vatom_stk(Aiddef(idkey,v), stk) ->
-      nf_whd env (whd_stack v stk) typ
-  | Vatom_stk(Aind ind, stk) ->
-      nf_stk env (mkInd ind) (type_of_ind env ind) stk 
-  | Vatom_stk(_,stk) -> assert false
-
-and nf_stk env c t stk  =
-  match stk with
-  | [] -> c
-  | Zapp vargs :: stk ->
-      let t, args = nf_args env vargs t in
-      nf_stk env (mkApp(c,args)) t stk 
-  | Zfix fa :: stk ->   
-      let f = fix fa in
-      let vargs = args_of_fix fa in
-      let fd = nf_fix env f in
-      let (_,i),(_,ta,_) = destFix fd in
-      let tf = ta.(i) in
-      let typ, args = nf_args env vargs tf in
-      let _,_,codom = decompose_prod env typ in
-      nf_stk env (mkApp(mkApp(fd,args),[|c|])) (subst1 c codom) stk
-  | Zswitch sw :: stk -> 
-      let (mind,_ as ind),allargs = find_rectype (whd_betadeltaiota env t) in
-      let (mib,mip) = Inductive.lookup_mind_specif env ind in
-      let nparams = mib.mind_nparams in
-      let params,realargs = Util.array_chop nparams allargs in
-      (* calcul du predicat du case, 
-        [dep] indique si c'est un case dependant *)
-      let dep,p = 
-	let dep = ref false in
-	let rec nf_predicate env v pT =
-	  match whd_val v, kind_of_term pT with
-	  | Vfun f, Prod _ ->
-	      let k = nb_rel env in
-	      let vb = body_of_vfun k f in
-	      let name,dom,codom = decompose_prod env pT in
-	      let body = 
-		nf_predicate (push_rel (name,None,dom) env) vb codom in
-              mkLambda(name,dom,body)
-	  | Vfun f, _ ->
-	      dep := true;
-	      let k = nb_rel env in
-	      let vb = body_of_vfun k f in
-	      let name = Name (id_of_string "c") in
-	      let n = mip.mind_nrealargs in
-	      let rargs = Array.init n (fun i -> mkRel (n-i)) in
-	      let dom = mkApp(mkApp(mkInd ind,params),rargs) in
-	      let body = 
-		nf_val (push_rel (name,None,dom) env) vb crazy_type in
-	      mkLambda(name,dom,body)
-          | _, _ -> nf_val env v crazy_type
-	in 
-	let aux = 
-	  nf_predicate env (type_of_switch sw) 
-	    (hnf_prod_applist env (type_of_ind env ind) (Array.to_list params))
-	in
-	!dep,aux in
-      (* Calcul du type des branches *)
-      let btypes = 
-	build_branches_type ind mib mip params dep p mip.mind_reloc_tbl in
-      (* calcul des branches *)
-      let bsw = branch_of_switch (nb_rel env) sw in
-      let mkbranch i (n,v) =
-	let decl,codom = btypes.(i) in
-	let env = 
-	  List.fold_right 
-	    (fun (name,t) env -> push_rel (name,None,t) env) decl env in
-	let b = nf_val env v codom in
-	compose_lam decl b 
-      in 
-      let branchs = Array.mapi mkbranch bsw in
-      let tcase = 
-	if dep then mkApp(mkApp(p, params), [|c|])
-	else mkApp(p, params)
-      in
-      let ci = case_info sw in
-      nf_stk env (mkCase(ci, p, c, branchs)) tcase stk
-       
-and nf_args env vargs t =
-  let t = ref t in
-  let len = nargs vargs in
-  let targs = 
-    Array.init len 
-      (fun i ->
-	let _,dom,codom = decompose_prod env !t in
-	let c = nf_val env (arg vargs i) dom in
-	t := subst1 c codom; c) in
-  !t,targs
-
-and nf_bargs env b t =
-  let t = ref t in
-  let len = bsize b in
-  let args = Array.create len crazy_type in
-  for i = 0 to len - 1 do
-    let _,dom,codom = decompose_prod env !t in
-    let c = nf_val env (bfield b i) dom in
-    args.(i) <- c;
-    t := subst1 c codom
-  done;
-  args
-(*  Array.init len 
-    (fun i ->
-      let _,dom,codom = decompose_prod env !t in
-      let c = nf_val env (bfield b i) dom in
-      t := subst1 c codom; c) *) 
-
-and nf_fun env f typ =
-  let k = nb_rel env in
-  let vb = body_of_vfun k f in
-  let name,dom,codom = decompose_prod env typ in
-  let body = nf_val (push_rel (name,None,dom) env) vb codom in
-  mkLambda(name,dom,body)
-
-and nf_fix env f =
-  let init = fix_init f in
-  let rec_args = rec_args f in
-  let ndef = fix_ndef f in
-  let vt = types_of_fix f in
-  let ft = Array.map (fun v -> nf_val env v crazy_type) vt in
-  let name = Array.init ndef (fun _ -> (Name (id_of_string "Ffix"))) in
-  let k = nb_rel env in
-  let vb = bodies_of_fix k f in 
-  let env = push_rec_types (name,ft,ft) env in 
-  let fb = Util.array_map2 (fun v t -> nf_fun env v t) vb ft in
-  mkFix ((rec_args,init),(name,ft,fb))
-  
-and nf_cofix env cf =
-  let init = cofix_init cf in
-  let ndef = cofix_ndef cf in
-  let vt = types_of_cofix cf in
-  let cft = Array.map (fun v -> nf_val env v crazy_type) vt in
-  let name = Array.init ndef (fun _ -> (Name (id_of_string "Fcofix"))) in
-  let k = nb_rel env in
-  let vb = bodies_of_cofix k cf in 
-  let env = push_rec_types (name,cft,cft) env in 
-  let cfb = Util.array_map2 (fun v t -> nf_val env v t) vb cft in
-  mkCoFix (init,(name,cft,cfb))
-  
-let cbv_vm env c t  =
-  let transp = transp_values () in
-  if not transp then set_transp_values true; 
-  let v = val_of_constr env c in
-  let c = nf_val env v t in
-  if not transp then set_transp_values false; 
-  c
-  
 
diff --git a/kernel/vconv.mli b/kernel/vconv.mli
index 4aed5d05..551615aa 100644
--- a/kernel/vconv.mli
+++ b/kernel/vconv.mli
@@ -19,28 +19,5 @@ val use_vm : unit -> bool
 val set_use_vm : bool -> unit
 val vconv : conv_pb -> types conversion_function
 
-(***********************************************************************)
-(*s Reduction functions *)
-val cbv_vm : env -> constr -> types -> constr
-
-
-
-
-
-val nf_val : env -> values -> types -> constr
-
-val nf_whd : env -> Vm.whd -> types -> constr
-
-val nf_stk : env -> constr -> types -> Vm.stack  -> constr
-       
-val nf_args : env -> Vm.arguments -> types ->  types * constr array
-
-val nf_bargs : env -> Vm.vblock -> types -> constr array
-
-val nf_fun : env -> Vm.vfun -> types -> constr
-
-val nf_fix : env -> Vm.vfix -> constr 
-  
-val nf_cofix : env -> Vm.vcofix -> constr
+val val_of_constr : env -> constr -> values
 
-  
diff --git a/kernel/vm.ml b/kernel/vm.ml
index c8be979e..de9bd753 100644
--- a/kernel/vm.ml
+++ b/kernel/vm.ml
@@ -1,20 +1,16 @@
-open Obj
 open Names
 open Term
 open Conv_oracle
 open Cbytecodes
 
-
 external set_drawinstr : unit -> unit = "coq_set_drawinstr"
 
 (******************************************)
 (* Fonctions en plus du module Obj ********)
 (******************************************)
 
-external offset_closure : t -> int -> t = "coq_offset_closure"
-external offset : t -> int = "coq_offset"
-let first o = (offset_closure o (offset o))
-let last o = (field o (size o - 1))
+external offset_closure : Obj.t -> int -> Obj.t = "coq_offset_closure"
+external offset : Obj.t -> int = "coq_offset"
 
 let accu_tag = 0
 
@@ -34,8 +30,10 @@ external set_transp_values : bool -> unit = "coq_set_transp_value"
 (*******************************************)
 
 type tcode 
-let tcode_of_obj v = ((obj v):tcode)
-let fun_code v = tcode_of_obj (field (repr v) 0)
+let tcode_of_obj v = ((Obj.obj v):tcode)
+let fun_code v = tcode_of_obj (Obj.field (Obj.repr v) 0) 
+
+  
 
 external mkAccuCode : int -> tcode = "coq_makeaccu"
 external mkPopStopCode : int -> tcode = "coq_pushpop"
@@ -63,155 +61,26 @@ let popstop_code i =
     end
 
 let stop = popstop_code 0
-  
+ 
 (******************************************************)
 (* Types de donnees abstraites et fonctions associees *)
 (******************************************************)
 
 (* Values of the abstract machine *)
-let val_of_obj v = ((obj v):values)
-let crasy_val = (val_of_obj (repr 0))
-
-
-(* Functions *)
-type vfun  
-(* v = [Tc | c | fv1 | ... | fvn ] *)
-(*         ^                       *)
-(* [Tc | (Restart : c) | v | a1 | ... an] *)
-(*              ^                         *)
+let val_of_obj v = ((Obj.obj v):values)
+let crasy_val = (val_of_obj (Obj.repr 0))
 
-(* Products *)
+(* Abstract data *)
 type vprod 
-(* [0 | dom : codom] *) 
-(*     ^              *)
-let dom : vprod -> values = fun p -> val_of_obj (field (repr p) 0) 
-let codom : vprod -> vfun = fun p -> (obj (field (repr p) 1))
-
-(* Arguments *)
-type arguments 
-(* arguments = [_ | _ | _ | a1 | ... | an] *)
-(*                ^                        *)
-let nargs : arguments -> int = fun args -> (size (repr args)) - 2
-
-let unsafe_arg : arguments -> int -> values =
-     fun args i ->  val_of_obj (field (repr args) (i+2))
-
-let arg args i = 
-  if  0 <= i && i < (nargs args) then unsafe_arg args i 
-  else raise (Invalid_argument 
-		("Vm.arg size = "^(string_of_int (nargs args))^
-		 " acces "^(string_of_int i)))
-
-(* Fixpoints *)
+type vfun
 type vfix
+type vcofix
+type vblock
+type arguments
 
-(* [Tc|c0|Ti|c1|...|Ti|cn|fv1|...|fvn| [ct0|...|ctn]] *)
-(*          ^                                         *)
-type vfix_block 
-
-let fix_init : vfix -> int = fun vf -> (offset (repr vf)/2)
-
-let block_of_fix : vfix -> vfix_block = fun vf -> obj (first (repr vf))
-
-let fix_block_type : vfix_block -> tcode array =
-  fun fb -> (obj (last (repr fb)))
-
-let fix_block_ndef : vfix_block -> int = 
-  fun fb -> size (last (repr fb))
-
-let fix_ndef vf = fix_block_ndef (block_of_fix vf)
-
-let unsafe_fb_code : vfix_block -> int -> tcode =
-  fun fb i -> tcode_of_obj (field (repr fb) (2 * i))
-
-let unsafe_rec_arg fb i = int_tcode (unsafe_fb_code fb i) 1
-  
-let rec_args vf =
-  let fb = block_of_fix vf in
-  let size = fix_block_ndef fb in
-  Array.init size (unsafe_rec_arg fb)
-
-exception FALSE
-
-let check_fix f1 f2 = 
-  let i1, i2 = fix_init f1, fix_init f2 in
-  (* Verification du point de depart *)
-    if i1 = i2 then
-      let fb1,fb2 = block_of_fix f1, block_of_fix f2 in
-      let n = fix_block_ndef fb1 in
-    (* Verification du nombre de definition *)
-      if n = fix_block_ndef fb2 then
-      (* Verification des arguments recursifs *)
-	try
-	  for i = 0 to n - 1 do
-	    if not (unsafe_rec_arg fb1 i = unsafe_rec_arg fb2 i) then
-	      raise FALSE
-	  done;
-	  true
-	with FALSE -> false
-      else false 
-    else false
-
-(* Partials applications of Fixpoints *)
-type vfix_app
-let fix : vfix_app -> vfix = 
-  fun vfa -> ((obj (field (repr vfa) 1)):vfix)
-let args_of_fix : vfix_app -> arguments =
-  fun vfa -> ((magic  vfa) : arguments)
-
-(* CoFixpoints *)
-type vcofix 
-type vcofix_block
-let cofix_init : vcofix -> int = fun vcf -> (offset (repr vcf)/2)
-
-let block_of_cofix : vcofix -> vcofix_block = fun vcf -> obj (first (repr vcf))
-
-let cofix_block_ndef : vcofix_block -> int = 
-  fun fb -> size (last (repr fb))
-
-let cofix_ndef vcf= cofix_block_ndef (block_of_cofix vcf)
-
-let cofix_block_type : vcofix_block -> tcode array =
-  fun cfb -> (obj (last (repr cfb)))
-
-let check_cofix cf1 cf2 = 
-  cofix_init cf1 = cofix_init cf2 &&
-  cofix_ndef cf1 = cofix_ndef cf2 
-
-let cofix_arity c = int_tcode c 1
-
-let unsafe_cfb_code : vcofix_block -> int -> tcode =
-  fun cfb i -> tcode_of_obj (field (repr cfb) (2 * i))
-
-(* Partials applications of CoFixpoints *)
-type vcofix_app 
-let cofix : vcofix_app -> vcofix = 
-  fun vcfa -> ((obj (field (repr vcfa) 1)):vcofix)
-let args_of_cofix : vcofix_app -> arguments = 
-  fun vcfa -> ((magic  vcfa) : arguments)
-
-(* Blocks *)
-type vblock (* la representation Ocaml *)
-let btag : vblock -> int = fun b -> tag (repr b)
-let bsize : vblock -> int = fun b -> size (repr b)
-let bfield b i =
-  if 0 <= i && i < (bsize b) then
-    val_of_obj (field (repr b) i)
-  else raise (Invalid_argument "Vm.bfield")
-
-(* Accumulators and atoms *)
-
-type accumulator 
-(* [Ta | accumulate | at | a1 | ... | an ] *)
-
-type inv_rel_key = int
-
-type id_key = inv_rel_key tableKey
-
+type vm_env      
 type vstack = values array
 
-type vm_env 
-
 type vswitch = {
     sw_type_code : tcode; 
     sw_code : tcode; 
@@ -220,138 +89,148 @@ type vswitch = {
     sw_env : vm_env
   } 
 
-(* Ne pas changer ce type sans modifier le code C *)
+(* Representation des types abstraits:                                    *)
+(* + Les produits :                                                       *)
+(*   -   vprod = 0_[ dom | codom]                                         *)
+(*             dom : values, codom : vfun                                 *)
+(*                                                                        *)
+(* + Les fonctions ont deux representations possibles :                   *)
+(*   - fonction non applique :  vf = Ct_[ C | fv1 | ... | fvn]            *) 
+(*                                       C:tcode, fvi : values            *)
+(*     Remarque : il n'y a pas de difference entre la fct et son          *)
+(*                environnement.                                          *) 
+(*   - Application partielle  : Ct_[Restart:C| vf | arg1 | ... argn]      *)
+(*                                                                        *)
+(* + Les points fixes :                                                   *)
+(*   -        Ct_[C1|Infix_t|C2|...|Infix_t|Cn|fv1|...|fvn]               *)
+(*     Remarque il n'y a qu'un seul block pour representer tout les       *)
+(*     points fixes d'une declaration mutuelle, chaque point fixe         *)
+(*     pointe sur la position de son code dans le block.                  *)
+(*   - L'application partielle d'un point fixe suit le meme schema        *)
+(*     que celui des fonctions                                            *)
+(*     Remarque seul les points fixes qui n'ont pas encore recu leur      *)
+(*     argument recursif sont encode de cette maniere (si l'argument      *)
+(*     recursif etait un constructeur le point fixe se serait reduit      *)
+(*     sinon il est represente par un accumulateur)                       *)
+(*                                                                        *)
+(* + Les cofix sont expliques dans cbytegen.ml                            *)
+(*                                                                        *)
+(* + Les vblock encodent les constructeurs (non constant) de caml,        *)
+(*   la difference est que leur tag commence a 1 (0 est reserve pour les  *)
+(*   accumulateurs : accu_tag)                                            *)
+(*                                                                        *)
+(* + vm_env est le type des environnement machine (une fct ou un pt fixe) *)
+(*                                                                        *)
+(* + Les accumulateurs : At_[accumulate| accu | arg1 | ... | argn ]       *)
+(*   - representation des [accu] : tag_[....]                             *)
+(*     -- tag <= 2 : encodage du type atom                                *)
+(*     -- 3_[accu|fix_app] : un point fixe bloque par un accu             *)
+(*     -- 4_[accu|vswitch] : un case bloque par un accu                   *)
+(*     -- 5_[fcofix]       : une fonction de cofix                        *)
+(*     -- 6_[fcofix|val]   : une fonction de cofix, val represente        *)
+(*        la valeur de la reduction de la fct applique a arg1 ... argn    *) 
+(* Le type [arguments] est utiliser de maniere abstraite comme un         *)
+(* tableau, il represente la structure de donnee suivante :               *)
+(*          tag[ _ | _ |v1|... | vn]                                      *)
+(* Generalement le 1er champs est un pointeur de code                     *)
+
+(* Ne pas changer ce type sans modifier le code C, *)
+(* en particulier le fichier "coq_values.h"        *)
 type atom = 
   | Aid of id_key
   | Aiddef of id_key * values
   | Aind of inductive
-  | Afix_app of accumulator * vfix_app
-  | Aswitch of accumulator * vswitch
-
-let atom_of_accu : accumulator -> atom =
-  fun a -> ((obj (field (repr a) 1)) : atom)
-
-let args_of_accu : accumulator -> arguments = 
-  fun a -> ((magic a) : arguments)
-
-let nargs_of_accu a = nargs (args_of_accu a)
 
 (* Les zippers *)
 
 type zipper =
   | Zapp of arguments
-  | Zfix of vfix_app
+  | Zfix of vfix*arguments  (* Peut-etre vide *)
   | Zswitch of vswitch
 
 type stack = zipper list
 
+type to_up = values
+
 type whd =
   | Vsort of sorts
   | Vprod of vprod 
   | Vfun of vfun
-  | Vfix of vfix
-  | Vfix_app of vfix_app
-  | Vcofix of vcofix
-  | Vcofix_app of vcofix_app
+  | Vfix of vfix * arguments option
+  | Vcofix of vcofix * to_up * arguments option
   | Vconstr_const of int
   | Vconstr_block of vblock
   | Vatom_stk of atom * stack
-(* Les atomes sont forcement Aid Aiddef Aind *)
-
-(**********************************************)
-(* Constructeurs ******************************)
-(**********************************************)
-(* obj_of_atom : atom -> t *)
-let obj_of_atom : atom -> t =
-  fun a -> 
-    let res = Obj.new_block accu_tag 2 in
-    set_field res 0 (repr accumulate);
-    set_field res 1 (repr a);
-    res 
-
-(* obj_of_str_const : structured_constant -> t *)
-let rec obj_of_str_const str =
-  match str with 
-  | Const_sorts s -> repr (Vsort s)
-  | Const_ind ind -> obj_of_atom (Aind ind)
-  | Const_b0 tag -> repr tag
-  | Const_bn(tag, args) ->
-      let len = Array.length args in
-      let res = new_block tag len in
-      for i = 0 to len - 1 do 
-	set_field res i (obj_of_str_const args.(i)) 
-      done;
-      res
-
-let val_of_obj o = ((obj o) : values)
-
-let val_of_str_const str = val_of_obj (obj_of_str_const str)
-
-let val_of_atom a = val_of_obj (obj_of_atom a)
-
-let idkey_tbl = Hashtbl.create 31
-
-let val_of_idkey key =
-  try Hashtbl.find idkey_tbl key 
-  with Not_found -> 
-    let v = val_of_atom (Aid key) in
-    Hashtbl.add idkey_tbl key v;
-    v
-
-let val_of_rel k = val_of_idkey (RelKey k)
-let val_of_rel_def k v = val_of_atom(Aiddef(RelKey k, v))
-
-let val_of_named id = val_of_idkey (VarKey id)
-let val_of_named_def id v = val_of_atom(Aiddef(VarKey id, v))
-  
-let val_of_constant c = val_of_idkey (ConstKey c)
-let val_of_constant_def n c v = 
-  let res = Obj.new_block accu_tag 2 in
-  set_field res 0 (repr (mkAccuCond n));
-  set_field res 1 (repr (Aiddef(ConstKey c, v)));
-  val_of_obj res 
-
-
 
 (*************************************************)
 (* Destructors ***********************************)
 (*************************************************)
 
-
 let rec whd_accu a stk =
   let stk = 
-    if nargs_of_accu a = 0 then stk
-    else Zapp (args_of_accu a) :: stk in
-  let at = atom_of_accu a in 
-  match at with
-  | Aid _ | Aiddef _ | Aind _ -> Vatom_stk(at, stk)
-  | Afix_app(a,fa) -> whd_accu a (Zfix fa :: stk)
-  | Aswitch(a,sw) -> whd_accu a (Zswitch sw :: stk)
+    if Obj.size a = 2 then stk
+    else Zapp (Obj.obj a) :: stk in
+  let at = Obj.field a 1 in
+  match Obj.tag at with
+  | i when i <= 2 -> 
+      Vatom_stk(Obj.magic at, stk)
+  | 3 (* fix_app tag *) ->
+      let fa = Obj.field at 1 in
+      let zfix  = 
+	Zfix (Obj.obj (Obj.field fa 1), Obj.obj fa) in
+      whd_accu (Obj.field at 0) (zfix :: stk)
+  | 4 (* switch tag  *) ->
+      let zswitch = Zswitch (Obj.obj (Obj.field at 1)) in
+      whd_accu (Obj.field at 0) (zswitch :: stk)
+  | 5 (* cofix_tag *) ->
+      begin match stk with
+      | [] -> 
+	  let vcfx = Obj.obj (Obj.field at 0) in
+	  let to_up = Obj.obj a in
+	  Vcofix(vcfx, to_up, None)
+      | [Zapp args] ->
+	  let vcfx = Obj.obj (Obj.field at 0) in
+	  let to_up = Obj.obj a in
+	  Vcofix(vcfx, to_up, Some args)
+      | _           -> assert false
+      end
+  | 6 (* cofix_evaluated_tag *) ->
+      begin match stk with
+      | [] ->
+	  let vcofix = Obj.obj (Obj.field at 0) in
+	  let res = Obj.obj a in
+	  Vcofix(vcofix, res, None)
+      | [Zapp args] -> 
+	  let vcofix = Obj.obj (Obj.field at 0) in
+	  let res = Obj.obj a in
+	  Vcofix(vcofix, res, Some args)
+      | _ -> assert false
+      end
+  | _ -> assert false
 
-external kind_of_closure : t -> int = "coq_kind_of_closure"
+external kind_of_closure : Obj.t -> int = "coq_kind_of_closure"
 
 let whd_val : values -> whd =
   fun v -> 
-    let o = repr v in 
-    if is_int o then Vconstr_const (obj o)
+    let o = Obj.repr v in 
+    if Obj.is_int o then Vconstr_const (Obj.obj o)
     else 
-      let tag = tag o in
+      let tag = Obj.tag o in
       if tag = accu_tag then
-	if is_accumulate (fun_code o) then whd_accu (obj o) []
+	(
+	if Obj.size o = 1 then Obj.obj o (* sort *)
 	else 
-	  if size o = 1 then Vsort(obj (field o 0))
-	  else Vprod(obj o)
+	  if is_accumulate (fun_code o) then whd_accu o []
+	  else (Vprod(Obj.obj o)))
       else 
-	if tag = closure_tag || tag = infix_tag then
-	  match kind_of_closure o with
-	  | 0 -> Vfun(obj o)
-	  | 1 -> Vfix(obj o)
-	  | 2 -> Vfix_app(obj o) 
-	  | 3 -> Vcofix(obj o)
-	  | 4 -> Vcofix_app(obj o)
-	  | 5 -> Vatom_stk(Aid(RelKey(int_tcode (fun_code o) 1)), [])
-	  | _ -> Util.anomaly "Vm.whd : kind_of_closure does not work"
-	else Vconstr_block(obj o)
+	if tag = Obj.closure_tag || tag = Obj.infix_tag then
+	  (	   match kind_of_closure o with
+	   | 0 -> Vfun(Obj.obj o)
+	   | 1 -> Vfix(Obj.obj o, None)
+	   | 2 -> Vfix(Obj.obj (Obj.field o 1), Some (Obj.obj o))
+	   | 3 -> Vatom_stk(Aid(RelKey(int_tcode (fun_code o) 1)), [])
+	   | _ -> Util.anomaly "Vm.whd : kind_of_closure does not work")
+	else Vconstr_block(Obj.obj o)
 	
 
 
@@ -359,7 +238,6 @@ let whd_val : values -> whd =
 (* La machine abstraite *************************)
 (************************************************)
 
-
 (* gestion de la pile *)
 external push_ra : tcode -> unit = "coq_push_ra"
 external push_val : values -> unit = "coq_push_val"
@@ -371,6 +249,17 @@ external push_vstack : vstack -> unit = "coq_push_vstack"
 external interprete : tcode -> values -> vm_env -> int -> values =
   "coq_interprete_ml"
 
+
+
+(* Functions over arguments *)
+let nargs : arguments -> int = fun args -> (Obj.size (Obj.repr args)) - 2
+let arg args i = 
+  if  0 <= i && i < (nargs args) then 
+    val_of_obj (Obj.field (Obj.repr args) (i+2))
+  else raise (Invalid_argument 
+		("Vm.arg size = "^(string_of_int (nargs args))^
+		 " acces "^(string_of_int i)))
+
 let apply_arguments vf vargs =
   let n = nargs vargs in
   if n = 0 then vf 
@@ -378,7 +267,7 @@ let apply_arguments vf vargs =
    begin
      push_ra stop;
      push_arguments vargs;
-     interprete (fun_code vf) vf (magic vf) (n - 1)
+     interprete (fun_code vf) vf (Obj.magic vf) (n - 1)
    end
 
 let apply_vstack vf vstk =
@@ -388,80 +277,130 @@ let apply_vstack vf vstk =
     begin
       push_ra stop;
       push_vstack vstk;
-      interprete (fun_code vf) vf (magic vf) (n - 1)
+      interprete (fun_code vf) vf (Obj.magic vf) (n - 1)
     end
 
-let apply_fix_app vfa arg =
-  let vf = fix vfa in
-  let vargs = args_of_fix vfa in
-  push_ra stop;
-  push_val arg;
-  push_arguments vargs;
-  interprete (fun_code vf) (magic vf) (magic vf) (nargs vargs)
-
-external set_forcable : unit -> unit = "coq_set_forcable"
-let force_cofix v =
-  match whd_val v with
-  | Vcofix _    | Vcofix_app _ ->
-      push_ra stop;
-      set_forcable ();
-      interprete (fun_code v) (magic v) (magic v) 0
-  | _ -> v
-  
-let apply_switch sw arg =
-  let arg = force_cofix arg in
-  let tc = sw.sw_annot.tailcall in
-  if tc then 
-    (push_ra stop;push_vstack sw.sw_stk)
-  else 
-    (push_vstack sw.sw_stk; push_ra (popstop_code (Array.length sw.sw_stk)));
-  interprete sw.sw_code arg sw.sw_env 0
+(**********************************************)
+(* Constructeurs ******************************)
+(**********************************************)
 
-let is_accu v = 
-  is_block (repr v) && tag (repr v) = accu_tag && 
-  fun_code v == accumulate 
+let obj_of_atom : atom -> Obj.t =
+  fun a -> 
+    let res = Obj.new_block accu_tag 2 in
+    Obj.set_field res 0 (Obj.repr accumulate);
+    Obj.set_field res 1 (Obj.repr a);
+    res 
 
-let rec whd_stack v stk =  
-  match stk with
-  | [] -> whd_val v
-  | Zapp a :: stkt -> whd_stack (apply_arguments v a) stkt
-  | Zfix fa :: stkt -> 
-      if is_accu v then whd_accu (magic v) stk
-      else whd_stack (apply_fix_app fa v) stkt
-  | Zswitch sw :: stkt -> 
-      if is_accu v then whd_accu (magic v) stk 
-      else whd_stack (apply_switch sw v) stkt 
+(* obj_of_str_const : structured_constant -> Obj.t *)
+let rec obj_of_str_const str =
+  match str with 
+  | Const_sorts s -> Obj.repr (Vsort s)
+  | Const_ind ind -> obj_of_atom (Aind ind)
+  | Const_b0 tag -> Obj.repr tag
+  | Const_bn(tag, args) ->
+      let len = Array.length args in
+      let res = Obj.new_block tag len in
+      for i = 0 to len - 1 do 
+	Obj.set_field res i (obj_of_str_const args.(i)) 
+      done;
+      res
 
-let rec force_whd v stk =
-  match whd_stack v stk with
-  | Vatom_stk(Aiddef(_,v),stk) -> force_whd v stk
-  | res -> res
+let val_of_obj o = ((Obj.obj o) : values)
 
-	  
+let val_of_str_const str = val_of_obj (obj_of_str_const str)
 
-(* Function *)
-external closure_arity : vfun -> int = "coq_closure_arity"
+let val_of_atom a = val_of_obj (obj_of_atom a)
+
+let idkey_tbl = Hashtbl.create 31
+
+let val_of_idkey key =
+  try Hashtbl.find idkey_tbl key 
+  with Not_found -> 
+    let v = val_of_atom (Aid key) in
+    Hashtbl.add idkey_tbl key v;
+    v
+
+let val_of_rel k = val_of_idkey (RelKey k)
+let val_of_rel_def k v = val_of_atom(Aiddef(RelKey k, v))
+
+let val_of_named id = val_of_idkey (VarKey id)
+let val_of_named_def id v = val_of_atom(Aiddef(VarKey id, v))
+  
+let val_of_constant c = val_of_idkey (ConstKey c)
+let val_of_constant_def n c v = 
+  let res = Obj.new_block accu_tag 2 in
+  Obj.set_field res 0 (Obj.repr (mkAccuCond n));
+  Obj.set_field res 1 (Obj.repr (Aiddef(ConstKey c, v)));
+  val_of_obj res
 
-(* [apply_rel v k arity] applique la valeurs [v] aux arguments 
-   [k],[k+1], ... , [k+arity-1] *)
 let mkrel_vstack k arity =
   let max = k + arity - 1 in
   Array.init arity (fun i -> val_of_rel (max - i))
 
+(*************************************************)
+(** Operations pour la manipulation des donnees **)
+(*************************************************)
+
+
+(* Functions over products *)
+
+let dom : vprod -> values = fun p -> val_of_obj (Obj.field (Obj.repr p) 0) 
+let codom : vprod -> vfun = fun p -> (Obj.obj (Obj.field (Obj.repr p) 1))
+
+(* Functions over vfun *)
+
+external closure_arity : vfun -> int = "coq_closure_arity"
+
 let body_of_vfun k vf =
   let vargs = mkrel_vstack k 1 in
-  apply_vstack (magic vf) vargs
+  apply_vstack (Obj.magic vf) vargs
 
 let decompose_vfun2 k vf1 vf2 =
   let arity = min (closure_arity vf1) (closure_arity vf2) in
-  assert (0 <= arity && arity < Sys.max_array_length);
+  assert (0 < arity && arity < Sys.max_array_length);
   let vargs = mkrel_vstack k arity in
-  let v1 = apply_vstack (magic vf1) vargs in
-  let v2 = apply_vstack (magic vf2) vargs in
+  let v1 = apply_vstack (Obj.magic vf1) vargs in
+  let v2 = apply_vstack (Obj.magic vf2) vargs in
   arity, v1, v2
-    
+
+(* Functions over fixpoint *)
+
+let first o = (offset_closure o (offset o))
+let last o = (Obj.field o (Obj.size o - 1))
+
+let current_fix vf = - (offset (Obj.repr vf) / 2)
+
+let unsafe_fb_code fb i = tcode_of_obj (Obj.field (Obj.repr fb) (2 * i))
+
+let unsafe_rec_arg fb i = int_tcode (unsafe_fb_code fb i) 1
   
-(* Fix *)
+let rec_args vf =
+  let fb = first (Obj.repr vf) in
+  let size = Obj.size (last fb) in
+  Array.init size (unsafe_rec_arg fb)
+
+exception FALSE
+
+let check_fix f1 f2 = 
+  let i1, i2 = current_fix f1, current_fix f2 in
+  (* Verification du point de depart *)
+  if i1 = i2 then
+    let fb1,fb2 = first (Obj.repr f1), first (Obj.repr f2) in
+    let n = Obj.size (last fb1) in
+    (* Verification du nombre de definition *)
+    if n = Obj.size (last fb2) then
+      (* Verification des arguments recursifs *)
+      try
+	for i = 0 to n - 1 do
+	  if unsafe_rec_arg fb1 i <> unsafe_rec_arg fb2 i
+	  then raise FALSE
+	done;
+	true
+      with FALSE -> false
+    else false 
+  else false
+
+(* Functions over vfix *)
 external atom_rel : unit -> atom array = "get_coq_atom_tbl"
 external realloc_atom_rel : int -> unit = "realloc_coq_atom_tbl"
 
@@ -486,69 +425,89 @@ let relaccu_code i =
       !relaccu_tbl.(i) 
     end
 
-let jump_grabrec c = offset_tcode c 2
-let jump_grabrecrestart c = offset_tcode c 3
-
-let bodies_of_fix k vf = 
-  let fb = block_of_fix vf in
-  let ndef = fix_block_ndef fb in
+let reduce_fix k vf =
+  let fb = first (Obj.repr vf) in
+  (* calcul des types *)
+  let fc_typ = ((Obj.obj (last fb)) : tcode array) in
+  let ndef = Array.length fc_typ in
+  let et = offset_closure fb (2*(ndef - 1)) in
+  let ftyp =  
+    Array.map 
+      (fun c -> interprete c crasy_val (Obj.magic et) 0) fc_typ in
   (* Construction de l' environnement des corps des points fixes *)
-  let e = dup (repr fb) in
+  let e = Obj.dup fb in
   for i = 0 to ndef - 1 do
-    set_field e (2 * i) (repr (relaccu_code (k + i)))
+    Obj.set_field e (2 * i) (Obj.repr (relaccu_code (k + i)))
   done;
   let fix_body i =
+    let jump_grabrec c = offset_tcode c 2 in
     let c = jump_grabrec (unsafe_fb_code fb i)  in
-    let res = Obj.new_block closure_tag 2 in
-    set_field res 0 (repr c);
-    set_field res 1 (offset_closure e (2*i));
-    ((obj res) : vfun)
-  in Array.init ndef fix_body
- 
-let types_of_fix vf =
-  let fb = block_of_fix vf in
-  let type_code = fix_block_type fb in
-  let type_val c = interprete c crasy_val (magic fb) 0 in
-  Array.map type_val type_code
-
+    let res = Obj.new_block Obj.closure_tag 2 in
+    Obj.set_field res 0 (Obj.repr c);
+    Obj.set_field res 1 (offset_closure e (2*i));
+    ((Obj.obj res) : vfun)  in 
+  (Array.init ndef fix_body, ftyp)
  
-(* CoFix *)
-let jump_cograb c = offset_tcode c 2
-let jump_cograbrestart c = offset_tcode c 3 
-
-let bodies_of_cofix k vcf =
-  let cfb = block_of_cofix vcf in
-  let ndef = cofix_block_ndef cfb in
-  (* Construction de l' environnement des corps des cofix *)
-  let e = dup (repr cfb) in
+(* Functions over vcofix *)
+
+let get_fcofix vcf i = 
+  match whd_val (Obj.obj (Obj.field (Obj.repr vcf) (i+1))) with
+  | Vcofix(vcfi, _, _) -> vcfi
+  | _ -> assert false
+
+let current_cofix vcf =
+  let ndef = Obj.size (last (Obj.repr vcf)) in
+  let rec find_cofix pos =
+    if pos < ndef then
+      if get_fcofix vcf pos == vcf then pos
+      else find_cofix (pos+1)
+    else raise Not_found in
+  try find_cofix 0
+  with _ -> assert false
+
+let check_cofix vcf1 vcf2 =
+  (current_cofix vcf1 = current_cofix vcf2) &&
+  (Obj.size (last (Obj.repr vcf1)) = Obj.size (last (Obj.repr vcf2)))
+
+external print_point : Obj.t -> unit = "coq_print_pointer"
+
+let reduce_cofix k vcf =
+  let fc_typ = ((Obj.obj (last (Obj.repr vcf))) : tcode array) in
+  let ndef = Array.length fc_typ in
+  let ftyp =  
+    Array.map (fun c -> interprete c crasy_val (Obj.magic vcf) 0) fc_typ in
+  (* Construction de l'environnement des corps des cofix *)
+
+  let max = k + ndef - 1 in 
+  let e = Obj.dup (Obj.repr vcf) in 
   for i = 0 to ndef - 1 do
-    set_field e (2 * i) (repr (relaccu_code (k + i)))
+    Obj.set_field e (i+1) (Obj.repr (val_of_rel (k+i))) 
   done;
+   
   let cofix_body i =
-    let c = unsafe_cfb_code cfb i in 
-    let arity = int_tcode c 1 in
-    if arity = 0 then 
-      begin
-	push_ra stop;
-	interprete (jump_cograbrestart c) crasy_val 
-	  (obj (offset_closure e (2*i))) 0
-      end
-    else 
-      let res = Obj.new_block closure_tag 2 in
-      set_field res 0 (repr (jump_cograb c));
-      set_field res 1 (offset_closure e (2*i));
-      ((obj res) : values)
-  in Array.init ndef cofix_body
-
-let types_of_cofix vcf =
-  let cfb = block_of_cofix vcf in
-  let type_code = cofix_block_type cfb in
-  let type_val c = interprete c crasy_val (magic cfb) 0 in
-  Array.map type_val type_code
-
-(* Switch *)
-      
-let eq_tbl sw1 sw2 = sw1.sw_annot.rtbl = sw2.sw_annot.rtbl 
+    let vcfi = get_fcofix vcf i in
+    let c = Obj.field (Obj.repr vcfi) 0 in
+    Obj.set_field e 0 c; 
+    let atom = Obj.new_block cofix_tag 1 in
+    let self = Obj.new_block accu_tag 2 in
+    Obj.set_field self 0 (Obj.repr accumulate);
+    Obj.set_field self 1 (Obj.repr atom);
+    apply_vstack (Obj.obj e) [|Obj.obj self|] in  
+  (Array.init ndef cofix_body, ftyp)
+
+
+(* Functions over vblock *)
+  
+let btag : vblock -> int = fun b -> Obj.tag (Obj.repr b)
+let bsize : vblock -> int = fun b -> Obj.size (Obj.repr b)
+let bfield b i =
+  if 0 <= i && i < (bsize b) then val_of_obj (Obj.field (Obj.repr b) i)
+  else raise (Invalid_argument "Vm.bfield")
+
+
+(* Functions over vswitch *)
+
+let check_switch sw1 sw2 = sw1.sw_annot.rtbl = sw2.sw_annot.rtbl 
     
 let case_info sw = sw.sw_annot.ci
     
@@ -557,15 +516,22 @@ let type_of_switch sw =
   interprete sw.sw_type_code crasy_val sw.sw_env 0 
     
 let branch_arg k (tag,arity) = 
-  if arity = 0 then  ((magic tag):values)
+  if arity = 0 then  ((Obj.magic tag):values)
   else
-    let b = new_block tag arity in
+    let b = Obj.new_block tag arity in
     for i = 0 to arity - 1 do
-      set_field b i (repr (val_of_rel (k+i)))
+      Obj.set_field b i (Obj.repr (val_of_rel (k+i)))
     done;
     val_of_obj b
-  
-      
+
+let apply_switch sw arg =
+  let tc = sw.sw_annot.tailcall in
+  if tc then 
+    (push_ra stop;push_vstack sw.sw_stk)
+  else 
+    (push_vstack sw.sw_stk; push_ra (popstop_code (Array.length sw.sw_stk)));
+  interprete sw.sw_code arg sw.sw_env 0
+        
 let branch_of_switch k sw =
   let eval_branch (_,arity as ta) =
     let arg = branch_arg k ta in
@@ -573,27 +539,62 @@ let branch_of_switch k sw =
     (arity, v)
   in 
   Array.map eval_branch sw.sw_annot.rtbl
-    
-
-    
-
-
-
-
-
-
-
-
-
-
-
-
-
+	
 
+(* Evaluation *)
 
 
+let is_accu v = 
+  let o = Obj.repr v in
+  Obj.is_block o && Obj.tag o = accu_tag && 
+  fun_code v == accumulate && Obj.tag (Obj.field o 1) < cofix_tag 
 
+let rec whd_stack v stk =  
+  match stk with
+  | [] -> whd_val v
+  | Zapp args :: stkt -> whd_stack (apply_arguments v args) stkt
+  | Zfix (f,args) :: stkt -> 
+      let o = Obj.repr v in
+      if Obj.is_block o && Obj.tag o = accu_tag then
+	whd_accu (Obj.repr v) stk
+      else 
+	let v', stkt =
+	  match stkt with
+	  | Zapp args' :: stkt ->
+	      push_ra stop;
+	      push_arguments args';
+	      push_val v;
+	      push_arguments args;
+	      let v' =
+		interprete (fun_code f) (Obj.magic f) (Obj.magic f) 
+		  (nargs args+ nargs args') in
+	      v', stkt
+	  | _ -> 
+	      push_ra stop;
+	      push_val v;
+	      push_arguments args;
+	      let v' =
+		interprete (fun_code f) (Obj.magic f) (Obj.magic f) 
+		  (nargs args) in
+	      v', stkt
+	in
+	whd_stack v' stkt
+  | Zswitch sw :: stkt -> 
+      let o = Obj.repr v in
+      if Obj.is_block o && Obj.tag o = accu_tag then
+	if Obj.tag (Obj.field o 1) < cofix_tag then whd_accu (Obj.repr v) stk
+	else
+	  let to_up = 
+	    match whd_accu (Obj.repr v) [] with
+	    | Vcofix (_, to_up, _) -> to_up
+	    | _ -> assert false in
+	  whd_stack (apply_switch sw to_up) stkt
+      else whd_stack (apply_switch sw v) stkt 
 
+let rec force_whd v stk =
+  match whd_stack v stk with
+  | Vatom_stk(Aiddef(_,v),stk) -> force_whd v stk
+  | res -> res
 
 
 
diff --git a/kernel/vm.mli b/kernel/vm.mli
index b5fd9b9d..279ac937 100644
--- a/kernel/vm.mli
+++ b/kernel/vm.mli
@@ -13,45 +13,41 @@ type tcode
 
 (* Les valeurs ***********)
 
-type accumulator
 type vprod 
 type vfun
 type vfix
-type vfix_app
 type vcofix
-type vcofix_app 
 type vblock
 type vswitch
 type arguments
 
+type atom = 
+  | Aid of id_key
+  | Aiddef of id_key * values
+  | Aind of inductive
+
+(* Les zippers *)
+
 type zipper =
   | Zapp of arguments
-  | Zfix of vfix_app
+  | Zfix of vfix*arguments  (* Peut-etre vide *)
   | Zswitch of vswitch
 
 type stack = zipper list
 
-
-type atom = 
-  | Aid of id_key
-  | Aiddef of id_key * values
-  | Aind of inductive
-  | Afix_app of accumulator * vfix_app
-  | Aswitch of accumulator * vswitch
+type to_up
 
 type whd =
   | Vsort of sorts
   | Vprod of vprod 
   | Vfun of vfun
-  | Vfix of vfix
-  | Vfix_app of vfix_app
-  | Vcofix of vcofix
-  | Vcofix_app of vcofix_app
+  | Vfix of vfix * arguments option
+  | Vcofix of vcofix * to_up * arguments option
   | Vconstr_const of int
   | Vconstr_block of vblock
   | Vatom_stk of atom * stack
-
-(* Constructors *)
+ 
+(** Constructors *)
 val val_of_str_const : structured_constant -> values
 
 val val_of_rel : int -> values 
@@ -63,44 +59,43 @@ val val_of_named_def : identifier -> values -> values
 val val_of_constant : constant -> values 
 val val_of_constant_def : int -> constant -> values -> values
 
-(* Destructors *)
+(** Destructors *)
 val whd_val : values -> whd
 
+(* Arguments *)  
+val nargs : arguments -> int
+val arg : arguments -> int -> values
+
 (* Product *)
 val dom : vprod -> values
 val codom : vprod -> vfun
+
 (* Function *)
 val body_of_vfun : int -> vfun -> values 
 val decompose_vfun2  : int -> vfun -> vfun -> int * values * values
+
 (* Fix *)
-val fix : vfix_app -> vfix
-val args_of_fix : vfix_app -> arguments
-val fix_init : vfix -> int
-val fix_ndef : vfix -> int 
-val rec_args : vfix -> int array 
+val current_fix : vfix -> int
 val check_fix : vfix -> vfix -> bool
-val bodies_of_fix : int -> vfix -> vfun array
-val types_of_fix : vfix -> values array
+val rec_args : vfix -> int array 
+val reduce_fix : int -> vfix -> vfun array * values array
+                              (* bodies ,  types *)
+
 (* CoFix *)
-val cofix : vcofix_app -> vcofix
-val args_of_cofix : vcofix_app -> arguments
-val cofix_init : vcofix -> int 
-val cofix_ndef : vcofix -> int
+val current_cofix : vcofix -> int 
 val check_cofix : vcofix -> vcofix -> bool
-val bodies_of_cofix : int -> vcofix -> values array
-val types_of_cofix : vcofix -> values array
+val reduce_cofix : int -> vcofix -> values array * values array
+                                      (* bodies , types *)
 (* Block *)
 val btag : vblock -> int
 val bsize : vblock -> int
 val bfield : vblock -> int -> values
+
 (* Switch *)
-val eq_tbl : vswitch -> vswitch -> bool
+val check_switch : vswitch -> vswitch -> bool
 val case_info : vswitch -> case_info
 val type_of_switch : vswitch -> values
 val branch_of_switch : int -> vswitch -> (int * values) array
-(* Arguments *)  
-val nargs : arguments -> int
-val arg : arguments -> int -> values
 
 (* Evaluation *)
 val whd_stack : values -> stack -> whd
diff --git a/lib/options.ml b/lib/options.ml
index 2e29f61b..c46857e3 100644
--- a/lib/options.ml
+++ b/lib/options.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: options.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: options.ml 9191 2006-09-29 15:45:42Z courtieu $ *)
 
 open Util
 
@@ -22,6 +22,7 @@ let batch_mode = ref false
 let debug = ref false
 
 let print_emacs = ref false
+let print_emacs_safechar = ref false
 
 let term_quality = ref false
 
diff --git a/lib/options.mli b/lib/options.mli
index 1a5444a4..30d585fb 100644
--- a/lib/options.mli
+++ b/lib/options.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: options.mli 7740 2005-12-26 20:07:21Z herbelin $ i*)
+(*i $Id: options.mli 9191 2006-09-29 15:45:42Z courtieu $ i*)
 
 (* Global options of the system. *)
 
@@ -17,6 +17,7 @@ val batch_mode : bool ref
 val debug : bool ref
 
 val print_emacs : bool ref
+val print_emacs_safechar : bool ref
 
 val term_quality : bool ref
 
diff --git a/lib/stamps.mli b/lib/stamps.mli
deleted file mode 100644
index 6fa3077f..00000000
--- a/lib/stamps.mli
+++ /dev/null
@@ -1,28 +0,0 @@
-(************************************************************************)
-(*  v      *   The Coq Proof Assistant  /  The Coq Development Team     *)
-(* <O___,, * CNRS-Ecole Polytechnique-INRIA Futurs-Universite Paris Sud *)
-(*   \VV/  **************************************************************)
-(*    //   *      This file is distributed under the terms of the       *)
-(*         *       GNU Lesser General Public License Version 2.1        *)
-(************************************************************************)
-
-(*i $Id: stamps.mli 5920 2004-07-16 20:01:26Z herbelin $ i*)
-
-(* Time stamps. *)
-
-type 'a timestamped
-
-(* [ts_mod] gives a ['b timestamped] with a new stamp *)
-val ts_mod : ('a -> 'b) -> 'a timestamped -> 'b timestamped
-val ts_it : 'a timestamped -> 'a
-val ts_mk : 'a -> 'a timestamped
-val ts_eq : 'a timestamped -> 'a timestamped -> bool
-val ts_stamp : 'a timestamped -> int
-
-type 'a idstamped
-
-(* [ids_mod] gives a ['b stamped] with the same stamp *)
-val ids_mod : ('a -> 'b) -> 'a idstamped -> 'b idstamped
-val ids_it : 'a idstamped -> 'a
-val ids_mk : 'a -> 'a idstamped
-val ids_eq : 'a idstamped -> 'a idstamped -> bool
diff --git a/lib/util.ml b/lib/util.ml
index 503dfeda..89cfd6fc 100644
--- a/lib/util.ml
+++ b/lib/util.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: util.ml 8867 2006-05-28 16:21:41Z herbelin $ *)
+(* $Id: util.ml 9225 2006-10-09 15:59:23Z herbelin $ *)
 
 open Pp
 
@@ -194,7 +194,7 @@ let list_map_i f =
 let list_map2_i f i l1 l2 =  
   let rec map_i i = function
     | ([], []) -> []
-    | ((h1::t1), (h2::t2)) -> (f i h1 h2) :: (map_i (succ i) (t1,t2))
+    | ((h1::t1), (h2::t2)) -> let v = f i h1 h2 in v :: map_i (succ i) (t1,t2)
     | (_, _) -> invalid_arg "map2_i"
   in 
   map_i i (l1,l2)
@@ -202,7 +202,7 @@ let list_map2_i f i l1 l2 =
 let list_map3 f l1 l2 l3 =
   let rec map = function
     | ([], [], []) -> []
-    | ((h1::t1), (h2::t2), (h3::t3)) -> (f h1 h2 h3) :: (map (t1,t2,t3))
+    | ((h1::t1), (h2::t2), (h3::t3)) -> let v = f h1 h2 h3 in v::map (t1,t2,t3)
     | (_, _, _) -> invalid_arg "map3"
   in 
   map (l1,l2,l3)
@@ -295,9 +295,11 @@ let list_try_find f =
   in 
   try_find_f
 
-let rec list_uniquize = function
-  | [] -> []
-  | h::t -> if List.mem h t then list_uniquize t else h::(list_uniquize t)
+let list_uniquize l =
+  let rec aux acc = function
+  | [] -> List.rev acc
+  | h::t -> if List.mem h acc then aux acc t else aux (h::acc) t
+  in aux [] l
 
 let rec list_distinct = function
   | h::t -> (not (List.mem h t)) && list_distinct t
@@ -473,6 +475,17 @@ let array_last v =
 
 let array_cons e v = Array.append [|e|] v
 
+let array_rev t = 
+  let n=Array.length t in
+    if n <=0 then () 
+    else
+      let tmp=ref t.(0) in
+      for i=0 to pred (n/2) do 
+	tmp:=t.((pred n)-i);
+	t.((pred n)-i)<- t.(i);
+	t.(i)<- !tmp
+      done
+
 let array_fold_right_i f v a =
   let rec fold a n =
     if n=0 then a
@@ -649,6 +662,17 @@ let array_fold_map2' f v1 v2 e =
   in
   (v',!e')
 
+let array_distinct v =
+  try
+    for i=0 to Array.length v-1 do
+      for j=i+1 to Array.length v-1 do
+	if v.(i)=v.(j) then raise Exit
+      done
+    done;
+    true
+  with Exit ->
+    false
+
 (* Matrices *)
 
 let matrix_transpose mat =
@@ -713,6 +737,10 @@ let option_fold_left2 f e a b = match (a,b) with
   | Some x, Some y -> f e x y
   | _ -> e
 
+let option_fold_left f e a = match a with
+  | Some x -> f e x
+  | _ -> e
+
 let option_fold_right f a e = match a with
   | Some x -> f x e
   | _ -> e
@@ -789,6 +817,8 @@ let prvect_with_sep sep elem v =
   let n = Array.length v in
   if n = 0 then mt () else pr (n - 1)
 
+let surround p = hov 1 (str"(" ++ p ++ str")")
+
 (*s Size of ocaml values. *)
 
 module Size = struct
diff --git a/lib/util.mli b/lib/util.mli
index 959ef802..b2d8f135 100644
--- a/lib/util.mli
+++ b/lib/util.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(*i $Id: util.mli 8867 2006-05-28 16:21:41Z herbelin $ i*)
+(*i $Id: util.mli 9225 2006-10-09 15:59:23Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -149,6 +149,7 @@ val array_hd : 'a array -> 'a
 val array_tl : 'a array -> 'a array
 val array_last : 'a array -> 'a
 val array_cons : 'a -> 'a array -> 'a array
+val array_rev : 'a array -> unit
 val array_fold_right_i : 
   (int -> 'b -> 'a -> 'a) -> 'b array -> 'a -> 'a
 val array_fold_left_i : (int -> 'a -> 'b -> 'a) -> 'a -> 'b array -> 'a
@@ -175,6 +176,7 @@ val array_map_left_pair : ('a -> 'b) -> 'a array -> ('c -> 'd) -> 'c array ->
 val array_fold_map' : ('a -> 'c -> 'b * 'c) -> 'a array -> 'c -> 'b array * 'c
 val array_fold_map2' :
   ('a -> 'b -> 'c -> 'd * 'c) -> 'a array -> 'b array -> 'c -> 'd array * 'c
+val array_distinct : 'a array -> bool
 
 (*s Matrices *)
 
@@ -207,6 +209,7 @@ val out_some : 'a option -> 'a
 val option_map : ('a -> 'b) -> 'a option -> 'b option
 val option_cons : 'a option -> 'a list -> 'a list
 val option_fold_right : ('a -> 'b -> 'b) -> 'a option -> 'b -> 'b
+val option_fold_left : ('a -> 'b -> 'a) -> 'a -> 'b option -> 'a
 val option_fold_left2 : ('a -> 'b -> 'c -> 'a) -> 'a -> 'b option ->
   'c option -> 'a
 val option_iter : ('a -> unit) -> 'a option -> unit
@@ -238,6 +241,8 @@ val prlist_with_sep :
 val prvect_with_sep :
    (unit -> std_ppcmds) -> ('b -> std_ppcmds) -> 'b array -> std_ppcmds
 val pr_vertical_list : ('b -> std_ppcmds) -> 'b list -> std_ppcmds
+val surround : std_ppcmds -> std_ppcmds
+
 
 (*s Size of an ocaml value (in words, bytes and kilobytes). *)
 
diff --git a/library/declare.ml b/library/declare.ml
index 81401a8e..e9e54cd3 100644
--- a/library/declare.ml
+++ b/library/declare.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: declare.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: declare.ml 9104 2006-09-01 11:04:44Z notin $ *)
 
 open Pp
 open Util
@@ -150,18 +150,18 @@ let open_constant i ((sp,kn),_) =
 let cache_constant ((sp,kn),(cdt,dhyps,imps,kind)) =
   let id = basename sp in
   let _,dir,_ = repr_kn kn in
-  if Idmap.mem id !vartab then
-    errorlabstrm "cache_constant" (pr_id id ++ str " already exists");
-  if Nametab.exists_cci sp then
-    errorlabstrm "cache_constant" (pr_id id ++ str " already exists");
-  let kn' = Global.add_constant dir id cdt in
-  assert (kn' = constant_of_kn kn);
-  Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn));
-  add_section_constant kn' (Global.lookup_constant kn').const_hyps;
-  Dischargedhypsmap.set_discharged_hyps sp dhyps;
-  with_implicits imps declare_constant_implicits kn';
-  Notation.declare_ref_arguments_scope (ConstRef kn');
-  csttab := Spmap.add sp kind !csttab
+    if Idmap.mem id !vartab then
+      errorlabstrm "cache_constant" (pr_id id ++ str " already exists");
+    if Nametab.exists_cci sp then
+      errorlabstrm "cache_constant" (pr_id id ++ str " already exists");
+    let kn' = Global.add_constant dir id cdt in
+      assert (kn' = constant_of_kn kn);
+      Nametab.push (Nametab.Until 1) sp (ConstRef (constant_of_kn kn));
+      add_section_constant kn' (Global.lookup_constant kn').const_hyps;
+      Dischargedhypsmap.set_discharged_hyps sp dhyps;
+      with_implicits imps declare_constant_implicits kn';
+      Notation.declare_ref_arguments_scope (ConstRef kn');
+      csttab := Spmap.add sp kind !csttab
 
 (*s Registration as global tables and rollback. *)
 
diff --git a/library/global.ml b/library/global.ml
index 863d26b7..ab5d8956 100644
--- a/library/global.ml
+++ b/library/global.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: global.ml 8723 2006-04-16 15:51:02Z herbelin $ *)
+(* $Id: global.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -141,10 +141,10 @@ open Libnames
 
 let type_of_reference env = function
   | VarRef id -> Environ.named_type id env 
-  | ConstRef c -> Environ.constant_type env c
+  | ConstRef c -> Typeops.type_of_constant env c
   | IndRef ind ->
      let specif = Inductive.lookup_mind_specif env ind in
-      Inductive.type_of_inductive specif
+      Inductive.type_of_inductive env specif
   | ConstructRef cstr ->
      let specif =
       Inductive.lookup_mind_specif env (inductive_of_constructor cstr) in
diff --git a/library/goptions.ml b/library/goptions.ml
index c220544c..4d36e1c5 100644
--- a/library/goptions.ml
+++ b/library/goptions.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: goptions.ml 6304 2004-11-16 15:49:08Z sacerdot $ *)
+(* $Id: goptions.ml 9060 2006-07-27 15:30:35Z notin $ *)
 
 (* This module manages customization parameters at the vernacular level     *)
 
@@ -253,7 +253,7 @@ let declare_option cast uncast
 	       unfreeze_function = write;
 	       init_function = (fun () -> write default);
 	       survive_module = false;
-	       survive_section = true}
+	       survive_section = false}
     in 
     fun v -> add_anonymous_leaf (decl_obj v)
   else write
diff --git a/library/impargs.ml b/library/impargs.ml
index 68fc046c..67848d8f 100644
--- a/library/impargs.ml
+++ b/library/impargs.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: impargs.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: impargs.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -259,10 +259,9 @@ let list_of_implicits = function
 
 let constants_table = ref Cmap.empty
 
-let compute_constant_implicits kn =
+let compute_constant_implicits cst =
   let env = Global.env () in
-  let cb = lookup_constant kn env in
-  auto_implicits env (body_of_type cb.const_type)
+  auto_implicits env (Typeops.type_of_constant env cst)
 
 let constant_implicits sp =
   try Cmap.find sp !constants_table with Not_found -> No_impl
@@ -282,12 +281,13 @@ let compute_mib_implicits kn =
   let ar =
     Array.to_list
       (Array.map  (* No need to lift, arities contain no de Bruijn *)
-        (fun mip -> (Name mip.mind_typename, None, type_of_inductive (mib,mip)))
+        (fun mip ->
+	  (Name mip.mind_typename, None, type_of_inductive env (mib,mip)))
         mib.mind_packets) in
   let env_ar = push_rel_context ar env in
   let imps_one_inductive i mip =
     let ind = (kn,i) in
-    let ar = type_of_inductive (mib,mip) in
+    let ar = type_of_inductive env (mib,mip) in
     ((IndRef ind,auto_implicits env ar),
      Array.mapi (fun j c -> (ConstructRef (ind,j+1),auto_implicits env_ar c))
        mip.mind_nf_lc)
diff --git a/library/lib.ml b/library/lib.ml
index ba6b9c79..09200a5c 100644
--- a/library/lib.ml
+++ b/library/lib.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: lib.ml 8852 2006-05-23 17:52:43Z notin $ *)
+(* $Id: lib.ml 9133 2006-09-12 14:52:07Z notin $ *)
 
 open Pp
 open Util
@@ -186,9 +186,9 @@ let add_leaf id obj =
   if fst (current_prefix ()) = initial_path then 
     error ("No session module started (use -top dir)");
   let oname = make_oname id in
-  cache_object (oname,obj);
-  add_entry oname (Leaf obj);
-  oname
+    cache_object (oname,obj);
+    add_entry oname (Leaf obj);
+    oname
 
 let add_leaves id objs =
   let oname = make_oname id in
@@ -319,7 +319,7 @@ let end_compilation dir =
       | _, OpenedModtype _ -> error "There are some open module types"
       | _ -> assert false
     with
-	Not_found -> ()
+	Not_found -> () 
   in
   let module_p =
     function (_,CompilingLibrary _) -> true | x -> is_something_opened x
@@ -331,16 +331,17 @@ let end_compilation dir =
     with
 	Not_found -> anomaly "No module declared"
   in
-  let _ =  match !comp_name with
+  let _ =  
+    match !comp_name with
       | None -> anomaly "There should be a module name..."
       | Some m ->
 	  if m <> dir then anomaly 
 	    ("The current open module has name "^ (string_of_dirpath m) ^ 
-	     " and not " ^ (string_of_dirpath m));
+	       " and not " ^ (string_of_dirpath m));
   in
   let (after,_,before) = split_lib oname in
-  comp_name := None;
-  !path_prefix,after
+    comp_name := None;
+    !path_prefix,after
 
 (* Returns true if we are inside an opened module type *)
 let is_modtype () = 
@@ -444,15 +445,15 @@ let open_section id =
   let dir = extend_dirpath olddir id in
   let prefix = dir, (mp, extend_dirpath oldsec id) in
   let name = make_path id, make_kn id (* this makes little sense however *) in
-  if Nametab.exists_section dir then
-    errorlabstrm "open_section" (pr_id id ++ str " already exists");
-  let sum = freeze_summaries() in
-  add_entry name (OpenedSection (prefix, sum));
-  (*Pushed for the lifetime of the section: removed by unfrozing the summary*)
-  Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
-  path_prefix := prefix;
-  if !Options.xml_export then !xml_open_section id;
-  add_section ()
+    if Nametab.exists_section dir then
+      errorlabstrm "open_section" (pr_id id ++ str " already exists");
+    let sum = freeze_summaries() in
+      add_entry name (OpenedSection (prefix, sum));
+      (*Pushed for the lifetime of the section: removed by unfrozing the summary*)
+      Nametab.push_dir (Nametab.Until 1) dir (DirOpenSection prefix);
+      path_prefix := prefix;
+      if !Options.xml_export then !xml_open_section id;
+      add_section ()
 
 
 (* Restore lib_stk and summaries as before the section opening, and
@@ -476,16 +477,16 @@ let close_section id =
       error "no opened section"
   in
   let (secdecls,_,before) = split_lib oname in
-  lib_stk := before;
-  let full_olddir = fst !path_prefix in
-  pop_path_prefix ();
-  add_entry (make_oname id) ClosedSection;
-  if !Options.xml_export then !xml_close_section id;
-  let newdecls = List.map discharge_item secdecls in
-  Summary.section_unfreeze_summaries fs;
-  List.iter (option_iter (fun (id,o) -> ignore (add_leaf id o))) newdecls;
-  Cooking.clear_cooking_sharing ();
-  Nametab.push_dir (Nametab.Until 1) full_olddir (DirClosedSection full_olddir)
+    lib_stk := before;
+    let full_olddir = fst !path_prefix in
+      pop_path_prefix ();
+      add_entry (make_oname id) ClosedSection;
+      if !Options.xml_export then !xml_close_section id;
+      let newdecls = List.map discharge_item secdecls in
+	Summary.section_unfreeze_summaries fs;
+	List.iter (option_iter (fun (id,o) -> ignore (add_leaf id o))) newdecls;
+	Cooking.clear_cooking_sharing ();
+	Nametab.push_dir (Nametab.Until 1) full_olddir (DirClosedSection full_olddir)
 
 (*****************)
 (* Backtracking. *)
diff --git a/library/libobject.ml b/library/libobject.ml
index 7f383a3b..709fb1bb 100644
--- a/library/libobject.ml
+++ b/library/libobject.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: libobject.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: libobject.ml 9104 2006-09-01 11:04:44Z notin $ *)
 
 open Util
 open Names
@@ -144,7 +144,7 @@ let apply_dyn_fun deflt f lobj =
 	  else
 	    anomaly
 	      ("Cannot find library functions for an object with tag "^tag) in 
-  	f dodecl
+	f dodecl
     with
 	Failure "local to_apply_dyn_fun" -> deflt;;
 
diff --git a/library/library.ml b/library/library.ml
index cfd88ca0..43eeb695 100644
--- a/library/library.ml
+++ b/library/library.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: library.ml 8877 2006-05-30 16:37:04Z notin $ *)
+(* $Id: library.ml 9352 2006-11-07 16:12:10Z notin $ *)
 
 open Pp
 open Util
@@ -300,7 +300,7 @@ let (in_import, out_import) =
 
 (*s Loading from disk to cache (preparation phase) *)
 
-let vo_magic_number = 08003 (* V8.0 final new syntax + new params in ind *)
+let vo_magic_number = 080999 (* V8.1gamma *)
 
 let (raw_extern_library, raw_intern_library) =
   System.raw_extern_intern vo_magic_number ".vo"
@@ -606,7 +606,7 @@ let save_library_to dir f =
     let di = Digest.file f' in
     System.marshal_out ch di;
     close_out ch
-  with e -> (warning ("Removed file "^f');close_out ch; Sys.remove f'; raise e)
+  with e -> (warning ("Removed file "^f'); close_out ch; Sys.remove f'; raise e)
 
 (************************************************************************)
 (*s Display the memory use of a library. *)
diff --git a/library/nameops.ml b/library/nameops.ml
index 1c6a7d56..779f3389 100644
--- a/library/nameops.ml
+++ b/library/nameops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: nameops.ml 8727 2006-04-24 09:48:06Z herbelin $ *)
+(* $Id: nameops.ml 9225 2006-10-09 15:59:23Z herbelin $ *)
 
 open Pp
 open Util
@@ -154,6 +154,10 @@ let name_app f = function
   | Name id -> Name (f id)
   | Anonymous -> Anonymous
 
+let name_fold_map f e = function
+  | Name id -> let (e,id) = f e id in (e,Name id)
+  | Anonymous -> e,Anonymous
+
 let next_name_away_with_default default name l = 
   match name with
     | Name str  -> next_ident_away str l
diff --git a/library/nameops.mli b/library/nameops.mli
index 9d1722d4..8e291761 100644
--- a/library/nameops.mli
+++ b/library/nameops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: nameops.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
+(*i $Id: nameops.mli 9225 2006-10-09 15:59:23Z herbelin $ i*)
 
 open Names
 
@@ -38,6 +38,8 @@ val out_name : name -> identifier
 val name_fold : (identifier -> 'a -> 'a) -> name -> 'a -> 'a
 val name_cons : name -> identifier list -> identifier list
 val name_app : (identifier -> identifier) -> name -> name
+val name_fold_map : ('a -> identifier -> 'a * identifier) -> 'a -> name -> 'a * name
+
 
 val pr_lab : label -> Pp.std_ppcmds
 
diff --git a/library/states.ml b/library/states.ml
index 3bb37a4d..169a3857 100644
--- a/library/states.ml
+++ b/library/states.ml
@@ -6,16 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: states.ml 6692 2005-02-06 13:03:51Z herbelin $ *)
+(* $Id: states.ml 9100 2006-08-31 18:04:26Z herbelin $ *)
 
 open System
 
 type state = Lib.frozen * Summary.frozen
 
-let get_state () =
+let freeze () =
   (Lib.freeze(), Summary.freeze_summaries())
 
-let set_state (fl,fs) =
+let unfreeze (fl,fs) =
   Lib.unfreeze fl;
   Summary.unfreeze_summaries fs
 
@@ -23,17 +23,14 @@ let state_magic_number = 19764
 
 let (extern_state,intern_state) =
   let (raw_extern, raw_intern) = extern_intern state_magic_number ".coq" in
-  (fun s -> raw_extern s (get_state())),
-  (fun s -> set_state (raw_intern (Library.get_load_paths ()) s))
+  (fun s -> raw_extern s (freeze())),
+  (fun s -> unfreeze (raw_intern (Library.get_load_paths ()) s))
 
 (* Rollback. *)
 
-let freeze = get_state
-let unfreeze = set_state
-
 let with_heavy_rollback f x =
-  let st = get_state () in
+  let st = freeze () in
   try 
     f x
   with reraise ->
-    (set_state st; raise reraise)
+    (unfreeze st; raise reraise)
diff --git a/man/coqc.1 b/man/coqc.1
index 741b3dcb..7113d504 100644
--- a/man/coqc.1
+++ b/man/coqc.1
@@ -32,10 +32,13 @@ For interactive use of Coq, see
 
 .SH OPTIONS
 
-.TP
-.BI \-h
-Will give you a description of the whole list of options of coqc and
-coqtop.
+.B coqc
+is a script that simply runs
+.B coqtop
+with option 
+.B \-compile
+it accepts the same options as
+.B coqtop.
 
 .SH SEE ALSO
 
diff --git a/man/coqdep.1 b/man/coqdep.1
index 01d080fc..6ae89f8b 100644
--- a/man/coqdep.1
+++ b/man/coqdep.1
@@ -23,6 +23,9 @@ coqdep \- Compute inter-module dependencies for Coq and Caml programs
 [
 .BI \-D
 ]
+[
+.BI \-slash
+]
 .I filename ...
 .I directory ...
 
@@ -37,10 +40,11 @@ When a directory is given as argument, it is recursively looked at.
 Dependencies of Coq modules are computed by looking at
 .IR Require \&
 commands (Require, Require Export, Require Import, Require Implementation),
-and
 .IR Declare \& 
 .IR ML \& 
 .IR Module \&
+commands and
+.IR Load \&
 commands. Dependencies relative to modules from the Coq library are not
 printed.
 
@@ -54,8 +58,7 @@ directives and the dot notation
 .TP
 .BI \-c
 Prints the dependencies of Caml modules.
-(On Caml modules, the behaviour is exactly the same as cldepend,
-except that nested comments and strings are correctly handled).
+(On Caml modules, the behaviour is exactly the same as ocamldep).
 .TP
 .BI \-w
 Prints a warning if a Coq command
@@ -78,6 +81,10 @@ of each Coq file given as argument and complete (if needed)
 the list of Caml modules. The new command is printed on
 the standard output. No dependency is computed with this option.
 .TP 
+.BI \-slash
+Prints paths using a slash instead of the OS specific separator. This
+option is useful when developping under Cygwin.
+.TP
 .BI \-I \ directory
 The files .v .ml .mli of the directory
 .IR directory \&
@@ -87,7 +94,7 @@ but their own dependencies are not printed.
 .BI \-coqlib \ directory
 Indicates where is the Coq library. The default value has been
 determined at installation time, and therefore this option should not
-be used.
+be used under normal circumstances.
 
 
 .SH SEE ALSO
@@ -120,7 +127,7 @@ Consider the files (in the same directory):
 where
 .TP
 .BI \+ 
-D.ml contains the commands `#open "A"', `#open "B"' and `type t = C__t' ;
+D.ml contains the commands `open A', `open B' and `type t = C.t' ;
 .TP
 .BI \+
 Y.v contains the command `Require X' ;
@@ -135,7 +142,7 @@ example% coqdep -I . *.v
 .RS
 .sp .5
 .nf
-.B Z.vo: Z.v ./X.vo ./D.zo
+.B Z.vo: Z.v ./X.vo ./D.cmo
 .B Y.vo: Y.v ./X.vo
 .B X.vo: X.v
 .fi
@@ -150,7 +157,7 @@ example% coqdep -w -I . *.v
 .RS
 .sp .5
 .nf
-.B Z.vo: Z.v ./X.vo ./D.zo
+.B Z.vo: Z.v ./X.vo ./D.cmo
 .B Y.vo: Y.v ./X.vo
 .B X.vo: X.v
 ### Warning : In file Z.v, the ML modules declaration should be
@@ -167,10 +174,14 @@ example% coqdep -c -I . *.ml
 .RS
 .sp .5
 .nf
-.B D.zo: D.ml ./A.zo ./B.zo ./C.zo
-.B C.zo: C.ml
-.B B.zo: B.ml
-.B A.zo: A.ml
+.B D.cmo: D.ml ./A.cmo ./B.cmo ./C.cmo
+.B D.cmx: D.ml ./A.cmx ./B.cmx ./C.cmx
+.B C.cmo: C.ml
+.B C.cmx: C.ml
+.B B.cmo: B.ml
+.B B.cmx: B.ml
+.B A.cmo: A.ml
+.B A.cmx: A.ml
 .fi
 .RE
 .br
diff --git a/man/coqmktop.1 b/man/coqmktop.1
index 05e73d75..3640d439 100644
--- a/man/coqmktop.1
+++ b/man/coqmktop.1
@@ -28,6 +28,44 @@ directly or through coqc(1), using the -image option.
 .BI \-h
 Help. List the available options.
 
+.TP
+.BI \-srcdir \ dir
+Specify where the Coq source files are
+
+.TP
+.BI \-o \ exec\-file
+Specify the name of the resulting toplevel
+
+.TP
+.B \-opt
+Compile in native code
+
+.TP
+.B \-full
+Link high level tactics
+
+.TP
+.B \-top
+Build Coq on a ocaml toplevel (incompatible with
+.BR \-opt )
+
+.TP
+.B \-searchisos
+Build a toplevel for SearchIsos
+
+.TP
+.B \-ide
+Build a toplevel for the Coq IDE
+
+.TP
+.BI \-R \ dir
+Specify recursively directories for Ocaml
+
+.TP
+.B \-v8
+Link with V8 grammar
+
+
 .SH SEE ALSO
 
 .BR coqtop (1),
diff --git a/man/coqtop.1 b/man/coqtop.1
index d75b283f..a3b3aac4 100644
--- a/man/coqtop.1
+++ b/man/coqtop.1
@@ -1,4 +1,4 @@
-.TH COQ 1 "April 25, 2001"
+.TH COQ 1 "October 11, 2006"
 
 .SH NAME
 coqtop \- The Coq Proof Assistant toplevel system
@@ -24,9 +24,169 @@ For batch-oriented use of Coq, see
 .SH OPTIONS
 
 .TP
-.B \-h
+.B \-h, \-\-help
 Help. Will give you the complete list of options accepted by coqtop.
 
+.TP
+.BI \-I \ dir, \ \-\-include \ dir
+add directory 
+.I dir
+in the include path
+
+.TP
+.BI \-R \ dir\ coqdir          
+recursively map physical
+.I dir
+to logical
+.I coqdir
+
+.TP
+.BI \-top \ coqdir
+set the toplevel name to be
+.I coqdir
+instead of Top
+
+.TP
+.BI \-inputstate \ filename, \ \-is \ filename 
+read state from file
+.I filename.coq
+
+.TP
+.B \-nois
+start with an empty intial state
+
+.TP
+.BI \-outputstate filename
+write state in file
+.I filename.coq
+
+.TP
+.BI \-load\-ml\-object \ filename
+load ML object file
+.I filenname
+
+.TP
+.BI \-load\-ml\-source \ filename
+load ML file
+.I filename
+
+.TP
+.BI \-load\-vernac\-source \ filename, \ \-l \ filename
+load Coq file
+.I filename.v
+(Load filename.)
+
+.TP
+.BI \-load\-vernac\-source\-verbose \ filename, \ \-lv \ filename 
+load verbosely Coq file
+.I filename.v
+(Load Verbose filename.)
+
+.TP
+.BI \-load\-vernac\-object \ filename
+load Coq object file
+.I filename.vo
+
+.TP
+.BI \-require \ filename
+load Coq object file
+.I filename.vo
+and import it (Require Import filename.)
+
+.TP
+.BI \-compile \ filename
+compile Coq file
+.I filename.v 
+(implies 
+.B \-batch
+)
+
+.TP
+.BI \-compile\-verbose \ filename
+verbosely compile Coq file
+.I filename.v
+(implies 
+.B \-batch
+)
+
+.TP
+.B \-opt
+run the native\-code version of Coq
+
+.TP
+.B \-byte
+run the bytecode version of Coq
+
+.TP
+.B \-where
+print Coq's standard library location and exit
+
+.TP
+.B \-v
+print Coq version and exit
+
+.TP
+.B \-q
+skip loading of rcfile
+
+.TP
+.BI \-init\-file \ filename
+set the rcfile to
+.I filename
+
+.TP
+.BI \-user \ uid
+use the rcfile of user
+.I uid
+
+
+.TP
+.B \-batch
+batch mode (exits just after arguments parsing)
+
+.TP
+.B \-boot
+boot mode (implies
+.B \-q
+and
+.B \-batch
+)
+
+.TP
+.B \-emacs
+tells Coq it is executed under Emacs
+
+.TP
+.BI \-dump\-glob \ filename
+dump globalizations in file f (to be used by
+.B coqdoc(1)
+)
+
+.TP
+.BI \-with\-geoproof \ (yes|no)
+to (de)activate special functions for Geoproof within Coqide (default is
+.I yes
+)
+
+.TP
+.B \-impredicative\-set
+set sort Set impredicative
+
+.TP
+.B \-dont\-load\-proofs
+don't load opaque proofs in memory
+
+.TP
+.B \-xml
+export XML files either to the hierarchy rooted in
+the directory $COQ_XML_LIBRARY_ROOT (if set) or to
+stdout (if unset)
+
+.TP
+.B \-quality
+improve the legibility of the proof terms produced by
+some tactics
+
 .SH SEE ALSO
 
 .BR coqc (1),
diff --git a/parsing/argextend.ml4 b/parsing/argextend.ml4
index 638a8d65..12c0ea1d 100644
--- a/parsing/argextend.ml4
+++ b/parsing/argextend.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: argextend.ml4 8976 2006-06-23 10:03:54Z herbelin $ *)
+(* $Id: argextend.ml4 9265 2006-10-24 08:35:38Z herbelin $ *)
 
 open Genarg
 open Q_util
@@ -213,7 +213,7 @@ EXTEND
       [ e = argtype; LIDENT "list" -> List0ArgType e
       | e = argtype; LIDENT "option" -> OptArgType e ]
     | "0"
-      [ e = LIDENT -> fst (interp_entry_name loc e) 
+      [ e = LIDENT -> fst (interp_entry_name loc e "")
       | "("; e = argtype; ")" -> e ] ]
   ;
   argrule:
@@ -221,7 +221,9 @@ EXTEND
   ;
   genarg:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = interp_entry_name loc e in (g, Some (s,t))
+        let t, g = interp_entry_name loc e "" in (g, Some (s,t))
+      | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
+        let t, g = interp_entry_name loc e sep in (g, Some (s,t))
       | s = STRING ->
 	  if String.length s > 0 && Util.is_letter s.[0] then
 	    Pcoq.lexer.Token.using ("", s);
diff --git a/parsing/egrammar.ml b/parsing/egrammar.ml
index 9ec7c532..07a0a65f 100644
--- a/parsing/egrammar.ml
+++ b/parsing/egrammar.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: egrammar.ml 8926 2006-06-08 20:23:17Z herbelin $ *)
+(* $Id: egrammar.ml 9333 2006-11-02 13:59:14Z barras $ *)
 
 open Pp
 open Util
@@ -196,23 +196,24 @@ let find_index s t =
   if s <> t or n = None then raise Not_found;
   out_some n
 
-let rec interp_entry_name up_level u s =
+let rec interp_entry_name up_level s =
   let l = String.length s in
   if l > 8 & String.sub s 0 3 = "ne_" & String.sub s (l-5) 5 = "_list" then
-    let t, g = interp_entry_name up_level u (String.sub s 3 (l-8)) in
+    let t, g = interp_entry_name up_level (String.sub s 3 (l-8)) in
     List1ArgType t, Gramext.Slist1 g
   else if l > 5 & String.sub s (l-5) 5 = "_list" then
-    let t, g = interp_entry_name up_level u (String.sub s 0 (l-5)) in
+    let t, g = interp_entry_name up_level (String.sub s 0 (l-5)) in
     List0ArgType t, Gramext.Slist0 g
   else if l > 4 & String.sub s (l-4) 4 = "_opt" then
-    let t, g = interp_entry_name up_level u (String.sub s 0 (l-4)) in
+    let t, g = interp_entry_name up_level (String.sub s 0 (l-4)) in
     OptArgType t, Gramext.Sopt g
   else
+    let s = if s = "hyp" then "var" else s in
     try 
       let i = find_index "tactic" s in
       ExtraArgType s, 
-      if i=up_level then Gramext.Sself else
-      if i=up_level-1 then Gramext.Snext else
+      if up_level<>5 && i=up_level then Gramext.Sself else
+      if up_level<>5 && i=up_level-1 then Gramext.Snext else
       Gramext.Snterml(Pcoq.Gram.Entry.obj Tactic.tactic_expr,string_of_int i)
     with Not_found ->
     let e = 
@@ -228,16 +229,18 @@ let rec interp_entry_name up_level u s =
     let t = type_of_typed_entry e in
     t,Gramext.Snterm (Pcoq.Gram.Entry.obj o)
 
-let make_vprod_item n univ = function
+let make_vprod_item n = function
   | VTerm s -> (Gramext.Stoken (Lexer.terminal s), None)
   | VNonTerm (loc, nt, po) ->
-      let (etyp, e) = interp_entry_name n univ nt in
+      let (etyp, e) = interp_entry_name n nt in
       e, option_map (fun p -> (p,etyp)) po
 
 let get_tactic_entry n =
   if n = 0 then
     weaken_entry Tactic.simple_tactic, None
-  else if 1<=n && n<=5 then
+  else if n = 5 then
+    weaken_entry Tactic.binder_tactic, None
+  else if 1<=n && n<5 then
     weaken_entry Tactic.tactic_expr, Some (Gramext.Level (string_of_int n))
   else 
     error ("Invalid Tactic Notation level: "^(string_of_int n))
@@ -249,7 +252,7 @@ let head_is_ident = function VTerm _::_ -> true | _ -> false
 let add_tactic_entry (key,lev,prods,tac) =
   let univ = get_univ "tactic" in
   let entry, pos = get_tactic_entry lev in
-  let mkprod = make_vprod_item lev "tactic" in
+  let mkprod = make_vprod_item lev in
   let rules = 
     if lev = 0 then begin
       if not (head_is_ident prods) then
diff --git a/parsing/egrammar.mli b/parsing/egrammar.mli
index 31247044..5dda69ba 100644
--- a/parsing/egrammar.mli
+++ b/parsing/egrammar.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: egrammar.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
+(*i $Id: egrammar.mli 9147 2006-09-15 21:49:56Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -61,8 +61,7 @@ val get_extend_vernac_grammars :
 (*
 val reset_extend_grammars_v8 : unit -> unit
 *)
-val interp_entry_name : int -> string -> string -> 
-  entry_type * Token.t Gramext.g_symbol
+val interp_entry_name : int -> string -> entry_type * Token.t Gramext.g_symbol
 
 val recover_notation_grammar :
   notation -> (precedence * tolerability list) -> notation_grammar
diff --git a/parsing/g_constr.ml4 b/parsing/g_constr.ml4
index a1c0c9ae..130c6804 100644
--- a/parsing/g_constr.ml4
+++ b/parsing/g_constr.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_constr.ml4 9043 2006-07-12 10:06:40Z herbelin $ *)
+(* $Id: g_constr.ml4 9226 2006-10-09 16:11:01Z herbelin $ *)
 
 open Pcoq
 open Constr
@@ -155,8 +155,14 @@ GEXTEND Gram
     [ "200" RIGHTA
       [ c = binder_constr -> c ]
     | "100" RIGHTA
-      [ c1 = operconstr; ":"; c2 = binder_constr -> CCast(loc,c1, CastConv DEFAULTcast,c2)
-      | c1 = operconstr; ":"; c2 = SELF -> CCast(loc,c1,CastConv DEFAULTcast,c2) ]
+      [ c1 = operconstr; "<:"; c2 = binder_constr -> 
+                 CCast(loc,c1, CastConv VMcast,c2)
+      | c1 = operconstr; "<:"; c2 = SELF -> 
+                 CCast(loc,c1, CastConv VMcast,c2)
+      | c1 = operconstr; ":";c2 = binder_constr -> 
+                 CCast(loc,c1, CastConv DEFAULTcast,c2)
+      | c1 = operconstr; ":"; c2 = SELF -> 
+                 CCast(loc,c1, CastConv DEFAULTcast,c2) ]
     | "99" RIGHTA [ ]
     | "90" RIGHTA
       [ c1 = operconstr; "->"; c2 = binder_constr -> CArrow(loc,c1,c2)
@@ -287,7 +293,7 @@ GEXTEND Gram
         (match p with
           | CPatAtom (_, Some r) -> CPatCstr (loc, r, lp)
           | _ -> Util.user_err_loc 
-              (cases_pattern_loc p, "compound_pattern",
+              (cases_pattern_expr_loc p, "compound_pattern",
                Pp.str "Constructor expected"))
       | p = pattern; "as"; id = ident ->
 	  CPatAlias (loc, p, id) ]
diff --git a/parsing/g_decl_mode.ml4 b/parsing/g_decl_mode.ml4
new file mode 100644
index 00000000..8d7fd1f1
--- /dev/null
+++ b/parsing/g_decl_mode.ml4
@@ -0,0 +1,171 @@
+(************************************************************************)
+(*  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:$ *)
+(*i camlp4deps: "parsing/grammar.cma" i*)
+
+open Decl_expr
+open Names
+open Term
+open Genarg
+open Pcoq
+
+open Pcoq.Constr
+open Pcoq.Tactic
+open Pcoq.Vernac_
+
+let none_is_empty = function
+    None -> []
+  | Some l -> l
+
+GEXTEND Gram
+GLOBAL: proof_instr;
+  thesis :
+    [[ "thesis" -> Plain 
+     | "thesis"; "for"; i=ident -> (For i)
+     | "thesis"; "["; n=INT ;"]" -> (Sub (int_of_string n))
+     ]];
+  statement :
+    [[ i=ident ; ":" ; c=constr -> {st_label=Name i;st_it=c}
+     | i=ident -> {st_label=Anonymous;
+		   st_it=Topconstr.CRef (Libnames.Ident (loc, i))}
+     | c=constr -> {st_label=Anonymous;st_it=c}
+     ]];
+  constr_or_thesis :
+     [[ t=thesis -> Thesis t ] |
+      [ c=constr -> This c
+      ]];
+  statement_or_thesis : 
+    [
+      [ t=thesis -> {st_label=Anonymous;st_it=Thesis t} ] 
+    |
+      [ i=ident ; ":" ; cot=constr_or_thesis -> {st_label=Name i;st_it=cot}
+      | i=ident -> {st_label=Anonymous;
+		    st_it=This (Topconstr.CRef (Libnames.Ident (loc, i)))}
+      | c=constr -> {st_label=Anonymous;st_it=This c}
+      ]
+    ];
+  justification : 
+    [[ -> Automated [] 
+     | IDENT "by"; l=LIST1 constr SEP "," -> Automated l
+     | IDENT "by"; IDENT "tactic"; tac=tactic -> By_tactic tac ]]
+  ;
+  simple_cut_or_thesis :
+    [[ ls = statement_or_thesis;
+       j=justification -> {cut_stat=ls;cut_by=j} ]]
+  ;
+  simple_cut :
+    [[ ls = statement;
+       j=justification -> {cut_stat=ls;cut_by=j} ]]
+  ;
+  elim_type:
+    [[ IDENT "induction" -> ET_Induction
+     | IDENT "cases" -> ET_Case_analysis ]]
+  ;
+  block_type :
+    [[ IDENT "claim" -> B_claim
+     | IDENT "focus" -> B_focus
+     | IDENT "proof" -> B_proof
+     | et=elim_type -> B_elim et ]]
+  ;    
+  elim_obj:
+    [[ IDENT "on"; c=constr -> Real c
+     | IDENT "of"; c=simple_cut -> Virtual c ]]
+  ;    
+  elim_step:
+    [[ IDENT "consider" ; h=vars ; IDENT "from" ; c=constr -> Pconsider (c,h)
+     | IDENT "per"; et=elim_type; obj=elim_obj -> Pper (et,obj)]]
+  ;
+  rew_step :
+    [[ "~=" ;         c=simple_cut -> (Rhs,c)       
+     | "=~" ;         c=simple_cut -> (Lhs,c)]]
+  ;
+  cut_step:
+    [[ "then"; tt=elim_step -> Pthen tt
+     | "then"; c=simple_cut_or_thesis -> Pthen (Pcut c)
+     | IDENT "thus"; tt=rew_step -> Pthus (let s,c=tt in Prew (s,c)) 
+     | IDENT "thus"; c=simple_cut_or_thesis -> Pthus (Pcut c)
+     | IDENT "hence"; c=simple_cut_or_thesis -> Phence (Pcut c)
+     | tt=elim_step -> tt
+     | tt=rew_step -> let s,c=tt in Prew (s,c); 
+     | IDENT "have"; c=simple_cut_or_thesis -> Pcut c;
+     | IDENT "claim"; c=statement -> Pclaim c;
+     | IDENT "focus"; IDENT "on"; c=statement -> Pfocus c;    
+     | "end"; bt = block_type -> Pend bt;
+     | IDENT "escape" -> Pescape ]]
+  ;
+  (* examiner s'il est possible de faire R _ et _ R pour R une relation qcq*)
+  loc_id: 
+    [[ id=ident -> fun x -> (loc,(id,x)) ]];
+  hyp:
+    [[ id=loc_id -> id None ;
+     | id=loc_id ; ":" ; c=constr -> id (Some c)]]
+  ;
+  vars:
+    [[ name=hyp -> [Hvar name]
+     | name=hyp; ","; v=vars -> (Hvar name) :: v
+     | name=hyp; IDENT "be"; 
+       IDENT "such"; IDENT "that"; h=hyps -> (Hvar name)::h
+     | name=hyp; 
+       IDENT "such"; IDENT "that"; h=hyps -> (Hvar name)::h
+     ]]
+  ;
+  hyps:  
+    [[ IDENT "we"; IDENT "have"; v=vars -> v
+     | st=statement; IDENT "and"; h=hyps  -> Hprop st::h
+     | st=statement; IDENT "and"; v=vars  -> Hprop st::v
+     | st=statement -> [Hprop st]
+     ]]
+  ;
+  vars_or_thesis:
+    [[name=hyp -> [Hvar name] 
+     |name=hyp; ","; v=vars_or_thesis -> (Hvar name) :: v
+     |name=hyp; OPT[IDENT "be"]; 
+      IDENT "such"; IDENT "that"; h=hyps_or_thesis -> (Hvar name)::h
+     ]]
+  ;
+  hyps_or_thesis:  
+    [[ IDENT "we"; IDENT "have"; v=vars_or_thesis -> v
+     | st=statement_or_thesis; IDENT "and"; h=hyps_or_thesis  -> Hprop st::h
+     | st=statement_or_thesis; IDENT "and"; v=vars_or_thesis  -> Hprop st::v
+     | st=statement_or_thesis -> [Hprop st];
+     ]]
+  ;
+  intro_step:
+    [[ IDENT "suppose" ; h=hyps -> Psuppose h
+     | IDENT "suppose" ; IDENT "it"; IDENT "is" ; c=pattern LEVEL "0" ;
+       po=OPT[ IDENT "with"; p=LIST1 hyp -> p ] ; 
+       ho=OPT[ IDENT "and" ; h=hyps_or_thesis -> h ] -> 
+	 Pcase (none_is_empty po,c,none_is_empty ho)
+     | "let" ; v=vars -> Plet v	 
+     | IDENT "take"; witnesses = LIST1 constr SEP ","  -> Ptake witnesses
+     | IDENT "assume"; h=hyps -> Passume h
+     | IDENT "given"; h=vars -> Pgiven h
+     | IDENT "define"; id=ident; args=LIST0 hyp; 
+       "as"; body=constr -> Pdefine(id,args,body)
+     | IDENT "reconsider"; id=ident; "as" ; typ=constr -> Pcast (This id,typ)
+     | IDENT "reconsider"; t=thesis; "as" ; typ=constr -> Pcast (Thesis t ,typ)
+     ]]
+  ;
+  emphasis : 
+    [[ -> 0
+     | "*" -> 1
+     | "**" -> 2
+     | "***" -> 3
+     ]]
+  ;
+  bare_proof_instr:
+    [[ c = cut_step -> c ;
+     | i = intro_step -> i ]]
+  ;
+  proof_instr :
+    [[ e=emphasis;i=bare_proof_instr -> {emph=e;instr=i}]]
+  ;
+END;;
+
+ 
diff --git a/parsing/g_ltac.ml4 b/parsing/g_ltac.ml4
index c01c23b6..27ff8140 100644
--- a/parsing/g_ltac.ml4
+++ b/parsing/g_ltac.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_ltac.ml4 9037 2006-07-11 12:43:50Z herbelin $ *)
+(* $Id: g_ltac.ml4 9333 2006-11-02 13:59:14Z barras $ *)
 
 open Pp
 open Util
@@ -43,38 +43,34 @@ let tacarg_of_expr = function
 (* Tactics grammar rules *)
 
 GEXTEND Gram
-  GLOBAL: tactic Vernac_.command tactic_expr tactic_arg constr_may_eval;
+  GLOBAL: tactic Vernac_.command tactic_expr binder_tactic tactic_arg
+          constr_may_eval;
 
   tactic_expr:
-    [ "5" LEFTA
-      [ ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0, ta1)
+    [ "5" RIGHTA
+      [ te = binder_tactic -> te ]
+    | "4" LEFTA
+      [ ta0 = tactic_expr; ";"; ta1 = binder_tactic -> TacThen (ta0, ta1)
+      | ta0 = tactic_expr; ";"; ta1 = tactic_expr -> TacThen (ta0, ta1)
       | ta = tactic_expr; ";"; 
 	"["; lta = LIST0 OPT tactic_expr SEP "|"; "]" ->
 	  let lta = List.map (function None -> TacId [] | Some t -> t) lta in 
 	  TacThens (ta, lta) ]
-    | "4"
-      [ ]
     | "3" RIGHTA
       [ IDENT "try"; ta = tactic_expr -> TacTry ta
       | IDENT "do"; n = int_or_var; ta = tactic_expr -> TacDo (n,ta)
       | IDENT "repeat"; ta = tactic_expr -> TacRepeat ta
       | IDENT "progress"; ta = tactic_expr -> TacProgress ta
-      | IDENT "info"; tc = tactic_expr -> TacInfo tc
 (*To do: put Abstract in Refiner*)
       | IDENT "abstract"; tc = NEXT -> TacAbstract (tc,None)
       | IDENT "abstract"; tc = NEXT; "using";  s = ident ->
           TacAbstract (tc,Some s) ]
 (*End of To do*)
     | "2" RIGHTA
-      [ ta0 = tactic_expr; "||"; ta1 = tactic_expr -> TacOrelse (ta0,ta1) ]
+      [ ta0 = tactic_expr; "||"; ta1 = binder_tactic -> TacOrelse (ta0,ta1)
+      | ta0 = tactic_expr; "||"; ta1 = tactic_expr -> TacOrelse (ta0,ta1) ]
     | "1" RIGHTA
-      [ "fun"; it = LIST1 input_fun ; "=>"; body = tactic_expr ->
-          TacFun (it,body)
-      | "let"; IDENT "rec"; rcl = LIST1 rec_clause SEP "with"; "in";
-          body = tactic_expr -> TacLetRecIn (rcl,body)
-      | "let"; llc = LIST1 let_clause SEP "with"; "in";
-          u = tactic_expr -> TacLetIn (make_letin_clause loc llc,u)
-      | b = match_key; IDENT "goal"; "with"; mrl = match_context_list; "end" ->
+      [ b = match_key; IDENT "goal"; "with"; mrl = match_context_list; "end" ->
           TacMatchContext (b,false,mrl)
       | b = match_key; IDENT "reverse"; IDENT "goal"; "with";
         mrl = match_context_list; "end" ->
@@ -104,6 +100,17 @@ GEXTEND Gram
       [ "("; a = tactic_expr; ")" -> a
       | a = tactic_atom -> TacArg a ] ]
   ;
+  (* binder_tactic: level 5 of tactic_expr *)
+  binder_tactic:
+    [ RIGHTA
+      [ "fun"; it = LIST1 input_fun ; "=>"; body = tactic_expr LEVEL "5" ->
+          TacFun (it,body)
+      | "let"; IDENT "rec"; rcl = LIST1 rec_clause SEP "with"; "in";
+          body = tactic_expr LEVEL "5" -> TacLetRecIn (rcl,body)
+      | "let"; llc = LIST1 let_clause SEP "with"; "in";
+          u = tactic_expr LEVEL "5" -> TacLetIn (make_letin_clause loc llc,u)
+      | IDENT "info"; tc = tactic_expr LEVEL "5" -> TacInfo tc ] ]
+  ;
   (* Tactic arguments *)
   tactic_arg:
     [ [ IDENT "ltac"; ":"; a = tactic_expr LEVEL "0" -> tacarg_of_expr a
@@ -115,7 +122,10 @@ GEXTEND Gram
   ;
   may_eval_arg:
     [ [ c = constr_eval -> ConstrMayEval c
-      | IDENT "fresh"; s = OPT STRING -> TacFreshId s ] ]
+      | IDENT "fresh"; l = LIST0 fresh_id -> TacFreshId l ] ]
+  ;
+  fresh_id:
+    [ [ s = STRING -> ArgArg s | id = ident -> ArgVar (loc,id) ] ]
   ;
   constr_eval:
     [ [ IDENT "eval"; rtc = red_expr; "in"; c = Constr.constr ->
diff --git a/parsing/g_proofs.ml4 b/parsing/g_proofs.ml4
index 94205fa8..2f515a81 100644
--- a/parsing/g_proofs.ml4
+++ b/parsing/g_proofs.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_proofs.ml4 8875 2006-05-29 19:59:11Z msozeau $ *)
+(* $Id: g_proofs.ml4 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Pcoq
 open Pp
@@ -75,6 +75,7 @@ GEXTEND Gram
       | IDENT "Show"; IDENT "Intro" -> VernacShow (ShowIntros false)
       | IDENT "Show"; IDENT "Intros" -> VernacShow (ShowIntros true)
       | IDENT "Show"; IDENT "Match"; id = identref -> VernacShow (ShowMatch id)
+      | IDENT "Show"; IDENT "Thesis" -> VernacShow ShowThesis
       | IDENT "Explain"; IDENT "Proof"; l = LIST0 integer ->
 	  VernacShow (ExplainProof l)
       | IDENT "Explain"; IDENT "Proof"; IDENT "Tree"; l = LIST0 integer -> 
diff --git a/parsing/g_vernac.ml4 b/parsing/g_vernac.ml4
index a72ced97..9bbdc1d4 100644
--- a/parsing/g_vernac.ml4
+++ b/parsing/g_vernac.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_vernac.ml4 9017 2006-07-05 17:27:34Z herbelin $ *)
+(* $Id: g_vernac.ml4 9306 2006-10-28 18:28:19Z herbelin $ *)
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
 open Pp
@@ -15,6 +15,7 @@ open Names
 open Topconstr
 open Vernacexpr
 open Pcoq
+open Decl_mode
 open Tactic
 open Decl_kinds
 open Genarg
@@ -34,13 +35,28 @@ let _ = List.iter (fun s -> Lexer.add_token ("",s)) vernac_kw
 (* compilation on PowerPC and Sun architectures *)
 
 let check_command = Gram.Entry.create "vernac:check_command"
+
+let tactic_mode = Gram.Entry.create "vernac:tactic_command"
+let proof_mode = Gram.Entry.create "vernac:proof_command"
+let noedit_mode = Gram.Entry.create "vernac:noedit_command"
+
 let class_rawexpr = Gram.Entry.create "vernac:class_rawexpr"
 let thm_token = Gram.Entry.create "vernac:thm_token"
 let def_body = Gram.Entry.create "vernac:def_body"
 
+let get_command_entry () =
+  match Decl_mode.get_current_mode () with
+      Mode_proof -> proof_mode
+    | Mode_tactic -> tactic_mode
+    | Mode_none -> noedit_mode
+
+let default_command_entry =
+  Gram.Entry.of_parser "command_entry" 
+    (fun strm -> Gram.Entry.parse_token (get_command_entry ()) strm)
+
 let no_hook _ _ = ()
 GEXTEND Gram
-  GLOBAL: vernac gallina_ext;
+  GLOBAL: vernac gallina_ext tactic_mode proof_mode noedit_mode;
   vernac:
     (* Better to parse "." here: in case of failure (e.g. in coerce_to_var), *)
     (* "." is still in the stream and discard_to_dot works correctly         *)
@@ -54,9 +70,15 @@ GEXTEND Gram
   vernac: FIRST
     [ [ IDENT "Time"; v = vernac  -> VernacTime v ] ]
   ;
-  vernac: LAST
-    [ [ gln = OPT[n=natural; ":" -> n];
-        tac = subgoal_command -> tac gln ] ]
+  vernac: LAST  
+    [ [ prfcom = default_command_entry -> prfcom ] ]
+  ;
+  noedit_mode:
+    [ [ c = subgoal_command -> c None] ]
+  ;
+  tactic_mode:
+  [ [ gln = OPT[n=natural; ":" -> n];
+      tac = subgoal_command -> tac gln ] ]
   ;
   subgoal_command:
     [ [ c = check_command; "." -> c
@@ -66,6 +88,12 @@ GEXTEND Gram
             let g = match g with Some gl -> gl | _ -> 1 in
             VernacSolve(g,tac,use_dft_tac)) ] ]
   ;
+  proof_mode:
+    [ [ instr = proof_instr; "." -> VernacProofInstr instr ] ] 
+  ;
+  proof_mode: LAST
+    [ [ c=subgoal_command -> c (Some 1) ] ]
+  ; 
   located_vernac:
     [ [ v = vernac -> loc, v ] ]
   ;
@@ -191,9 +219,9 @@ GEXTEND Gram
     ;
   (* Inductives and records *)
   inductive_definition:
-    [ [ id = identref; indpar = LIST0 binder_let; ":"; c = lconstr; 
+    [ [ id = identref; indpar = LIST0 binder_let; ":"; c = lconstr;
         ":="; lc = constructor_list; ntn = decl_notation ->
-	  (id,ntn,indpar,c,lc) ] ]
+	  ((id,indpar,c,lc),ntn) ] ]
   ;
   constructor_list:
     [ [ "|"; l = LIST1 constructor SEP "|" -> l
@@ -212,7 +240,7 @@ GEXTEND Gram
   (* (co)-fixpoints *)
   rec_definition:
     [ [ id = ident; bl = LIST1 binder_let;
-        annot = rec_annotation; type_ = type_cstr; 
+        annot = rec_annotation; ty = type_cstr; 
 	":="; def = lconstr; ntn = decl_notation ->
           let names = List.map snd (names_of_local_assums bl) in
           let ni =
@@ -227,12 +255,12 @@ GEXTEND Gram
 		     otherwise, we search the recursive index later *)
 		  if List.length names = 1 then Some 0 else None	  
 	  in 
-	  ((id, (ni, snd annot), bl, type_, def),ntn) ] ]
+	  ((id,(ni,snd annot),bl,ty,def),ntn) ] ]
   ;
   corec_definition:
-    [ [ id = ident; bl = LIST0 binder_let; c = type_cstr; ":=";
-        def = lconstr ->
-          (id,bl,c ,def) ] ]
+    [ [ id = ident; bl = LIST0 binder_let; ty = type_cstr; ":=";
+        def = lconstr; ntn = decl_notation ->
+          ((id,bl,ty,def),ntn) ] ]
   ;
   rec_annotation:
     [ [ "{"; IDENT "struct"; id=IDENT; "}" -> (Some (id_of_string id), CStructRec)
@@ -460,9 +488,8 @@ GEXTEND Gram
       | IDENT "Declare"; IDENT "ML"; IDENT "Module"; l = LIST1 ne_string ->
 	  VernacDeclareMLModule l
 
-      (* Dump of the universe graph - to file or to stdout *) 
       | IDENT "Dump"; IDENT "Universes"; fopt = OPT ne_string ->
-	  VernacPrint (PrintUniverses fopt)
+	  error "This command is deprecated, use Print Universes"
 
       | IDENT "Locate"; l = locatable -> VernacLocate l
 
@@ -556,7 +583,9 @@ GEXTEND Gram
       | IDENT "Remove"; table = IDENT; field = IDENT; v= LIST1 option_ref_value
         -> VernacRemoveOption (SecondaryTable (table,field), v)
       | IDENT "Remove"; table = IDENT; v = LIST1 option_ref_value ->
-	  VernacRemoveOption (PrimaryTable table, v) ] ]
+	  VernacRemoveOption (PrimaryTable table, v) 
+      | IDENT "proof" -> VernacDeclProof
+      | "return" -> VernacReturn ]]
   ;
   check_command: (* TODO: rapprocher Eval et Check *)
     [ [ IDENT "Eval"; r = Tactic.red_expr; "in"; c = lconstr ->
@@ -596,7 +625,8 @@ GEXTEND Gram
       | IDENT "Scopes" -> PrintScopes
       | IDENT "Scope"; s = IDENT -> PrintScope s
       | IDENT "Visibility"; s = OPT IDENT -> PrintVisibility s
-      | IDENT "Implicit"; qid = global -> PrintImplicit qid ] ]
+      | IDENT "Implicit"; qid = global -> PrintImplicit qid
+      | IDENT "Universes"; fopt = OPT ne_string -> PrintUniverses fopt ] ]
   ;
   class_rawexpr:
     [ [ IDENT "Funclass" -> FunClass
diff --git a/parsing/g_xml.ml4 b/parsing/g_xml.ml4
index a89fffa0..c13532cc 100644
--- a/parsing/g_xml.ml4
+++ b/parsing/g_xml.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: g_xml.ml4 9016 2006-07-05 17:19:39Z herbelin $ *)
+(* $Id: g_xml.ml4 9200 2006-10-03 14:11:08Z herbelin $ *)
 
 open Pp
 open Util
@@ -146,9 +146,11 @@ let rec interp_xml_constr = function
       let ctx = List.map interp_xml_decl decls in
       List.fold_right (fun (na,t) b -> RProd (loc, na, t, b))
 	ctx (interp_xml_target body)
-  | XmlTag (loc,"LETIN",al,[x1;x2]) ->
-      let na,t = interp_xml_def x1 in
-      RLetIn (loc, na, t, interp_xml_target x2) 
+  | XmlTag (loc,"LETIN",al,(_::_ as xl)) ->
+      let body,defs = list_sep_last xl in
+      let ctx = List.map interp_xml_def defs in
+      List.fold_right (fun (na,t) b -> RLetIn (loc, na, t, b))
+        ctx (interp_xml_target body)
   | XmlTag (loc,"APPLY",_,x::xl) ->
       RApp (loc, interp_xml_constr x, List.map interp_xml_constr xl)
   | XmlTag (loc,"instantiate",_,
diff --git a/parsing/pcoq.ml4 b/parsing/pcoq.ml4
index 56e434fb..f7adfdd8 100644
--- a/parsing/pcoq.ml4
+++ b/parsing/pcoq.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.ml4 9043 2006-07-12 10:06:40Z herbelin $ i*)
+(*i $Id: pcoq.ml4 9333 2006-11-02 13:59:14Z barras $ i*)
 
 open Pp
 open Util
@@ -430,6 +430,7 @@ module Tactic =
     (* Main entries for ltac *)
     let tactic_arg = Gram.Entry.create "tactic:tactic_arg"
     let tactic_expr = Gram.Entry.create "tactic:tactic_expr"
+    let binder_tactic = Gram.Entry.create "tactic:binder_tactic"
 
     let tactic = make_gen_entry utactic (rawwit_tactic tactic_main_level) "tactic"
 
@@ -451,6 +452,12 @@ module Vernac_ =
     let syntax = gec_vernac "syntax_command"
     let vernac = gec_vernac "Vernac_.vernac"
 
+    (* MMode *)
+
+    let proof_instr = Gram.Entry.create "proofmode:instr"
+
+    (* /MMode *)
+
     let vernac_eoi = eoi_entry vernac
   end
 
diff --git a/parsing/pcoq.mli b/parsing/pcoq.mli
index 3998d71b..1fe8c122 100644
--- a/parsing/pcoq.mli
+++ b/parsing/pcoq.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pcoq.mli 8926 2006-06-08 20:23:17Z herbelin $ i*)
+(*i $Id: pcoq.mli 9333 2006-11-02 13:59:14Z barras $ i*)
 
 open Util
 open Names
@@ -184,6 +184,7 @@ module Tactic :
     val simple_intropattern : Genarg.intro_pattern_expr Gram.Entry.e
     val tactic_arg : raw_tactic_arg Gram.Entry.e
     val tactic_expr : raw_tactic_expr Gram.Entry.e
+    val binder_tactic : raw_tactic_expr Gram.Entry.e
     val tactic : raw_tactic_expr Gram.Entry.e
     val tactic_eoi : raw_tactic_expr Gram.Entry.e
   end
@@ -196,6 +197,13 @@ module Vernac_ :
     val command : vernac_expr Gram.Entry.e
     val syntax : vernac_expr Gram.Entry.e
     val vernac : vernac_expr Gram.Entry.e
+    
+  (* MMode *)
+
+    val proof_instr : Decl_expr.raw_proof_instr Gram.Entry.e
+
+  (*/ MMode *)
+
     val vernac_eoi : vernac_expr Gram.Entry.e
   end
 
diff --git a/parsing/ppconstr.ml b/parsing/ppconstr.ml
index a1ca386e..349d5df8 100644
--- a/parsing/ppconstr.ml
+++ b/parsing/ppconstr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppconstr.ml 8997 2006-07-03 16:40:20Z herbelin $ *)      
+(* $Id: ppconstr.ml 9304 2006-10-28 09:58:16Z herbelin $ *)      
 
 (*i*)
 open Util
@@ -95,8 +95,6 @@ let pr_patnotation = pr_notation_gen decode_patlist_value
 let pr_delimiters key strm =
   strm ++ str ("%"^key)
 
-let surround p = hov 1 (str"(" ++ p ++ str")")
-
 let pr_located pr ((b,e),x) =
   if Options.do_translate() && (b,e)<>dummy_loc then
     let (b,e) = unloc (b,e) in
@@ -115,12 +113,14 @@ let pr_optc pr = function
   | None -> mt ()
   | Some x -> pr_sep_com spc pr x
 
+let pr_in_comment pr x = str "(* " ++ pr x ++ str " *)"
+
 let pr_universe = Univ.pr_uni 
 
 let pr_rawsort = function
   | RProp Term.Null -> str "Prop"
   | RProp Term.Pos -> str "Set"
-  | RType u -> str "Type" ++ pr_opt pr_universe u
+  | RType u -> hov 0 (str "Type" ++ pr_opt (pr_in_comment pr_universe) u)
 
 let pr_id = pr_id
 let pr_name = pr_name
@@ -180,7 +180,7 @@ let rec pr_patt sep inh p =
   | CPatPrim (_,p) -> pr_prim_token p, latom
   | CPatDelimiters (_,k,p) -> pr_delimiters k (pr_patt mt lsimple p), 1
   in
-  let loc = cases_pattern_loc p in
+  let loc = cases_pattern_expr_loc p in
   pr_with_comments loc
     (sep() ++ if prec_less prec inh then strm else surround strm)
 
@@ -566,8 +566,9 @@ let rec pr sep inherited a =
   | CEvar (_,n) -> str (Evd.string_of_existential n), latom
   | CPatVar (_,(_,p)) -> str "?" ++ pr_patvar p, latom
   | CSort (_,s) -> pr_rawsort s, latom
-  | CCast (_,a,_,b) ->
-      hv 0 (pr mt (lcast,L) a ++ cut () ++ str ":" ++ pr mt (-lcast,E) b),
+  | CCast (_,a,k,b) ->
+      let s = match k with CastConv  VMcast -> "<:" | _ -> ":" in
+      hv 0 (pr mt (lcast,L) a ++ cut () ++ str s ++ pr mt (-lcast,E) b),
       lcast
   | CNotation (_,"( _ )",[t]) ->
       pr (fun()->str"(") (max_int,L) t ++ str")", latom
diff --git a/parsing/ppdecl_proof.ml b/parsing/ppdecl_proof.ml
new file mode 100644
index 00000000..7e57885c
--- /dev/null
+++ b/parsing/ppdecl_proof.ml
@@ -0,0 +1,180 @@
+(************************************************************************)
+(*  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:$ *)
+
+open Util 
+open Pp
+open Decl_expr
+open Names 
+open Nameops
+
+let pr_constr = Printer.pr_constr_env
+let pr_tac = Pptactic.pr_glob_tactic
+let pr_pat mpat = Ppconstr.pr_cases_pattern_expr mpat.pat_expr 
+
+let pr_label = function
+    Anonymous -> mt ()
+  | Name id -> pr_id id ++ spc () ++ str ":" ++ spc () 
+
+let pr_justification env = function
+    Automated [] -> mt ()
+  | Automated (_::_ as l) -> 
+      spc () ++ str "by" ++ spc () ++  
+	prlist_with_sep (fun () -> str ",") (pr_constr env) l
+  | By_tactic tac -> 
+      spc () ++ str "by" ++ spc () ++ str "tactic" ++  pr_tac env tac
+
+let pr_statement pr_it env st = 
+  pr_label st.st_label ++ pr_it env st.st_it
+
+let pr_or_thesis pr_this env = function
+    Thesis Plain -> str "thesis"
+  | Thesis (For id) -> 
+      str "thesis" ++ spc() ++ str "for" ++ spc () ++ pr_id id 
+  | Thesis (Sub n) -> str "thesis[" ++ int n ++ str "]"
+  | This c -> pr_this env c
+
+let pr_cut pr_it env c = 
+  hov 1 (pr_statement pr_it env c.cut_stat) ++ 
+    pr_justification env c.cut_by
+
+let type_or_thesis = function
+    Thesis _ -> Term.mkProp
+  | This c -> c
+
+let _I x = x
+
+let rec print_hyps pconstr gtyp env _and _be hyps = 
+  let _andp = if _and then str "and" ++spc () else mt () in
+    match hyps with 
+	(Hvar _ ::_) as rest -> 
+	  spc () ++ _andp ++ str "we have" ++ 
+	    print_vars pconstr gtyp env false _be rest
+      | Hprop st :: rest -> 
+	  begin
+	    let nenv =
+	      match st.st_label with
+		  Anonymous -> env
+		| Name id -> Environ.push_named (id,None,gtyp st.st_it) env in
+	      spc() ++ _andp ++ pr_statement pconstr env st ++ 
+		print_hyps pconstr gtyp nenv true _be rest
+	  end
+      | [] -> mt ()
+
+and print_vars pconstr gtyp env _and _be vars =
+  match vars with
+    Hvar st :: rest -> 
+      begin
+	let nenv = 
+	  match st.st_label with
+	      Anonymous -> anomaly "anonymous variable"
+	    | Name id -> Environ.push_named (id,None,st.st_it) env in
+	let _andp = if _and then pr_coma () else mt () in
+		spc() ++ _andp ++
+		   pr_statement pr_constr env st ++
+		  print_vars pconstr gtyp nenv true _be rest
+      end
+   | (Hprop _ :: _) as rest ->
+      let _st =  if _be then 
+	str "be such that" 
+      else 
+	str "such that" in
+	spc() ++ _st ++  print_hyps pconstr gtyp env false _be rest
+  | [] -> mt ()
+
+let pr_elim_type = function
+    ET_Case_analysis -> str "cases"
+  | ET_Induction -> str "induction"
+
+let pr_casee env =function
+    Real c -> str "on" ++ spc () ++ pr_constr env c
+  | Virtual cut -> str "of" ++ spc () ++ pr_cut pr_constr env cut
+
+let pr_side = function
+    Lhs -> str "=~"
+  | Rhs -> str "~="
+
+let rec pr_bare_proof_instr _then _thus env = function
+  | Pescape -> str "escape"
+  | Pthen i -> pr_bare_proof_instr true _thus env i 
+  | Pthus i -> pr_bare_proof_instr _then true env i 
+  | Phence i -> pr_bare_proof_instr true true env i
+  | Pcut c -> 
+      begin
+	match _then,_thus with
+	    false,false -> str "have" ++ spc () ++ 
+	      pr_cut (pr_or_thesis pr_constr) env c
+	  | false,true  -> str "thus" ++ spc () ++ 
+	      pr_cut (pr_or_thesis pr_constr) env c
+	  | true,false  -> str "then" ++ spc () ++
+	      pr_cut (pr_or_thesis pr_constr) env c
+	  | true,true   -> str "hence" ++ spc () ++ 
+	      pr_cut (pr_or_thesis pr_constr) env c
+      end
+  | Prew (sid,c) ->
+      (if _thus then str "thus" else str "    ") ++ spc () ++
+	pr_side sid ++ spc () ++ pr_cut pr_constr env c
+  | Passume hyps -> 
+      str "assume" ++ print_hyps pr_constr _I env false false hyps
+  | Plet hyps -> 
+      str "let" ++ print_vars pr_constr _I env false true hyps
+  | Pclaim st ->
+      str "claim" ++ spc () ++ pr_statement pr_constr env st
+  | Pfocus st ->
+      str "focus on" ++ spc () ++ pr_statement pr_constr env st
+  | Pconsider (id,hyps) ->
+      str "consider" ++ print_vars pr_constr _I env false false hyps 
+      ++ spc () ++ str "from " ++ pr_constr env id 
+  | Pgiven hyps ->
+      str "given" ++ print_vars pr_constr _I env false false hyps
+  | Ptake witl -> 
+      str "take" ++ spc () ++ 
+	prlist_with_sep pr_coma (pr_constr env) witl
+  | Pdefine (id,args,body) ->
+      str "define" ++ spc () ++ pr_id id ++ spc () ++ 
+	prlist_with_sep spc 
+	(fun st -> str "(" ++ 
+	   pr_statement pr_constr env st ++ str ")") args ++ spc () ++ 
+	str "as" ++ (pr_constr env body) 
+  | Pcast (id,typ) -> 
+      str "reconsider" ++ spc () ++ 
+	pr_or_thesis (fun _ -> pr_id) env id ++ spc () ++ 
+	str "as" ++ (pr_constr env typ)  
+  | Psuppose hyps -> 
+      str "suppose" ++ 
+	print_hyps pr_constr _I env false false hyps
+  | Pcase (params,pat,hyps) ->
+      str "suppose it is" ++ spc () ++ pr_pat pat ++
+	(if params = [] then mt () else 
+	   (spc () ++ str "with" ++ spc () ++ 
+	      prlist_with_sep spc 
+	      (fun st -> str "(" ++ 
+		 pr_statement pr_constr env st ++ str ")") params ++ spc ())) 
+      ++
+	(if hyps = [] then mt () else 
+	   (spc () ++ str "and" ++ 
+	      print_hyps (pr_or_thesis pr_constr) type_or_thesis
+	      env false false hyps))
+  | Pper (et,c) -> 
+      str "per" ++ spc () ++ pr_elim_type et ++ spc () ++
+      pr_casee env c
+  | Pend (B_elim et) -> str "end" ++ spc () ++ pr_elim_type et
+  | _ -> anomaly "unprintable instruction"
+
+let pr_emph = function
+    0 -> str "    "
+  | 1 -> str "*   "
+  | 2 -> str "**  "
+  | 3 -> str "*** "
+  | _ -> anomaly "unknown emphasis"
+
+let pr_proof_instr env instr = 
+  pr_emph instr.emph ++ spc () ++ 
+    pr_bare_proof_instr false false env instr.instr
+
diff --git a/parsing/ppdecl_proof.mli b/parsing/ppdecl_proof.mli
new file mode 100644
index 00000000..b0f0e110
--- /dev/null
+++ b/parsing/ppdecl_proof.mli
@@ -0,0 +1,2 @@
+
+val pr_proof_instr : Environ.env -> Decl_expr.proof_instr -> Pp.std_ppcmds  
diff --git a/parsing/pptactic.ml b/parsing/pptactic.ml
index 2113ae89..c7e1db60 100644
--- a/parsing/pptactic.ml
+++ b/parsing/pptactic.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pptactic.ml 8926 2006-06-08 20:23:17Z herbelin $ *)
+(* $Id: pptactic.ml 9319 2006-10-30 12:41:21Z barras $ *)
 
 open Pp
 open Names
@@ -127,6 +127,8 @@ let rec pr_message_token prid = function
   | MsgInt n -> int n
   | MsgIdent id -> prid id
 
+let pr_fresh_ids = prlist (fun s -> spc() ++ pr_or_var qs s)
+
 let rec pr_raw_generic prc prlc prtac prref (x:(Genarg.rlevel, Tacexpr.raw_tactic_expr) Genarg.generic_argument) =
   match Genarg.genarg_tag x with
   | BoolArgType -> pr_arg str (if out_gen rawwit_bool x then "true" else "false")
@@ -261,8 +263,6 @@ let rec pr_tacarg_using_rule pr_gen = function
   | [], [] -> mt ()
   | _ -> failwith "Inconsistent arguments of extended tactic"
 
-let surround p = hov 1 (str"(" ++ p ++ str")")
-
 let pr_extend_gen prgen lev s l =
   try 
     let tags = List.map genarg_tag l in
@@ -521,11 +521,11 @@ let rec pr_tacarg_using_rule pr_gen = function
 let pr_then () = str ";"
 
 let ltop = (5,E)
-let lseq = 5
+let lseq = 4
 let ltactical = 3
 let lorelse = 2
-let llet = 1
-let lfun = 1
+let llet = 5
+let lfun = 5
 let lcomplete = 1
 let labstract = 3
 let lmatch = 1
@@ -533,6 +533,7 @@ let latom = 0
 let lcall = 1
 let leval = 1
 let ltatom = 1
+let linfo = 5
 
 let level_of (n,p) = match p with E -> n | L -> n-1 | Prec n -> n | Any -> lseq
 
@@ -875,7 +876,7 @@ let rec pr_tac inherited tac =
       ltactical
   | TacInfo t ->
       hov 1 (str "info" ++ spc () ++ pr_tac (ltactical,E) t),
-      ltactical
+      linfo
   | TacOrelse (t1,t2) ->
       hov 1 (pr_tac (lorelse,L) t1 ++ str " ||" ++ brk (1,1) ++
              pr_tac (lorelse,E) t2),
@@ -902,7 +903,7 @@ let rec pr_tac inherited tac =
       str "constr:" ++ pr_constr c, latom
   | TacArg(ConstrMayEval c) ->
       pr_may_eval pr_constr pr_lconstr pr_cst c, leval
-  | TacArg(TacFreshId sopt) -> str "fresh" ++ pr_opt qs sopt, latom
+  | TacArg(TacFreshId l) -> str "fresh" ++ pr_fresh_ids l, latom
   | TacArg(Integer n) -> int n, latom
   | TacArg(TacCall(loc,f,l)) ->
       pr_with_comments loc
@@ -923,7 +924,7 @@ and pr_tacarg = function
   | Reference r -> pr_ref r
   | ConstrMayEval c ->
       pr_may_eval pr_constr pr_lconstr pr_cst c
-  | TacFreshId sopt -> str "fresh" ++ pr_opt qs sopt
+  | TacFreshId l -> str "fresh" ++ pr_fresh_ids l
   | TacExternal (_,com,req,la) ->
       str "external" ++ spc() ++ qs com ++ spc() ++ qs req ++ 
       spc() ++ prlist_with_sep spc pr_tacarg la
diff --git a/parsing/ppvernac.ml b/parsing/ppvernac.ml
index 7e3c853d..f86b5708 100644
--- a/parsing/ppvernac.ml
+++ b/parsing/ppvernac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: ppvernac.ml 9020 2006-07-05 17:35:23Z herbelin $ *)  
+(* $Id: ppvernac.ml 9154 2006-09-20 17:18:18Z corbinea $ *)  
 
 open Pp
 open Names
@@ -410,6 +410,7 @@ let rec pr_vernac = function
 	| ShowProofNames -> str"Show Conjectures"
 	| ShowIntros b -> str"Show " ++ (if b then str"Intros" else str"Intro")
 	| ShowMatch id -> str"Show Match " ++ pr_lident id
+	| ShowThesis -> str "Show Thesis"
 	| ExplainProof l -> str"Explain Proof" ++ spc() ++ prlist_with_sep sep int l
 	| ExplainTree l -> str"Explain Proof Tree" ++ spc() ++ prlist_with_sep sep int l 
       in pr_showable s
@@ -530,7 +531,7 @@ let rec pr_vernac = function
             fnl() ++
             str (if List.length l = 1 then "   " else " | ") ++
             prlist_with_sep (fun _ -> fnl() ++ str" | ") pr_constructor l in
-      let pr_oneind key (id,ntn,indpar,s,lc) =
+      let pr_oneind key ((id,indpar,s,lc),ntn) =
 	hov 0 (
           str key ++ spc() ++
           pr_lident id ++ pr_and_type_binders_arg indpar ++ spc() ++ str":" ++ 
@@ -585,14 +586,16 @@ let rec pr_vernac = function
         prlist_with_sep (fun _ -> fnl() ++ fnl() ++ str"with ") pr_onerec recs)
 
   | VernacCoFixpoint (corecs,b) ->
-      let pr_onecorec (id,bl,c,def) =
+      let pr_onecorec ((id,bl,c,def),ntn) =
         let (bl',def,c) =
               if Options.do_translate() then extract_def_binders def c
               else ([],def,c) in
         let bl = bl @ bl' in
         pr_id id ++ spc() ++ pr_binders bl ++ spc() ++ str":" ++
         spc() ++ pr_lconstr_expr c ++
-        str" :=" ++ brk(1,1) ++ pr_lconstr def in
+        str" :=" ++ brk(1,1) ++ pr_lconstr def  ++ 
+	pr_decl_notation pr_constr ntn
+      in
       let start = if b then "Boxed CoFixpoint" else "CoFixpoint" in
       hov 1 (str start ++ spc() ++
       prlist_with_sep (fun _ -> fnl() ++ str"with ") pr_onecorec corecs)  
@@ -679,6 +682,14 @@ let rec pr_vernac = function
   | VernacSolveExistential (i,c) ->
       str"Existential " ++ int i ++ pr_lconstrarg c
 
+  (* MMode *)
+ 
+  | VernacProofInstr instr -> anomaly "Not implemented"
+  | VernacDeclProof -> str "proof" 
+  | VernacReturn -> str "return"
+
+  (* /MMode *) 
+
   (* Auxiliary file and library management *)
   | VernacRequireFrom (exp,spe,f) -> hov 2
       (str"Require" ++ spc() ++ pr_require_token exp ++
@@ -820,7 +831,7 @@ let rec pr_vernac = function
 
   (* For extension *)
   | VernacExtend (s,c) -> pr_extend s c
-  | VernacProof Tacexpr.TacId _ -> str "Proof"
+  | VernacProof (Tacexpr.TacId _) -> str "Proof"
   | VernacProof te -> str "Proof with" ++ spc() ++ pr_raw_tactic te 
 
 and pr_extend s cl =
diff --git a/parsing/prettyp.ml b/parsing/prettyp.ml
index 4534369f..57028469 100644
--- a/parsing/prettyp.ml
+++ b/parsing/prettyp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: prettyp.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: prettyp.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
 
 open Pp
 open Util
@@ -246,6 +246,7 @@ let print_safe_judgment env j =
 let print_named_def name body typ =
   let pbody = pr_lconstr body in
   let ptyp = pr_ltype typ in
+  let pbody = if isCast body then surround pbody else pbody in
   (str "*** [" ++ str name ++ str " " ++
      hov 0 (str ":=" ++ brk (1,2) ++ pbody ++ spc () ++
 	      str ":" ++ brk (1,2) ++ ptyp) ++
@@ -278,11 +279,15 @@ let print_constructors envpar names types =
   hv 0 (str "  " ++ pc)
 
 let build_inductive sp tyi =
-  let (mib,mip as specif) = Global.lookup_inductive (sp,tyi) in
+  let (mib,mip) = Global.lookup_inductive (sp,tyi) in
   let params = mib.mind_params_ctxt in
   let args = extended_rel_list 0 params in
   let env = Global.env() in
-  let arity = hnf_prod_applist env (Inductive.type_of_inductive specif) args in
+  let fullarity = match mip.mind_arity with
+    | Monomorphic ar -> ar.mind_user_arity 
+    | Polymorphic ar ->
+	it_mkProd_or_LetIn (mkSort (Type ar.poly_level)) mip.mind_arity_ctxt in
+  let arity = hnf_prod_applist env fullarity args in
   let cstrtypes = arities_of_constructors env (sp,tyi) in
   let cstrtypes =
     Array.map (fun c -> hnf_prod_applist env c args) cstrtypes in
@@ -325,10 +330,14 @@ let print_body = function
 let print_typed_body (val_0,typ) =
   (print_body val_0 ++ fnl () ++ str "     : " ++ pr_ltype typ ++ fnl ())
 
+let ungeneralized_type_of_constant_type = function
+  | PolymorphicArity (ctx,a) -> mkArity (ctx, Type a.poly_level)
+  | NonPolymorphicType t -> t
+
 let print_constant with_values sep sp =
   let cb = Global.lookup_constant sp in
   let val_0 = cb.const_body in
-  let typ = cb.const_type in
+  let typ = ungeneralized_type_of_constant_type cb.const_type in
   hov 0 (
     match val_0 with 
     | None -> 
diff --git a/parsing/printer.ml b/parsing/printer.ml
index 8cb5ac42..c0a98809 100644
--- a/parsing/printer.ml
+++ b/parsing/printer.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: printer.ml 8831 2006-05-19 09:29:54Z herbelin $ *)
+(* $Id: printer.ml 9164 2006-09-23 09:36:05Z herbelin $ *)
 
 open Pp
 open Util
@@ -23,6 +23,7 @@ open Nametab
 open Ppconstr
 open Evd
 open Proof_type
+open Decl_mode
 open Refiner
 open Pfedit
 open Ppconstr
@@ -108,6 +109,13 @@ let pr_evaluable_reference ref =
   | EvalVarRef sp -> VarRef sp in
  pr_global ref'
 
+(*let pr_rawterm t =
+  pr_lconstr (Constrextern.extern_rawconstr Idset.empty t)*)
+
+(*open Pattern
+
+let pr_pattern t = pr_pattern_env (Global.env()) empty_names_context t*)
+
 (**********************************************************************)
 (* Contexts and declarations                                          *)
 
@@ -117,6 +125,7 @@ let pr_var_decl env (id,c,typ) =
     | Some c ->
 	(* Force evaluation *) 
 	let pb = pr_lconstr_env env c in
+	let pb = if isCast c then surround pb else pb in
 	(str" := " ++ pb ++ cut () ) in
   let pt = pr_ltype_env env typ in
   let ptyp = (str" : " ++ pt) in
@@ -128,6 +137,7 @@ let pr_rel_decl env (na,c,typ) =
     | Some c ->
 	(* Force evaluation *) 
 	let pb = pr_lconstr_env env c in
+	let pb = if isCast c then surround pb else pb in
 	(str":=" ++ spc () ++ pb ++ spc ()) in
   let ptyp = pr_ltype_env env typ in
   match na with
@@ -219,23 +229,53 @@ let pr_context_of env = match Options.print_hyps_limit () with
   | None -> hv 0 (pr_context_unlimited env)
   | Some n -> hv 0 (pr_context_limit n env)
 
+(* display goal parts (Proof mode) *)
+
+let pr_restricted_named_context among env =
+  hv 0 (fold_named_context
+	  (fun env ((id,_,_) as d) pps ->
+	     if true || Idset.mem id among then
+	       pps ++ 
+		 fnl () ++ str (emacs_str (String.make 1 (Char.chr 253))) ++
+		 pr_var_decl env d
+	     else 
+	       pps)
+          env ~init:(mt ()))
+
+let pr_subgoal_metas metas env=
+  let pr_one (meta,typ) = 
+    str "?" ++ int meta ++ str " : " ++ 
+      hov 0 (pr_ltype_env_at_top env typ) ++ fnl () ++ 
+      str (emacs_str (String.make 1 (Char.chr 253))) in
+    hv 0 (prlist_with_sep mt pr_one metas)
 
 (* display complete goal *)
 let pr_goal g =
   let env = evar_env g in
-  let penv = pr_context_of env in
-  let pc = pr_ltype_env_at_top env g.evar_concl in
-  str"  " ++ hv 0 (penv ++ fnl () ++
-		   str (emacs_str (String.make 1 (Char.chr 253)))  ++
-                   str "============================" ++ fnl ()  ++
-                   str" "  ++ pc) ++ fnl ()
-
+  let preamb,penv,pc =
+    if g.evar_extra = None then
+          mt (),
+	  pr_context_of env,
+	  pr_ltype_env_at_top env g.evar_concl
+    else 
+      let {pm_subgoals=metas;pm_hyps=among} = get_info g in
+	(str "     *** Declarative Mode ***" ++ fnl ()++fnl ()),
+    pr_restricted_named_context among env,
+    pr_subgoal_metas metas env
+  in
+    preamb ++
+    str"  " ++ hv 0 (penv ++ fnl () ++
+		       str (emacs_str (String.make 1 (Char.chr 253)))  ++
+		       str "============================" ++ fnl ()  ++
+		       str" "  ++ pc) ++ fnl ()
+     
 (* display the conclusion of a goal *)
 let pr_concl n g =
   let env = evar_env g in
   let pc = pr_ltype_env_at_top env g.evar_concl in
-  str (emacs_str (String.make 1 (Char.chr 253)))  ++
-  str "subgoal " ++ int n ++ str " is:" ++ cut () ++ str" "  ++ pc
+    str (emacs_str (String.make 1 (Char.chr 253)))  ++
+      str "subgoal " ++ int n ++ str " is:" ++ cut () ++ str" "  ++ pc
+
 
 (* display evar type: a context and a type *)
 let pr_evgl_sign gl = 
@@ -266,15 +306,22 @@ let pr_subgoal n =
   prrec n
 
 (* Print open subgoals. Checks for uninstantiated existential variables *)
-let pr_subgoals sigma = function 
+let pr_subgoals close_cmd sigma = function 
   | [] -> 
-      let exl = Evarutil.non_instantiated sigma in 
-      if exl = [] then 
-	(str"Proof completed."  ++ fnl ())
-      else
-        let pei = pr_evars_int 1 exl in
-        (str "No more subgoals but non-instantiated existential " ++
-           str "variables :"  ++fnl () ++ (hov 0 pei))
+      begin
+	match close_cmd with
+	  Some cmd ->
+	    (str "Subproof completed, now type " ++ str cmd ++ 
+	       str "." ++ fnl ())
+	| None ->
+	    let exl = Evarutil.non_instantiated sigma in 
+	      if exl = [] then 
+		(str"Proof completed."  ++ fnl ())
+	      else
+		let pei = pr_evars_int 1 exl in
+		  (str "No more subgoals but non-instantiated existential " ++
+		     str "variables :"  ++fnl () ++ (hov 0 pei))
+      end
   | [g] ->
       let pg = pr_goal g in
       v 0 (str ("1 "^"subgoal") ++cut () ++ pg)
@@ -291,12 +338,12 @@ let pr_subgoals sigma = function
       v 0 (int(List.length rest+1) ++ str" subgoals" ++ cut () 
 	   ++ pg1 ++ prest ++ fnl ())
 
-
-let pr_subgoals_of_pfts pfts = 
+let pr_subgoals_of_pfts pfts =
+  let close_cmd = Decl_mode.get_end_command pfts in
   let gls = fst (Refiner.frontier (proof_of_pftreestate pfts)) in 
   let sigma = (top_goal_of_pftreestate pfts).sigma in
-  pr_subgoals sigma gls
-
+    pr_subgoals close_cmd sigma gls
+      
 let pr_open_subgoals () =
   let pfts = get_pftreestate () in
   match focus() with
@@ -351,7 +398,6 @@ let pr_prim_rule = function
 	  (pr_id f ++ str" : " ++ pr_lconstr ar ++ print_mut oth)
         | [] -> mt () in
       (str"cofix " ++ pr_id f ++  str" with " ++ print_mut others)
-
   | Refine c -> 
       str(if occur_meta c then "refine " else "exact ") ++
       Constrextern.with_meta_as_hole pr_constr c
diff --git a/parsing/printer.mli b/parsing/printer.mli
index 9d59bf75..6795889c 100644
--- a/parsing/printer.mli
+++ b/parsing/printer.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: printer.mli 8831 2006-05-19 09:29:54Z herbelin $ i*)
+(*i $Id: printer.mli 9249 2006-10-19 07:46:03Z herbelin $ i*)
 
 (*i*)
 open Pp
@@ -35,6 +35,7 @@ val pr_lconstr             : constr -> std_ppcmds
 val pr_constr_env          : env -> constr -> std_ppcmds
 val pr_constr              : constr -> std_ppcmds
 
+val pr_ltype_env_at_top    : env -> types -> std_ppcmds
 val pr_ltype_env           : env -> types -> std_ppcmds
 val pr_ltype               : types -> std_ppcmds
 
@@ -87,7 +88,7 @@ val pr_context_of          : env -> std_ppcmds
 (* Proofs *)
 
 val pr_goal                : goal -> std_ppcmds
-val pr_subgoals            : evar_map -> goal list -> std_ppcmds
+val pr_subgoals            : string option -> evar_map -> goal list -> std_ppcmds
 val pr_subgoal             : int -> goal list -> std_ppcmds
 
 val pr_open_subgoals       : unit -> std_ppcmds
diff --git a/parsing/q_coqast.ml4 b/parsing/q_coqast.ml4
index b5b07091..23d24497 100644
--- a/parsing/q_coqast.ml4
+++ b/parsing/q_coqast.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: q_coqast.ml4 8926 2006-06-08 20:23:17Z herbelin $ *)
+(* $Id: q_coqast.ml4 9315 2006-10-29 21:53:30Z barras $ *)
 
 open Util
 open Names
@@ -441,8 +441,12 @@ and mlexpr_of_tactic : (Tacexpr.raw_tactic_expr -> MLast.expr) = function
         $mlexpr_of_bool lz$
         $mlexpr_of_bool lr$
         $mlexpr_of_list (mlexpr_of_match_rule mlexpr_of_tactic) l$>>
+
+  | Tacexpr.TacFun (idol,body) ->
+      <:expr< Tacexpr.TacFun
+        ($mlexpr_of_list mlexpr_of_ident_option idol$,
+         $mlexpr_of_tactic body$) >>
 (*
-  | Tacexpr.TacFun of $dloc$ * tactic_fun_ast
   | Tacexpr.TacFunRec of $dloc$ * identifier * tactic_fun_ast
 *)
 (*
diff --git a/parsing/q_util.ml4 b/parsing/q_util.ml4
index 61a552f3..2ef56907 100644
--- a/parsing/q_util.ml4
+++ b/parsing/q_util.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: q_util.ml4 8982 2006-06-23 13:17:49Z herbelin $ *)
+(* $Id: q_util.ml4 9333 2006-11-02 13:59:14Z barras $ *)
 
 (* This file defines standard combinators to build ml expressions *)
 
@@ -71,22 +71,46 @@ open Vernacexpr
 open Pcoq
 open Genarg
 
-let rec interp_entry_name loc s =
+let modifiers e =
+<:expr<  Gramext.srules
+    [([], Gramext.action(fun _loc -> []));
+     ([Gramext.Stoken ("", "(");
+       Gramext.Slist1sep ($e$, Gramext.Stoken ("", ","));
+       Gramext.Stoken ("", ")")],
+      Gramext.action (fun _ l _ _loc -> l))]
+ >>
+
+let rec interp_entry_name loc s sep =
   let l = String.length s in
   if l > 8 & String.sub s 0 3 = "ne_" & String.sub s (l-5) 5 = "_list" then
-    let t, g = interp_entry_name loc (String.sub s 3 (l-8)) in
+    let t, g = interp_entry_name loc (String.sub s 3 (l-8)) "" in
     List1ArgType t, <:expr< Gramext.Slist1 $g$ >>
+  else if l > 12 & String.sub s 0 3 = "ne_" &
+                   String.sub s (l-9) 9 = "_list_sep" then
+    let t, g = interp_entry_name loc (String.sub s 3 (l-12)) "" in
+    let sep = <:expr< Gramext.Stoken("",$str:sep$) >> in
+    List1ArgType t, <:expr< Gramext.Slist1sep $g$ $sep$ >>
   else if l > 5 & String.sub s (l-5) 5 = "_list" then
-    let t, g = interp_entry_name loc (String.sub s 0 (l-5)) in
+    let t, g = interp_entry_name loc (String.sub s 0 (l-5)) "" in
     List0ArgType t, <:expr< Gramext.Slist0 $g$ >>
+  else if l > 9 & String.sub s (l-9) 9 = "_list_sep" then
+    let t, g = interp_entry_name loc (String.sub s 0 (l-9)) "" in
+    let sep = <:expr< Gramext.Stoken("",$str:sep$) >> in
+    List0ArgType t, <:expr< Gramext.Slist0sep $g$ $sep$ >>
   else if l > 4 & String.sub s (l-4) 4 = "_opt" then
-    let t, g = interp_entry_name loc (String.sub s 0 (l-4)) in
+    let t, g = interp_entry_name loc (String.sub s 0 (l-4)) "" in
     OptArgType t, <:expr< Gramext.Sopt $g$ >>
+  else if l > 5 & String.sub s (l-5) 5 = "_mods" then
+    let t, g = interp_entry_name loc (String.sub s 0 (l-1)) "" in
+    List0ArgType t, modifiers g
   else
     let s = if s = "hyp" then "var" else s in
     let t, se, lev =
       match tactic_genarg_level s with
-	| Some n -> Some (ExtraArgType s), <:expr< Tactic. tactic_expr >>, Some n
+        | Some 5 ->
+            Some (ExtraArgType s), <:expr< Tactic. binder_tactic >>, None
+	| Some n ->
+            Some (ExtraArgType s), <:expr< Tactic. tactic_expr >>, Some n
 	| None ->
       match Pcoq.entry_type (Pcoq.get_univ "prim") s with
 	| Some _ as x -> x, <:expr< Prim. $lid:s$ >>, None
diff --git a/parsing/q_util.mli b/parsing/q_util.mli
index d31b217c..901f9198 100644
--- a/parsing/q_util.mli
+++ b/parsing/q_util.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: q_util.mli 7732 2005-12-26 13:51:24Z herbelin $ i*)
+(*i $Id: q_util.mli 9265 2006-10-24 08:35:38Z herbelin $ i*)
 
 val patt_of_expr : MLast.expr -> MLast.patt
 
@@ -28,4 +28,5 @@ val mlexpr_of_string : string -> MLast.expr
 
 val mlexpr_of_option : ('a -> MLast.expr) -> 'a option -> MLast.expr
 
-val interp_entry_name : Util.loc -> string -> Pcoq.entry_type * MLast.expr
+val interp_entry_name : Util.loc -> string -> string -> 
+  Pcoq.entry_type * MLast.expr
diff --git a/parsing/search.ml b/parsing/search.ml
index 995aa953..28362d72 100644
--- a/parsing/search.ml
+++ b/parsing/search.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: search.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
+(* $Id: search.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Pp
 open Util
@@ -57,12 +57,12 @@ let gen_crible refopt (fn : global_reference -> env -> constr -> unit) =
 	     fn (VarRef idc) env typ
 	 with Not_found -> (* we are in a section *) ())
     | "CONSTANT" ->
-	let kn = locate_constant (qualid_of_sp sp) in
-	let {const_type=typ} = Global.lookup_constant kn in
+	let cst = locate_constant (qualid_of_sp sp) in
+	let typ = Typeops.type_of_constant env cst in
         if refopt = None
 	  || head_const typ = constr_of_global (out_some refopt)
 	then
-	  fn (ConstRef kn) env typ
+	  fn (ConstRef cst) env typ
     | "INDUCTIVE" -> 
 	let kn = locate_mind (qualid_of_sp sp) in
         let mib = Global.lookup_mind kn in 
diff --git a/parsing/tacextend.ml4 b/parsing/tacextend.ml4
index 3d41e388..73d41465 100644
--- a/parsing/tacextend.ml4
+++ b/parsing/tacextend.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacextend.ml4 8926 2006-06-08 20:23:17Z herbelin $ *)
+(* $Id: tacextend.ml4 9265 2006-10-24 08:35:38Z herbelin $ *)
 
 open Genarg
 open Q_util
@@ -165,7 +165,7 @@ let declare_tactic loc s cl =
       open Pcoq;
       declare $list:hidden$ end;
       try
-        let _=Refiner.add_tactic $se$ (fun [ $list:make_clauses s cl$ ]) in
+        let _=Tacinterp.add_tactic $se$ (fun [ $list:make_clauses s cl$ ]) in
         List.iter
           (fun s -> Tacinterp.add_primitive_tactic s
               (Tacexpr.TacAtom($default_loc$,
@@ -198,7 +198,10 @@ EXTEND
   ;
   tacargs:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = Q_util.interp_entry_name loc e in
+        let t, g = Q_util.interp_entry_name loc e "" in
+        TacNonTerm (loc, t, g, Some s)
+      | e = LIDENT; "("; s = LIDENT; ","; sep = STRING; ")" ->
+        let t, g = Q_util.interp_entry_name loc e sep in
         TacNonTerm (loc, t, g, Some s)
       | s = STRING ->
 	if s = "" then Util.user_err_loc (loc,"",Pp.str "Empty terminal");
diff --git a/parsing/tactic_printer.ml b/parsing/tactic_printer.ml
index 3584e375..6ea1c97e 100644
--- a/parsing/tactic_printer.ml
+++ b/parsing/tactic_printer.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tactic_printer.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
+(* $Id: tactic_printer.ml 9244 2006-10-16 17:11:44Z barras $ *)
 
 open Pp
 open Util
@@ -15,6 +15,7 @@ open Evd
 open Tacexpr
 open Proof_type
 open Proof_trees
+open Decl_expr
 open Logic
 open Printer
 
@@ -25,19 +26,34 @@ let pr_tactic = function
   | t -> 
       Pptactic.pr_tactic (Global.env()) t
 
+let pr_proof_instr instr = 
+    Ppdecl_proof.pr_proof_instr (Global.env()) instr
+
 let pr_rule = function
   | Prim r -> hov 0 (pr_prim_rule r)
-  | Tactic (texp,_) -> hov 0 (pr_tactic texp)
+  | Nested(cmpd,_) ->
+      begin
+	match cmpd with 
+	    Tactic (texp,_) -> hov 0 (pr_tactic texp)
+	  | Proof_instr (_,instr) -> hov 0 (pr_proof_instr instr)
+      end
+  | Daimon -> str "<Daimon>"
+  | Decl_proof _ -> str "proof" 
   | Change_evars ->
       (* This is internal tactic and cannot be replayed at user-level.
          Function pr_rule_dot below is used when we want to hide
          Change_evars *)
       str "Evar change"
 
+let uses_default_tac = function
+  | Nested(Tactic(_,dflt),_) -> dflt
+  | _ -> false
+
 (* Does not print change of evars *)
 let pr_rule_dot = function 
   | Change_evars -> mt ()
-  | r -> pr_rule r ++ str"."
+  | r ->
+      pr_rule r ++ if uses_default_tac r then str "..." else str"."
 
 exception Different
 
@@ -52,59 +68,145 @@ let thin_sign osign sign =
     sign ~init:Environ.empty_named_context_val
 
 let rec print_proof sigma osign pf =
-  let {evar_hyps=hyps; evar_concl=cl; 
-       evar_body=body} = pf.goal in
-  let hyps = Environ.named_context_of_val hyps in
+  let hyps = Environ.named_context_of_val pf.goal.evar_hyps in
   let hyps' = thin_sign osign hyps in
   match pf.ref with
     | None -> 
-	hov 0 (pr_goal {evar_hyps=hyps'; evar_concl=cl; evar_body=body})
+	hov 0 (pr_goal {pf.goal with evar_hyps=hyps'})
     | Some(r,spfl) ->
     	hov 0 
-	  (hov 0 (pr_goal {evar_hyps=hyps'; evar_concl=cl; evar_body=body}) ++
+	  (hov 0 (pr_goal {pf.goal with evar_hyps=hyps'}) ++
 	   spc () ++ str" BY " ++
 	   hov 0 (pr_rule r) ++ fnl () ++
 	   str"  " ++
-	   hov 0 (prlist_with_sep pr_fnl (print_proof sigma hyps) spfl)
-)
+	   hov 0 (prlist_with_sep pr_fnl (print_proof sigma hyps) spfl))
 	  
 let pr_change gl = 
-  str"Change " ++
+  str"change " ++
   pr_lconstr_env (Global.env_of_context gl.evar_hyps) gl.evar_concl ++ str"."
 
-let rec print_script nochange sigma osign pf =
-  let {evar_hyps=sign; evar_concl=cl} = pf.goal in
-  let sign = Environ.named_context_of_val sign in
+let rec print_decl_script tac_printer nochange sigma pf =
+  match pf.ref with
+    | None ->
+	(if nochange then 
+	   (str"<Your Proof Text here>")
+	 else 
+	   pr_change pf.goal)
+	++ fnl ()
+    | Some (Daimon,_) -> mt ()
+    | Some (Nested(Proof_instr (opened,instr),_) as rule,subprfs) ->
+	begin
+	  match instr.instr,subprfs with
+	    Pescape,[{ref=Some(_,subsubprfs)}] ->
+	      hov 7
+		(pr_rule_dot rule ++ fnl () ++
+		   prlist_with_sep pr_fnl tac_printer subsubprfs) ++ fnl () ++
+		if opened then mt () else str "return."
+	  | Pclaim _,[body;cont] ->
+	      hov 2
+		(pr_rule_dot rule ++ fnl () ++
+		   print_decl_script tac_printer nochange sigma body) ++ 
+		fnl () ++
+		if opened then mt () else str "end claim." ++ fnl () ++
+		  print_decl_script tac_printer nochange sigma cont
+	  | Pfocus _,[body;cont] ->
+	      hov 2 
+		(pr_rule_dot rule ++ fnl () ++
+		   print_decl_script tac_printer nochange sigma body) ++ 
+		fnl () ++
+		if opened then mt () else str "end focus." ++ fnl () ++
+		  print_decl_script tac_printer nochange sigma cont
+	  | (Psuppose _ |Pcase (_,_,_)),[body;cont] ->
+	      hov 2 
+		(pr_rule_dot rule ++ fnl () ++
+		   print_decl_script tac_printer nochange sigma body) ++ 
+		fnl () ++
+		print_decl_script tac_printer nochange sigma cont 
+	  | _,[next] ->
+	      pr_rule_dot rule ++ fnl () ++
+		print_decl_script tac_printer nochange sigma next
+	  | _,[] ->
+	      pr_rule_dot rule		
+	  | _,_ -> anomaly "unknown branching instruction"
+	end
+    | _ -> anomaly "Not Applicable"
+
+let rec print_script nochange sigma pf =
   match pf.ref with
     | None ->
         (if nochange then 
-	  (str"<Your Tactic Text here>") 
-	else 
-	  pr_change pf.goal)
+	   (str"<Your Tactic Text here>") 
+	 else 
+	   pr_change pf.goal)
 	++ fnl ()
-    | Some(r,spfl) ->
-        ((if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())) ++
-           pr_rule_dot r ++ fnl () ++
-           prlist_with_sep pr_fnl
-             (print_script nochange sigma sign) spfl)
+    | Some(Decl_proof opened,script) ->
+	assert (List.length script = 1);
+	begin
+	  if nochange then (mt ()) else (pr_change pf.goal ++ fnl ()) 
+	end ++
+	  begin
+	    hov 0 (str "proof." ++ fnl () ++ 
+		     print_decl_script (print_script nochange sigma) 
+		     nochange sigma (List.hd script))
+	  end ++ fnl () ++
+	  begin
+	    if opened then mt () else (str "end proof." ++ fnl ())
+	  end
+    | Some(Daimon,spfl) ->
+	((if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())) ++
+	   prlist_with_sep pr_fnl
+           (print_script nochange sigma) spfl )
+    | Some(rule,spfl) ->
+	((if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())) ++
+	   pr_rule_dot rule ++ fnl () ++
+	   prlist_with_sep pr_fnl
+           (print_script nochange sigma) spfl )	
 
 (* printed by Show Script command *)
-let print_treescript nochange sigma _osign pf =
+
+let print_treescript nochange sigma pf =
   let rec aux top pf =
     match pf.ref with
     | None ->
         if nochange then 
-	  (str"<Your Tactic Text here>") 
+	  if pf.goal.evar_extra=None then
+	    (str"<Your Tactic Text here>")
+	  else (str"<Your Proof Text here>")
 	else 
 	  (pr_change pf.goal)
+    | Some(Decl_proof opened,script) ->
+	assert (List.length script = 1);
+	begin
+	  if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())
+	end ++
+	  hov 0 
+	  begin str "proof." ++ fnl () ++
+	    print_decl_script (aux false)  
+	    nochange sigma (List.hd script) 
+	  end ++ fnl () ++ 
+	  begin
+	    if opened then mt () else (str "end proof." ++ fnl ())
+	  end
+    | Some(Daimon,spfl) ->
+	((if nochange then (mt ()) else (pr_change pf.goal ++ fnl ())) ++
+	   prlist_with_sep pr_fnl
+           (print_script nochange sigma) spfl )
     | Some(r,spfl) ->
         (if nochange then mt () else (pr_change pf.goal ++ fnl ())) ++
-	pr_rule_dot r ++
-	match spfl with
-	| [] -> mt ()
-	| [spf] -> fnl () ++ (if top then mt () else str "  ") ++ aux top spf
-	| _ -> fnl () ++ str " " ++
-	    hov 0 (prlist_with_sep fnl (aux false) spfl)
+	  pr_rule_dot r ++
+	  begin
+	    if List.length spfl > 1 then
+	      fnl ()  ++ 
+		str " " ++  hov 0 (aux false (List.hd spfl)) ++ fnl () ++
+		hov 0 (prlist_with_sep fnl (aux false) (List.tl spfl))
+	    else
+	      match spfl with
+		| [] -> mt ()
+		| [spf] -> fnl () ++ 
+		    (if top then mt () else str "  ") ++ aux top spf
+		| _ -> fnl () ++ str " " ++
+		    hov 0 (prlist_with_sep fnl (aux false) spfl)
+	  end
   in hov 0 (aux true pf)
 
 let rec print_info_script sigma osign pf =
diff --git a/parsing/tactic_printer.mli b/parsing/tactic_printer.mli
index db5dd794..b1f6d41c 100644
--- a/parsing/tactic_printer.mli
+++ b/parsing/tactic_printer.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tactic_printer.mli 6113 2004-09-17 20:28:19Z barras $ i*)
+(*i $Id: tactic_printer.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Pp
@@ -22,6 +22,6 @@ val print_proof : evar_map -> named_context -> proof_tree -> std_ppcmds
 val pr_rule     : rule -> std_ppcmds
 val pr_tactic   : tactic_expr -> std_ppcmds
 val print_script :
-  bool -> evar_map -> named_context -> proof_tree -> std_ppcmds
+  bool -> evar_map -> proof_tree -> std_ppcmds
 val print_treescript :
-  bool -> evar_map -> named_context -> proof_tree -> std_ppcmds
+  bool -> evar_map -> proof_tree -> std_ppcmds
diff --git a/parsing/vernacextend.ml4 b/parsing/vernacextend.ml4
index af0d6781..7cf542fe 100644
--- a/parsing/vernacextend.ml4
+++ b/parsing/vernacextend.ml4
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernacextend.ml4 7732 2005-12-26 13:51:24Z herbelin $ *)
+(* $Id: vernacextend.ml4 9265 2006-10-24 08:35:38Z herbelin $ *)
 
 open Genarg
 open Q_util
@@ -114,7 +114,7 @@ EXTEND
   ;
   args:
     [ [ e = LIDENT; "("; s = LIDENT; ")" ->
-        let t, g = Q_util.interp_entry_name loc e in
+        let t, g = Q_util.interp_entry_name loc e "" in
         VernacNonTerm (loc, t, g, Some s)
       | s = STRING ->
         VernacTerm s
diff --git a/pretyping/cases.ml b/pretyping/cases.ml
index b0fe83a3..58dda021 100644
--- a/pretyping/cases.ml
+++ b/pretyping/cases.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cases.ml 8875 2006-05-29 19:59:11Z msozeau $ *)
+(* $Id: cases.ml 9215 2006-10-05 15:40:31Z herbelin $ *)
 
 open Util
 open Names
@@ -336,8 +336,8 @@ let inh_coerce_to_ind isevars env ty tyi =
         un inductif cela doit être égal *)
   let _ = e_cumul env isevars expected_typ ty in ()
 
-let unify_tomatch_with_patterns isevars env typ tm =
-  match find_row_ind tm with
+let unify_tomatch_with_patterns isevars env loc typ pats =
+  match find_row_ind pats with
     | None -> NotInd (None,typ)
     | Some (_,(ind,_)) ->
 	inh_coerce_to_ind isevars env typ ind;
@@ -345,29 +345,26 @@ let unify_tomatch_with_patterns isevars env typ tm =
 	with Not_found -> NotInd (None,typ)
 
 let find_tomatch_tycon isevars env loc = function
-  (* Try first if some 'in I ...' is present and can be used as a constraint *)
-  | Some (_,ind,_,_),_ 
-  (* Otherwise try to get constraints from (the 1st) constructor in clauses *)
-  | None, Some (_,(ind,_)) ->
-      mk_tycon (inductive_template isevars env loc ind)
-  | None, None -> 
-      empty_tycon
-
-let coerce_row typing_fun isevars env cstropt (tomatch,(_,indopt)) =
+  (* Try if some 'in I ...' is present and can be used as a constraint *)
+  | Some (_,ind,_,_) -> mk_tycon (inductive_template isevars env loc ind)
+  | None -> empty_tycon
+
+let coerce_row typing_fun isevars env pats (tomatch,(_,indopt)) =
   let loc = Some (loc_of_rawconstr tomatch) in
-  let tycon = find_tomatch_tycon isevars env loc (indopt,cstropt) in
+  let tycon = find_tomatch_tycon isevars env loc indopt in
   let j = typing_fun tycon env tomatch in
   let typ = nf_evar (Evd.evars_of !isevars) j.uj_type in
-  let t = 
+  let t =
     try IsInd (typ,find_rectype env (Evd.evars_of !isevars) typ)
-    with Not_found -> NotInd (None,typ) in
+    with Not_found ->
+      unify_tomatch_with_patterns isevars env loc typ pats in
   (j.uj_val,t)
 
 let coerce_to_indtype typing_fun isevars env matx tomatchl =
   let pats = List.map (fun r ->  r.patterns) matx in
   let matx' = match matrix_transpose pats with
-    | [] -> List.map (fun _ -> None) tomatchl (* no patterns at all *)
-    | m -> List.map find_row_ind m in
+    | [] -> List.map (fun _ -> []) tomatchl (* no patterns at all *)
+    | m -> m in
   List.map2 (coerce_row typing_fun isevars env) matx' tomatchl
 
 (************************************************************************)
@@ -500,12 +497,12 @@ let rec adjust_local_defs loc = function
   | [], [] -> []
   | _ -> raise NotAdjustable
 
-let check_and_adjust_constructor ind cstrs = function 
+let check_and_adjust_constructor env ind cstrs = function 
   | PatVar _ as pat -> pat
   | PatCstr (loc,((_,i) as cstr),args,alias) as pat ->
       (* Check it is constructor of the right type *)
       let ind' = inductive_of_constructor cstr in
-      if ind' = ind then
+      if Closure.mind_equiv env ind' ind then
 	(* Check the constructor has the right number of args *)
 	let ci = cstrs.(i-1) in
 	let nb_args_constr = ci.cs_nargs in
@@ -1132,7 +1129,7 @@ let first_clause_irrefutable env = function
   | eqn::mat -> List.for_all (irrefutable env) eqn.patterns
   | _ -> false
 
-let group_equations pb mind current cstrs mat =
+let group_equations pb ind current cstrs mat =
   let mat =
     if first_clause_irrefutable pb.env mat then [List.hd mat] else mat in
   let brs = Array.create (Array.length cstrs) [] in
@@ -1142,7 +1139,7 @@ let group_equations pb mind current cstrs mat =
       (fun eqn () ->
 	 let rest = remove_current_pattern eqn in
 	 let pat = current_pattern eqn in
-	 match check_and_adjust_constructor mind cstrs pat with 
+	 match check_and_adjust_constructor pb.env ind cstrs pat with 
 	   | PatVar (_,name) -> 
 	       (* This is a default clause that we expand *)
 	       for i=1 to Array.length cstrs do
diff --git a/pretyping/classops.ml b/pretyping/classops.ml
index b6cce031..bbad005c 100644
--- a/pretyping/classops.ml
+++ b/pretyping/classops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: classops.ml 8642 2006-03-17 10:09:02Z notin $ *)
+(* $Id: classops.ml 9257 2006-10-21 17:28:28Z herbelin $ *)
 
 open Util
 open Pp
@@ -154,7 +154,8 @@ let lookup_pattern_path_between (s,t) =
 	   coe.coe_value
        in 
        match kind_of_term c with
-	 | Construct sp -> (sp, coe.coe_param)
+	 | Construct cstr ->
+	     (cstr, Inductiveops.constructor_nrealargs (Global.env()) cstr -1)
 	 | _ -> raise Not_found) l
 
 (* find_class_type : constr -> cl_typ * int *)
@@ -207,7 +208,7 @@ let class_of env sigma t =
 
 let inductive_class_of ind = fst (class_info (CL_IND ind))
 
-let class_args_of c = snd (decompose_app c)
+let class_args_of c = snd (find_class_type c)
 
 let string_of_class = function
   | CL_FUN -> "Funclass"
diff --git a/pretyping/clenv.ml b/pretyping/clenv.ml
index 6113ec2d..abe31e06 100644
--- a/pretyping/clenv.ml
+++ b/pretyping/clenv.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: clenv.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: clenv.ml 9279 2006-10-25 15:51:24Z herbelin $ *)
 
 open Pp
 open Util
@@ -74,6 +74,26 @@ let clenv_get_type_of ce c =
       (meta_list ce.env) in
   Retyping.get_type_of_with_meta (cl_env ce) (cl_sigma ce) metamap c
 
+exception NotExtensibleClause
+
+let clenv_push_prod cl =
+  let typ = whd_betadeltaiota (cl_env cl) (cl_sigma cl) (clenv_type cl) in
+  let rec clrec typ = match kind_of_term typ with
+    | Cast (t,_,_) -> clrec t
+    | Prod (na,t,u) ->
+	let mv = new_meta () in
+	let dep = dependent (mkRel 1) u in
+	let na' = if dep then na else Anonymous in
+	let e' = meta_declare mv t ~name:na' cl.env in
+	let concl = if dep then subst1 (mkMeta mv) u else u in
+	let def = applist (cl.templval.rebus,[mkMeta mv]) in
+	{ templval = mk_freelisted def;
+	  templtyp = mk_freelisted concl;
+	  env = e';
+	  templenv = cl.templenv }
+    | _ -> raise NotExtensibleClause
+  in clrec typ
+
 let clenv_environments evd bound c =
   let rec clrec (e,metas) n c =
     match n, kind_of_term c with
@@ -258,7 +278,20 @@ let connect_clenv gls clenv =
  * resolution can cause unification of already-existing metavars, and
  * of the fresh ones which get created.  This operation is a composite
  * of operations which pose new metavars, perform unification on
- * terms, and make bindings.  *)
+ * terms, and make bindings. 
+
+   Otherwise said, from 
+
+     [clenv] = [env;sigma;metas |- c:T]
+     [clenv'] = [env';sigma';metas' |- d:U]
+     [mv] = [mi] of type [Ti] in [metas]
+
+   then, if the unification of [Ti] and [U] produces map [rho], the
+   chaining is [env';sigma';rho'(metas),rho(metas') |- c:rho'(T)] for
+   [rho'] being [rho;mi:=d].
+
+   In particular, it assumes that [env'] and [sigma'] extend [env] and [sigma].
+*)
 let clenv_fchain mv clenv nextclenv =
   (* Add the metavars of [nextclenv] to [clenv], with their name-environment *)
   let clenv' =
@@ -412,18 +445,18 @@ let clenv_constrain_missing_args mlist clause =
 (****************************************************************)
 (* Clausal environment for an application *)
 
-let make_clenv_binding_gen n gls (c,t) = function
+let make_clenv_binding_gen hyps_only n gls (c,t) = function
   | ImplicitBindings largs ->
       let clause = mk_clenv_from_n gls n (c,t) in
-      clenv_constrain_dep_args (n <> None) clause largs
+      clenv_constrain_dep_args hyps_only clause largs
   | ExplicitBindings lbind ->
       let clause = mk_clenv_rename_from_n gls n (c,t) in
       clenv_match_args lbind clause
   | NoBindings ->
       mk_clenv_from_n gls n (c,t)
 
-let make_clenv_binding_apply wc n = make_clenv_binding_gen (Some n) wc
-let make_clenv_binding = make_clenv_binding_gen None
+let make_clenv_binding_apply gls n = make_clenv_binding_gen true n gls
+let make_clenv_binding = make_clenv_binding_gen false None
 
 (****************************************************************)
 (* Pretty-print *)
diff --git a/pretyping/clenv.mli b/pretyping/clenv.mli
index f585dfea..b5433cac 100644
--- a/pretyping/clenv.mli
+++ b/pretyping/clenv.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: clenv.mli 7659 2005-12-17 21:07:17Z herbelin $ i*)
+(*i $Id: clenv.mli 9277 2006-10-25 13:02:22Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -17,6 +17,7 @@ open Environ
 open Evd
 open Evarutil
 open Mod_subst
+open Rawterm
 (*i*)
 
 (***************************************************************)
@@ -93,24 +94,41 @@ val clenv_missing : clausenv -> metavariable list
 
 (* defines metas corresponding to the name of the bindings *)
 val clenv_match_args :
-  constr Rawterm.explicit_bindings -> clausenv -> clausenv
+  constr explicit_bindings -> clausenv -> clausenv
 val clenv_constrain_with_bindings : arg_bindings -> clausenv -> clausenv
 
 (* start with a clenv to refine with a given term with bindings *)
 
-(* 1- the arity of the lemma is fixed *)
+(* the arity of the lemma is fixed *)
+(* the optional int tells how many prods of the lemma have to be used *)
+(* use all of them if None *)
 val make_clenv_binding_apply :
-  evar_info sigma -> int -> constr * constr -> constr Rawterm.bindings ->
+  evar_info sigma -> int option -> constr * constr -> constr bindings ->
    clausenv
 val make_clenv_binding :
-  evar_info sigma -> constr * constr -> constr Rawterm.bindings -> clausenv
-
-(* other stuff *)
+  evar_info sigma -> constr * constr -> constr bindings -> clausenv
+
+(* [clenv_environments sigma n t] returns [sigma',lmeta,ccl] where
+   [lmetas] is a list of metas to be applied to a proof of [t] so that
+   it produces the unification pattern [ccl]; [sigma'] is [sigma]
+   extended with [lmetas]; if [n] is defined, it limits the size of
+   the list even if [ccl] is still a product; otherwise, it stops when
+   [ccl] is not a product; example: if [t] is [forall x y, x=y -> y=x]
+   and [n] is [None], then [lmetas] is [Meta n1;Meta n2;Meta n3] and
+   [ccl] is [Meta n1=Meta n2]; if [n] is [Some 1], [lmetas] is [Meta n1]
+   and [ccl] is [forall y, Meta n1=y -> y=Meta n1] *)
 val clenv_environments :
  evar_defs -> int option -> types -> evar_defs * constr list * types
+
+(* [clenv_environments_evars env sigma n t] does the same but returns
+   a list of Evar's defined in [env] and extends [sigma] accordingly *)
 val clenv_environments_evars :
  env -> evar_defs -> int option -> types -> evar_defs * constr list * types
 
+(* if the clause is a product, add an extra meta for this product *)
+exception NotExtensibleClause
+val clenv_push_prod : clausenv -> clausenv
+
 (***************************************************************)
 (* Pretty-print *)
 val pr_clenv : clausenv -> Pp.std_ppcmds
diff --git a/pretyping/coercion.ml b/pretyping/coercion.ml
index d0ee913f..cc74b0ad 100644
--- a/pretyping/coercion.ml
+++ b/pretyping/coercion.ml
@@ -5,7 +5,7 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(* $Id: coercion.ml 8875 2006-05-29 19:59:11Z msozeau $ *)
+(* $Id: coercion.ml 9257 2006-10-21 17:28:28Z herbelin $ *)
 
 open Util
 open Names
@@ -20,6 +20,7 @@ open Evarutil
 open Evarconv
 open Retyping
 open Evd
+open Termops
 
 module type S = sig
   (*s Coercions. *)
@@ -66,7 +67,14 @@ module Default = struct
   (* Typing operations dealing with coercions *)
   exception NoCoercion
 
-  let class_of1 env sigma t = class_of env sigma (nf_evar sigma t)
+  let whd_app_evar sigma t =
+    match kind_of_term t with
+      | App (f,l) -> mkApp (whd_evar sigma f,l)
+      | _ -> whd_evar sigma t
+
+  let class_of1 env isevars t =
+    let sigma = evars_of isevars in
+    class_of env sigma (whd_app_evar sigma t)
 
   (* Here, funj is a coercion therefore already typed in global context *)
   let apply_coercion_args env argl funj =
@@ -84,7 +92,6 @@ module Default = struct
       apply_rec [] funj.uj_type argl
 
   (* appliquer le chemin de coercions de patterns p *)
-
   let apply_pattern_coercion loc pat p =
     List.fold_left
       (fun pat (co,n) ->
@@ -100,7 +107,6 @@ module Default = struct
       apply_pattern_coercion loc pat p
 
   (* appliquer le chemin de coercions p à hj *)
-
   let apply_coercion env p hj typ_cl =
     try 
       fst (List.fold_left
@@ -120,22 +126,23 @@ module Default = struct
     let t = whd_betadeltaiota env (evars_of isevars) j.uj_type in
       match kind_of_term t with
 	| Prod (_,_,_) -> (isevars,j)
-	| Evar ev when not (is_defined_evar isevars ev) ->
+	| Evar ev ->
 	    let (isevars',t) = define_evar_as_arrow isevars ev in
 	      (isevars',{ uj_val = j.uj_val; uj_type = t })
 	| _ ->
        	    (try
- 	       let t,i1 = class_of1 env (evars_of isevars) j.uj_type in
+ 	       let t,i1 = class_of1 env isevars j.uj_type in
       	       let p = lookup_path_to_fun_from i1 in
 		 (isevars,apply_coercion env p j t)
 	     with Not_found -> (isevars,j))
 
   let inh_tosort_force loc env isevars j =
     try
-      let t,i1 = class_of1 env (evars_of isevars) j.uj_type in
+      let t,i1 = class_of1 env isevars j.uj_type in
       let p = lookup_path_to_sort_from i1 in
       let j1 = apply_coercion env p j t in 
-	(isevars,type_judgment env (j_nf_evar (evars_of isevars) j1))
+      let j2 = on_judgment_type (whd_evar (evars_of isevars)) j1 in
+        (isevars,type_judgment env j2)
     with Not_found ->
       error_not_a_type_loc loc env (evars_of isevars) j
 
@@ -154,8 +161,8 @@ module Default = struct
   let inh_coerce_to_fail env isevars c1 v t =
     let v', t' =
       try 
-	let t1,i1 = class_of1 env (evars_of isevars) c1 in
-	let t2,i2 = class_of1 env (evars_of isevars) t in
+	let t1,i1 = class_of1 env isevars c1 in
+	let t2,i2 = class_of1 env isevars t in
 	let p = lookup_path_between (i2,i1) in
 	  match v with
 	      Some v -> 
@@ -166,64 +173,68 @@ module Default = struct
     in
       try (the_conv_x_leq env t' c1 isevars, v', t')
       with Reduction.NotConvertible -> raise NoCoercion
-  open Pp
+
   let rec inh_conv_coerce_to_fail loc env isevars v t c1 =
     try (the_conv_x_leq env t c1 isevars, v, t)
     with Reduction.NotConvertible ->
-      (try 
-	 inh_coerce_to_fail env isevars c1 v t
-	 with NoCoercion ->
-	   (match kind_of_term (whd_betadeltaiota env (evars_of isevars) t),
-	      kind_of_term (whd_betadeltaiota env (evars_of isevars) c1) with
-		| Prod (_,t1,t2), Prod (name,u1,u2) -> 
-		    let v' = option_map (whd_betadeltaiota env (evars_of isevars)) v in
-		    let (evd',b) =
-		      match v' with 
-			  Some v' ->
-			    (match kind_of_term v' with
-			       | Lambda (x,v1,v2) ->
-				   (try the_conv_x env v1 u1 isevars, Some (x, v1, v2)  (* leq v1 u1? *)
-				    with Reduction.NotConvertible -> (isevars, None))
-			       | _  -> (isevars, None))
-			| None -> (isevars, None)
-		    in 
-		      (match b with
-			   Some (x, v1, v2) ->
-			     let env1 = push_rel (x,None,v1) env in
-			     let (evd'', v2', t2') = inh_conv_coerce_to_fail loc env1 evd'
-						       (Some v2) t2 u2 in
-			       (evd'', option_map (fun v2' -> mkLambda (x, v1, v2')) v2', 
-				mkProd (x, v1, t2'))
-			 | None ->
-			     (* Mismatch on t1 and u1 or not a lambda: we eta-expand *)
-			     (* we look for a coercion c:u1->t1 s.t. [name:u1](v' (c x)) *)
-			     (* has type (name:u1)u2 (with v' recursively obtained) *)
-			     let name = (match name with 
-					   | Anonymous -> Name (id_of_string "x")
-					   | _ -> name) in
-			     let env1 = push_rel (name,None,u1) env in
-			     let (evd', v1', t1') =
-			       inh_conv_coerce_to_fail loc env1 isevars
-				 (Some (mkRel 1)) (lift 1 u1) (lift 1 t1) 
-			     in
-			     let (evd'', v2', t2') = 
-			       let v2 =
-				 match v with 
-				     Some v -> option_map (fun v1' -> mkApp (lift 1 v, [|v1'|])) v1'
-				   | None -> None
-			       and evd', t2 =
-				 match v1' with 
-				     Some v1' -> evd', subst1 v1' t2
-				   | None -> 
-				       let evd', ev = new_evar evd' env ~src:(loc, InternalHole) t1' in
-					 evd', subst1 ev t2
-			       in
-				 inh_conv_coerce_to_fail loc env1 evd' v2 t2 u2
-			     in
-			       (evd'', option_map (fun v2' -> mkLambda (name, u1, v2')) v2',
-				mkProd (name, u1, t2')))
-		| _ -> raise NoCoercion))
-	
+    try inh_coerce_to_fail env isevars c1 v t
+    with NoCoercion ->
+    match
+      kind_of_term (whd_betadeltaiota env (evars_of isevars) t),
+      kind_of_term (whd_betadeltaiota env (evars_of isevars) c1)
+    with
+    | Prod (_,t1,t2), Prod (name,u1,u2) -> 
+	let v' = option_map (whd_betadeltaiota env (evars_of isevars)) v in
+	let (evd',b) =
+	  match v' with 
+	  | Some v' ->
+	      (match kind_of_term v' with
+	       | Lambda (x,v1,v2) ->
+		   (* sous-typage non contravariant: pas de "leq v1 u1" *)
+		   (try the_conv_x env v1 u1 isevars, Some (x, v1, v2)
+		   with Reduction.NotConvertible -> (isevars, None))
+	       | _  -> (isevars, None))
+	  | None -> (isevars, None)
+	in
+	(match b with
+	 | Some (x, v1, v2) ->
+	     let env1 = push_rel (x,None,v1) env in
+	     let (evd'', v2', t2') = inh_conv_coerce_to_fail loc env1 evd'
+	       (Some v2) t2 u2 in
+	     (evd'', option_map (fun v2' -> mkLambda (x, v1, v2')) v2', 
+	     mkProd (x, v1, t2'))
+	 | None ->
+	     (* Mismatch on t1 and u1 or not a lambda: we eta-expand *)
+	     (* we look for a coercion c:u1->t1 s.t. [name:u1](v' (c x)) *)
+	     (* has type (name:u1)u2 (with v' recursively obtained) *)
+	     let name = match name with 
+	       | Anonymous -> Name (id_of_string "x")
+	       | _ -> name
+	     in
+	     let env1 = push_rel (name,None,u1) env in
+	     let (evd', v1', t1') =
+	       inh_conv_coerce_to_fail loc env1 isevars
+		 (Some (mkRel 1)) (lift 1 u1) (lift 1 t1)
+	     in
+	     let (evd'', v2', t2') = 
+	       let v2 =
+		 match v with 
+		 | Some v -> option_map (fun x -> mkApp(lift 1 v,[|x|])) v1'
+		 | None -> None
+	       and evd', t2 =
+		 match v1' with 
+		 | Some v1' -> evd', subst_term v1' t2
+		 | None -> 
+		     let evd', ev =
+		       new_evar evd' env ~src:(loc, InternalHole) t1' in
+		     evd', subst_term ev t2
+	       in
+	       inh_conv_coerce_to_fail loc env1 evd' v2 t2 u2
+	     in
+	     (evd'', option_map (fun v2' -> mkLambda (name, u1, v2')) v2',
+	     mkProd (name, u1, t2')))
+    | _ -> raise NoCoercion
+
   (* Look for cj' obtained from cj by inserting coercions, s.t. cj'.typ = t *)
   let inh_conv_coerce_to loc env isevars cj (n, t) =
     match n with
@@ -236,8 +247,7 @@ module Default = struct
 		error_actual_type_loc loc env sigma cj t
 	  in
 	  let val' = match val' with Some v -> v | None -> assert(false) in
-	  let nf = nf_isevar evd' in
-	    (evd',{ uj_val = nf val'; uj_type = nf t })
+	    (evd',{ uj_val = val'; uj_type = t })
       | Some (init, cur) -> (isevars, cj)
       
     let inh_conv_coerces_to loc env (isevars : evar_defs) t (abs, t') = isevars
diff --git a/pretyping/evarconv.ml b/pretyping/evarconv.ml
index 458f5bd3..3c4a23ec 100644
--- a/pretyping/evarconv.ml
+++ b/pretyping/evarconv.ml
@@ -6,14 +6,16 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evarconv.ml 8793 2006-05-05 17:41:41Z barras $ *)
+(* $Id: evarconv.ml 9141 2006-09-15 10:07:01Z herbelin $ *)
 
+open Pp
 open Util
 open Names
 open Term
 open Closure
 open Reduction
 open Reductionops
+open Termops
 open Environ
 open Typing
 open Classops
@@ -83,7 +85,7 @@ let evar_apprec env isevars stack c =
       | Evar (n,_ as ev) when Evd.is_defined sigma n ->
 	  aux (Evd.existential_value sigma ev, stack)
       | _ -> (t, list_of_stack stack)
-  in aux (c, append_stack (Array.of_list stack) empty_stack)
+  in aux (c, append_stack_list stack empty_stack)
 
 let apprec_nohdbeta env isevars c =
   let (t,stack as s) = Reductionops.whd_stack c in
@@ -126,7 +128,6 @@ let check_conv_record (t1,l1) (t2,l2) =
   with _ -> 
     raise Not_found
 
-
 (* Precondition: one of the terms of the pb is an uninstantiated evar,
  * possibly applied to arguments. *)
 
@@ -190,12 +191,7 @@ let rec evar_conv_x env isevars pbty term1 term2 =
   else 
     let (t1,l1) = apprec_nohdbeta env isevars term1 in
     let (t2,l2) = apprec_nohdbeta env isevars term2 in
-    if (head_is_embedded_evar isevars t1 & not(is_eliminator t2))
-      or (head_is_embedded_evar isevars t2 & not(is_eliminator t1))
-    then 
-      (add_conv_pb (pbty,applist(t1,l1),applist(t2,l2)) isevars, true)
-    else 
-      evar_eqappr_x env isevars pbty (t1,l1) (t2,l2)
+    evar_eqappr_x env isevars pbty (t1,l1) (t2,l2)
 
 and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
   (* Evar must be undefined since we have whd_ised *)
@@ -229,7 +225,20 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 
     | Flexible ev1, MaybeFlexible flex2 ->
 	let f1 i =
-          if List.length l1 <= List.length l2 then
+	  if 
+	    is_unification_pattern_evar ev1 l1 & 
+	    not (occur_evar (fst ev1) (applist (term2,l2)))
+	  then
+	    (* Miller-Pfenning's patterns unification *)
+	    (* Preserve generality (except that CCI has no eta-conversion) *)
+	    let t2 = nf_evar (evars_of isevars) (applist(term2,l2)) in
+	    let t2 = solve_pattern_eqn env l1 t2 in
+	    solve_simple_eqn evar_conv_x env isevars (pbty,ev1,t2)
+	  else if
+            List.length l1 <= List.length l2
+	  then
+	    (* Try first-order unification *)
+	    (* (heuristic that gives acceptable results in practice) *)
 	    let (deb2,rest2) =
               list_chop (List.length l2-List.length l1) l2 in
             ise_and i
@@ -248,7 +257,20 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 
     | MaybeFlexible flex1, Flexible ev2 ->
 	let f1 i =
-       	  if List.length l2 <= List.length l1 then
+	  if 
+	    is_unification_pattern_evar ev2 l2 & 
+	    not (occur_evar (fst ev2) (applist (term1,l1)))
+	  then
+	    (* Miller-Pfenning's patterns unification *)
+	    (* Preserve generality (except that CCI has no eta-conversion) *)
+	    let t1 = nf_evar (evars_of isevars) (applist(term1,l1)) in
+	    let t1 = solve_pattern_eqn env l2 t1 in
+	    solve_simple_eqn evar_conv_x env isevars (pbty,ev2,t1)
+	  else if
+       	    List.length l2 <= List.length l1
+	  then
+	    (* Try first-order unification *)
+	    (* (heuristic that gives acceptable results in practice) *)
             let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
             ise_and i
             (* First compare extra args for better failure message *)
@@ -273,8 +295,7 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	  (try conv_record env i
              (try check_conv_record appr1 appr2
 	      with Not_found -> check_conv_record appr2 appr1)
-(* TODO: remove this _ !!! *)
-           with _ -> (i,false))
+           with Not_found -> (i,false))
 	and f4 i =
           (* heuristic: unfold second argument first, exception made
              if the first argument is a beta-redex (expand a constant
@@ -295,38 +316,39 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	ise_try isevars [f2; f3; f4]
 
     | Flexible ev1, Rigid _ ->
-       	if (List.length l1 <= List.length l2) then
-       	  let (deb2,rest2) = list_chop (List.length l2-List.length l1) l2 in
-          ise_and isevars
-            (* First compare extra args for better failure message *)
-            [(fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) l1 rest2);
-             (fun i ->
-               (* Then instantiate evar unless already done by unifying args *)
-	       let t2 = applist(term2,deb2) in
-	       if is_defined_evar i ev1 then
-		 evar_conv_x env i pbty (mkEvar ev1) t2
-	       else
-		 solve_simple_eqn evar_conv_x env i (pbty,ev1,t2))]
-        else (isevars,false)
+	if 
+	  is_unification_pattern_evar ev1 l1 & 
+	  not (occur_evar (fst ev1) (applist (term2,l2)))
+	then
+	  (* Miller-Pfenning's patterns unification *)
+	  (* Preserve generality (except that CCI has no eta-conversion) *)
+	  let t2 = nf_evar (evars_of isevars) (applist(term2,l2)) in
+	  let t2 = solve_pattern_eqn env l1 t2 in
+	  solve_simple_eqn evar_conv_x env isevars (pbty,ev1,t2)
+	else
+	  (* Postpone the use of an heuristic *)
+	  add_conv_pb (pbty,applist(term1,l1),applist(term2,l2)) isevars,
+	  true
+
     | Rigid _, Flexible ev2 ->
-        if List.length l2 <= List.length l1 then
-       	  let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
-          ise_and isevars
-            (* First compare extra args for better failure message *)
-            [(fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) rest1 l2);
-	     (fun i ->
-               (* Then instantiate evar unless already done by unifying args *)
-	       let t1 = applist(term1,deb1) in
-	       if is_defined_evar i ev2 then
-		 evar_conv_x env i pbty t1 (mkEvar ev2)
-	       else
-		 solve_simple_eqn evar_conv_x env i (pbty,ev2,t1))]
-        else (isevars,false)
+	if 
+	  is_unification_pattern_evar ev2 l2 & 
+	  not (occur_evar (fst ev2) (applist (term1,l1)))
+	then
+	  (* Miller-Pfenning's patterns unification *)
+	  (* Preserve generality (except that CCI has no eta-conversion) *)
+	  let t1 = nf_evar (evars_of isevars) (applist(term1,l1)) in
+	  let t1 = solve_pattern_eqn env l2 t1 in
+	  solve_simple_eqn evar_conv_x env isevars (pbty,ev2,t1)
+	else
+	  (* Postpone the use of an heuristic *)
+	  add_conv_pb (pbty,applist(term1,l1),applist(term2,l2)) isevars,
+	  true
 
     | MaybeFlexible flex1, Rigid _ ->
 	let f3 i =
 	  (try conv_record env i (check_conv_record appr1 appr2)
-           with _ -> (i,false))
+           with Not_found -> (i,false))
 	and f4 i =
 	  match eval_flexible_term env flex1 with
 	    | Some v1 ->
@@ -337,8 +359,8 @@ and evar_eqappr_x env isevars pbty (term1,l1 as appr1) (term2,l2 as appr2) =
 	     
     | Rigid _ , MaybeFlexible flex2 -> 
 	let f3 i = 
-	  (try (conv_record env i (check_conv_record appr2 appr1))
-           with _ -> (i,false))
+	  (try conv_record env i (check_conv_record appr2 appr1)
+           with Not_found -> (i,false))
 	and f4 i =
 	  match eval_flexible_term env flex2 with
 	    | Some v2 ->
@@ -468,7 +490,51 @@ and conv_record env isevars (c,bs,(params,params1),(us,us2),(ts,ts1),c1) =
          params1 params);
      (fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) ts ts1);
      (fun i -> evar_conv_x env i CONV c1 (applist (c,(List.rev ks))))]
-    
+
+let first_order_unification env isevars pbty (term1,l1) (term2,l2) =
+  match kind_of_term term1, kind_of_term term2 with
+    | Evar ev1,_ when List.length l1 <= List.length l2 ->
+	let (deb2,rest2) = list_chop (List.length l2-List.length l1) l2 in
+	ise_and isevars
+          (* First compare extra args for better failure message *)
+        [(fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) rest2 l1);
+	(fun i ->
+          (* Then instantiate evar unless already done by unifying args *)
+	  let t2 = applist(term2,deb2) in
+	  if is_defined_evar i ev1 then
+	    evar_conv_x env i pbty t2 (mkEvar ev1)
+	  else
+	    solve_simple_eqn evar_conv_x env i (pbty,ev1,t2))]
+    | _,Evar ev2 when List.length l2 <= List.length l1 ->
+	let (deb1,rest1) = list_chop (List.length l1-List.length l2) l1 in
+	ise_and isevars
+          (* First compare extra args for better failure message *)
+        [(fun i -> ise_list2 i (fun i -> evar_conv_x env i CONV) rest1 l2);
+	(fun i ->
+          (* Then instantiate evar unless already done by unifying args *)
+	  let t1 = applist(term1,deb1) in
+	  if is_defined_evar i ev2 then
+	    evar_conv_x env i pbty t1 (mkEvar ev2)
+	  else
+	    solve_simple_eqn evar_conv_x env i (pbty,ev2,t1))]
+    | _ -> 
+	(* Some head evar have been instantiated *)
+	evar_conv_x env isevars pbty (applist(term1,l1)) (applist(term2,l2))
+
+let consider_remaining_unif_problems env isevars =
+  let (isevars,pbs) = get_conv_pbs isevars (fun _ -> true) in
+  List.fold_left
+    (fun (isevars,b as p) (pbty,t1,t2) ->
+      (* Pas le bon env pour le problème... *)
+      if b then first_order_unification env isevars pbty 
+	(apprec_nohdbeta env isevars (whd_castappevar (evars_of isevars) t1))
+	(apprec_nohdbeta env isevars (whd_castappevar (evars_of isevars) t2))
+      else p)
+    (isevars,true)
+    pbs
+
+(* Main entry points *)
+
 let the_conv_x     env t1 t2 isevars =
   match evar_conv_x env isevars CONV  t1 t2 with
       (evd',true) -> evd'
diff --git a/pretyping/evarconv.mli b/pretyping/evarconv.mli
index a6f5b489..f92a6fdb 100644
--- a/pretyping/evarconv.mli
+++ b/pretyping/evarconv.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evarconv.mli 6109 2004-09-15 16:50:56Z barras $ i*)
+(*i $Id: evarconv.mli 9141 2006-09-15 10:07:01Z herbelin $ i*)
 
 (*i*)
 open Term
@@ -33,3 +33,5 @@ val evar_eqappr_x :
     conv_pb -> constr * constr list -> constr * constr list ->
       evar_defs * bool
 (*i*)
+
+val consider_remaining_unif_problems : env -> evar_defs -> evar_defs * bool
diff --git a/pretyping/evarutil.ml b/pretyping/evarutil.ml
index 506cd03f..307c9886 100644
--- a/pretyping/evarutil.ml
+++ b/pretyping/evarutil.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evarutil.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: evarutil.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Util
 open Pp
@@ -21,13 +21,6 @@ open Evd
 open Reductionops
 open Pretype_errors
 
-
-let rec filter_unique = function
-  | [] -> []
-  | x::l ->
-      if List.mem x l then filter_unique (List.filter (fun y -> x<>y) l)
-      else x::filter_unique l
-
 (* Expanding existential variables (pretyping.ml) *)
 (* 1- whd_ise fails if an existential is undefined *)
 
@@ -63,9 +56,9 @@ let jv_nf_evar = Pretype_errors.jv_nf_evar
 let tj_nf_evar = Pretype_errors.tj_nf_evar
 
 let nf_evar_info evc info =
-  { evar_concl = Reductionops.nf_evar evc info.evar_concl;
-    evar_hyps = map_named_val (Reductionops.nf_evar evc) info.evar_hyps;
-    evar_body = info.evar_body}
+  { info with 
+      evar_concl = Reductionops.nf_evar evc info.evar_concl;
+      evar_hyps = map_named_val (Reductionops.nf_evar evc) info.evar_hyps}
 
 let nf_evars evm = Evd.fold (fun ev evi evm' -> Evd.add evm' ev (nf_evar_info evm evi))
 		     evm Evd.empty
@@ -310,29 +303,45 @@ let is_defined_equation env evd (ev,inst) rhs =
  * ?3 <-- ?1          no pb: env of ?3 is larger than ?1's
  * ?1 <-- (list ?2)   pb: ?2 may depend on x, but not ?1.
  * What we do is that ?2 is defined by a new evar ?4 whose context will be
- * a prefix of ?2's env, included in ?1's env. *)
+ * a prefix of ?2's env, included in ?1's env.
+
+ Concretely, the assumptions are "env |- ev : T" and "Gamma |-
+ ev[hyps:=args]" for some Gamma whose de Bruijn context has length k.
+ We create "env' |- ev' : T" for some env' <= env and define ev:=ev'
+*)
 
-let do_restrict_hyps evd ev args =
+let do_restrict_hyps env k evd ev args =
   let args = Array.to_list args in
   let evi = Evd.find (evars_of !evd) ev in
-  let env = evar_env evi in
   let hyps = evar_context evi in
-  let (sign,ncargs) = list_filter2 (fun _ a -> closed0 a) (hyps,args) in
+  let (hyps',ncargs) = list_filter2 (fun _ a -> closedn k a) (hyps,args) in
   (* No care is taken in case the evar type uses vars filtered out!
-     Is it important ? *)
-  let nc =
-    let env =
-      Sign.fold_named_context push_named sign ~init:(reset_context env) in
-    e_new_evar evd env ~src:(evar_source ev !evd) evi.evar_concl in
+     Assuming that the restriction comes from a well-typed Flex/Flex
+     unification problem (see real_clean), the type of the evar cannot
+     depend on variables that are not in the scope of the other evar,
+     since this other evar has the same type (up to unification).
+     Since moreover, the evar contexts uses names only, the
+     restriction raise no de Bruijn reallocation problem *)
+  let env' =
+    Sign.fold_named_context push_named hyps' ~init:(reset_context env) in
+  let nc = e_new_evar evd env' ~src:(evar_source ev !evd) evi.evar_concl in
   evd := Evd.evar_define ev nc !evd;
   let (evn,_) = destEvar nc in
   mkEvar(evn,Array.of_list ncargs)
 
-
-let need_restriction isevars args = not (array_for_all closed0 args)
+let need_restriction k args = not (array_for_all (closedn k) args)
 
 (* We try to instantiate the evar assuming the body won't depend
- * on arguments that are not Rels or Vars, or appearing several times.
+ * on arguments that are not Rels or Vars, or appearing several times
+   (i.e. we tackle only Miller-Pfenning patterns unification) 
+
+  1) Let a unification problem "env |- ev[hyps:=args] = rhs"
+  2) We limit it to a patterns unification problem "env |- ev[subst] = rhs"
+     where only Rel's and Var's are relevant in subst
+  3) We recur on rhs, "imitating" the term failing if some Rel/Var not in scope
+
+  Note: we don't assume rhs in normal form, it may fail while it would
+  have succeeded after some reductions
  *)
 (* Note: error_not_clean should not be an error: it simply means that the
  * conversion test that lead to the faulty call to [real_clean] should return
@@ -341,36 +350,52 @@ let need_restriction isevars args = not (array_for_all closed0 args)
 
 let real_clean env isevars ev evi args rhs =
   let evd = ref isevars in
-  let subst = List.map (fun (x,y) -> (y,mkVar x)) (filter_unique args) in
+  let subst = List.map (fun (x,y) -> (y,mkVar x)) (list_uniquize args) in
   let rec subs rigid k t =
     match kind_of_term t with
       | Rel i ->
  	 if i<=k then t
- 	 else (try List.assoc (mkRel (i-k)) subst with Not_found -> t)
+ 	 else
+	   (* Flex/Rel problem: unifiable as a pattern iff Rel in ev scope *)
+	   (try List.assoc (mkRel (i-k)) subst 
+	    with Not_found -> if rigid then raise Exit else t)
       | Evar (ev,args) ->
           if Evd.is_defined_evar !evd (ev,args) then
             subs rigid k (existential_value (evars_of !evd) (ev,args))
           else
+	    (* Flex/Flex problem: restriction to a common scope *)
 	    let args' = Array.map (subs false k) args in
-	    if need_restriction !evd args' then
-              do_restrict_hyps evd ev args'
+	    if need_restriction k args' then
+              do_restrict_hyps (reset_context env) k evd ev args'
 	    else
 	      mkEvar (ev,args')
       | Var id ->
+	  (* Flex/Var problem: unifiable as a pattern iff Var in scope of ev *)
           (try List.assoc t subst
            with Not_found ->
              if
                not rigid 
+	     (* I don't understand this line: vars from evar_context evi
+		are private (especially some of them are freshly
+		generated in push_rel_context_to_named_context). They
+		have a priori nothing to do with the vars in env. I
+		remove the test [HH 25/8/06]
+
 		 or List.exists (fun (id',_,_) -> id=id') (evar_context evi)
+	     *)
              then t
-             else
-               error_not_clean env (evars_of !evd) ev rhs
-                 (evar_source ev !evd))
-      | _ -> map_constr_with_binders succ (subs rigid) k t
+             else raise Exit)
+               
+      | _ ->
+	  (* Flex/Rigid problem (or assimilated if not normal): we "imitate" *)
+	  map_constr_with_binders succ (subs rigid) k t
   in
-  let body = subs true 0 (nf_evar (evars_of isevars) rhs) in
-  if not (closed0 body)
-  then error_not_clean env (evars_of !evd) ev body (evar_source ev !evd);
+  let rhs = nf_evar (evars_of isevars) rhs in
+  let rhs = whd_beta rhs (* heuristic *) in
+  let body = 
+    try subs true 0 rhs
+    with Exit -> 
+      error_not_clean env (evars_of !evd) ev rhs (evar_source ev !evd) in
   (!evd,body)
 
 (* [evar_define] solves the problem lhs = rhs when lhs is an uninstantiated
@@ -464,6 +489,34 @@ let head_evar =
   in 
   hrec 
 
+(* Check if an applied evar "?X[args] l" is a Miller's pattern; note
+   that we don't care whether args itself contains Rel's or even Rel's
+   distinct from the ones in l *)
+
+let is_unification_pattern_evar (_,args) l =
+  let l' = Array.to_list args @ l in
+  List.for_all (fun a -> isRel a or isVar a) l' & list_distinct l'
+
+let is_unification_pattern f l =
+  match kind_of_term f with
+    | Meta _ -> array_for_all isRel l & array_distinct l
+    | Evar ev -> is_unification_pattern_evar ev (Array.to_list l)
+    | _ -> false
+
+(* From a unification problem "?X l1 = term1 l2" such that l1 is made
+   of distinct rel's, build "\x1...xn.(term1 l2)" (patterns unification) *)
+
+let solve_pattern_eqn env l1 c =
+  let c' = List.fold_right (fun a c ->
+    let c' = subst_term (lift 1 a) (lift 1 c) in
+    match kind_of_term a with
+      (* Rem: if [a] links to a let-in, do as if it were an assumption *)
+      | Rel n -> let (na,_,t) = lookup_rel n env in mkLambda (na,lift n t,c')
+      | Var id -> let (id,_,t) = lookup_named id env in mkNamedLambda id t c'
+      | _ -> assert false) 
+    l1 c in
+  whd_eta c'
+
 (* This code (i.e. solve_pb, etc.) takes a unification
  * problem, and tries to solve it. If it solves it, then it removes
  * all the conversion problems, and re-runs conversion on each one, in
@@ -550,11 +603,28 @@ let solve_simple_eqn conv_algo env isevars (pbty,(n1,args1 as ev1),t2) =
     let (isevars,pbs) = get_conv_pbs isevars (status_changed lsp) in
     List.fold_left
       (fun (isevars,b as p) (pbty,t1,t2) ->
-        if b then conv_algo env isevars pbty t1 t2 else p) (isevars,true)
+	if b then conv_algo env isevars pbty t1 t2 else p) (isevars,true)
       pbs
   with e when precatchable_exception e ->
     (isevars,false)
 
+
+(* [check_evars] fails if some unresolved evar remains *)
+(* it assumes that the defined existentials have already been substituted *)
+
+let check_evars env initial_sigma isevars c =
+  let sigma = evars_of isevars in
+  let c = nf_evar sigma c in
+  let rec proc_rec c =
+    match kind_of_term c with
+      | Evar (ev,args) ->
+          assert (Evd.mem sigma ev);
+	  if not (Evd.mem initial_sigma ev) then
+            let (loc,k) = evar_source ev isevars in
+	    error_unsolvable_implicit loc env sigma k
+      | _ -> iter_constr proc_rec c
+  in proc_rec c
+
 (* Operations on value/type constraints *)
 
 type type_constraint_type = (int * int) option * constr
diff --git a/pretyping/evarutil.mli b/pretyping/evarutil.mli
index 7429cd16..3ac05481 100644
--- a/pretyping/evarutil.mli
+++ b/pretyping/evarutil.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evarutil.mli 8695 2006-04-10 16:33:52Z msozeau $ i*)
+(*i $Id: evarutil.mli 9141 2006-09-15 10:07:01Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -78,10 +78,18 @@ val solve_simple_eqn :
   -> env ->  evar_defs -> conv_pb * existential * constr ->
     evar_defs * bool
 
+(* [check_evars env initial_sigma extended_sigma c] fails if some
+   new unresolved evar remains in [c] *)
+val check_evars : env -> evar_map -> evar_defs -> constr -> unit
+
 val define_evar_as_arrow : evar_defs -> existential -> evar_defs * types
 val define_evar_as_lambda : evar_defs -> existential -> evar_defs * types
 val define_evar_as_sort : evar_defs -> existential -> evar_defs * sorts
 
+val is_unification_pattern_evar : existential -> constr list -> bool
+val is_unification_pattern : constr -> constr array -> bool
+val solve_pattern_eqn : env -> constr list -> constr -> constr
+
 (***********************************************************)
 (* Value/Type constraints *)
 
diff --git a/pretyping/evd.ml b/pretyping/evd.ml
index 33f88ebd..030983e1 100644
--- a/pretyping/evd.ml
+++ b/pretyping/evd.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evd.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: evd.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Pp
 open Util
@@ -30,7 +30,8 @@ type evar_body =
 type evar_info = {
   evar_concl : constr;
   evar_hyps : named_context_val;
-  evar_body : evar_body}
+  evar_body : evar_body;
+  evar_extra : Dyn.t option}
 
 let evar_context evi = named_context_of_val evi.evar_hyps
 
@@ -46,7 +47,11 @@ type evar_map1 = evar_info Evarmap.t
 
 let empty = Evarmap.empty
 
-let to_list evc = Evarmap.fold (fun ev x acc -> (ev,x)::acc) evc []
+let to_list evc = (* Workaround for change in Map.fold behavior *)
+  let l = ref [] in 
+    Evarmap.iter (fun ev x -> l:=(ev,x)::!l) evc;
+    !l
+
 let dom evc = Evarmap.fold (fun ev _ acc -> ev::acc) evc []
 let find evc k = Evarmap.find k evc
 let remove evc k = Evarmap.remove k evc
@@ -60,9 +65,8 @@ let define evd ev body =
     try find evd ev
     with Not_found -> error "Evd.define: cannot define undeclared evar" in
   let newinfo =
-    { evar_concl = oldinfo.evar_concl;
-      evar_hyps = oldinfo.evar_hyps;
-      evar_body = Evar_defined body} in
+    { oldinfo with
+      evar_body = Evar_defined body } in
   match oldinfo.evar_body with
     | Evar_empty -> Evarmap.add ev newinfo evd
     | _ -> anomaly "Evd.define: cannot define an isevar twice"
@@ -377,14 +381,7 @@ let create_evar_defs sigma =
 let evars_of d = d.evars
 let evars_reset_evd evd d = {d with evars = evd}
 let reset_evd (sigma,mmap) d = {d with evars = sigma; metas=mmap}
-let add_conv_pb pb d =
-(*  let (pbty,c1,c2) = pb in
-  pperrnl
-    (Termops.print_constr c1 ++
-    (if pbty=Reduction.CUMUL then str " <="++ spc()
-    else str" =="++spc()) ++
-    Termops.print_constr c2);*)
-  {d with conv_pbs = pb::d.conv_pbs}
+let add_conv_pb pb d = {d with conv_pbs = pb::d.conv_pbs}
 let evar_source ev d =
   try List.assoc ev d.history
   with Not_found -> (dummy_loc, InternalHole)
@@ -396,7 +393,10 @@ let evar_define sp body isevars =
 let evar_declare hyps evn ty ?(src=(dummy_loc,InternalHole)) evd =
   { evd with
     evars = add evd.evars evn
-      {evar_hyps=hyps; evar_concl=ty; evar_body=Evar_empty};
+      {evar_hyps=hyps; 
+       evar_concl=ty; 
+       evar_body=Evar_empty; 
+       evar_extra=None};
     history = (evn,src)::evd.history }
 
 let is_defined_evar isevars (n,_) = is_defined isevars.evars n
@@ -548,14 +548,21 @@ let pr_evar_map sigma =
         h 0 (str(string_of_existential ev)++str"=="++ pr_evar_info evi))
       (to_list sigma))
 
+let pr_constraints pbs =
+  h 0
+    (prlist_with_sep pr_fnl (fun (pbty,t1,t2) ->
+      print_constr t1 ++ spc() ++
+      str (match pbty with
+	| Reduction.CONV -> "=="
+	| Reduction.CUMUL -> "<=") ++ 
+      spc() ++ print_constr t2) pbs)
+
 let pr_evar_defs evd =
   let pp_evm =
     if evd.evars = empty then mt() else
       str"EVARS:"++brk(0,1)++pr_evar_map evd.evars++fnl() in
-  let n = List.length evd.conv_pbs in
   let cstrs =
-    if n=0 then mt() else
-      str"=> " ++ int n ++ str" constraints" ++ fnl() ++ fnl() in
+    str"CONSTRAINTS:"++brk(0,1)++pr_constraints evd.conv_pbs++fnl() in
   let pp_met =
     if evd.metas = Metamap.empty then mt() else
       str"METAS:"++brk(0,1)++pr_meta_map evd.metas in
diff --git a/pretyping/evd.mli b/pretyping/evd.mli
index cbc96b04..876c34d2 100644
--- a/pretyping/evd.mli
+++ b/pretyping/evd.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evd.mli 8759 2006-04-28 12:24:14Z herbelin $ i*)
+(*i $Id: evd.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Util
@@ -32,7 +32,8 @@ type evar_body =
 type evar_info = {
   evar_concl : constr;
   evar_hyps : Environ.named_context_val;
-  evar_body : evar_body}
+  evar_body : evar_body;
+  evar_extra : Dyn.t option}
 
 val eq_evar_info : evar_info -> evar_info -> bool
 val evar_context : evar_info -> named_context
@@ -94,6 +95,7 @@ type 'a freelisted = {
   rebus : 'a;
   freemetas : Metaset.t }
 
+val metavars_of : constr -> Metaset.t
 val mk_freelisted : constr -> constr freelisted
 val map_fl : ('a -> 'b) -> 'a freelisted -> 'b freelisted
 
diff --git a/pretyping/inductiveops.ml b/pretyping/inductiveops.ml
index e0cdeeee..14136f61 100644
--- a/pretyping/inductiveops.ml
+++ b/pretyping/inductiveops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: inductiveops.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: inductiveops.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -23,7 +23,7 @@ open Reductionops
 
 let type_of_inductive env ind =
  let specif = Inductive.lookup_mind_specif env ind in
-  Inductive.type_of_inductive specif
+  Inductive.type_of_inductive env specif
 
 (* Return type as quoted by the user *)
 let type_of_constructor env cstr =
@@ -126,6 +126,10 @@ let inductive_nargs env ind =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
   mib.mind_nparams, mip.mind_nrealargs
 
+let allowed_sorts env (kn,i as ind) =
+  let (mib,mip) = Inductive.lookup_mind_specif env ind in
+  mip.mind_kelim
+
 (* Annotation for cases *)
 let make_case_info env ind style pats_source =
   let (mib,mip) = Inductive.lookup_mind_specif env ind in
diff --git a/pretyping/inductiveops.mli b/pretyping/inductiveops.mli
index dcd86716..d49b64d9 100644
--- a/pretyping/inductiveops.mli
+++ b/pretyping/inductiveops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: inductiveops.mli 8845 2006-05-23 07:41:58Z herbelin $ i*)
+(*i $Id: inductiveops.mli 9194 2006-10-01 09:25:19Z herbelin $ i*)
 
 open Names
 open Term
@@ -66,6 +66,8 @@ val constructor_nrealhyps : env -> constructor -> int
 
 val get_full_arity_sign : env -> inductive -> rel_context
 
+val allowed_sorts : env -> inductive -> sorts_family list
+
 (* Extract information from an inductive family *)
 
 type constructor_summary = {
diff --git a/pretyping/matching.ml b/pretyping/matching.ml
index 12c1ea33..65ce2ef4 100644
--- a/pretyping/matching.ml
+++ b/pretyping/matching.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: matching.ml 8827 2006-05-17 15:15:34Z jforest $ *)
+(* $Id: matching.ml 9280 2006-10-25 21:37:37Z herbelin $ *)
 
 (*i*)
 open Util
@@ -119,6 +119,8 @@ let matches_core convert allow_partial_app pat c =
 
       | PSort (RType _), Sort (Type _) -> sigma
 
+      | PApp (p, [||]), _ -> sorec stk sigma p t
+
       | PApp (PApp (h, a1), a2), _ ->
           sorec stk sigma (PApp(h,Array.append a1 a2)) t
 
diff --git a/pretyping/pretype_errors.ml b/pretyping/pretype_errors.ml
index f5a81659..59cdad04 100644
--- a/pretyping/pretype_errors.ml
+++ b/pretyping/pretype_errors.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pretype_errors.ml 8752 2006-04-27 19:37:33Z herbelin $ *)
+(* $Id: pretype_errors.ml 9217 2006-10-05 17:31:23Z notin $ *)
 
 open Util
 open Stdpp
@@ -27,6 +27,7 @@ type pretype_error =
   | NotClean of existential_key * constr * Evd.hole_kind
   | UnsolvableImplicit of Evd.hole_kind
   | CannotUnify of constr * constr
+  | CannotUnifyLocal of Environ.env * constr * constr * constr
   | CannotUnifyBindingType of constr * constr
   | CannotGeneralize of constr
   | NoOccurrenceFound of constr
@@ -157,6 +158,9 @@ let error_unsolvable_implicit loc env sigma e =
 let error_cannot_unify env sigma (m,n) =
   raise (PretypeError (env_ise sigma env,CannotUnify (m,n)))
 
+let error_cannot_unify_local env sigma (e,m,n,sn) = 
+  raise (PretypeError (env_ise sigma env,CannotUnifyLocal (e,m,n,sn)))
+
 let error_cannot_coerce env sigma (m,n) =
   raise (PretypeError (env_ise sigma env,CannotUnify (m,n)))
 
diff --git a/pretyping/pretype_errors.mli b/pretyping/pretype_errors.mli
index 3c78d48d..137ef639 100644
--- a/pretyping/pretype_errors.mli
+++ b/pretyping/pretype_errors.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pretype_errors.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
+(*i $Id: pretype_errors.mli 9217 2006-10-05 17:31:23Z notin $ i*)
 
 (*i*)
 open Pp
@@ -29,6 +29,7 @@ type pretype_error =
   | NotClean of existential_key * constr * Evd.hole_kind
   | UnsolvableImplicit of Evd.hole_kind
   | CannotUnify of constr * constr
+  | CannotUnifyLocal of Environ.env * constr * constr * constr
   | CannotUnifyBindingType of constr * constr
   | CannotGeneralize of constr
   | NoOccurrenceFound of constr
@@ -96,6 +97,8 @@ val error_unsolvable_implicit :
 
 val error_cannot_unify : env -> Evd.evar_map -> constr * constr -> 'b
 
+val error_cannot_unify_local : env -> Evd.evar_map -> Environ.env * constr * constr * constr -> 'b
+
 (*s Ml Case errors *)
 
 val error_cant_find_case_type_loc :
diff --git a/pretyping/pretyping.ml b/pretyping/pretyping.ml
index e3cfe974..0b00c82c 100644
--- a/pretyping/pretyping.ml
+++ b/pretyping/pretyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pretyping.ml 8992 2006-06-27 21:29:18Z herbelin $ *)
+(* $Id: pretyping.ml 9338 2006-11-03 13:09:53Z herbelin $ *)
 
 open Pp
 open Util
@@ -245,6 +245,9 @@ module Pretyping_F (Coercion : Coercion.S) = struct
     let ccl' = mkLambda (Anonymous, ind, ccl) in
       {uj_val=lam_it ccl' sign; uj_type=prod_it s' sign} 
 
+  let evar_kind_of_term sigma c =
+    kind_of_term (whd_evar (Evd.evars_of sigma) c)
+
   (*************************************************************************)
   (* Main pretyping function                                               *)
 
@@ -375,10 +378,9 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		  | Prod (na,c1,c2) ->
 		      let hj = pretype (mk_tycon c1) env isevars lvar c in
 		      let value, typ = applist (j_val resj, [j_val hj]), subst1 hj.uj_val c2 in
-		      let typ' = nf_isevar !isevars typ in
 			apply_rec env (n+1) 
-			  { uj_val = nf_isevar !isevars value;
-			    uj_type = typ' }
+			  { uj_val = value;
+			    uj_type = typ }
 			  rest
 		  | _ ->
 		      let hj = pretype empty_tycon env isevars lvar c in
@@ -386,15 +388,18 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 			  (join_loc floc argloc) env (evars_of !isevars)
 	      		  resj [hj]
 	in
-	let resj = j_nf_evar (evars_of !isevars) (apply_rec env 1 fj args) in
+	let resj = apply_rec env 1 fj args in
 	let resj =
-	  match kind_of_term resj.uj_val with
-	  | App (f,args) when isInd f ->
-	      let sigma = evars_of !isevars in
-	      let t = Retyping.type_of_inductive_knowing_parameters env sigma (destInd f) args in
-	      let s = snd (splay_arity env sigma t) in
-	      on_judgment_type (set_inductive_level env s) resj
-		(* Rem: no need to send sigma: no head evar, it's an arity *)
+	  match evar_kind_of_term !isevars resj.uj_val with
+	  | App (f,args) ->
+              let f = whd_evar (Evd.evars_of !isevars) f in
+              begin match kind_of_term f with
+              | Ind _ (* | Const _ *) ->
+	          let sigma = evars_of !isevars in
+		  let c = mkApp (f,Array.map (whd_evar sigma) args) in
+	          let t = Retyping.get_type_of env sigma c in
+		  make_judge c t
+              | _ -> resj end
 	  | _ -> resj in
 	inh_conv_coerce_to_tycon loc env isevars resj tycon
 
@@ -455,7 +460,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		 | Some p ->
 		     let env_p = push_rels psign env in
 		     let pj = pretype_type empty_valcon env_p isevars lvar p in
-		     let ccl = nf_evar (evars_of !isevars) pj.utj_val in
+		     let ccl = nf_isevar !isevars pj.utj_val in
 		     let psign = make_arity_signature env true indf in (* with names *)
 		     let p = it_mkLambda_or_LetIn ccl psign in
 		     let inst = 
@@ -475,7 +480,7 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 		     let tycon = lift_tycon cs.cs_nargs tycon in
 		     let fj = pretype tycon env_f isevars lvar d in
 		     let f = it_mkLambda_or_LetIn fj.uj_val fsign in
-		     let ccl = nf_evar (evars_of !isevars) fj.uj_type in
+		     let ccl = nf_isevar !isevars fj.uj_type in
 		     let ccl =
 		       if noccur_between 1 cs.cs_nargs ccl then
 			 lift (- cs.cs_nargs) ccl 
@@ -632,35 +637,6 @@ module Pretyping_F (Coercion : Coercion.S) = struct
 	  (pretype_type empty_valcon env isevars lvar c).utj_val in
       nf_evar (evars_of !isevars) c'
 
-  (* [check_evars] fails if some unresolved evar remains *)
-  (* it assumes that the defined existentials have already been substituted
-     (should be done in unsafe_infer and unsafe_infer_type) *)
-
-  let check_evars env initial_sigma isevars c =
-    let sigma = evars_of !isevars in
-    let rec proc_rec c =
-      match kind_of_term c with
-	| Evar (ev,args) ->
-            assert (Evd.mem sigma ev);
-	    if not (Evd.mem initial_sigma ev) then
-              let (loc,k) = evar_source ev !isevars in
-		error_unsolvable_implicit loc env sigma k
-	| _ -> iter_constr proc_rec c
-    in
-      proc_rec c(*;
-		  let (_,pbs) = get_conv_pbs !isevars (fun _ -> true) in
-		  if pbs <> [] then begin
-		  pperrnl
-		  (str"TYPING OF "++Termops.print_constr_env env c++fnl()++
-		  prlist_with_sep fnl
-		  (fun  (pb,c1,c2) ->
-		  Termops.print_constr c1 ++
-		  (if pb=Reduction.CUMUL then str " <="++ spc()
-		  else str" =="++spc()) ++
-		  Termops.print_constr c2)
-		  pbs ++ fnl())
-		  end*)
-
   (* TODO: comment faire remonter l'information si le typage a resolu des
      variables du sigma original. il faudrait que la fonction de typage
      retourne aussi le nouveau sigma...
@@ -669,7 +645,8 @@ module Pretyping_F (Coercion : Coercion.S) = struct
   let understand_judgment sigma env c =
     let isevars = ref (create_evar_defs sigma) in
     let j = pretype empty_tycon env isevars ([],[]) c in
-    let j = j_nf_evar (evars_of !isevars) j in
+    let isevars,_ = consider_remaining_unif_problems env !isevars in
+    let j = j_nf_evar (evars_of isevars) j in
       check_evars env sigma isevars (mkCast(j.uj_val,DEFAULTcast, j.uj_type));
       j
 
@@ -686,8 +663,10 @@ module Pretyping_F (Coercion : Coercion.S) = struct
   let ise_pretype_gen fail_evar sigma env lvar kind c =
     let isevars = ref (Evd.create_evar_defs sigma) in
     let c = pretype_gen isevars env lvar kind c in
+    let isevars,_ = consider_remaining_unif_problems env !isevars in
+    let c = nf_evar (evars_of isevars) c in
       if fail_evar then check_evars env sigma isevars c;
-      !isevars, c
+      isevars, c
 
   (** Entry points of the high-level type synthesis algorithm *)
 
diff --git a/pretyping/pretyping.mli b/pretyping/pretyping.mli
index 7bb8c374..b1ed20c2 100644
--- a/pretyping/pretyping.mli
+++ b/pretyping/pretyping.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pretyping.mli 8688 2006-04-07 15:08:12Z msozeau $ i*)
+(*i $Id: pretyping.mli 9141 2006-09-15 10:07:01Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -78,7 +78,6 @@ sig
   (* Idem but do not fail on unresolved evars *)
   val understand_judgment_tcc : evar_defs ref -> env -> rawconstr -> unsafe_judgment
 
-       
   (*i*)
   (* Internal of Pretyping...
    *)
diff --git a/pretyping/rawterm.ml b/pretyping/rawterm.ml
index ece536d1..00dd034d 100644
--- a/pretyping/rawterm.ml
+++ b/pretyping/rawterm.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: rawterm.ml 8969 2006-06-22 12:51:04Z msozeau $ *)
+(* $Id: rawterm.ml 9226 2006-10-09 16:11:01Z herbelin $ *)
 
 (*i*)
 open Util
@@ -26,7 +26,7 @@ type cases_pattern =
   | PatVar of loc * name
   | PatCstr of loc * constructor * cases_pattern list * name
 
-let pattern_loc = function
+let cases_pattern_loc = function
     PatVar(loc,_) -> loc
   | PatCstr(loc,_,_,_) -> loc
 
diff --git a/pretyping/rawterm.mli b/pretyping/rawterm.mli
index 89b13ff0..6c2276d7 100644
--- a/pretyping/rawterm.mli
+++ b/pretyping/rawterm.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: rawterm.mli 8969 2006-06-22 12:51:04Z msozeau $ i*)
+(*i $Id: rawterm.mli 9226 2006-10-09 16:11:01Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -17,7 +17,8 @@ open Libnames
 open Nametab
 (*i*)
 
-(* Untyped intermediate terms, after ASTs and before constr. *)
+(**********************************************************************)
+(* The kind of patterns that occurs in "match ... with ... end"       *)
 
 (* locs here refers to the ident's location, not whole pat *)
 (* the last argument of PatCstr is a possible alias ident for the pattern *)
@@ -25,7 +26,13 @@ type cases_pattern =
   | PatVar of loc * name
   | PatCstr of loc * constructor * cases_pattern list * name
 
-val pattern_loc : cases_pattern -> loc
+val cases_pattern_loc : cases_pattern -> loc
+
+(**********************************************************************)
+(* Untyped intermediate terms, after constr_expr and before constr    *)
+(* Resolution of names, insertion of implicit arguments placeholder,  *)
+(* and notations are done, but coercions, inference of implicit       *)
+(* arguments and pattern-matching compilation are not                 *)
 
 type patvar = identifier
 
diff --git a/pretyping/recordops.ml b/pretyping/recordops.ml
index 74df5eea..5bbaa207 100644
--- a/pretyping/recordops.ml
+++ b/pretyping/recordops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: recordops.ml 9032 2006-07-07 16:30:34Z herbelin $ *)
+(* $Id: recordops.ml 9166 2006-09-23 11:20:06Z herbelin $ *)
 
 open Util
 open Pp
@@ -20,6 +20,7 @@ open Libobject
 open Library
 open Classops
 open Mod_subst
+open Reductionops
 
 (*s A structure S is a non recursive inductive type with a single
    constructor (the name of which defaults to Build_S) *)
@@ -78,7 +79,7 @@ let (inStruc,outStruc) =
     discharge_function = discharge_structure;
     export_function = (function x -> Some x) }
 
-let declare_structure (s,c,_,kl,pl) = 
+let declare_structure (s,c,kl,pl) = 
   Lib.add_anonymous_leaf (inStruc (s,c,kl,pl))
 
 let lookup_structure indsp = Indmap.find indsp !structure_table
@@ -197,7 +198,8 @@ let check_and_decompose_canonical_structure ref =
   let vc = match Environ.constant_opt_value env sp with
     | Some vc -> vc
     | None -> error_not_structure ref in
-  let f,args = match kind_of_term (snd (decompose_lam vc)) with
+  let body = snd (splay_lambda (Global.env()) Evd.empty vc) in
+  let f,args = match kind_of_term body with
     | App (f,args) -> f,args
     | _ -> error_not_structure ref in
   let indsp = match kind_of_term f with
diff --git a/pretyping/recordops.mli b/pretyping/recordops.mli
index 91bc2ba1..0a05aef6 100755
--- a/pretyping/recordops.mli
+++ b/pretyping/recordops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: recordops.mli 9032 2006-07-07 16:30:34Z herbelin $ i*)
+(*i $Id: recordops.mli 9082 2006-08-24 17:03:28Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -22,7 +22,7 @@ open Library
    constructor (the name of which defaults to Build_S) *)
 
 val declare_structure : 
-  inductive * identifier * int * bool list * constant option list -> unit
+  inductive * identifier * bool list * constant option list -> unit
 
 (* [lookup_projections isp] returns the projections associated to the
    inductive path [isp] if it corresponds to a structure, otherwise
diff --git a/pretyping/reductionops.ml b/pretyping/reductionops.ml
index 82cc1b7d..19f515d0 100644
--- a/pretyping/reductionops.ml
+++ b/pretyping/reductionops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: reductionops.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: reductionops.ml 9106 2006-09-01 11:18:17Z herbelin $ *)
 
 open Pp
 open Util
@@ -37,11 +37,12 @@ type 'a stack_member =
 and 'a stack = 'a stack_member list
 
 let empty_stack = []
-let append_stack_list = function
+let append_stack_list l s =
+  match (l,s) with
   | ([],s) -> s
   | (l1, Zapp l :: s) -> Zapp (l1@l) :: s
   | (l1, s) -> Zapp l1 :: s
-let append_stack v s = append_stack_list (Array.to_list v, s)
+let append_stack v s = append_stack_list (Array.to_list v) s
 
 (* Collapse the shifts in the stack *)
 let zshift n s =
@@ -227,6 +228,7 @@ open RedFlags
 
 (* Local *)
 let beta = mkflags [fbeta]
+let eta = mkflags [feta]
 let evar = mkflags [fevar]
 let betaevar = mkflags [fevar; fbeta]
 let betaiota = mkflags [fiota; fbeta]
@@ -251,7 +253,7 @@ let rec stacklam recfun env t stack =
     | _ -> recfun (substl env t, stack)
 
 let beta_applist (c,l) =
-  stacklam app_stack [] c (append_stack (Array.of_list l) empty_stack)
+  stacklam app_stack [] c (append_stack_list l empty_stack)
 
 (* Iota reduction tools *)
 
@@ -261,7 +263,7 @@ type 'a miota_args = {
   mci     : case_info;  (* special info to re-build pattern *)
   mcargs  : 'a list;    (* the constructor's arguments *)
   mlf     : 'a array }  (* the branch code vector *)
-		       
+
 let reducible_mind_case c = match kind_of_term c with
   | Construct _ | CoFix _ -> true
   | _  -> false
@@ -505,6 +507,10 @@ let whd_betadeltaiota_nolet_stack env sigma x =
 let whd_betadeltaiota_nolet env sigma x = 
   app_stack (whd_betadeltaiota_nolet_state env sigma (x, empty_stack))
 
+(* 3. Eta reduction Functions *)
+
+let whd_eta c = app_stack (local_whd_state_gen eta (c,empty_stack))
+
 (****************************************************************************)
 (*                   Reduction Functions                                    *)
 (****************************************************************************)
@@ -641,7 +647,7 @@ let is_fconv = function | CONV -> is_conv | CUMUL -> is_conv_leq
 let whd_meta metamap c = match kind_of_term c with
   | Meta p -> (try List.assoc p metamap with Not_found -> c)
   | _ -> c
-	
+
 (* Try to replace all metas. Does not replace metas in the metas' values
  * Differs from (strong whd_meta). *)
 let plain_instance s c = 
@@ -668,7 +674,7 @@ let plain_instance s c =
     | _ -> map_constr irec u
   in 
   if s = [] then c else irec c
-    
+
 (* Pourquoi ne fait-on pas nf_betaiota si s=[] ? *)
 let instance s c = 
   if s = [] then c else local_strong whd_betaiota (plain_instance s c)
@@ -746,7 +752,7 @@ let splay_arity env sigma c =
     | _ -> error "not an arity"
 
 let sort_of_arity env c = snd (splay_arity env Evd.empty c)
-  
+
 let decomp_n_prod env sigma n = 
   let rec decrec env m ln c = if m = 0 then (ln,c) else 
     match kind_of_term (whd_betadeltaiota env sigma c) with
@@ -764,7 +770,12 @@ let decomp_sort env sigma t =
   | Sort s -> s
   | _ -> raise NotASort
 
-(* One step of approximation *)
+let is_sort env sigma arity =
+  try let _ = decomp_sort env sigma arity in true 
+  with NotASort -> false
+
+(* reduction to head-normal-form allowing delta/zeta only in argument
+   of case/fix (heuristic used by evar_conv) *)
 
 let rec apprec env sigma s =
   let (t, stack as s) = whd_betaiota_state s in
@@ -782,8 +793,6 @@ let rec apprec env sigma s =
 	     | NotReducible -> s)
     | _ -> s
 
-let hnf env sigma c = apprec env sigma (c, empty_stack)
-
 (* A reduction function like whd_betaiota but which keeps casts
  * and does not reduce redexes containing existential variables.
  * Used in Correctness.
diff --git a/pretyping/reductionops.mli b/pretyping/reductionops.mli
index 78afd22b..1e9b3b5b 100644
--- a/pretyping/reductionops.mli
+++ b/pretyping/reductionops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: reductionops.mli 8812 2006-05-13 11:46:02Z herbelin $ i*)
+(*i $Id: reductionops.mli 9106 2006-09-01 11:18:17Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -37,6 +37,7 @@ and 'a stack = 'a stack_member list
 
 val empty_stack : 'a stack
 val append_stack : 'a array -> 'a stack -> 'a stack
+val append_stack_list : 'a list -> 'a stack -> 'a stack
 
 val decomp_stack : 'a stack -> ('a * 'a stack) option
 val list_of_stack : 'a stack -> 'a list
@@ -140,6 +141,7 @@ val whd_betadeltaiotaeta_stack :  stack_reduction_function
 val whd_betadeltaiotaeta_state :  state_reduction_function
 val whd_betadeltaiotaeta :  reduction_function
 
+val whd_eta : constr -> constr
 
 
 
@@ -162,6 +164,7 @@ val decomp_n_prod :
 val splay_prod_assum :
   env ->  evar_map -> constr -> Sign.rel_context * constr
 val decomp_sort : env -> evar_map -> types -> sorts
+val is_sort : env -> evar_map -> types -> bool
 
 type 'a miota_args = {
   mP      : constr;     (* the result type *)
@@ -206,11 +209,8 @@ val whd_meta : (metavariable * constr) list -> constr -> constr
 val plain_instance : (metavariable * constr) list -> constr -> constr
 val instance : (metavariable * constr) list -> constr -> constr
 
-(*s Obsolete Reduction Functions *)
+(*s Heuristic for Conversion with Evar *)
 
-(*i
-val hnf : env -> 'a evar_map -> constr -> constr * constr list
-i*)
 val apprec :  state_reduction_function
 
 (*s Meta-related reduction functions *)
diff --git a/pretyping/retyping.ml b/pretyping/retyping.ml
index 428a7306..ecead438 100644
--- a/pretyping/retyping.ml
+++ b/pretyping/retyping.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: retyping.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: retyping.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
 
 open Util
 open Term
@@ -17,6 +17,7 @@ open Reductionops
 open Environ
 open Typeops
 open Declarations
+open Termops
 
 let rec subst_type env sigma typ = function
   | [] -> typ
@@ -38,6 +39,11 @@ let sort_of_atomic_type env sigma ft args =
     | _ -> decomp_sort env sigma (subst_type env sigma ft (Array.to_list args))
   in concl_of_arity env ft
 
+let type_of_var env id =
+  try let (_,_,ty) = lookup_named id env in ty
+  with Not_found ->
+    anomaly ("type_of: variable "^(string_of_id id)^" unbound")
+
 let typeur sigma metamap =
   let rec type_of env cstr=
     match kind_of_term cstr with
@@ -47,18 +53,11 @@ let typeur sigma metamap =
     | Rel n ->
         let (_,_,ty) = lookup_rel n env in
         lift n ty
-    | Var id ->
-        (try
-          let (_,_,ty) = lookup_named id env in
-          body_of_type ty
-        with Not_found ->
-          anomaly ("type_of: variable "^(string_of_id id)^" unbound"))
-    | Const c ->
-        let cb = lookup_constant c env in
-        body_of_type cb.const_type
+    | Var id -> type_of_var env id
+    | Const cst -> Typeops.type_of_constant env cst
     | Evar ev -> Evd.existential_type sigma ev
-    | Ind ind -> body_of_type (type_of_inductive env ind)
-    | Construct cstr -> body_of_type (type_of_constructor env cstr)
+    | Ind ind -> type_of_inductive env ind
+    | Construct cstr -> type_of_constructor env cstr
     | Case (_,p,c,lf) ->
         let Inductiveops.IndType(_,realargs) =
           try Inductiveops.find_rectype env sigma (type_of env c)
@@ -73,8 +72,8 @@ let typeur sigma metamap =
          subst1 b (type_of (push_rel (name,Some b,c1) env) c2)
     | Fix ((_,i),(_,tys,_)) -> tys.(i)
     | CoFix (i,(_,tys,_)) -> tys.(i)
-    | App(f,args) when isInd f ->
-	let t = type_of_inductive_knowing_parameters env (destInd f) args in
+    | App(f,args) when isGlobalRef f ->
+	let t = type_of_global_reference_knowing_parameters env f args in
         strip_outer_cast (subst_type env sigma t (Array.to_list args))
     | App(f,args) ->
         strip_outer_cast
@@ -97,8 +96,8 @@ let typeur sigma metamap =
 	  | Prop Pos, (Type u2) -> Type (Univ.sup Univ.base_univ u2)
 	  | Prop Null, (Type _ as s) -> s
 	  | Type u1, Type u2 -> Type (Univ.sup u1 u2))
-    | App(f,args) when isInd f ->
-	let t = type_of_inductive_knowing_parameters env (destInd f) args in
+    | App(f,args) when isGlobalRef f ->
+	let t = type_of_global_reference_knowing_parameters env f args in
         sort_of_atomic_type env sigma t args
     | App(f,args) -> sort_of_atomic_type env sigma (type_of env f) args
     | Lambda _ | Fix _ | Construct _ ->
@@ -117,18 +116,27 @@ let typeur sigma metamap =
         anomaly "sort_of: Not a type (1)"
     | _ -> family_of_sort (decomp_sort env sigma (type_of env t))
 
-  and type_of_inductive_knowing_parameters env ind args =
-    let (_,mip) = lookup_mind_specif env ind in
+  and type_of_global_reference_knowing_parameters env c args =
     let argtyps = Array.map (fun c -> nf_evar sigma (type_of env c)) args in
-    Inductive.type_of_inductive_knowing_parameters env mip argtyps
+    match kind_of_term c with
+    | Ind ind ->
+      let (_,mip) = lookup_mind_specif env ind in
+      Inductive.type_of_inductive_knowing_parameters env mip argtyps
+    | Const cst ->
+      let t = constant_type env cst in
+      Typeops.type_of_constant_knowing_parameters env t argtyps
+    | Var id -> type_of_var env id
+    | Construct cstr -> type_of_constructor env cstr
+    | _ -> assert false
 
-  in type_of, sort_of, sort_family_of, type_of_inductive_knowing_parameters
+  in type_of, sort_of, sort_family_of,
+     type_of_global_reference_knowing_parameters
 
 let get_type_of env sigma c = let f,_,_,_ = typeur sigma [] in f env c
 let get_sort_of env sigma t = let _,f,_,_ = typeur sigma [] in f env t
 let get_sort_family_of env sigma c = let _,_,f,_ = typeur sigma [] in f env c
-let type_of_inductive_knowing_parameters env sigma ind args =
-  let _,_,_,f = typeur sigma [] in f env ind args
+let type_of_global_reference_knowing_parameters env sigma c args =
+  let _,_,_,f = typeur sigma [] in f env c args
 
 let get_type_of_with_meta env sigma metamap = 
   let f,_,_,_ = typeur sigma metamap in f env
diff --git a/pretyping/retyping.mli b/pretyping/retyping.mli
index 923123c5..733cb4b1 100644
--- a/pretyping/retyping.mli
+++ b/pretyping/retyping.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: retyping.mli 8871 2006-05-28 16:46:48Z herbelin $ i*)
+(*i $Id: retyping.mli 9314 2006-10-29 20:11:08Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -34,5 +34,6 @@ val get_assumption_of : env -> evar_map -> constr -> types
 (* Makes an unsafe judgment from a constr *)
 val get_judgment_of : env -> evar_map -> constr -> unsafe_judgment
 
-val type_of_inductive_knowing_parameters : env -> evar_map -> inductive -> 
+val type_of_global_reference_knowing_parameters : env -> evar_map -> constr -> 
   constr array -> types
+ 
diff --git a/pretyping/termops.ml b/pretyping/termops.ml
index 823da969..9b8764f2 100644
--- a/pretyping/termops.ml
+++ b/pretyping/termops.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: termops.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: termops.ml 9314 2006-10-29 20:11:08Z herbelin $ *)
 
 open Pp
 open Util
@@ -855,7 +855,12 @@ let next_global_ident_away allow_secvar id avoid =
   else  
     next_global_ident_from allow_secvar (lift_ident id) avoid
 
-(* Nouvelle version de renommage des variables (DEC 98) *)
+let isGlobalRef c = 
+  match kind_of_term c with
+  | Const _ | Ind _ | Construct _ | Var _ -> true
+  | _ -> false
+
+(* nouvelle version de renommage des variables (DEC 98) *)
 (* This is the algorithm to display distinct bound variables 
 
     - Règle 1 : un nom non anonyme, même non affiché, contribue à la liste
@@ -1020,3 +1025,9 @@ let rec rename_bound_var env l c =
   | Cast (c,k,t) -> mkCast (rename_bound_var env l c, k,t)
   | x -> c
 
+(* Combinators on judgments *)
+
+let on_judgment f j = { uj_val = f j.uj_val; uj_type = f j.uj_type }
+let on_judgment_value f j = { j with uj_val = f j.uj_val }
+let on_judgment_type f j = { j with uj_type = f j.uj_type }
+
diff --git a/pretyping/termops.mli b/pretyping/termops.mli
index 49de4838..e406b148 100644
--- a/pretyping/termops.mli
+++ b/pretyping/termops.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: termops.mli 8845 2006-05-23 07:41:58Z herbelin $ i*)
+(*i $Id: termops.mli 9314 2006-10-29 20:11:08Z herbelin $ i*)
 
 open Util
 open Pp
@@ -203,3 +203,11 @@ val global_vars_set_of_decl : env -> named_declaration -> Idset.t
 
 (* Test if an identifier is the basename of a global reference *)
 val is_section_variable : identifier -> bool
+
+val isGlobalRef : constr -> bool
+
+(* Combinators on judgments *)
+
+val on_judgment       : (types -> types) -> unsafe_judgment -> unsafe_judgment
+val on_judgment_value : (types -> types) -> unsafe_judgment -> unsafe_judgment
+val on_judgment_type  : (types -> types) -> unsafe_judgment -> unsafe_judgment
diff --git a/pretyping/typing.ml b/pretyping/typing.ml
index 78902a7d..63fdd6d5 100644
--- a/pretyping/typing.ml
+++ b/pretyping/typing.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: typing.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: typing.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Util
 open Names
@@ -53,7 +53,7 @@ let rec execute env evd cstr =
         j_nf_evar (evars_of evd) (judge_of_variable env id)
 	  
     | Const c ->
-        make_judge cstr (nf_evar (evars_of evd) (constant_type env c))
+        make_judge cstr (nf_evar (evars_of evd) (type_of_constant env c))
 	  
     | Ind ind ->
 	make_judge cstr (nf_evar (evars_of evd) (type_of_inductive env ind))
@@ -90,12 +90,17 @@ let rec execute env evd cstr =
     | App (f,args) ->
         let jl = execute_array env evd args in
 	let j =
-	if isInd f then
-	  (* Sort-polymorphism of inductive types *)
-	  judge_of_inductive_knowing_parameters env (destInd f)
-	    (jv_nf_evar (evars_of evd) jl)
-	else
-	  execute env evd f
+	  match kind_of_term f with
+	    | Ind ind ->
+		(* Sort-polymorphism of inductive types *)
+		judge_of_inductive_knowing_parameters env ind
+		  (jv_nf_evar (evars_of evd) jl)
+	    | Const cst -> 
+		(* Sort-polymorphism of inductive types *)
+		judge_of_constant_knowing_parameters env cst
+		  (jv_nf_evar (evars_of evd) jl)
+	    | _ -> 
+		execute env evd f
 	in
 	fst (judge_of_apply env j jl)
 	    
diff --git a/pretyping/unification.ml b/pretyping/unification.ml
index e4bde925..fabe24ef 100644
--- a/pretyping/unification.ml
+++ b/pretyping/unification.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: unification.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: unification.ml 9217 2006-10-05 17:31:23Z notin $ *)
 
 open Pp
 open Util
@@ -47,6 +47,16 @@ let abstract_list_all env sigma typ c l =
   with UserError _ ->
     raise (PretypeError (env,CannotGeneralize typ))
 
+(**)
+
+let solve_pattern_eqn_array env f l c (metasubst,evarsubst) =
+  match kind_of_term f with
+    | Meta k -> 
+	(k,solve_pattern_eqn env (Array.to_list l) c)::metasubst,evarsubst
+    | Evar ev ->
+      (* Currently unused: incompatible with eauto/eassumption backtracking *)
+	metasubst,(f,solve_pattern_eqn env (Array.to_list l) c)::evarsubst
+    | _ -> assert false
 
 (*******************************)
 
@@ -70,58 +80,77 @@ let sort_eqns = unify_r2l
 
 let unify_0 env sigma cv_pb mod_delta m n =
   let trivial_unify pb substn m n =
-    if (not(occur_meta m)) && (if mod_delta then is_fconv pb env sigma m n else eq_constr m n) then substn
+    if (not(occur_meta m)) && 
+      (if mod_delta then is_fconv pb env sigma m n else eq_constr m n) 
+    then substn
     else error_cannot_unify env sigma (m,n) in
-  let rec unirec_rec pb ((metasubst,evarsubst) as substn) m n =
-    let cM = Evarutil.whd_castappevar sigma m
-    and cN = Evarutil.whd_castappevar sigma n in 
-    match (kind_of_term cM,kind_of_term cN) with
-      | Meta k1, Meta k2 ->
-	  if k1 < k2 then (k1,cN)::metasubst,evarsubst
-	  else if k1 = k2 then substn
-	  else (k2,cM)::metasubst,evarsubst
-      | Meta k, _    -> (k,cN)::metasubst,evarsubst
-      | _, Meta k    -> (k,cM)::metasubst,evarsubst
-      | Evar _, _ -> metasubst,((cM,cN)::evarsubst)
-      | _, Evar _ -> metasubst,((cN,cM)::evarsubst)
-
-      | Lambda (_,t1,c1), Lambda (_,t2,c2) ->
-	  unirec_rec CONV (unirec_rec CONV substn t1 t2) c1 c2
-      | Prod (_,t1,c1), Prod (_,t2,c2) ->
-	  unirec_rec pb (unirec_rec CONV substn t1 t2) c1 c2
-      | LetIn (_,b,_,c), _ -> unirec_rec pb substn (subst1 b c) cN
-      | _, LetIn (_,b,_,c) -> unirec_rec pb substn cM (subst1 b c)
-
-      | App (f1,l1), App (f2,l2) ->
-	  let len1 = Array.length l1
-	  and len2 = Array.length l2 in
-          let (f1,l1,f2,l2) =
-	    if len1 = len2 then (f1,l1,f2,l2)
-	    else if len1 < len2 then
-              let extras,restl2 = array_chop (len2-len1) l2 in 
-              (f1, l1, appvect (f2,extras), restl2)
-	    else 
-	      let extras,restl1 = array_chop (len1-len2) l1 in 
-              (appvect (f1,extras), restl1, f2, l2) in
-          (try
-            array_fold_left2 (unirec_rec CONV)
-	      (unirec_rec CONV substn f1 f2) l1 l2
-	  with ex when precatchable_exception ex ->
-            trivial_unify pb substn cM cN)
-      | Case (_,p1,c1,cl1), Case (_,p2,c2,cl2) ->
-          array_fold_left2 (unirec_rec CONV)
-	    (unirec_rec CONV (unirec_rec CONV substn p1 p2) c1 c2) cl1 cl2
-
-      | _ -> trivial_unify pb substn cM cN
-
+  let rec unirec_rec curenv pb ((metasubst,evarsubst) as substn) curm curn =
+    let cM = Evarutil.whd_castappevar sigma curm
+    and cN = Evarutil.whd_castappevar sigma curn in 
+      match (kind_of_term cM,kind_of_term cN) with
+	| Meta k1, Meta k2 ->
+	    if k1 < k2 
+	    then (k1,cN)::metasubst,evarsubst
+	    else if k1 = k2 then substn else (k2,cM)::metasubst,evarsubst
+	| Meta k, _    -> 
+	    (* Here we check that [cN] does not contain any local variables *)
+	    if (closedn (nb_rel env) cN)
+	    then (k,cN)::metasubst,evarsubst
+	    else error_cannot_unify_local curenv sigma (curenv,m,n,cN)
+	| _, Meta k    -> 
+	    (* Here we check that [cM] does not contain any local variables *)
+	    if (closedn (nb_rel env) cM) 
+	    then (k,cM)::metasubst,evarsubst
+	    else error_cannot_unify_local curenv sigma (curenv,m,n,cM)
+	| Evar _, _ -> metasubst,((cM,cN)::evarsubst)
+	| _, Evar _ -> metasubst,((cN,cM)::evarsubst)
+	| Lambda (na,t1,c1), Lambda (_,t2,c2) ->
+	    unirec_rec (push_rel_assum (na,t1) curenv) CONV 
+	      (unirec_rec curenv CONV substn t1 t2) c1 c2
+	| Prod (na,t1,c1), Prod (_,t2,c2) ->
+	    unirec_rec (push_rel_assum (na,t1) curenv) pb 
+	      (unirec_rec curenv CONV substn t1 t2) c1 c2
+	| LetIn (_,b,_,c), _ -> unirec_rec curenv  pb substn (subst1 b c) cN
+	| _, LetIn (_,b,_,c) -> unirec_rec curenv  pb substn cM (subst1 b c)
+	    
+	| App (f1,l1), App (f2,l2) ->
+	    if
+	      isMeta f1 & is_unification_pattern f1 l1 & not (dependent f1 cN)
+	    then
+	      solve_pattern_eqn_array curenv f1 l1 cN substn
+	    else if
+		isMeta f2 & is_unification_pattern f2 l2 & not (dependent f2 cM)
+	    then
+	      solve_pattern_eqn_array curenv f2 l2 cM substn
+	    else
+	      let len1 = Array.length l1
+	      and len2 = Array.length l2 in
+              let (f1,l1,f2,l2) =
+		if len1 = len2 then (f1,l1,f2,l2)
+		else if len1 < len2 then
+		  let extras,restl2 = array_chop (len2-len1) l2 in 
+		    (f1, l1, appvect (f2,extras), restl2)
+		else 
+		  let extras,restl1 = array_chop (len1-len2) l1 in 
+		    (appvect (f1,extras), restl1, f2, l2) in
+		(try
+		    array_fold_left2 (unirec_rec curenv CONV)
+		      (unirec_rec curenv CONV substn f1 f2) l1 l2
+		  with ex when precatchable_exception ex ->
+		    trivial_unify pb substn cM cN)
+	| Case (_,p1,c1,cl1), Case (_,p2,c2,cl2) ->
+            array_fold_left2 (unirec_rec curenv CONV)
+	      (unirec_rec curenv CONV 
+		  (unirec_rec curenv CONV substn p1 p2) c1 c2) cl1 cl2
+	| _ -> trivial_unify pb substn cM cN
   in
-  if (not(occur_meta m)) &&
-   (if mod_delta then is_fconv cv_pb env sigma m n else eq_constr m n)
-  then 
-    ([],[])
-  else 
-    let (mc,ec) = unirec_rec cv_pb ([],[]) m n in
-    ((*sort_eqns*) mc, (*sort_eqns*) ec)
+    if (not(occur_meta m)) &&
+      (if mod_delta then is_fconv cv_pb env sigma m n else eq_constr m n)
+    then 
+      ([],[])
+    else 
+      let (mc,ec) = unirec_rec env cv_pb ([],[]) m n in
+	((*sort_eqns*) mc, (*sort_eqns*) ec)
 
 
 (* Unification
@@ -442,30 +471,30 @@ let w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd =
 let w_unify allow_K env cv_pb ?(mod_delta=true) ty1 ty2 evd =
   let hd1,l1 = whd_stack ty1 in
   let hd2,l2 = whd_stack ty2 in
-  match kind_of_term hd1, l1<>[], kind_of_term hd2, l2<>[] with
-    (* Pattern case *)
-    | (Meta _, true, Lambda _, _ | Lambda _, _, Meta _, true)
-      when List.length l1 = List.length l2 ->
-	(try 
-	   w_typed_unify env cv_pb mod_delta ty1 ty2 evd
-	 with ex when precatchable_exception ex -> 
-	   try 
-	     w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd
-	   with PretypeError (env,NoOccurrenceFound c) as e -> raise e
-	     | ex when precatchable_exception ex -> 
-	     error "Cannot solve a second-order unification problem")
-
-     (* Second order case *)
-     | (Meta _, true, _, _ | _, _, Meta _, true) -> 
-	(try 
-	   w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd
-	with PretypeError (env,NoOccurrenceFound c) as e -> raise e
-	  | ex when precatchable_exception ex -> 
-          try 
-	     w_typed_unify env cv_pb mod_delta ty1 ty2 evd
-          with ex when precatchable_exception ex -> 
-             error "Cannot solve a second-order unification problem")
-
-     (* General case: try first order *)
-     | _ -> w_unify_0 env cv_pb mod_delta ty1 ty2 evd
+    match kind_of_term hd1, l1<>[], kind_of_term hd2, l2<>[] with
+      (* Pattern case *)
+      | (Meta _, true, Lambda _, _ | Lambda _, _, Meta _, true)
+	  when List.length l1 = List.length l2 ->
+	  (try 
+	      w_typed_unify env cv_pb mod_delta ty1 ty2 evd
+	    with ex when precatchable_exception ex -> 
+	      try 
+		w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd
+	      with PretypeError (env,NoOccurrenceFound c) as e -> raise e
+		| ex when precatchable_exception ex -> 
+		    error "Cannot solve a second-order unification problem")
+	    
+      (* Second order case *)
+      | (Meta _, true, _, _ | _, _, Meta _, true) -> 
+	  (try 
+	      w_unify2 env mod_delta allow_K cv_pb ty1 ty2 evd
+	    with PretypeError (env,NoOccurrenceFound c) as e -> raise e
+	      | ex when precatchable_exception ex -> 
+		  try 
+		    w_typed_unify env cv_pb mod_delta ty1 ty2 evd
+		  with ex when precatchable_exception ex -> 
+		    error "Cannot solve a second-order unification problem")
+	    
+      (* General case: try first order *)
+      | _ -> w_unify_0 env cv_pb mod_delta ty1 ty2 evd
 
diff --git a/pretyping/vnorm.ml b/pretyping/vnorm.ml
new file mode 100644
index 00000000..55f798de
--- /dev/null
+++ b/pretyping/vnorm.ml
@@ -0,0 +1,271 @@
+open Names
+open Declarations
+open Term
+open Environ
+open Inductive
+open Reduction 
+open Vm
+
+(*******************************************)
+(* Calcul de la forme normal d'un terme    *)
+(*******************************************)
+
+let crazy_type = mkSet 
+
+let decompose_prod env t =
+  let (name,dom,codom as res) = destProd (whd_betadeltaiota env t) in
+  if name = Anonymous then (Name (id_of_string "x"),dom,codom)
+  else res
+
+exception Find_at of int
+
+(* rend le numero du constructeur correspondant au tag [tag],
+   [cst] = true si c'est un constructeur constant *)
+
+let invert_tag cst tag reloc_tbl =
+  try 
+    for j = 0 to Array.length reloc_tbl - 1 do
+      let tagj,arity = reloc_tbl.(j) in
+      if tag = tagj && (cst && arity = 0 || not(cst || arity = 0)) then
+	raise (Find_at j)
+      else ()
+    done;raise Not_found 
+  with Find_at j -> (j+1)   
+             (* Argggg, ces constructeurs de ... qui commencent a 1*)
+
+let find_rectype_a env c =
+  let (t, l) = 
+    let t = whd_betadeltaiota env c in
+    try destApp t with _ -> (t,[||]) in
+  match kind_of_term t with
+  | Ind ind -> (ind, l)
+  | _ -> raise Not_found
+
+(* Instantiate inductives and parameters in constructor type *)
+let build_type_constructor mind mib params ctyp =
+  let si = ind_subst mind mib in
+  let ctyp1 = substl si ctyp in
+  let nparams = Array.length params in
+  if nparams = 0 then ctyp1
+  else
+    let _,ctyp2 = decompose_prod_n nparams ctyp1 in
+    let sp = List.rev (Array.to_list params) in substl sp ctyp2
+   
+let construct_of_constr_const env tag typ =
+  let ind,params = find_rectype env typ in
+  let (_,mip) = lookup_mind_specif env ind in
+  let i = invert_tag true tag mip.mind_reloc_tbl in
+  applistc (mkConstruct(ind,i)) params
+
+let construct_of_constr_block env tag typ =
+  let (mind,_ as ind), allargs = find_rectype_a env typ in
+  let (mib,mip) = lookup_mind_specif env ind in
+  let nparams = mib.mind_nparams in
+  let i = invert_tag false tag mip.mind_reloc_tbl in
+  let params = Array.sub allargs 0 nparams in
+  let specif = mip.mind_nf_lc in
+  let ctyp = build_type_constructor mind mib params specif.(i-1) in
+  (mkApp(mkConstruct(ind,i), params), ctyp)
+  	
+let constr_type_of_idkey env idkey =
+  match idkey with
+  | ConstKey cst ->
+      mkConst cst, Typeops.type_of_constant env cst
+  | VarKey id -> 
+      let (_,_,ty) = lookup_named id env in 
+      mkVar id, ty
+  | RelKey i -> 
+      let n = (nb_rel env - i) in
+      let (_,_,ty) = lookup_rel n env in
+      mkRel n, lift n ty
+
+let type_of_ind env ind = 
+  type_of_inductive env (Inductive.lookup_mind_specif env ind)
+
+let build_branches_type env (mind,_ as _ind) mib mip params dep p =
+  let rtbl = mip.mind_reloc_tbl in
+  (* [build_one_branch i cty] construit le type de la ieme branche (commence
+     a 0) et les lambda correspondant aux realargs *)
+  let build_one_branch i cty =
+    let typi = build_type_constructor mind mib params cty in
+    let decl,indapp = Term.decompose_prod typi in
+    let ind,cargs = find_rectype_a env indapp in
+    let nparams = Array.length params in
+    let carity = snd (rtbl.(i)) in
+    let crealargs = Array.sub cargs nparams (Array.length cargs - nparams) in
+    let codom = 
+      let papp = mkApp(p,crealargs) in
+      if dep then
+	let cstr = ith_constructor_of_inductive ind (i+1) in
+        let relargs = Array.init carity (fun i -> mkRel (carity-i)) in
+	let dep_cstr = mkApp(mkApp(mkConstruct cstr,params),relargs) in
+	mkApp(papp,[|dep_cstr|])
+      else papp
+    in 
+    decl, codom
+  in Array.mapi build_one_branch mip.mind_nf_lc
+
+let build_case_type dep p realargs c = 
+  if dep then mkApp(mkApp(p, realargs), [|c|])
+  else mkApp(p, realargs)
+
+(* La fonction de normalisation *)
+
+let rec nf_val env v t = nf_whd env (whd_val v) t 
+
+and nf_vtype env v =  nf_val env v crazy_type
+
+and nf_whd env whd typ =
+  match whd with
+  | Vsort s -> mkSort s
+  | Vprod p ->
+      let dom = nf_vtype env (dom p) in
+      let name = Name (id_of_string "x") in
+      let vc = body_of_vfun (nb_rel env) (codom p) in
+      let codom = nf_vtype (push_rel (name,None,dom) env) vc  in      
+      mkProd(name,dom,codom)	  
+  | Vfun f -> nf_fun env f typ
+  | Vfix(f,None) -> nf_fix env f
+  | Vfix(f,Some vargs) -> fst (nf_fix_app env f vargs)
+  | Vcofix(cf,_,None) -> nf_cofix env cf 
+  | Vcofix(cf,_,Some vargs) -> 
+      let cfd = nf_cofix env cf in
+      let i,(_,ta,_) = destCoFix cfd in
+      let t = ta.(i) in
+      let _, args = nf_args env vargs t in
+      mkApp(cfd,args) 
+  | Vconstr_const n -> construct_of_constr_const env n typ
+  | Vconstr_block b ->
+      let capp,ctyp = construct_of_constr_block env (btag b) typ in
+      let args = nf_bargs env b ctyp in
+      mkApp(capp,args)
+  | Vatom_stk(Aid idkey, stk) ->
+      let c,typ = constr_type_of_idkey env idkey in
+      nf_stk env c typ stk
+  | Vatom_stk(Aiddef(idkey,v), stk) ->
+      nf_whd env (whd_stack v stk) typ
+  | Vatom_stk(Aind ind, stk) ->
+      nf_stk env (mkInd ind) (type_of_ind env ind) stk 
+	
+and nf_stk env c t stk  =
+  match stk with
+  | [] -> c
+  | Zapp vargs :: stk ->
+      let t, args = nf_args env vargs t in
+      nf_stk env (mkApp(c,args)) t stk 
+  | Zfix (f,vargs) :: stk ->  
+      let fa, typ = nf_fix_app env f vargs in
+      let _,_,codom = decompose_prod env typ in
+      nf_stk env (mkApp(fa,[|c|])) (subst1 c codom) stk
+  | Zswitch sw :: stk -> 
+      let (mind,_ as ind),allargs = find_rectype_a env t in
+      let (mib,mip) = Inductive.lookup_mind_specif env ind in
+      let nparams = mib.mind_nparams in
+      let params,realargs = Util.array_chop nparams allargs in
+      let pT = 
+	hnf_prod_applist env (type_of_ind env ind) (Array.to_list params) in
+      let dep, p = nf_predicate env ind mip params (type_of_switch sw) pT in
+      (* Calcul du type des branches *)
+      let btypes = build_branches_type env ind mib mip params dep p in
+      (* calcul des branches *)
+      let bsw = branch_of_switch (nb_rel env) sw in
+      let mkbranch i (n,v) =
+	let decl,codom = btypes.(i) in
+	let env = 
+	  List.fold_right 
+	    (fun (name,t) env -> push_rel (name,None,t) env) decl env in
+	let b = nf_val env v codom in
+	compose_lam decl b 
+      in 
+      let branchs = Array.mapi mkbranch bsw in
+      let tcase = build_case_type dep p realargs c in
+      let ci = case_info sw in
+      nf_stk env (mkCase(ci, p, c, branchs)) tcase stk
+
+and nf_predicate env ind mip params v pT =
+  match whd_val v, kind_of_term pT with
+  | Vfun f, Prod _ ->
+      let k = nb_rel env in
+      let vb = body_of_vfun k f in
+      let name,dom,codom = decompose_prod env pT in
+      let dep,body = 
+	nf_predicate (push_rel (name,None,dom) env) ind mip params vb codom in
+      dep, mkLambda(name,dom,body)
+  | Vfun f, _ -> 
+      let k = nb_rel env in
+      let vb = body_of_vfun k f in
+      let name = Name (id_of_string "c") in
+      let n = mip.mind_nrealargs in
+      let rargs = Array.init n (fun i -> mkRel (n-i)) in
+      let dom = mkApp(mkApp(mkInd ind,params),rargs) in
+      let body = nf_vtype (push_rel (name,None,dom) env) vb in
+      true, mkLambda(name,dom,body)
+  | _, _ -> false, nf_val env v crazy_type
+	
+and nf_args env vargs t =
+  let t = ref t in
+  let len = nargs vargs in
+  let args = 
+    Array.init len 
+      (fun i ->
+	let _,dom,codom = decompose_prod env !t in
+	let c = nf_val env (arg vargs i) dom in
+	t := subst1 c codom; c) in
+  !t,args
+
+and nf_bargs env b t =
+  let t = ref t in
+  let len = bsize b in
+  let args =
+    Array.init len 
+      (fun i -> 
+	let _,dom,codom = decompose_prod env !t in
+	let c = nf_val env (bfield b i) dom in
+	t := subst1 c codom; c) in
+  args
+
+and nf_fun env f typ =
+  let k = nb_rel env in
+  let vb = body_of_vfun k f in
+  let name,dom,codom = decompose_prod env typ in
+  let body = nf_val (push_rel (name,None,dom) env) vb codom in
+  mkLambda(name,dom,body)
+
+and nf_fix env f =
+  let init = current_fix f in
+  let rec_args = rec_args f in
+  let k = nb_rel env in
+  let vb, vt = reduce_fix k f in
+  let ndef = Array.length vt in
+  let ft = Array.map (fun v -> nf_val env v crazy_type) vt in
+  let name = Array.init ndef (fun _ -> (Name (id_of_string "Ffix"))) in
+  let env = push_rec_types (name,ft,ft) env in 
+  let fb = Util.array_map2 (fun v t -> nf_fun env v t) vb ft in
+  mkFix ((rec_args,init),(name,ft,fb))
+      
+and nf_fix_app env f vargs =
+  let fd = nf_fix env f in
+  let (_,i),(_,ta,_) = destFix fd in
+  let t = ta.(i) in
+  let t, args = nf_args env vargs t in
+  mkApp(fd,args),t
+  
+and nf_cofix env cf =
+  let init = current_cofix cf in
+  let k = nb_rel env in
+  let vb,vt = reduce_cofix k cf in
+  let ndef = Array.length vt in
+  let cft = Array.map (fun v -> nf_val env v crazy_type) vt in
+  let name = Array.init ndef (fun _ -> (Name (id_of_string "Fcofix"))) in
+  let env = push_rec_types (name,cft,cft) env in 
+  let cfb = Util.array_map2 (fun v t -> nf_val env v t) vb cft in
+  mkCoFix (init,(name,cft,cfb))
+  
+let cbv_vm env c t  =
+  let transp = transp_values () in
+  if not transp then set_transp_values true; 
+  let v = Vconv.val_of_constr env c in
+  let c = nf_val env v t in
+  if not transp then set_transp_values false; 
+  c
+  
diff --git a/contrib/field/Field.v b/pretyping/vnorm.mli
index 3cc097fc..2ea94bfb 100644
--- a/contrib/field/Field.v
+++ b/pretyping/vnorm.mli
@@ -6,10 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field.v 5920 2004-07-16 20:01:26Z herbelin $ *)
+(*i*)
+open Names
+open Term
+open Environ
+open Reduction
+(*i*)
 
-Require Export Field_Compl.
-Require Export Field_Theory.
-Require Export Field_Tactic.
+(*s Reduction functions *)
+val cbv_vm : env -> constr -> types -> constr
 
-(* Command declarations are moved to the ML side *)
\ No newline at end of file
diff --git a/proofs/decl_expr.mli b/proofs/decl_expr.mli
new file mode 100644
index 00000000..24af3842
--- /dev/null
+++ b/proofs/decl_expr.mli
@@ -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        *)
+(************************************************************************)
+
+(* $Id:$ *)
+
+open Names
+open Util
+open Tacexpr
+
+type ('constr,'tac) justification =
+  By_tactic of 'tac
+| Automated of 'constr list
+
+type 'it statement = 
+    {st_label:name;
+     st_it:'it}
+
+type thesis_kind =
+    Plain
+  | Sub of int
+  | For of identifier
+
+type 'this or_thesis =
+    This of 'this
+  | Thesis of thesis_kind
+
+type side = Lhs | Rhs
+
+type elim_type =
+    ET_Case_analysis
+  | ET_Induction
+
+type block_type =
+    B_proof
+  | B_claim
+  | B_focus
+  | B_elim of elim_type
+
+type ('it,'constr,'tac) cut =
+    {cut_stat: 'it statement;
+     cut_by: ('constr,'tac) justification}
+
+type ('var,'constr) hyp = 
+    Hvar of 'var 
+  | Hprop of 'constr statement
+
+type ('constr,'tac) casee = 
+    Real of 'constr 
+  | Virtual of ('constr,'constr,'tac) cut
+
+type ('hyp,'constr,'pat,'tac) bare_proof_instr =
+  | Pthen of ('hyp,'constr,'pat,'tac) bare_proof_instr
+  | Pthus of ('hyp,'constr,'pat,'tac) bare_proof_instr
+  | Phence of ('hyp,'constr,'pat,'tac) bare_proof_instr
+  | Pcut of ('constr or_thesis,'constr,'tac) cut
+  | Prew of side * ('constr,'constr,'tac) cut
+  | Passume of ('hyp,'constr) hyp list
+  | Plet of ('hyp,'constr) hyp list
+  | Pgiven of ('hyp,'constr) hyp list
+  | Pconsider of 'constr*('hyp,'constr) hyp list
+  | Pclaim of 'constr statement
+  | Pfocus of 'constr statement
+  | Pdefine of identifier * 'hyp list * 'constr
+  | Pcast of identifier or_thesis * 'constr
+  | Psuppose of ('hyp,'constr) hyp list 
+  | Pcase of 'hyp list*'pat*(('hyp,'constr or_thesis) hyp list) 
+  | Ptake of 'constr list 
+  | Pper of elim_type * ('constr,'tac) casee
+  | Pend of block_type
+  | Pescape
+
+type emphasis = int
+
+type ('hyp,'constr,'pat,'tac) gen_proof_instr=
+    {emph: emphasis;
+     instr: ('hyp,'constr,'pat,'tac) bare_proof_instr }
+
+
+type raw_proof_instr =
+    ((identifier*(Topconstr.constr_expr option)) located,
+     Topconstr.constr_expr,
+     Topconstr.cases_pattern_expr,
+     raw_tactic_expr) gen_proof_instr
+
+type glob_proof_instr =
+    ((identifier*(Genarg.rawconstr_and_expr option)) located,
+     Genarg.rawconstr_and_expr,  
+     Topconstr.cases_pattern_expr,
+     Tacexpr.glob_tactic_expr) gen_proof_instr
+
+type proof_pattern = 
+    {pat_vars: Term.types statement list;
+     pat_aliases: (Term.constr*Term.types) statement list;
+     pat_constr: Term.constr;
+     pat_typ: Term.types;
+     pat_pat: Rawterm.cases_pattern;
+     pat_expr: Topconstr.cases_pattern_expr}
+
+type proof_instr =
+    (Term.constr statement,
+     Term.constr, 
+     proof_pattern,
+     Tacexpr.glob_tactic_expr) gen_proof_instr
diff --git a/proofs/decl_mode.ml b/proofs/decl_mode.ml
new file mode 100644
index 00000000..094c5625
--- /dev/null
+++ b/proofs/decl_mode.ml
@@ -0,0 +1,121 @@
+(************************************************************************)
+(*  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:$ *)
+
+open Names
+open Term
+open Evd
+open Util
+
+let daimon_flag = ref false
+
+let set_daimon_flag () = daimon_flag:=true 
+let clear_daimon_flag () = daimon_flag:=false
+let get_daimon_flag () = !daimon_flag 
+
+type command_mode =
+    Mode_tactic
+  | Mode_proof
+  | Mode_none
+
+let mode_of_pftreestate pts =
+  let goal = sig_it (Refiner.top_goal_of_pftreestate pts) in
+    if goal.evar_extra = None then
+      Mode_tactic 
+    else
+      Mode_proof
+	  
+let get_current_mode () =
+  try 
+    mode_of_pftreestate (Pfedit.get_pftreestate ())
+  with _ -> Mode_none
+
+let check_not_proof_mode str =
+ if get_current_mode () = Mode_proof then
+   error str
+
+type split_tree=
+    Push of (Idset.t * split_tree)
+  | Split of (Idset.t * inductive * (Idset.t * split_tree) option array)
+  | Pop of split_tree
+  | End_of_branch of (identifier * int)
+
+type elim_kind =
+    EK_dep of split_tree
+  | EK_nodep
+  | EK_unknown
+
+type per_info = 
+    {per_casee:constr;
+     per_ctype:types;
+     per_ind:inductive;
+     per_pred:constr;
+     per_args:constr list;
+     per_params:constr list;
+     per_nparams:int}
+
+type stack_info = 
+    Per of Decl_expr.elim_type * per_info * elim_kind * identifier list
+  | Suppose_case
+  | Claim
+  | Focus_claim
+
+type pm_info =
+    { pm_last: Names.name (* anonymous if none *);
+      pm_hyps: Idset.t;
+      pm_partial_goal : constr ; (* partial goal construction *)
+      pm_subgoals : (metavariable*constr) list;
+      pm_stack : stack_info list }
+
+let pm_in,pm_out = Dyn.create "pm_info" 
+
+let get_info gl=
+  match gl.evar_extra with
+      None ->  invalid_arg "get_info"
+    | Some extra ->
+	try pm_out extra with _ -> invalid_arg "get_info"
+
+let get_stack pts = 
+  let info = get_info (sig_it (Refiner.nth_goal_of_pftreestate 1 pts)) in
+    info.pm_stack
+
+let get_top_stack pts = 
+  let info = get_info (sig_it (Refiner.top_goal_of_pftreestate pts)) in
+    info.pm_stack
+
+let get_end_command pts =
+  match mode_of_pftreestate pts with 
+      Mode_proof ->
+	Some 
+	  begin
+	    match get_top_stack pts with
+		[] -> "\"end proof\""
+	      | Claim::_ -> "\"end claim\""
+	      | Focus_claim::_-> "\"end focus\""
+	      | (Suppose_case :: Per (et,_,_,_) :: _ 
+		| Per (et,_,_,_) :: _ ) -> 
+		  begin
+		    match et with
+			Decl_expr.ET_Case_analysis -> 
+			  "\"end cases\" or start a new case"
+		      | Decl_expr.ET_Induction -> 
+			  "\"end induction\" or start a new case"
+		  end
+	      | _ -> anomaly "lonely suppose"
+	  end
+    | Mode_tactic ->
+	begin
+	  try
+	    ignore 
+	      (Refiner.up_until_matching_rule Proof_trees.is_proof_instr pts);
+	    Some "\"return\""
+	  with Not_found -> None
+	end
+    | Mode_none ->
+        error "no proof in progress"
diff --git a/proofs/decl_mode.mli b/proofs/decl_mode.mli
new file mode 100644
index 00000000..0dd1cb33
--- /dev/null
+++ b/proofs/decl_mode.mli
@@ -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        *)
+(************************************************************************)
+
+(* $Id:$ *)
+
+open Names
+open Term
+open Evd
+open Tacmach
+
+val set_daimon_flag : unit -> unit
+val clear_daimon_flag : unit -> unit
+val get_daimon_flag : unit -> bool
+
+type command_mode =
+    Mode_tactic
+  | Mode_proof
+  | Mode_none
+
+val mode_of_pftreestate : pftreestate -> command_mode
+    
+val get_current_mode : unit -> command_mode
+
+val check_not_proof_mode : string -> unit
+
+type split_tree=
+    Push of  (Idset.t * split_tree)
+  | Split of (Idset.t * inductive * (Idset.t*split_tree) option array)
+  | Pop of split_tree
+  | End_of_branch of (identifier * int)
+
+type elim_kind =
+    EK_dep of split_tree
+  | EK_nodep
+  | EK_unknown
+
+
+type per_info = 
+    {per_casee:constr;
+     per_ctype:types;
+     per_ind:inductive;
+     per_pred:constr;
+     per_args:constr list;
+     per_params:constr list;
+     per_nparams:int}
+
+type stack_info = 
+    Per of Decl_expr.elim_type * per_info * elim_kind * Names.identifier list
+  | Suppose_case
+  | Claim
+  | Focus_claim
+
+type pm_info =
+    { pm_last: Names.name (* anonymous if none *);
+      pm_hyps: Idset.t;
+      pm_partial_goal : constr ; (* partial goal construction *)
+      pm_subgoals : (metavariable*constr) list;
+      pm_stack : stack_info list }
+
+val pm_in : pm_info -> Dyn.t
+
+val get_info : Proof_type.goal -> pm_info
+
+val get_end_command : pftreestate -> string option
+
+val get_stack : pftreestate -> stack_info list
+
+val get_top_stack : pftreestate -> stack_info list
diff --git a/proofs/evar_refiner.ml b/proofs/evar_refiner.ml
index 7a23d052..79f01ba1 100644
--- a/proofs/evar_refiner.ml
+++ b/proofs/evar_refiner.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evar_refiner.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: evar_refiner.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Util
 open Names
@@ -22,7 +22,7 @@ open Refiner
 
 (* w_tactic pour instantiate *) 
 
-let w_refine env ev rawc evd =
+let w_refine ev rawc evd =
   if Evd.is_defined (evars_of evd) ev then 
     error "Instantiate called on already-defined evar";
   let e_info = Evd.find (evars_of evd) ev in
@@ -45,5 +45,5 @@ let instantiate_pf_com n com pfts =
   let env = Evd.evar_env evi in
   let rawc = Constrintern.intern_constr sigma env com in 
   let evd = create_evar_defs sigma in
-  let evd' = w_refine env sp rawc evd in
+  let evd' = w_refine sp rawc evd in
   change_constraints_pftreestate (evars_of evd') pfts
diff --git a/proofs/evar_refiner.mli b/proofs/evar_refiner.mli
index 9880f2f0..baa6b19a 100644
--- a/proofs/evar_refiner.mli
+++ b/proofs/evar_refiner.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: evar_refiner.mli 6616 2005-01-21 17:18:23Z herbelin $ i*)
+(*i $Id: evar_refiner.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Names
@@ -18,7 +18,7 @@ open Refiner
 
 (* Refinement of existential variables. *)
 
-val w_refine :  env -> evar -> Rawterm.rawconstr  -> evar_defs -> evar_defs
+val w_refine : evar -> Rawterm.rawconstr  -> evar_defs -> evar_defs
 
 val instantiate_pf_com :
   int -> Topconstr.constr_expr -> pftreestate -> pftreestate
diff --git a/proofs/logic.ml b/proofs/logic.ml
index ffbc0d56..e40d1232 100644
--- a/proofs/logic.ml
+++ b/proofs/logic.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: logic.ml 8871 2006-05-28 16:46:48Z herbelin $ *)
+(* $Id: logic.ml 9323 2006-10-30 23:05:29Z herbelin $ *)
 
 open Pp
 open Util
@@ -80,15 +80,15 @@ let clear_hyps ids gl =
               error (string_of_id id'^
 		        " is used in hypothesis "^string_of_id id))
 	  (global_vars_set_of_decl env d) in
-    clear_hyps ids fcheck gl.evar_hyps in
+      clear_hyps ids fcheck gl.evar_hyps in
   let ncl = gl.evar_concl in
-  if !check && cleared_ids<>[] then
-    Idset.iter
-      (fun id' ->
-        if List.mem id' cleared_ids then
-          error (string_of_id id'^" is used in conclusion"))
-      (global_vars_set env ncl);
-  mk_goal nhyps ncl
+    if !check && cleared_ids<>[] then
+      Idset.iter
+	(fun id' ->
+          if List.mem id' cleared_ids then
+            error (string_of_id id'^" is used in conclusion"))
+	(global_vars_set_drop_evar env ncl);
+    mk_goal nhyps ncl gl.evar_extra
 
 (* The ClearBody tactic *)
 
@@ -155,7 +155,7 @@ let split_sign hfrom hto l =
       	else 
 	  splitrec (d::left) (toleft or (hyp = hto)) right
   in 
-  splitrec [] false l
+    splitrec [] false l
 
 let move_after with_dep toleft (left,(idfrom,_,_ as declfrom),right) hto =
   let env = Global.env() in
@@ -214,19 +214,25 @@ let check_forward_dependencies id tail =
 		^ (string_of_id id')))
     tail
 
+let check_goal_dependency id cl =
+  let env = Global.env() in
+    if Idset.mem id (global_vars_set_drop_evar env cl) then
+      error (string_of_id id^" is used in conclusion")
 
 let rename_hyp id1 id2 sign =
   apply_to_hyp_and_dependent_on sign id1
     (fun (_,b,t) _ -> (id2,b,t))
     (fun d _ -> map_named_declaration (replace_vars [id1,mkVar id2]) d)
 
-let replace_hyp sign id d =
+let replace_hyp sign id d cl =
+  if !check then
+    check_goal_dependency id cl;
   apply_to_hyp sign id
     (fun sign _ tail ->
-       if !check then
-	 (check_backward_dependencies sign d;
-	  check_forward_dependencies id tail);
-       d)
+      if !check then
+	(check_backward_dependencies sign d;
+	 check_forward_dependencies id tail); 
+      d)
 
 (* why we dont check that id does not appear in tail ??? *)
 let insert_after_hyp sign id d =
@@ -264,6 +270,7 @@ let goal_type_of env sigma c =
 let rec mk_refgoals sigma goal goalacc conclty trm =
   let env = evar_env goal in
   let hyps = goal.evar_hyps in
+  let mk_goal hyps concl = mk_goal hyps concl goal.evar_extra in
 (*
    if  not (occur_meta trm) then
     let t'ty = (unsafe_machine env sigma trm).uj_type in 	
@@ -284,9 +291,14 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
 
     | App (f,l) ->
 	let (acc',hdty) =
-	  if isInd f & not (array_exists occur_meta l) (* we could be finer *)
-	  then (goalacc,type_of_inductive_knowing_parameters env sigma (destInd f) l)
-	  else mk_hdgoals sigma goal goalacc f
+	  match kind_of_term f with
+	    | (Ind _ (* needed if defs in Type are polymorphic: | Const _*))
+		when not (array_exists occur_meta l) (* we could be finer *) ->
+		(* Sort-polymorphism of definition and inductive types *)
+		goalacc, 
+		type_of_global_reference_knowing_parameters env sigma f l
+	    | _ -> 
+		mk_hdgoals sigma goal goalacc f
 	in
 	let (acc'',conclty') =
 	  mk_arggoals sigma goal acc' hdty (Array.to_list l) in
@@ -315,6 +327,7 @@ let rec mk_refgoals sigma goal goalacc conclty trm =
 and mk_hdgoals sigma goal goalacc trm =
   let env = evar_env goal in
   let hyps = goal.evar_hyps in
+  let mk_goal hyps concl = mk_goal hyps concl goal.evar_extra in
   match kind_of_term trm with
     | Cast (c,_, ty) when isMeta c ->
 	check_typability env sigma ty;
@@ -326,8 +339,10 @@ and mk_hdgoals sigma goal goalacc trm =
 
     | App (f,l) ->
 	let (acc',hdty) = 
-	  if isInd f & not (array_exists occur_meta l) (* we could be finer *)
-	  then (goalacc,type_of_inductive_knowing_parameters env sigma (destInd f) l)
+	  if isInd f or isConst f 
+	     & not (array_exists occur_meta l) (* we could be finer *)
+	  then
+	    (goalacc,type_of_global_reference_knowing_parameters env sigma f l)
 	  else mk_hdgoals sigma goal goalacc f
 	in
 	mk_arggoals sigma goal acc' hdty (Array.to_list l)
@@ -392,6 +407,7 @@ let prim_refiner r sigma goal =
   let env = evar_env goal in
   let sign = goal.evar_hyps in
   let cl = goal.evar_concl in
+  let mk_goal hyps concl = mk_goal hyps concl goal.evar_extra in
   match r with
     (* Logical rules *)
     | Intro id ->
@@ -416,12 +432,12 @@ let prim_refiner r sigma goal =
 	(match kind_of_term (strip_outer_cast cl) with
            | Prod (_,c1,b) ->
 	       if occur_meta c1 then error_use_instantiate();
-	       let sign' = replace_hyp sign id (id,None,c1) in
+	       let sign' = replace_hyp sign id (id,None,c1) cl in
 	       let sg = mk_goal sign' (subst1 (mkVar id) b) in
 	       [sg]
            | LetIn (_,c1,t1,b) ->
 	       if occur_meta c1 then error_use_instantiate();
-	       let sign' = replace_hyp sign id (id,Some c1,t1) in
+	       let sign' = replace_hyp sign id (id,Some c1,t1) cl in
 	       let sg = mk_goal sign' (subst1 (mkVar id) b) in
 	       [sg]
 	   | _ ->
@@ -474,7 +490,8 @@ let prim_refiner r sigma goal =
 		  let _ = find_coinductive env sigma b in ()
                 with Not_found -> 
 		  error ("All methods must construct elements " ^
-			  "in coinductive types")
+			  "in coinductiv-> goal
+e types")
 	in
 	let all = (f,cl)::others in
      	List.iter (fun (_,c) -> check_is_coind env c) all;
diff --git a/proofs/pfedit.ml b/proofs/pfedit.ml
index fa6f8c37..565c9547 100644
--- a/proofs/pfedit.ml
+++ b/proofs/pfedit.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: pfedit.ml 6947 2005-04-20 16:18:41Z coq $ *)
+(* $Id: pfedit.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Pp
 open Util
@@ -150,6 +150,14 @@ let subtree_solved () =
   is_complete_proof (proof_of_pftreestate pts) & 
   not (is_top_pftreestate pts)
 
+let tree_solved () = 
+  let pts = get_pftreestate () in
+  is_complete_proof (proof_of_pftreestate pts)
+
+let top_tree_solved () = 
+  let pts = get_pftreestate () in
+  is_complete_proof (proof_of_pftreestate (top_of_tree pts))
+
 (*********************************************************************)
 (*                 Undo functions                                    *)
 (*********************************************************************)
@@ -243,7 +251,7 @@ let set_end_tac tac =
 (*********************************************************************)
 
 let start_proof na str sign concl hook =
-  let top_goal = mk_goal sign concl in
+  let top_goal = mk_goal sign concl None in
   let ts = { 
     top_end_tac = None;
     top_goal = top_goal;
@@ -253,7 +261,6 @@ let start_proof na str sign concl hook =
   start(na,ts);
   set_current_proof na
 
-
 let solve_nth k tac =
   let pft = get_pftreestate () in
   if not (List.mem (-1) (cursor_of_pftreestate pft)) then
@@ -309,7 +316,6 @@ let traverse_prev_unproven () = mutate prev_unproven
 
 let traverse_next_unproven () = mutate next_unproven
 
-
 (* The goal focused on *)
 let focus_n = ref 0
 let make_focus n = focus_n := n
@@ -317,5 +323,11 @@ let focus () = !focus_n
 let focused_goal () = let n = !focus_n in if n=0 then 1 else n
 
 let reset_top_of_tree () = 
-  let pts = get_pftreestate () in 
-  if not (is_top_pftreestate pts) then mutate top_of_tree
+  mutate top_of_tree
+ 
+let reset_top_of_script () = 
+  mutate (fun pts -> 
+	try
+	 up_until_matching_rule is_proof_instr pts
+	with Not_found -> top_of_tree pts)
+
diff --git a/proofs/pfedit.mli b/proofs/pfedit.mli
index ca379d2e..8c0c7f55 100644
--- a/proofs/pfedit.mli
+++ b/proofs/pfedit.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pfedit.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
+(*i $Id: pfedit.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Util
@@ -172,8 +172,12 @@ val make_focus : int -> unit
 val focus : unit -> int
 val focused_goal : unit -> int
 val subtree_solved : unit -> bool
+val tree_solved : unit -> bool
+val top_tree_solved : unit -> bool
 
 val reset_top_of_tree : unit -> unit
+val reset_top_of_script : unit -> unit
+
 val traverse : int -> unit
 val traverse_nth_goal : int -> unit
 val traverse_next_unproven : unit -> unit
diff --git a/proofs/proof_trees.ml b/proofs/proof_trees.ml
index 7e299b89..9d70d012 100644
--- a/proofs/proof_trees.ml
+++ b/proofs/proof_trees.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: proof_trees.ml 6113 2004-09-17 20:28:19Z barras $ *)
+(* $Id: proof_trees.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Closure
 open Util
@@ -18,6 +18,7 @@ open Sign
 open Evd
 open Environ
 open Evarutil
+open Decl_expr
 open Proof_type
 open Tacred
 open Typing
@@ -32,9 +33,9 @@ let is_bind = function
 
 (* Functions on goals *)
 
-let mk_goal hyps cl = 
+let mk_goal hyps cl extra = 
   { evar_hyps = hyps; evar_concl = cl; 
-    evar_body = Evar_empty}
+    evar_body = Evar_empty; evar_extra = extra }
 
 (* Functions on proof trees *)
 
@@ -52,7 +53,7 @@ let children_of_proof pf =
 let goal_of_proof pf = pf.goal
 
 let subproof_of_proof pf = match pf.ref with
-  | Some (Tactic (_,pf), _) -> pf
+  | Some (Nested (_,pf), _) -> pf
   | _ -> failwith "subproof_of_proof"
 
 let status_of_proof pf = pf.open_subgoals
@@ -62,7 +63,7 @@ let is_complete_proof pf = pf.open_subgoals = 0
 let is_leaf_proof pf = (pf.ref = None)
 
 let is_tactic_proof pf = match pf.ref with
-  | Some (Tactic _, _) -> true
+  | Some (Nested (Tactic _,_),_) -> true
   | _ -> false
 
 
@@ -72,6 +73,22 @@ let pf_lookup_name_as_renamed env ccl s =
 let pf_lookup_index_as_renamed env ccl n =
   Detyping.lookup_index_as_renamed env ccl n
 
+(* Functions on rules (Proof mode) *) 
+
+let is_dem_rule  = function
+    Decl_proof _  -> true
+  | _ -> false
+
+let is_proof_instr = function
+    Nested(Proof_instr (_,_),_) -> true
+  | _ -> false
+
+let is_focussing_command = function
+    Decl_proof b -> b 
+  | Nested (Proof_instr (b,_),_) -> b 
+  | _ -> false   
+
+
 (*********************************************************************)
 (*                  Pretty printing functions                        *)
 (*********************************************************************)
diff --git a/proofs/proof_trees.mli b/proofs/proof_trees.mli
index cbf91c8a..f9b64f41 100644
--- a/proofs/proof_trees.mli
+++ b/proofs/proof_trees.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: proof_trees.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
+(*i $Id: proof_trees.mli 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 (*i*)
 open Util
@@ -21,7 +21,7 @@ open Proof_type
 (* This module declares readable constraints, and a few utilities on
    constraints and proof trees *)
 
-val mk_goal : named_context_val -> constr -> goal
+val mk_goal : named_context_val -> constr -> Dyn.t option -> goal
 
 val rule_of_proof     : proof_tree -> rule
 val ref_of_proof      : proof_tree -> (rule * proof_tree list)
@@ -36,6 +36,8 @@ val is_tactic_proof   : proof_tree -> bool
 val pf_lookup_name_as_renamed  : env -> constr -> identifier -> int option
 val pf_lookup_index_as_renamed : env -> constr -> int -> int option
 
+val is_proof_instr : rule -> bool
+val is_focussing_command : rule -> bool
 
 (*s Pretty printing functions. *)
 
diff --git a/proofs/proof_type.ml b/proofs/proof_type.ml
index 009e9d5b..abe31624 100644
--- a/proofs/proof_type.ml
+++ b/proofs/proof_type.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: proof_type.ml 7639 2005-12-02 10:01:15Z gregoire $ *)
+(*i $Id: proof_type.ml 9244 2006-10-16 17:11:44Z barras $ *)
 
 (*i*)
 open Environ
@@ -16,6 +16,7 @@ open Libnames
 open Term
 open Util
 open Tacexpr
+open Decl_expr
 open Rawterm
 open Genarg
 open Nametab
@@ -39,12 +40,6 @@ type prim_rule =
   | Move of bool * identifier * identifier
   | Rename of identifier * identifier
 
-(*s Proof trees. 
-  [ref] = [None] if the goal has still to be proved, 
-  and [Some (r,l)] if the rule [r] was applied to the goal
-  and gave [l] as subproofs to be completed. 
-  if [ref = (Some(Tactic (t,p),l))] then [p] is the proof 
-  that the goal can be proven if the goals in [l] are solved. *)
 type proof_tree = {
   open_subgoals : int;
   goal : goal;
@@ -52,9 +47,15 @@ type proof_tree = {
 
 and rule =
   | Prim of prim_rule
-  | Tactic of tactic_expr * proof_tree
+  | Nested of compound_rule * proof_tree 
+  | Decl_proof of bool
+  | Daimon
   | Change_evars
 
+and compound_rule=  
+  | Tactic of tactic_expr * bool
+  | Proof_instr of bool*proof_instr (* the boolean is for focus restrictions *)
+
 and goal = evar_info
 
 and tactic = goal sigma -> (goal list sigma * validation)
diff --git a/proofs/proof_type.mli b/proofs/proof_type.mli
index 0e42dcba..d87c1298 100644
--- a/proofs/proof_type.mli
+++ b/proofs/proof_type.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: proof_type.mli 7639 2005-12-02 10:01:15Z gregoire $ i*)
+(*i $Id: proof_type.mli 9244 2006-10-16 17:11:44Z barras $ i*)
 
 (*i*)
 open Environ
@@ -16,6 +16,7 @@ open Libnames
 open Term
 open Util
 open Tacexpr
+open Decl_expr
 open Rawterm
 open Genarg
 open Nametab
@@ -46,7 +47,7 @@ type prim_rule =
              evar_body = Evar_Empty;
              evar_info = { pgm    : [The Realizer pgm if any]
                            lc     : [Set of evar num occurring in subgoal] }}
-   sigma = { stamp = [an int characterizing the ed field, for quick compare]
+   sigma = { stamp = [an int chardacterizing the ed field, for quick compare]
              ed : [A set of existential variables depending in the subgoal]
                number of first evar,
                it = { evar_concl = [the type of first evar]
@@ -71,7 +72,7 @@ type prim_rule =
   [ref] = [None] if the goal has still to be proved, 
   and [Some (r,l)] if the rule [r] was applied to the goal
   and gave [l] as subproofs to be completed. 
-  if [ref = (Some(Tactic (t,p),l))] then [p] is the proof 
+  if [ref = (Some(Nested(Tactic t,p),l))] then [p] is the proof 
   that the goal can be proven if the goals in [l] are solved. *)
 type proof_tree = {
   open_subgoals : int;
@@ -80,9 +81,16 @@ type proof_tree = {
 
 and rule =
   | Prim of prim_rule
-  | Tactic of tactic_expr * proof_tree
+  | Nested of compound_rule * proof_tree 
+  | Decl_proof of bool
+  | Daimon
   | Change_evars
 
+and compound_rule= 
+  (* the boolean of Tactic tells if the default tactic is used *)
+  | Tactic of tactic_expr * bool
+  | Proof_instr of bool * proof_instr
+
 and goal = evar_info
 
 and tactic = goal sigma -> (goal list sigma * validation)
diff --git a/proofs/redexpr.ml b/proofs/redexpr.ml
index eb47fc2e..ad277caa 100644
--- a/proofs/redexpr.ml
+++ b/proofs/redexpr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: redexpr.ml 8878 2006-05-30 16:44:25Z herbelin $ *)
+(* $Id: redexpr.ml 9058 2006-07-22 17:42:45Z bgregoir $ *)
 
 open Pp
 open Util
@@ -24,7 +24,7 @@ open RedFlags
 (* call by value normalisation function using the virtual machine *)
 let cbv_vm env _ c =
   let ctyp = (fst (Typeops.infer env c)).Environ.uj_type in
-  Vconv.cbv_vm env c ctyp
+  Vnorm.cbv_vm env c ctyp
 
 
 let set_opaque_const sp = 
diff --git a/proofs/refiner.ml b/proofs/refiner.ml
index 067ae471..70a0e3db 100644
--- a/proofs/refiner.ml
+++ b/proofs/refiner.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: refiner.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: refiner.ml 9261 2006-10-23 10:01:40Z barras $ *)
 
 open Pp
 open Util
@@ -43,6 +43,31 @@ let and_status = List.fold_left (+) 0
 let pf_env gls = Global.env_of_context (sig_it gls).evar_hyps
 let pf_hyps gls = named_context_of_val (sig_it gls).evar_hyps
 
+
+let descend n p =
+  match p.ref with
+    | None        -> error "It is a leaf."
+    | Some(r,pfl) ->
+    	if List.length pfl >= n then
+	  (match list_chop (n-1) pfl with 
+	     | left,(wanted::right) ->
+		 (wanted,
+		  (fun pfl' ->
+                     if (List.length pfl' = 1) 
+		       & (List.hd pfl').goal = wanted.goal 
+		     then
+                       let pf'       = List.hd pfl' in
+                       let spfl      = left@(pf'::right) in
+                       let newstatus = and_status (List.map pf_status spfl) in
+                       { p with 
+			   open_subgoals = newstatus;
+			   ref           = Some(r,spfl) }
+                     else 
+		       error "descend: validation"))
+	     | _ -> assert false)
+    	else 
+	  error "Too few subproofs"
+
 (* Normalizing evars in a goal. Called by tactic Local_constraints
    (i.e. when the sigma of the proof tree changes). Detect if the
    goal is unchanged *)
@@ -50,10 +75,10 @@ let norm_goal sigma gl =
   let red_fun = Evarutil.nf_evar sigma in
   let ncl = red_fun gl.evar_concl in
   let ngl =
-    { evar_concl = ncl;
-      evar_hyps = map_named_val red_fun gl.evar_hyps; 
-      evar_body = gl.evar_body} in
-  if Evd.eq_evar_info ngl gl then None else Some ngl
+    { gl with 
+	evar_concl = ncl;
+	evar_hyps = map_named_val red_fun gl.evar_hyps } in
+    if Evd.eq_evar_info ngl gl then None else Some ngl
 
 
 (* [mapshape [ l1 ; ... ; lk ] [ v1 ; ... ; vk ] [ p_1 ; .... ; p_(l1+...+lk) ]]
@@ -91,9 +116,9 @@ let rec frontier p =
     	(List.flatten gll,
          (fun retpfl ->
             let pfl' = mapshape (List.map List.length gll) vl retpfl in
-            { open_subgoals = and_status (List.map pf_status pfl');
-              goal = p.goal;
-              ref = Some(r,pfl')}))
+              { p with
+		  open_subgoals = and_status (List.map pf_status pfl');
+		  ref = Some(r,pfl')}))
 
 
 let rec frontier_map_rec f n p =
@@ -111,9 +136,9 @@ let rec frontier_map_rec f n p =
             (fun (n,acc) p -> (n-p.open_subgoals,frontier_map_rec f n p::acc))
             (n,[]) pfl in
         let pfl' = List.rev rpfl' in
-        { open_subgoals = and_status (List.map pf_status pfl');
-          goal = p.goal;
-          ref = Some(r,pfl')}
+        { p with
+	    open_subgoals = and_status (List.map pf_status pfl');
+            ref = Some(r,pfl')}
 
 let frontier_map f n p =
   let nmax = p.open_subgoals in
@@ -137,9 +162,9 @@ let rec frontier_mapi_rec f i p =
             (fun (n,acc) p -> (n+p.open_subgoals,frontier_mapi_rec f n p::acc))
             (i,[]) pfl in
         let pfl' = List.rev rpfl' in
-        { open_subgoals = and_status (List.map pf_status pfl');
-          goal = p.goal;
-          ref = Some(r,pfl')}
+        { p with 
+	    open_subgoals = and_status (List.map pf_status pfl');
+            ref = Some(r,pfl')}
 
 let frontier_mapi f p = frontier_mapi_rec f 1 p
 
@@ -152,50 +177,35 @@ let rec nb_unsolved_goals pf = pf.open_subgoals
 
 (* leaf g is the canonical incomplete proof of a goal g *)
 
-let leaf g = {
-  open_subgoals = 1;
-  goal = g;
-  ref = None }
-
-(* Tactics table. *)
-
-let tac_tab = Hashtbl.create 17
-
-let add_tactic s t =
-  if Hashtbl.mem tac_tab s then
-    errorlabstrm ("Refiner.add_tactic: ") 
-      (str ("Cannot redeclare tactic "^s));
-  Hashtbl.add tac_tab s t
-
-let overwriting_add_tactic s t =
-  if Hashtbl.mem tac_tab s then begin
-    Hashtbl.remove tac_tab s;
-    warning ("Overwriting definition of tactic "^s)
-  end;
-  Hashtbl.add tac_tab s t
-
-let lookup_tactic s =
-  try 
-    Hashtbl.find tac_tab s
-  with Not_found -> 
-    errorlabstrm "Refiner.lookup_tactic"
-      (str"The tactic " ++ str s ++ str" is not installed")
-
+let leaf g = 
+  { open_subgoals = 1;
+    goal = g;
+    ref = None }
 
 (* refiner r is a tactic applying the rule r *)
 
 let check_subproof_connection gl spfl =
   list_for_all2eq (fun g pf -> Evd.eq_evar_info g pf.goal) gl spfl
 
-let abstract_tactic_expr te tacfun gls =
-  let (sgl_sigma,v) = tacfun gls in
-  let hidden_proof = v (List.map leaf sgl_sigma.it) in
+
+let abstract_operation syntax semantics gls =
+  let (sgl_sigma,validation) = semantics gls in
+  let hidden_proof = validation (List.map leaf sgl_sigma.it) in
   (sgl_sigma,
    fun spfl ->
      assert (check_subproof_connection sgl_sigma.it spfl);
      { open_subgoals = and_status (List.map pf_status spfl);
        goal = gls.it;
-       ref = Some(Tactic(te,hidden_proof),spfl) })
+       ref = Some(Nested(syntax,hidden_proof),spfl)})
+
+let abstract_tactic_expr ?(dflt=false) te tacfun gls =
+  abstract_operation (Tactic(te,dflt)) tacfun gls	
+
+let abstract_tactic ?(dflt=false) te =
+  abstract_tactic_expr ~dflt (Tacexpr.TacAtom (dummy_loc,te))
+
+let abstract_extended_tactic ?(dflt=false) s args = 
+  abstract_tactic ~dflt (Tacexpr.TacExtend (dummy_loc, s, args))
 
 let refiner = function
   | Prim pr as r ->
@@ -209,8 +219,21 @@ let refiner = function
                goal = goal_sigma.it;
                ref = Some(r,spfl) })))
 
-  | Tactic _ -> failwith "Refiner: should not occur"
+
+  | Nested (_,_) | Decl_proof _ -> 
+      failwith "Refiner: should not occur"
       
+	(* Daimon is a canonical unfinished proof *)
+
+  | Daimon -> 
+      fun gls -> 
+	({it=[];sigma=gls.sigma},  
+	 fun spfl -> 
+	   assert (spfl=[]);
+	   { open_subgoals = 0;
+             goal = gls.it;
+             ref = Some(Daimon,[])})
+
    (* [Local_constraints lc] makes the local constraints be [lc] and
       normalizes evars *)
 
@@ -237,19 +260,11 @@ let local_Constraints gl = refiner Change_evars gl
 
 let norm_evar_tac = local_Constraints
 
-(*
-let vernac_tactic (s,args) =
-  let tacfun = lookup_tactic s args in
-  abstract_extra_tactic s args tacfun
-*)
-let abstract_tactic te = abstract_tactic_expr (Tacexpr.TacAtom (dummy_loc,te))
-
-let abstract_extended_tactic s args = 
-  abstract_tactic (Tacexpr.TacExtend (dummy_loc, s, args))
-
-let vernac_tactic (s,args) =
-  let tacfun = lookup_tactic s args in
-  abstract_extended_tactic s args tacfun
+let norm_evar_proof sigma pf =
+  let nf_subgoal i sgl =
+    let (gll,v) = norm_evar_tac {it=sgl.goal;sigma=sigma} in
+    v (List.map leaf gll.it) in
+  frontier_mapi nf_subgoal pf
 
 (* [extract_open_proof : proof_tree -> constr * (int * constr) list]
   takes a (not necessarly complete) proof and gives a pair (pfterm,obl)
@@ -271,14 +286,16 @@ let extract_open_proof sigma pf =
   let rec proof_extractor vl = function
     | {ref=Some(Prim _,_)} as pf -> prim_extractor proof_extractor vl pf
 	  
-    | {ref=Some(Tactic (_,hidden_proof),spfl)} ->
+    | {ref=Some(Nested(_,hidden_proof),spfl)} ->
 	let sgl,v = frontier hidden_proof in
 	let flat_proof = v spfl in
 	proof_extractor vl flat_proof
-	  
+ 
     | {ref=Some(Change_evars,[pf])} -> (proof_extractor vl) pf
+
+    | {ref=Some(Decl_proof _,[pf])} -> (proof_extractor vl) pf
 	  
-    | {ref=None;goal=goal} ->
+    | {ref=(None|Some(Daimon,[]));goal=goal} ->
 	let visible_rels =
           map_succeed
             (fun id ->
@@ -555,6 +572,8 @@ let tclIFTHENSELSE=ite_gen tclTHENS
 
 let tclIFTHENSVELSE=ite_gen tclTHENSV
 
+let tclIFTHENTRYELSEMUST tac1 tac2 gl = 
+  tclIFTHENELSE tac1 (tclTRY tac2) tac2 gl
 
 (* Fails if a tactic did not solve the goal *)
 let tclCOMPLETE tac = tclTHEN tac (tclFAIL_s "Proof is not complete.")
@@ -633,7 +652,6 @@ let tactic_list_tactic tac gls =
 
 
 
-
 (* The type of proof-trees state and a few utilities 
    A proof-tree state is built from a proof-tree, a set of global
    constraints, and a stack which allows to navigate inside the
@@ -665,41 +683,19 @@ let nth_goal_of_pftreestate n pts =
   try {it = List.nth goals (n-1); sigma = pts.tpfsigma }
   with Invalid_argument _ | Failure _ -> non_existent_goal n
 
-let descend n p =
-  match p.ref with
-    | None        -> error "It is a leaf."
-    | Some(r,pfl) ->
-    	if List.length pfl >= n then
-	  (match list_chop (n-1) pfl with 
-	     | left,(wanted::right) ->
-		 (wanted,
-		  (fun pfl' ->
-                     if (List.length pfl' = 1) 
-		       & (List.hd pfl').goal = wanted.goal 
-		     then
-                       let pf'       = List.hd pfl' in
-                       let spfl      = left@(pf'::right) in
-                       let newstatus = and_status (List.map pf_status spfl) in
-                       { open_subgoals = newstatus;
-			 goal          = p.goal;
-			 ref           = Some(r,spfl) }
-                     else 
-		       error "descend: validation"))
-	     | _ -> assert false)
-    	else 
-	  error "Too few subproofs"
-
 let traverse n pts = match n with 
   | 0 -> (* go to the parent *)
       (match  pts.tstack with
 	 | [] -> error "traverse: no ancestors"
 	 | (_,v)::tl ->
-	     { tpf = v [pts.tpf];
+             let pf = v [pts.tpf] in
+             let pf = norm_evar_proof pts.tpfsigma pf in
+	     { tpf = pf;
 	       tstack = tl;
 	       tpfsigma = pts.tpfsigma })
   | -1 -> (* go to the hidden tactic-proof, if any, otherwise fail *)
       (match pts.tpf.ref with
-	 | Some (Tactic (_,spf),_) ->
+	 | Some (Nested (_,spf),_) ->
 	     let v = (fun pfl -> pts.tpf) in 
 	     { tpf = spf;
                tstack = (-1,v)::pts.tstack;
@@ -718,17 +714,23 @@ let app_tac sigr tac p =
   sigr := gll.sigma;
   v (List.map leaf gll.it)
 
-(* solve the nth subgoal with tactic tac *)
-let solve_nth_pftreestate n tac pts =
+(* modify proof state at current position *)
+
+let map_pftreestate f pts =
   let sigr = ref pts.tpfsigma in
-  let tpf' = frontier_map (app_tac sigr tac) n pts.tpf in
+  let tpf' = f sigr pts.tpf in
   let tpf'' =
-    if !sigr == pts.tpfsigma then tpf'
-    else frontier_mapi (fun _ g -> app_tac sigr norm_evar_tac g) tpf' in
+    if !sigr == pts.tpfsigma then tpf' else norm_evar_proof !sigr tpf' in
   { tpf      = tpf'';
     tpfsigma = !sigr;
     tstack   = pts.tstack }
 
+(* solve the nth subgoal with tactic tac *)
+
+let solve_nth_pftreestate n tac =
+  map_pftreestate 
+    (fun sigr pt -> frontier_map (app_tac sigr tac) n pt)
+ 
 let solve_pftreestate = solve_nth_pftreestate 1
 
 (* This function implements a poor man's undo at the current goal.
@@ -880,6 +882,38 @@ let prev_unproven pts =
 let rec top_of_tree pts = 
   if is_top_pftreestate pts then pts else top_of_tree(traverse 0 pts)
 
+let change_rule f pts =
+  let mark_top _ pt =
+    match pt.ref with
+	Some (oldrule,l) -> 
+	  {pt with ref=Some (f oldrule,l)}
+      | _ -> invalid_arg "change_rule" in
+    map_pftreestate mark_top pts
+
+let match_rule p pts =
+  match (proof_of_pftreestate pts).ref with
+      Some (r,_) -> p r
+    | None -> false
+
+let rec up_until_matching_rule p pts = 
+  if is_top_pftreestate pts then 
+    raise Not_found
+  else
+    let one_up = traverse 0 pts in
+      if match_rule p one_up then 
+	pts
+      else
+	up_until_matching_rule p one_up
+
+let rec up_to_matching_rule p pts = 
+  if match_rule p pts then 
+    pts
+  else
+    if is_top_pftreestate pts then 
+      raise Not_found
+    else
+      let one_up = traverse 0 pts in
+      	up_to_matching_rule p one_up
 
 (* Change evars *)
 let tclEVARS sigma gls = tclIDTAC {gls with sigma=sigma}
diff --git a/proofs/refiner.mli b/proofs/refiner.mli
index 417ddbcd..d8b13dba 100644
--- a/proofs/refiner.mli
+++ b/proofs/refiner.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: refiner.mli 7911 2006-01-21 11:18:36Z herbelin $ i*)
+(*i $Id: refiner.mli 9244 2006-10-16 17:11:44Z barras $ i*)
 
 (*i*)
 open Term
@@ -32,20 +32,17 @@ val apply_sig_tac :
 
 type transformation_tactic = proof_tree -> (goal list * validation)
 
-val add_tactic             : string -> (closed_generic_argument list -> tactic) -> unit
-val overwriting_add_tactic : string -> (closed_generic_argument list -> tactic) -> unit
-val lookup_tactic          : string -> (closed_generic_argument list) -> tactic
-
 (*s Hiding the implementation of tactics. *)
 
 (* [abstract_tactic tac] hides the (partial) proof produced by [tac] under
-   a single proof node *)
-val abstract_tactic : atomic_tactic_expr -> tactic -> tactic
-val abstract_tactic_expr : tactic_expr -> tactic -> tactic
-val abstract_extended_tactic : string -> closed_generic_argument list -> tactic -> tactic
+   a single proof node. The boolean tells if the default tactic is used. *)
+val abstract_operation : compound_rule -> tactic -> tactic
+val abstract_tactic : ?dflt:bool -> atomic_tactic_expr -> tactic -> tactic
+val abstract_tactic_expr : ?dflt:bool -> tactic_expr -> tactic -> tactic
+val abstract_extended_tactic :
+  ?dflt:bool -> string -> closed_generic_argument list -> tactic -> tactic
 
 val refiner : rule -> tactic
-val vernac_tactic : string * closed_generic_argument list -> tactic
 val frontier : transformation_tactic
 val list_pf : proof_tree -> goal list
 val unTAC : tactic -> goal sigma -> proof_tree sigma
@@ -148,6 +145,12 @@ val tclIFTHENELSE    : tactic -> tactic -> tactic -> tactic
 val tclIFTHENSELSE   : tactic -> tactic list -> tactic ->tactic
 val tclIFTHENSVELSE   : tactic -> tactic array -> tactic ->tactic
 
+(* [tclIFTHENTRYELSEMUST tac1 tac2 gls] applies [tac1] then [tac2]. If [tac1]
+   has been successful, then [tac2] may fail. Otherwise, [tac2] must succeed. 
+   Equivalent to [(tac1;try tac2)||tac2] *)
+
+val tclIFTHENTRYELSEMUST : tactic -> tactic -> tactic
+
 (*s Tactics handling a list of goals. *)
 
 type validation_list = proof_tree list -> proof_tree list
@@ -170,11 +173,14 @@ type pftreestate
 val proof_of_pftreestate : pftreestate -> proof_tree
 val cursor_of_pftreestate : pftreestate -> int list
 val is_top_pftreestate : pftreestate -> bool
+val match_rule : (rule -> bool) -> pftreestate -> bool
 val evc_of_pftreestate : pftreestate -> evar_map
 val top_goal_of_pftreestate : pftreestate -> goal sigma
 val nth_goal_of_pftreestate : int -> pftreestate -> goal sigma
 
 val traverse : int -> pftreestate -> pftreestate
+val map_pftreestate : 
+  (evar_map ref -> proof_tree -> proof_tree) -> pftreestate -> pftreestate
 val solve_nth_pftreestate : int -> tactic -> pftreestate -> pftreestate
 val solve_pftreestate : tactic -> pftreestate -> pftreestate
 
@@ -193,6 +199,12 @@ val node_next_unproven : int -> pftreestate -> pftreestate
 val next_unproven : pftreestate -> pftreestate
 val prev_unproven : pftreestate -> pftreestate
 val top_of_tree : pftreestate -> pftreestate
+val match_rule : (rule -> bool) -> pftreestate -> bool
+val up_until_matching_rule : (rule -> bool) -> 
+  pftreestate -> pftreestate
+val up_to_matching_rule : (rule -> bool) -> 
+  pftreestate -> pftreestate
+val change_rule : (rule -> rule) -> pftreestate -> pftreestate
 val change_constraints_pftreestate 
   : evar_map -> pftreestate -> pftreestate
 
diff --git a/proofs/tacexpr.ml b/proofs/tacexpr.ml
index b721dacd..0fe21552 100644
--- a/proofs/tacexpr.ml
+++ b/proofs/tacexpr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacexpr.ml 8917 2006-06-07 16:59:05Z herbelin $ i*)
+(*i $Id: tacexpr.ml 9267 2006-10-24 12:55:46Z herbelin $ i*)
 
 open Names
 open Topconstr
@@ -234,7 +234,7 @@ and ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg =
       'ref * ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg list
   | TacExternal of loc * string * string * 
       ('constr,'pat,'cst,'ind,'ref,'id,'tac) gen_tactic_arg list
-  | TacFreshId     of string option
+  | TacFreshId     of string or_var list
   | Tacexp of 'tac
 
 (* Globalized tactics *)
diff --git a/proofs/tactic_debug.ml b/proofs/tactic_debug.ml
index 889e06a8..96df8f64 100644
--- a/proofs/tactic_debug.ml
+++ b/proofs/tactic_debug.ml
@@ -31,6 +31,8 @@ type debug_info =
 (* An exception handler *)
 let explain_logic_error = ref (fun e -> mt())
 
+let explain_logic_error_no_anomaly = ref (fun e -> mt())
+
 (* Prints the goal *)
 let db_pr_goal g =
   msgnl (str "Goal:" ++ fnl () ++ Proof_trees.db_pr_goal (Refiner.sig_it g))
diff --git a/proofs/tactic_debug.mli b/proofs/tactic_debug.mli
index fc1b6120..6de8244d 100644
--- a/proofs/tactic_debug.mli
+++ b/proofs/tactic_debug.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tactic_debug.mli 7911 2006-01-21 11:18:36Z herbelin $ i*)
+(*i $Id: tactic_debug.mli 9092 2006-08-28 11:42:14Z bertot $ i*)
 
 open Environ
 open Pattern
@@ -66,5 +66,11 @@ val db_eval_failure : debug_info -> Pp.std_ppcmds -> unit
 (* An exception handler *)
 val explain_logic_error: (exn -> Pp.std_ppcmds) ref
 
+(* For use in the Ltac debugger: some exception that are usually
+   consider anomalies are acceptable because they are caught later in
+   the process that is being debugged.  One should not require
+   from users that they report these anomalies. *)
+val explain_logic_error_no_anomaly : (exn -> Pp.std_ppcmds) ref
+
 (* Prints a logic failure message for a rule *)
 val db_logic_failure : debug_info -> exn -> unit
diff --git a/scripts/coqmktop.ml b/scripts/coqmktop.ml
index 4cc676cf..153b9747 100644
--- a/scripts/coqmktop.ml
+++ b/scripts/coqmktop.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqmktop.ml 8787 2006-05-04 13:25:52Z notin $ *)
+(* $Id: coqmktop.ml 9347 2006-11-06 16:58:28Z notin $ *)
 
 (* coqmktop is a script to link Coq, analogous to ocamlmktop.
    The command line contains options specific to coqmktop, options for the
@@ -49,6 +49,9 @@ let searchisos = ref false
 let coqide     = ref false
 let echo       = ref false
 
+(* Caml inline flag *)
+let caml_inline_0 = ref false
+
 let src_dirs () = 
   [ []; ["kernel";"byterun"]; [ "config" ]; [ "toplevel" ] ] @
   if !coqide then [[ "ide" ]] else []
@@ -57,7 +60,7 @@ let includes () =
   List.fold_right
     (fun d l -> "-I" :: List.fold_left Filename.concat !src_coqtop d :: l)
     (src_dirs ())
-    (["-I"; Coq_config.camlp4lib] @ 
+    (["-I"; "\""; Coq_config.camlp4lib; "\""] @ 
      (if !coqide then ["-thread"; "-I"; "+lablgtk2"] else []))
 
 (* Transform bytecode object file names in native object file names *)
@@ -168,6 +171,7 @@ let parse_args () =
     | "-R" :: [] -> usage ()
     | ("-noassert"|"-compact"|"-g"|"-p"|"-thread"|"-dtypes" as o) :: rem ->
         parse (o::op,fl) rem
+    | "-inline" :: p :: rem -> caml_inline_0 := true; parse (op,fl) rem
     | ("-h"|"--help") :: _ -> usage ()
     | f :: rem ->
 	if Filename.check_suffix f ".ml" 
@@ -276,19 +280,22 @@ let main () =
   let (options, userfiles) = parse_args () in
   (* which ocaml command to invoke *)
   let prog =
-    if !opt then begin
-      (* native code *)
-      if !top then failwith "no custom toplevel in native code !";
-      "ocamlopt -linkall"
-    end else
+    if !opt then
+      begin
+	(* native code *)
+	if !top then failwith "no custom toplevel in native code !";
+	let ocamloptexec = Filename.concat Coq_config.camldir "ocamlopt" in
+          (if !caml_inline_0 then ocamloptexec^" -linkall"^" -inline 0" else ocamloptexec^" -linkall")
+      end else
       (* bytecode (we shunt ocamlmktop script which fails on win32) *)
       let ocamlmktoplib = " toplevellib.cma" in
-      let ocamlccustom = "ocamlc -custom -linkall" in
-      (if !top then ocamlccustom^ocamlmktoplib else ocamlccustom)
+      let ocamlcexec = Filename.concat Coq_config.camldir "ocamlc" in
+      let ocamlccustom = ocamlcexec^" -custom -linkall" in
+	(if !top then ocamlccustom^ocamlmktoplib else ocamlccustom)
   in
-  (* files to link *)
+    (* files to link *)
   let (modules, tolink) = files_to_link userfiles in
-  (*file for dynlink *)
+    (*file for dynlink *)
   let dynlink=
     if not (!opt || !top) then
       [tmp_dynlink()]
diff --git a/tactics/auto.ml b/tactics/auto.ml
index 7c1c375b..3cd1591d 100644
--- a/tactics/auto.ml
+++ b/tactics/auto.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: auto.ml 8878 2006-05-30 16:44:25Z herbelin $ *)
+(* $Id: auto.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Pp
 open Util
@@ -192,7 +192,10 @@ let make_exact_entry (c,cty) =
 	   { pri=0; pat=None; code=Give_exact c })
 
 let dummy_goal =
-  {it={evar_hyps=empty_named_context_val;evar_concl=mkProp;evar_body=Evar_empty};
+  {it={evar_hyps=empty_named_context_val;
+       evar_concl=mkProp;
+       evar_body=Evar_empty;
+       evar_extra=None};
    sigma=Evd.empty}
 
 let make_apply_entry env sigma (eapply,verbose) (c,cty) =
diff --git a/tactics/autorewrite.ml b/tactics/autorewrite.ml
index ceeb4763..872b8697 100644
--- a/tactics/autorewrite.ml
+++ b/tactics/autorewrite.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: autorewrite.ml 8114 2006-03-02 18:09:27Z herbelin $ *)
+(* $Id: autorewrite.ml 9157 2006-09-21 15:10:08Z herbelin $ *)
 
 open Equality
 open Hipattern
@@ -60,11 +60,11 @@ type raw_rew_rule = constr * bool * raw_tactic_expr
 
 (* Applies all the rules of one base *)
 let one_base general_rewrite_maybe_in tac_main bas =
-  let lrul = 
-    try 
+  let lrul =
+    try
       Stringmap.find bas !rewtab
-    with Not_found -> 
-      errorlabstrm "AutoRewrite" 
+    with Not_found ->
+      errorlabstrm "AutoRewrite"
         (str ("Rewriting base "^(bas)^" does not exist"))
   in
   let lrul = List.map (fun (c,_,b,t) -> (c,b,Tacinterp.eval_tactic t)) lrul in
@@ -74,16 +74,19 @@ let one_base general_rewrite_maybe_in tac_main bas =
 	  (tclTHENSFIRSTn (general_rewrite_maybe_in dir csr) [|tac_main|] tc)))
       tclIDTAC lrul))
 
+
+
 (* The AutoRewrite tactic *)
 let autorewrite tac_main lbas =
   tclREPEAT_MAIN (tclPROGRESS
     (List.fold_left (fun tac bas -> 
        tclTHEN tac (one_base general_rewrite tac_main bas)) tclIDTAC lbas))
 
-let autorewrite_in id tac_main lbas gl =
+let autorewrite_mutlti_in idl tac_main lbas : tactic =
+  fun gl -> 
  (* let's check at once if id exists (to raise the appropriate error) *)
- let _ = Tacmach.pf_get_hyp gl id in
- let general_rewrite_in =
+ let _ = List.map (Tacmach.pf_get_hyp gl) idl in
+ let general_rewrite_in id =
   let id = ref id in
   let to_be_cleared = ref false in
    fun dir cstr gl ->
@@ -117,10 +120,51 @@ let autorewrite_in id tac_main lbas gl =
           | _ -> assert false) (* there must be at least an hypothesis *)
      | _ -> assert false (* rewriting cannot complete a proof *)
  in
+ tclMAP (fun id -> 
   tclREPEAT_MAIN (tclPROGRESS
     (List.fold_left (fun tac bas -> 
-       tclTHEN tac (one_base general_rewrite_in tac_main bas)) tclIDTAC lbas))
-   gl
+       tclTHEN tac (one_base (general_rewrite_in id) tac_main bas)) tclIDTAC lbas)))
+   idl gl
+
+let autorewrite_in id = autorewrite_mutlti_in [id]
+
+let gen_auto_multi_rewrite tac_main lbas cl = 
+  let try_do_hyps treat_id l = 
+    autorewrite_mutlti_in (List.map treat_id l) tac_main lbas
+  in 
+  if cl.concl_occs <> [] then 
+    error "The \"at\" syntax isn't available yet for the autorewrite tactic"
+  else 
+    let compose_tac t1 t2 = 
+      match cl.onhyps with 
+	| Some [] -> t1 
+	| _ ->      tclTHENFIRST t1 t2
+    in
+    compose_tac
+	(if cl.onconcl then autorewrite tac_main lbas else tclIDTAC)
+	(match cl.onhyps with 
+	   | Some l -> try_do_hyps (fun ((_,id),_) -> id) l
+	   | None -> 
+	       fun gl -> 
+		 (* try to rewrite in all hypothesis 
+		    (except maybe the rewritten one) *)
+		 let ids =  Tacmach.pf_ids_of_hyps gl
+		 in try_do_hyps (fun id -> id)  ids gl)
+
+let auto_multi_rewrite = gen_auto_multi_rewrite Refiner.tclIDTAC
+
+let auto_multi_rewrite_with tac_main lbas cl gl = 
+  match cl.Tacexpr.onconcl,cl.Tacexpr.onhyps with 
+    | false,Some [_] | true,Some [] | false,Some [] ->   
+	(* autorewrite with .... in clause using tac n'est sur que 
+	   si clause reprensente soit le but soit UNE hypothse 
+	*)
+	gen_auto_multi_rewrite tac_main  lbas cl gl
+    | _ -> 
+	    Util.errorlabstrm "autorewrite" 
+	      (str "autorewrite .. in .. using can only be used either with a unique hypothesis or" ++
+		 str " on the conclusion")
+
 
 (* Functions necessary to the library object declaration *)
 let cache_hintrewrite (_,(rbase,lrl)) =
@@ -165,8 +209,8 @@ let classify_hintrewrite (_,x) = Libobject.Substitute x
 (* Declaration of the Hint Rewrite library object *)
 let (in_hintrewrite,out_hintrewrite)=
   Libobject.declare_object {(Libobject.default_object "HINT_REWRITE") with
-       Libobject.open_function = (fun i o -> if i=1 then cache_hintrewrite o);
        Libobject.cache_function = cache_hintrewrite;
+       Libobject.load_function = (fun _ -> cache_hintrewrite);
        Libobject.subst_function = subst_hintrewrite;
        Libobject.classify_function = classify_hintrewrite;
        Libobject.export_function = export_hintrewrite }
diff --git a/tactics/autorewrite.mli b/tactics/autorewrite.mli
index 47d3c86a..f402a35d 100644
--- a/tactics/autorewrite.mli
+++ b/tactics/autorewrite.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: autorewrite.mli 7034 2005-05-18 19:30:44Z sacerdot $ i*)
+(*i $Id: autorewrite.mli 9073 2006-08-22 08:54:29Z jforest $ i*)
 
 (*i*)
 open Tacmach
@@ -22,4 +22,9 @@ val add_rew_rules : string -> raw_rew_rule list -> unit
 val autorewrite : tactic -> string list -> tactic
 val autorewrite_in : Names.identifier -> tactic -> string list -> tactic
 
+
+val auto_multi_rewrite : string list -> Tacticals.clause -> tactic
+
+val auto_multi_rewrite_with : tactic -> string list -> Tacticals.clause -> tactic
+
 val print_rewrite_hintdb : string -> unit
diff --git a/tactics/contradiction.ml b/tactics/contradiction.ml
index 0f274aae..eca16066 100644
--- a/tactics/contradiction.ml
+++ b/tactics/contradiction.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: contradiction.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: contradiction.ml 9269 2006-10-24 13:01:55Z herbelin $ *)
 
 open Util
 open Term
@@ -22,6 +22,10 @@ open Rawterm
 (* Absurd *)
 
 let absurd c gls =
+  let env = pf_env gls and sigma = project gls in
+  let _,j = Coercion.Default.inh_coerce_to_sort dummy_loc env
+    (Evd.create_evar_defs sigma) (Retyping.get_judgment_of env sigma c) in
+  let c = j.Environ.utj_val in
   (tclTHENS
      (tclTHEN (elim_type (build_coq_False ())) (cut c)) 
      ([(tclTHENS
diff --git a/tactics/decl_interp.ml b/tactics/decl_interp.ml
new file mode 100644
index 00000000..8ace0a08
--- /dev/null
+++ b/tactics/decl_interp.ml
@@ -0,0 +1,429 @@
+(************************************************************************)
+(*  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:$ *)
+
+open Util
+open Names
+open Topconstr
+open Tacinterp
+open Tacmach
+open Decl_expr
+open Decl_mode
+open Pretyping.Default
+open Rawterm
+open Term
+open Pp
+
+let raw_app (loc,hd,args) = if args =[] then hd else RApp(loc,hd,args) 
+
+let intern_justification globs = function
+    Automated l -> Automated (List.map (intern_constr globs) l)
+  | By_tactic tac -> By_tactic (intern_tactic globs tac) 
+
+let intern_statement intern_it globs st =
+  {st_label=st.st_label;
+   st_it=intern_it globs st.st_it}
+    
+let intern_constr_or_thesis globs = function
+    Thesis n -> Thesis n
+  | This c -> This (intern_constr globs c)
+
+let add_var id globs= 
+  let l1,l2=globs.ltacvars in
+    {globs with ltacvars= (id::l1),(id::l2)}
+
+let add_name nam globs=
+ match nam with 
+     Anonymous -> globs
+   | Name id -> add_var id globs
+
+let intern_hyp iconstr globs = function 
+    Hvar (loc,(id,topt)) -> add_var id globs,
+      Hvar (loc,(id,option_map (intern_constr globs) topt))
+  | Hprop st -> add_name st.st_label globs,
+      Hprop (intern_statement iconstr globs st)
+
+let intern_hyps iconstr globs hyps = 
+  snd (list_fold_map (intern_hyp iconstr) globs hyps)
+
+let intern_cut intern_it globs cut=
+ {cut_stat=intern_statement intern_it globs cut.cut_stat;
+  cut_by=intern_justification globs cut.cut_by}
+
+let intern_casee globs = function 
+    Real c -> Real (intern_constr globs c)
+  | Virtual cut -> Virtual (intern_cut intern_constr globs cut) 
+
+let intern_hyp_list args globs =
+  let intern_one globs (loc,(id,opttyp)) =
+    (add_var id globs),
+    (loc,(id,option_map (intern_constr globs) opttyp)) in
+  list_fold_map intern_one globs args 
+
+let intern_fundecl args body globs= 
+  let nglobs,nargs = intern_hyp_list args globs in
+    nargs,intern_constr nglobs body
+          
+let rec add_vars_of_simple_pattern globs = function
+    CPatAlias (loc,p,id) ->
+      add_vars_of_simple_pattern (add_var id globs) p
+(*      Stdpp.raise_with_loc loc 
+	(UserError ("simple_pattern",str "\"as\" is not allowed here"))*)
+  | CPatOr (loc, _)->
+      Stdpp.raise_with_loc loc 
+	(UserError ("simple_pattern",str "\"(_ | _)\" is not allowed here"))
+  | CPatDelimiters (_,_,p) ->
+      add_vars_of_simple_pattern globs p
+  | CPatCstr (_,_,pl) | CPatNotation(_,_,pl) ->
+      List.fold_left add_vars_of_simple_pattern globs pl
+  | CPatAtom (_,Some (Libnames.Ident (_,id))) -> add_var id globs
+  |  _  -> globs 
+
+let rec intern_bare_proof_instr globs = function
+    Pthus i -> Pthus (intern_bare_proof_instr globs i)
+  | Pthen i -> Pthen (intern_bare_proof_instr globs i)
+  | Phence i -> Phence (intern_bare_proof_instr globs i)
+  | Pcut c -> Pcut (intern_cut intern_constr_or_thesis globs c) 
+  | Prew (s,c) -> Prew (s,intern_cut intern_constr globs c) 
+  | Psuppose hyps -> Psuppose (intern_hyps intern_constr globs hyps)
+  | Pcase (params,pat,hyps) -> 
+      let nglobs,nparams = intern_hyp_list params globs in
+      let nnglobs= add_vars_of_simple_pattern nglobs pat in
+      let nhyps = intern_hyps intern_constr_or_thesis nnglobs hyps in
+	Pcase (nparams,pat,nhyps) 
+  | Ptake witl -> Ptake (List.map (intern_constr globs) witl)
+  | Pconsider (c,hyps) -> Pconsider (intern_constr globs c,
+				      intern_hyps intern_constr globs hyps)
+  | Pper (et,c) -> Pper (et,intern_casee globs c)
+  | Pend bt -> Pend bt
+  | Pescape -> Pescape
+  | Passume hyps -> Passume (intern_hyps intern_constr globs hyps)
+  | Pgiven hyps -> Pgiven (intern_hyps intern_constr globs hyps)
+  | Plet hyps -> Plet (intern_hyps intern_constr globs hyps)
+  | Pclaim st -> Pclaim (intern_statement intern_constr globs st)
+  | Pfocus st -> Pfocus (intern_statement intern_constr globs st)
+  | Pdefine (id,args,body) -> 
+      let nargs,nbody = intern_fundecl args body globs in
+	Pdefine (id,nargs,nbody)
+  | Pcast (id,typ) ->
+      Pcast (id,intern_constr globs typ)
+
+let rec intern_proof_instr globs instr=
+  {emph = instr.emph;
+   instr = intern_bare_proof_instr globs instr.instr}
+
+let interp_justification env sigma  = function
+    Automated l -> 
+      Automated (List.map (fun c ->understand env sigma (fst c)) l)
+  | By_tactic tac -> By_tactic tac 
+
+let interp_constr check_sort env sigma c = 
+  if check_sort then 
+    understand_type env sigma (fst c) 
+  else 
+    understand env sigma (fst c)
+
+let special_whd env =
+  let infos=Closure.create_clos_infos Closure.betadeltaiota env in
+    (fun t -> Closure.whd_val infos (Closure.inject t))
+
+let _eq = Libnames.constr_of_reference (Coqlib.glob_eq)
+
+let decompose_eq env id =
+  let typ = Environ.named_type id env in
+  let whd = special_whd env typ in
+    match kind_of_term whd with
+	App (f,args)->
+	  if eq_constr f _eq && (Array.length args)=3 
+	  then args.(0)
+	  else error "previous step is not an equality"
+      | _ -> error "previous step is not an equality"
+
+let get_eq_typ info env =
+  let last_id = 	    
+    match info.pm_last with
+	Anonymous -> error "no previous equality"
+      | Name id -> id in
+  let typ = decompose_eq env last_id in  
+    typ
+
+let interp_constr_in_type typ env sigma c =
+  understand env sigma (fst c) ~expected_type:typ
+
+let interp_statement interp_it env sigma st =
+  {st_label=st.st_label;
+   st_it=interp_it env sigma st.st_it}
+	
+let interp_constr_or_thesis check_sort env sigma = function
+    Thesis n -> Thesis n
+  | This c -> This (interp_constr check_sort env sigma c)
+
+let type_tester_var body typ = 
+  raw_app(dummy_loc,
+       RLambda(dummy_loc,Anonymous,typ,
+	       RSort (dummy_loc,RProp Null)),body)
+
+let abstract_one_hyp inject h raw = 
+  match h with 
+      Hvar (loc,(id,None)) ->  
+	RProd (dummy_loc,Name id, RHole (loc,Evd.BinderType (Name id)), raw)
+    | Hvar (loc,(id,Some typ)) ->  
+	RProd (dummy_loc,Name id,fst typ, raw)
+    | Hprop st -> 
+	RProd (dummy_loc,st.st_label,inject st.st_it, raw)
+
+let rawconstr_of_hyps inject hyps = 
+  List.fold_right (abstract_one_hyp inject) hyps (RSort (dummy_loc,RProp Null))
+  
+let rec match_hyps blend names constr = function 
+    [] -> []
+  | hyp::q -> 
+      let (name,typ,body)=destProd constr in
+      let st= {st_label=name;st_it=substl names typ} in
+      let qnames=
+	match name with
+	    Anonymous -> mkMeta 0 :: names
+	  | Name id -> mkVar id :: names in
+      let qhyp = match hyp with
+	  Hprop st' -> Hprop (blend st st')
+	| Hvar _ -> Hvar st in
+	qhyp::(match_hyps blend qnames body q)
+
+let interp_hyps_gen inject blend env sigma hyps = 
+  let constr=understand env sigma (rawconstr_of_hyps inject hyps) in
+    match_hyps blend [] constr hyps
+
+let interp_hyps = interp_hyps_gen fst (fun x _ -> x)
+
+let dummy_prefix= id_of_string "__"
+
+let rec deanonymize ids = 
+  function 
+      PatVar (loc,Anonymous) -> 
+	let (found,known) = !ids in
+	let new_id=Nameops.next_ident_away dummy_prefix known in
+	let _= ids:= (loc,new_id) :: found , new_id :: known in
+	  PatVar (loc,Name new_id)
+    | PatVar (loc,Name id) as pat -> 
+	let (found,known) = !ids in
+	let _= ids:= (loc,id) :: found , known in
+	  pat
+    | PatCstr(loc,cstr,lpat,nam) -> 
+	PatCstr(loc,cstr,List.map (deanonymize ids) lpat,nam)
+
+let rec raw_of_pat =
+  function 
+      PatVar (loc,Anonymous) -> anomaly "Anonymous pattern variable" 
+    | PatVar (loc,Name id) -> 
+	  RVar (loc,id)
+    | PatCstr(loc,((ind,_) as cstr),lpat,_) -> 
+	let mind= fst (Global.lookup_inductive ind) in
+	let rec add_params n q =
+	  if n<=0 then q else
+	    add_params (pred n) (RHole(dummy_loc,
+				       Evd.TomatchTypeParameter(ind,n))::q) in
+	    let args = List.map raw_of_pat lpat in 
+	      raw_app(loc,RRef(dummy_loc,Libnames.ConstructRef cstr),
+		   add_params mind.Declarations.mind_nparams args) 
+			 
+let prod_one_hyp = function
+    (loc,(id,None)) ->
+      (fun raw ->  
+	 RProd (dummy_loc,Name id, 
+		RHole (loc,Evd.BinderType (Name id)), raw))
+  | (loc,(id,Some typ)) -> 
+      (fun raw ->  
+	 RProd (dummy_loc,Name id,fst typ, raw))
+
+let prod_one_id (loc,id) raw =
+  RProd (dummy_loc,Name id,
+	 RHole (loc,Evd.BinderType (Name id)), raw)
+
+let let_in_one_alias (id,pat) raw =
+  RLetIn (dummy_loc,Name id,raw_of_pat pat, raw)
+
+let rec bind_primary_aliases map pat =
+  match pat with 
+      PatVar (_,_) -> map
+    | PatCstr(loc,_,lpat,nam) ->
+	let map1 =
+	  match nam with 
+	      Anonymous -> map
+	    | Name id -> (id,pat)::map 
+	in
+	  List.fold_left bind_primary_aliases map1 lpat
+
+let bind_secondary_aliases map subst =
+  List.fold_left (fun map (ids,idp) -> (ids,List.assoc idp map)::map) map subst
+
+let bind_aliases patvars subst patt =
+  let map = bind_primary_aliases [] patt in
+  let map1 = bind_secondary_aliases map subst in
+  List.rev map1
+
+let interp_pattern env pat_expr = 
+  let patvars,pats = Constrintern.intern_pattern env pat_expr in
+    match pats with 
+	[] -> anomaly "empty pattern list"
+      | [subst,patt] ->
+	  (patvars,bind_aliases patvars subst patt,patt)
+      | _  -> anomaly "undetected disjunctive pattern"
+
+let rec match_args dest names constr = function 
+    [] -> [],names,substl names constr
+  | _::q -> 
+      let (name,typ,body)=dest constr in
+      let st={st_label=name;st_it=substl names typ} in
+      let qnames=
+	match name with
+	    Anonymous -> assert  false
+	  | Name id -> mkVar id :: names in
+      let args,bnames,body = match_args dest qnames body q in
+	st::args,bnames,body
+
+let rec match_aliases names constr = function 
+    [] -> [],names,substl names constr
+  | _::q -> 
+      let (name,c,typ,body)=destLetIn constr in
+      let st={st_label=name;st_it=(substl names c,substl names typ)} in
+      let qnames=
+	match name with
+	    Anonymous -> assert false
+	  | Name id -> mkVar id :: names in
+      let args,bnames,body = match_aliases qnames body q in
+	st::args,bnames,body
+
+let detype_ground c = Detyping.detype false [] [] c
+
+let interp_cases info env sigma params (pat:cases_pattern_expr) hyps =
+  let et,pinfo =
+    match info.pm_stack with
+	Per(et,pi,_,_)::_ -> et,pi
+      | _ -> error "No proof per cases/induction/inversion in progress." in
+  let mib,oib=Global.lookup_inductive  pinfo.per_ind in
+  let num_params = pinfo.per_nparams in
+  let _ = 
+    let expected = mib.Declarations.mind_nparams - num_params in
+      if List.length params <> expected then
+	errorlabstrm "suppose it is" 
+	  (str "Wrong number of extra arguments : " ++ 
+	     (if expected = 0 then str "none" else int expected) ++ 
+	     str "expected") in
+  let app_ind =
+    let rind = RRef (dummy_loc,Libnames.IndRef pinfo.per_ind) in
+    let rparams = List.map detype_ground pinfo.per_params in 
+    let rparams_rec = 
+      List.map 
+	(fun (loc,(id,_)) -> 
+	   RVar (loc,id)) params in 
+    let dum_args= 
+      list_tabulate (fun _ -> RHole (dummy_loc,Evd.QuestionMark))
+	oib.Declarations.mind_nrealargs in
+      raw_app(dummy_loc,rind,rparams@rparams_rec@dum_args) in
+  let pat_vars,aliases,patt = interp_pattern env pat in
+  let inject = function
+      Thesis (Plain) -> Rawterm.RSort(dummy_loc,RProp Null)
+    | Thesis (Sub n) ->
+	error "thesis[_] is not allowed here"
+    | Thesis (For rec_occ) ->
+	if not (List.mem rec_occ pat_vars) then 
+	  errorlabstrm "suppose it is" 
+	    (str "Variable " ++ Nameops.pr_id rec_occ ++ 
+	       str " does not occur in pattern.");
+	Rawterm.RSort(dummy_loc,RProp Null)
+    | This (c,_) -> c in
+  let term1 = rawconstr_of_hyps inject hyps in
+  let loc_ids,npatt =
+    let rids=ref ([],pat_vars) in
+    let npatt= deanonymize rids patt in 
+      List.rev (fst !rids),npatt in
+  let term2 =
+    RLetIn(dummy_loc,Anonymous,
+	   RCast(dummy_loc,raw_of_pat npatt,
+		 CastConv DEFAULTcast,app_ind),term1) in
+  let term3=List.fold_right let_in_one_alias aliases term2 in  
+  let term4=List.fold_right prod_one_id loc_ids term3 in
+  let term5=List.fold_right prod_one_hyp params term4 in
+  let constr = understand  sigma env term5 in
+  let tparams,nam4,rest4 = match_args destProd [] constr params in
+  let tpatvars,nam3,rest3 = match_args destProd nam4 rest4 loc_ids in
+  let taliases,nam2,rest2 = match_aliases nam3 rest3 aliases in
+  let (_,pat_pat,pat_typ,rest1) = destLetIn rest2 in
+  let blend  st st' =
+    match st'.st_it with 
+	Thesis nam -> {st_it=Thesis nam;st_label=st'.st_label} 
+      | This _ -> {st_it = This st.st_it;st_label=st.st_label} in
+  let thyps = match_hyps blend nam2 (Termops.pop rest1) hyps in
+    tparams,{pat_vars=tpatvars;
+	     pat_aliases=taliases;
+	     pat_constr=pat_pat;
+	     pat_typ=pat_typ;
+	     pat_pat=patt;
+	     pat_expr=pat},thyps
+
+let interp_cut interp_it env sigma cut=
+ {cut_stat=interp_statement interp_it env sigma cut.cut_stat;
+  cut_by=interp_justification env sigma cut.cut_by}
+
+let interp_casee env sigma = function 
+    Real c -> Real (understand env sigma (fst c))
+  | Virtual cut -> Virtual (interp_cut (interp_constr true) env sigma cut) 
+
+let abstract_one_arg = function
+    (loc,(id,None)) ->
+      (fun raw ->  
+	 RLambda (dummy_loc,Name id, 
+		RHole (loc,Evd.BinderType (Name id)), raw))
+  | (loc,(id,Some typ)) -> 
+      (fun raw ->  
+	 RLambda (dummy_loc,Name id,fst typ, raw))
+
+let rawconstr_of_fun args body = 
+  List.fold_right abstract_one_arg args (fst body)
+
+let interp_fun env sigma args body = 
+  let constr=understand env sigma (rawconstr_of_fun args body) in
+    match_args destLambda [] constr args
+
+let rec interp_bare_proof_instr info sigma env = function
+    Pthus i -> Pthus (interp_bare_proof_instr info sigma env i)
+  | Pthen i -> Pthen (interp_bare_proof_instr info sigma env i)
+  | Phence i -> Phence (interp_bare_proof_instr info sigma env i)
+  | Pcut c -> Pcut (interp_cut (interp_constr_or_thesis true) sigma env c) 
+  | Prew (s,c) -> Prew (s,interp_cut 
+			  (interp_constr_in_type (get_eq_typ info env))
+			  sigma env c) 
+  | Psuppose hyps -> Psuppose (interp_hyps sigma env hyps)
+  | Pcase (params,pat,hyps) -> 
+      let tparams,tpat,thyps = interp_cases info env sigma params pat hyps in 
+	Pcase (tparams,tpat,thyps)
+  | Ptake witl -> 
+      Ptake (List.map (fun c -> understand sigma env (fst c)) witl)
+  | Pconsider (c,hyps) -> Pconsider (interp_constr false sigma env c,
+				     interp_hyps sigma env hyps)
+  | Pper (et,c) -> Pper (et,interp_casee sigma env c)
+  | Pend bt -> Pend bt
+  | Pescape -> Pescape
+  | Passume hyps -> Passume (interp_hyps sigma env hyps)
+  | Pgiven hyps -> Pgiven (interp_hyps sigma env hyps)
+  | Plet hyps -> Plet (interp_hyps sigma env hyps)
+  | Pclaim st -> Pclaim (interp_statement (interp_constr true) sigma env st)
+  | Pfocus st -> Pfocus (interp_statement (interp_constr true) sigma env st)
+  | Pdefine (id,args,body) -> 
+      let nargs,_,nbody = interp_fun sigma env args body in
+	Pdefine (id,nargs,nbody)
+  | Pcast (id,typ) -> 
+      Pcast(id,interp_constr true sigma env typ)
+
+let rec interp_proof_instr info sigma env instr=
+  {emph = instr.emph;
+   instr = interp_bare_proof_instr info sigma env instr.instr}
+ 
+
+
diff --git a/lib/stamps.ml b/tactics/decl_interp.mli
index 0f481516..08d97646 100644
--- a/lib/stamps.ml
+++ b/tactics/decl_interp.mli
@@ -6,23 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: stamps.ml 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id:$ *)
 
-let new_stamp = 
-  let stamp_ctr = ref 0 in
-  fun () -> incr stamp_ctr; !stamp_ctr
+open Tacinterp
+open Decl_expr
+open Mod_subst
 
-type 'a timestamped = { stamp : int; ed : 'a }
 
-let ts_stamp st = st.stamp
-let ts_mod f st = { stamp = new_stamp(); ed = f st.ed }
-let ts_it st = st.ed
-let ts_mk v = { stamp = new_stamp(); ed = v}
-let ts_eq st1 st2 = st1.stamp = st2.stamp
-
-type 'a idstamped = 'a timestamped
-
-let ids_mod f st = { stamp = st.stamp; ed = f st.ed}
-let ids_it = ts_it
-let ids_mk = ts_mk
-let ids_eq = ts_eq
+val intern_proof_instr : glob_sign -> raw_proof_instr -> glob_proof_instr
+val interp_proof_instr : Decl_mode.pm_info ->
+  Evd.evar_map -> Environ.env -> glob_proof_instr -> proof_instr
diff --git a/tactics/decl_proof_instr.ml b/tactics/decl_proof_instr.ml
new file mode 100644
index 00000000..e7acd6d6
--- /dev/null
+++ b/tactics/decl_proof_instr.ml
@@ -0,0 +1,1476 @@
+(************************************************************************)
+(*  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:$ *)
+
+open Util
+open Pp
+open Evd
+
+open Refiner
+open Proof_type
+open Proof_trees
+open Tacmach
+open Tacinterp
+open Decl_expr
+open Decl_mode
+open Decl_interp
+open Rawterm
+open Names
+open Declarations
+open Tactics
+open Tacticals
+open Term
+open Termops
+open Reductionops
+open Goptions
+
+(* Strictness option *)
+
+let get_its_info gls = get_info gls.it
+
+let get_strictness,set_strictness = 
+  let strictness = ref false in
+    (fun () -> (!strictness)),(fun b -> strictness:=b)
+
+let _ =
+  declare_bool_option 
+    { optsync  = true;
+      optname  = "strict mode";
+      optkey   = (SecondaryTable ("Strict","Proofs"));
+      optread  = get_strictness;
+      optwrite = set_strictness }
+
+let tcl_change_info_gen info_gen = 
+  (fun gls ->
+  let gl =sig_it gls in  
+    {it=[{gl with evar_extra=info_gen}];sigma=sig_sig gls}, 
+  function 
+      [pftree] ->
+	{pftree with
+	   goal=gl;
+	   ref=Some (Change_evars,[pftree])} 
+    | _ -> anomaly "change_info : Wrong number of subtrees")
+
+let tcl_change_info info gls =  tcl_change_info_gen (Some (pm_in info)) gls
+
+let tcl_erase_info gls =  tcl_change_info_gen None gls
+
+let special_whd gl=
+  let infos=Closure.create_clos_infos Closure.betadeltaiota (pf_env gl) in
+    (fun t -> Closure.whd_val infos (Closure.inject t))
+
+let special_nf gl=
+  let infos=Closure.create_clos_infos Closure.betaiotazeta (pf_env gl) in
+    (fun t -> Closure.norm_val infos (Closure.inject t))
+
+let is_good_inductive env ind =
+  let mib,oib = Inductive.lookup_mind_specif env ind in
+    oib.mind_nrealargs = 0 && not (Inductiveops.mis_is_recursive (ind,mib,oib))
+
+let check_not_per pts =
+  if not (Proof_trees.is_complete_proof (proof_of_pftreestate pts)) then
+    match get_stack pts with
+	Per (_,_,_,_)::_ -> 
+	  error "You are inside a proof per cases/induction.\n\
+Please \"suppose\" something or \"end\" it now."
+      | _ -> ()
+
+let get_thesis gls0 = 
+ let info = get_its_info gls0 in  
+    match info.pm_subgoals with
+	[m,thesis] -> thesis
+      | _ -> error "Thesis is split"
+
+let mk_evd metalist gls =
+  let evd0= create_evar_defs (sig_sig gls) in
+  let add_one (meta,typ) evd = 
+    meta_declare meta typ evd in
+    List.fold_right add_one metalist evd0
+	  
+(* start a proof *)
+
+let start_proof_tac gls=
+  let gl=sig_it gls in
+  let info={pm_last=Anonymous;
+	    pm_partial_goal=mkMeta 1; 
+	    pm_hyps= 
+      begin
+	let hyps = pf_ids_of_hyps gls in
+	  List.fold_right Idset.add hyps Idset.empty
+      end; 
+	    pm_subgoals= [1,gl.evar_concl];
+	    pm_stack=[]} in
+    {it=[{gl with evar_extra=Some (pm_in info)}];sigma=sig_sig gls}, 
+  function 
+      [pftree] ->
+	{pftree with
+	   goal=gl;
+	   ref=Some (Decl_proof true,[pftree])} 
+    | _ -> anomaly "Dem : Wrong number of subtrees"
+
+let go_to_proof_mode () = 
+  Pfedit.mutate 
+    (fun pts -> nth_unproven 1 (solve_pftreestate start_proof_tac pts))
+
+(* closing gaps *)
+
+let daimon_tac gls =
+  set_daimon_flag ();
+  ({it=[];sigma=sig_sig gls}, 
+   function 
+       [] ->
+	 {open_subgoals=0;
+	    goal=sig_it gls;
+	    ref=Some (Daimon,[])} 
+     | _ -> anomaly "Daimon: Wrong number of subtrees")
+    
+let daimon _ pftree =
+  set_daimon_flag ();
+  {pftree with
+     open_subgoals=0;
+     ref=Some (Daimon,[])}
+
+let daimon_subtree = map_pftreestate (fun _ ->  frontier_mapi daimon )
+
+(* marking closed blocks *)
+
+let rec is_focussing_instr = function
+    Pthus i | Pthen i | Phence i -> is_focussing_instr i
+  | Pescape | Pper _ | Pclaim _ | Pfocus _ 
+  | Psuppose _ | Pcase (_,_,_)  -> true
+  | _ -> false
+
+let mark_rule_as_done = function
+    Decl_proof true -> Decl_proof false
+  | Decl_proof false ->
+      anomaly "already marked as done"
+  | Nested(Proof_instr (lock_focus,instr),spfl) -> 
+      if lock_focus then
+	Nested(Proof_instr (false,instr),spfl)
+      else
+	anomaly "already marked as done"
+  | _ -> anomaly "mark_rule_as_done"
+
+let mark_proof_tree_as_done pt =
+  match pt.ref with
+      None -> anomaly "mark_proof_tree_as_done"
+    | Some (r,spfl) -> 
+	{pt with ref= Some (mark_rule_as_done r,spfl)}
+
+let mark_as_done pts = 
+  map_pftreestate 
+    (fun _ -> mark_proof_tree_as_done) 
+    (traverse 0 pts) 
+
+(* post-instruction focus management *)
+
+let goto_current_focus pts = up_until_matching_rule is_focussing_command pts
+
+let goto_current_focus_or_top pts = 
+  try 
+    up_until_matching_rule is_focussing_command pts
+  with Not_found -> top_of_tree pts
+
+(* return *)
+
+let close_tactic_mode pts =
+    let pts1=  
+      try goto_current_focus pts 
+      with Not_found -> 
+	error "\"return\" cannot be used outside of Declarative Proof Mode" in
+    let pts2 = daimon_subtree pts1 in
+    let pts3 = mark_as_done pts2 in 
+      goto_current_focus pts3 
+	  
+let return_from_tactic_mode () = Pfedit.mutate close_tactic_mode
+
+(* end proof/claim *)
+
+let close_block bt pts =
+  let stack =
+    if Proof_trees.is_complete_proof (proof_of_pftreestate pts) then
+      get_top_stack pts
+    else
+      get_stack pts in
+    match bt,stack with
+	B_claim, Claim::_ | B_focus, Focus_claim::_ | B_proof, [] -> 
+	  daimon_subtree (goto_current_focus pts)
+      | _, Claim::_ -> 
+	  error "\"end claim\" expected" 
+      | _, Focus_claim::_ -> 
+	  error "\"end focus\" expected" 
+      | _, [] ->
+ 	  error "\"end proof\" expected" 
+      | _, (Per (et,_,_,_)::_|Suppose_case::Per (et,_,_,_)::_) ->
+	  begin
+	    match et with
+		ET_Case_analysis -> error "\"end cases\" expected"
+	      | ET_Induction ->  error "\"end induction\" expected"
+	  end
+      | _,_ -> anomaly "lonely suppose on stack"
+
+(* utility for suppose / suppose it is *)
+
+let close_previous_case pts = 
+  if 
+    Proof_trees.is_complete_proof (proof_of_pftreestate pts) 
+  then
+    match get_top_stack pts with
+	Per (et,_,_,_) :: _ -> anomaly "Weird case occured ..."  
+      | Suppose_case :: Per (et,_,_,_) :: _ -> 
+	  goto_current_focus (mark_as_done pts)
+      | _ -> error "Not inside a proof per cases or induction."   
+  else
+    match get_stack pts with
+	Per (et,_,_,_) :: _ -> pts 
+      | Suppose_case :: Per (et,_,_,_) :: _ ->
+	  goto_current_focus (mark_as_done (daimon_subtree pts))
+      | _ -> error "Not inside a proof per cases or induction."
+
+(* Proof instructions *)
+
+(* automation *)
+
+let filter_hyps f gls =
+  let filter_aux (id,_,_) = 
+    if f id then 
+      tclIDTAC
+    else 
+      tclTRY (clear [id])  in
+    tclMAP filter_aux (Environ.named_context_of_val gls.it.evar_hyps) gls
+
+let local_hyp_prefix = id_of_string "___"
+
+let add_justification_hyps keep items gls =
+  let add_aux c gls=
+    match kind_of_term c with 
+	Var id -> 
+	  keep:=Idset.add id !keep;
+	  tclIDTAC gls 
+      | _ -> 
+	  let id=pf_get_new_id local_hyp_prefix gls in 
+	    keep:=Idset.add id !keep; 
+	    letin_tac false (Names.Name id) c Tacexpr.nowhere gls in 
+    tclMAP add_aux items gls   
+
+let apply_to_prepared_goal items kont gls =
+  let tokeep = ref Idset.empty in
+  let auxres = add_justification_hyps tokeep items gls in
+   tclTHENLIST
+     [ (fun _ -> auxres);
+       filter_hyps (let keep = !tokeep in fun id -> Idset.mem id keep);
+       kont ] gls
+
+let my_automation_tac = ref 
+  (fun gls -> anomaly "No automation registered")
+
+let register_automation_tac tac = my_automation_tac:= tac
+
+let automation_tac gls = !my_automation_tac gls
+
+let justification tac gls= 
+    tclORELSE 
+      (tclSOLVE [tac]) 
+      (fun gls -> 
+	 if get_strictness () then 
+	   error "insufficient justification" 
+	 else
+	   begin
+	     msgnl (str "Warning: insufficient justification");  
+	     daimon_tac gls
+	   end) gls
+
+let default_justification items gls=
+  justification (apply_to_prepared_goal items automation_tac) gls
+
+(* code for have/then/thus/hence *)
+
+type stackd_elt =
+{se_meta:metavariable;
+ se_type:types;
+ se_last_meta:metavariable;
+ se_meta_list:(metavariable*types) list;
+ se_evd: evar_defs}
+
+let rec replace_in_list m l = function
+    [] -> raise Not_found
+  | c::q -> if m=fst c then l@q else c::replace_in_list m l q
+
+let enstack_subsubgoals env se stack gls=
+  let hd,params = decompose_app (special_whd gls se.se_type) in
+    match kind_of_term hd with
+	Ind ind when is_good_inductive env ind ->
+	  let mib,oib=
+	    Inductive.lookup_mind_specif env ind in
+          let gentypes=
+            Inductive.arities_of_constructors ind (mib,oib) in
+	  let process i gentyp = 
+	    let constructor = mkConstruct(ind,succ i) 
+	      (* constructors numbering*) in
+	    let appterm = applist (constructor,params) in
+	    let apptype = Term.prod_applist gentyp params in
+	    let rc,_ = Reduction.dest_prod env apptype in
+	    let rec meta_aux last lenv = function 
+		[] -> (last,lenv,[])
+	      | (nam,_,typ)::q ->
+		  let nlast=succ last in
+		  let (llast,holes,metas) =
+		    meta_aux nlast (mkMeta nlast :: lenv) q in
+		    (llast,holes,(nlast,special_nf gls (substl lenv typ))::metas) in
+	    let (nlast,holes,nmetas) = 
+		meta_aux se.se_last_meta [] (List.rev rc) in
+	    let refiner = applist (appterm,List.rev holes) in
+	    let evd = meta_assign se.se_meta refiner se.se_evd in
+	    let ncreated = replace_in_list 
+	      se.se_meta nmetas se.se_meta_list in
+	    let evd0 = List.fold_left 
+	      (fun evd (m,typ) -> meta_declare m typ evd) evd nmetas in  
+	      List.iter (fun (m,typ) -> 
+			   Stack.push 
+			     {se_meta=m;
+			      se_type=typ;
+			      se_evd=evd0;
+			      se_meta_list=ncreated;
+			      se_last_meta=nlast} stack) (List.rev nmetas) 
+	  in
+	    Array.iteri process gentypes
+      | _ -> ()
+
+let find_subsubgoal env c ctyp skip evd metas gls =
+  let stack = Stack.create () in
+  let max_meta = 
+    List.fold_left (fun a (m,_) -> max a m) 0 metas in
+  let _ = 
+    List.iter (fun (m,typ) -> 
+		 Stack.push 
+		   {se_meta=m;
+		    se_type=typ;
+		    se_last_meta=max_meta;
+		    se_meta_list=metas;
+		    se_evd=evd} stack) (List.rev metas) in
+  let rec dfs n = 
+    let se = Stack.pop stack in
+      try 
+	let unifier = 
+	  Unification.w_unify true env Reduction.CUMUL 
+	    ctyp se.se_type se.se_evd in
+	  if n <= 0 then 
+	      {se with se_evd=meta_assign se.se_meta c unifier}	  
+	  else
+	      dfs (pred n)
+      with _ -> 
+	begin
+	  enstack_subsubgoals env se stack gls;
+	  dfs n
+	end in
+  let nse= try dfs skip with Stack.Empty -> raise Not_found in
+    nse.se_meta_list,nse.se_evd
+
+let rec nf_list evd = 
+  function
+      [] -> []  
+    | (m,typ)::others -> 
+	if meta_defined evd m then 
+	    nf_list evd others
+	else
+	  (m,nf_meta evd typ)::nf_list evd others
+
+
+let rec max_linear_context meta_one c =
+  if !meta_one = None then
+     if isMeta c then
+       	begin
+	  meta_one:= Some c;
+          mkMeta 1
+	end
+     else
+       try
+	 map_constr (max_linear_context meta_one) c
+       with Not_found -> 
+	 begin
+	   meta_one:= Some c;
+           mkMeta 1
+	 end
+  else   
+    if isMeta c then 
+      raise Not_found
+    else
+      map_constr (max_linear_context meta_one) c
+
+let thus_tac c ctyp gls =  
+  let info = get_its_info gls in
+  let evd0 = mk_evd info.pm_subgoals gls in
+  let list,evd = 
+    try
+      find_subsubgoal (pf_env gls) c ctyp 0 evd0 info.pm_subgoals gls
+    with Not_found -> 
+      error "I could not relate this statement to the thesis" in
+  let nflist = nf_list evd list in
+  let nfgoal = nf_meta evd info.pm_partial_goal in
+(*  let _ = msgnl (str "Partial goal : " ++ 
+		   print_constr_env (pf_env gls) nfgoal) in *)
+  let rgl = ref None in
+  let refiner = max_linear_context rgl nfgoal in
+    match !rgl with
+	None -> exact_check refiner gls
+      | Some pgl when not (isMeta refiner) ->
+	  let ninfo={info with
+		       pm_partial_goal = pgl;
+		       pm_subgoals = nflist} in
+	    tclTHEN
+	      (Tactics.refine refiner)
+	      (tcl_change_info ninfo) 
+	      gls
+      | _ -> 
+	  let ninfo={info with
+		       pm_partial_goal = nfgoal;
+		       pm_subgoals = nflist} in
+	    tcl_change_info ninfo gls
+
+let anon_id_base = id_of_string "__" 
+
+
+let mk_stat_or_thesis info = function  
+    This c -> c
+  | Thesis (For _ ) -> 
+      error "\"thesis for ...\" is not applicable here" 
+  | Thesis (Sub n) ->
+      begin
+	try List.assoc n info.pm_subgoals 
+	with Not_found -> error "No such part in thesis."
+      end
+  | Thesis Plain ->   
+      match info.pm_subgoals with
+	  [_,c] -> c
+	| _ -> error 
+	    "\"thesis\" is split, please specify which part you refer to."
+			
+let instr_cut mkstat _thus _then cut gls0 = 
+  let info = get_its_info gls0 in  
+  let just_tac gls = 
+    match cut.cut_by with
+        Automated l ->	
+	  let elems = 
+	    if _then then
+	      match info.pm_last with
+		  Anonymous -> l
+		| Name id -> (mkVar id) ::l
+	    else l in
+	    default_justification elems gls
+      | By_tactic t -> 
+	  justification (Tacinterp.eval_tactic t) gls in
+  let c_id = match cut.cut_stat.st_label with 
+      Anonymous -> 
+	pf_get_new_id (id_of_string "_fact") gls0 
+    | Name id -> id in
+  let c_stat = mkstat info cut.cut_stat.st_it in
+  let thus_tac gls= 
+    if _thus then 
+      thus_tac (mkVar c_id) c_stat gls
+    else tclIDTAC gls in
+  let ninfo = {info with pm_last=Name c_id} in
+    tclTHENS (internal_cut c_id c_stat) 
+      [tclTHEN tcl_erase_info just_tac;
+       tclTHEN (tcl_change_info ninfo) thus_tac] gls0
+
+(* iterated equality *)
+let _eq = Libnames.constr_of_reference (Coqlib.glob_eq)
+
+let decompose_eq id gls =
+  let typ = pf_get_hyp_typ gls id in
+  let whd =  (special_whd gls typ) in
+    match kind_of_term whd with
+	App (f,args)->
+	  if eq_constr f _eq && (Array.length args)=3 
+	  then (args.(0),
+		args.(1), 
+		args.(2)) 
+	  else error "previous step is not an equality"
+      | _ -> error "previous step is not an equality"
+	  
+let instr_rew _thus rew_side cut gls0 = 
+  let info = get_its_info gls0 in
+  let last_id = 	    
+    match info.pm_last with
+	Anonymous -> error "no previous equality"
+      | Name id -> id in
+  let typ,lhs,rhs = decompose_eq last_id gls0 in  
+  let just_tac gls = 
+    match cut.cut_by with
+        Automated l ->	
+	  let elems = (mkVar last_id) :: l in
+	    default_justification elems gls
+      | By_tactic t -> 
+	  justification (Tacinterp.eval_tactic t) gls in
+  let c_id = match cut.cut_stat.st_label with 
+      Anonymous -> 
+	pf_get_new_id (id_of_string "_eq") gls0 
+    | Name id -> id in
+  let ninfo = {info with pm_last=Name c_id} in
+  let thus_tac new_eq gls= 
+    if _thus then 
+      thus_tac (mkVar c_id) new_eq gls
+    else tclIDTAC gls in
+    match rew_side with 
+	Lhs ->
+	  let new_eq = mkApp(_eq,[|typ;cut.cut_stat.st_it;rhs|]) in
+	    tclTHENS (internal_cut c_id new_eq) 
+	      [tclTHEN tcl_erase_info 
+		 (tclTHENS (transitivity lhs) 
+		    [just_tac;exact_check (mkVar last_id)]);
+	       tclTHEN (tcl_change_info ninfo) (thus_tac new_eq)] gls0
+      | Rhs ->
+	  let new_eq = mkApp(_eq,[|typ;lhs;cut.cut_stat.st_it|]) in
+	    tclTHENS (internal_cut c_id new_eq) 
+	      [tclTHEN tcl_erase_info 
+		 (tclTHENS (transitivity rhs) 
+		    [exact_check (mkVar last_id);just_tac]);
+	       tclTHEN (tcl_change_info ninfo) (thus_tac new_eq)] gls0
+	      
+
+
+(* tactics for claim/focus *)
+
+let instr_claim _thus st gls0 = 
+  let info = get_its_info gls0 in  
+  let id = match st.st_label with 
+      Anonymous -> pf_get_new_id (id_of_string "_claim") gls0 
+    | Name id -> id in
+  let thus_tac gls= 
+    if _thus then 
+      thus_tac (mkVar id) st.st_it gls
+    else tclIDTAC gls in
+  let ninfo1 = {info with 
+		  pm_stack=
+      (if _thus then Focus_claim else Claim)::info.pm_stack;
+		  pm_partial_goal=mkMeta 1;
+	          pm_subgoals = [1,st.st_it]} in
+  let ninfo2 = {info with pm_last=Name id} in
+    tclTHENS (internal_cut id st.st_it) 
+      [tcl_change_info ninfo1;
+       tclTHEN (tcl_change_info ninfo2) thus_tac] gls0
+
+(* tactics for assume *)
+
+let reset_concl gls =
+  let info = get_its_info gls in
+    tcl_change_info 
+      {info with 
+	 pm_partial_goal=mkMeta 1;
+	 pm_subgoals= [1,gls.it.evar_concl]} gls
+
+let set_last id gls = 
+  let info = get_its_info gls in
+    tcl_change_info 
+      {info with 
+	 pm_last=Name id} gls
+
+let intro_pm id gls=
+  let info = get_its_info gls in
+    match info.pm_subgoals with
+	[(_,typ)] -> 
+	  tclTHEN (intro_mustbe_force id) reset_concl gls
+      | _ -> error "Goal is split"
+
+let push_intro_tac coerce nam gls = 
+      let hid =
+	match nam with 
+	    Anonymous -> pf_get_new_id (id_of_string "_hyp") gls 
+	  | Name id -> id in
+      let mark_id gls0 =
+	let info = get_its_info gls0 in
+	let ninfo = {info with 
+		       pm_last = Name hid;
+		       pm_hyps = Idset.add hid info.pm_hyps } in
+	  tcl_change_info ninfo gls0 in
+	tclTHENLIST 
+	  [intro_pm hid;
+	   coerce hid;
+	   mark_id]
+	  gls 
+
+let assume_tac hyps gls = 
+  List.fold_right 
+    (fun (Hvar st | Hprop st) -> 
+       tclTHEN 
+	 (push_intro_tac 
+	    (fun id -> 
+	       convert_hyp (id,None,st.st_it)) st.st_label))
+	 hyps tclIDTAC gls 
+
+let assume_hyps_or_theses hyps gls = 
+  List.fold_right 
+    (function 
+	 (Hvar {st_label=nam;st_it=c} | Hprop {st_label=nam;st_it=This c}) -> 
+	   tclTHEN 
+	     (push_intro_tac 
+		(fun id -> 
+		   convert_hyp (id,None,c)) nam)
+       | Hprop {st_label=nam;st_it=Thesis (tk)} -> 
+	   tclTHEN 
+	     (push_intro_tac 
+		(fun id -> tclIDTAC) nam))
+    hyps tclIDTAC gls 
+
+let assume_st hyps gls = 
+  List.fold_right 
+    (fun st -> 
+       tclTHEN 
+	 (push_intro_tac 
+	    (fun id -> convert_hyp (id,None,st.st_it)) st.st_label))
+	 hyps tclIDTAC gls 
+
+let assume_st_letin hyps gls = 
+  List.fold_right 
+    (fun st -> 
+       tclTHEN 
+	 (push_intro_tac 
+	    (fun id -> 
+	       convert_hyp (id,Some (fst st.st_it),snd st.st_it)) st.st_label))
+	 hyps tclIDTAC gls 
+
+(* tactics for consider/given *)
+
+let update_goal_info gls =
+  let info = get_its_info gls in
+    match info.pm_subgoals with
+	[m,_] -> tcl_change_info {info with pm_subgoals =[m,pf_concl gls]} gls
+      | _ -> error "thesis is split"
+
+let conjunction_arity id gls =
+  let typ = pf_get_hyp_typ gls id  in
+  let hd,params = decompose_app (special_whd gls typ) in
+  let env =pf_env gls in 
+    match kind_of_term hd with
+	Ind ind when is_good_inductive env ind ->
+	  let mib,oib=
+	    Inductive.lookup_mind_specif env ind in
+          let gentypes=
+            Inductive.arities_of_constructors ind (mib,oib) in
+	  let _ = if Array.length gentypes <> 1 then raise Not_found in
+	  let apptype = Term.prod_applist gentypes.(0) params in
+	  let rc,_ = Reduction.dest_prod env apptype in
+	    List.length rc
+      | _ -> raise Not_found
+
+let rec intron_then n ids ltac gls = 
+  if n<=0 then 
+    tclTHEN
+    (fun gls -> 
+       if List.exists (fun id -> occur_id [] id (pf_concl gls)) ids  then 
+	 update_goal_info gls
+       else 
+	 tclIDTAC gls)
+    (ltac ids)
+      gls
+  else  
+    let id = pf_get_new_id (id_of_string "_tmp") gls in 
+      tclTHEN 
+	(intro_mustbe_force id) 
+	(intron_then (pred n) (id::ids) ltac) gls 
+
+let pm_rename_hyp id hid gls =
+  if occur_id [] id (pf_concl gls) then
+    tclTHEN (rename_hyp id hid) update_goal_info gls
+  else
+    rename_hyp id hid gls 
+
+let rec consider_match may_intro introduced available expected gls =
+  match available,expected with 
+      [],[] ->
+	if not may_intro then 
+	  set_last (List.hd introduced) gls
+	else
+	  let info = get_its_info gls in 
+	  let nameset=List.fold_right Idset.add introduced info.pm_hyps in
+	    tcl_change_info {info with 
+			       pm_last = Name (List.hd introduced);
+			       pm_hyps = nameset} gls
+    | _,[] -> error "last statements do not match a complete hypothesis" 
+	(* should tell which ones *)
+    | [],hyps -> 
+	if may_intro then
+	  begin
+ 	    let id = pf_get_new_id (id_of_string "_tmp") gls in
+	      tclIFTHENELSE 
+		(intro_pm id)
+		(consider_match true [] [id] hyps) 
+		(fun _ -> 
+		   error "not enough sub-hypotheses to match statements")
+		gls 
+          end
+	else
+	  error "not enough sub-hypotheses to match statements" 
+	    (* should tell which ones *)
+    | id::rest_ids,(Hvar st | Hprop st)::rest ->
+	tclIFTHENELSE (convert_hyp (id,None,st.st_it))
+	  begin
+	    match st.st_label with 
+		Anonymous -> 
+		  consider_match may_intro (id::introduced) rest_ids rest
+	      | Name hid -> 
+		  tclTHENLIST 
+		    [pm_rename_hyp id hid;
+		     consider_match may_intro (hid::introduced) rest_ids rest]
+	  end
+	  begin
+	    (fun gls -> 
+	       let nhyps =
+		 try conjunction_arity id gls with 
+		     Not_found -> error "matching hypothesis not found" in 
+		 tclTHENLIST 
+		   [general_case_analysis (mkVar id,NoBindings);
+		    intron_then nhyps []
+		      (fun l -> consider_match may_intro introduced 
+			 (List.rev_append l rest_ids) expected)] gls)
+	  end
+	  gls
+	  
+let consider_tac c hyps gls =
+  match kind_of_term (strip_outer_cast c) with
+      Var id ->
+	consider_match false [] [id] hyps gls 
+    | _ -> 
+	let id = pf_get_new_id (id_of_string "_tmp") gls in
+	tclTHEN 
+	  (forward None (Genarg.IntroIdentifier id) c)
+ 	  (consider_match false [] [id] hyps) gls 
+	  
+
+let given_tac hyps gls =
+  consider_match true [] [] hyps gls
+
+(* tactics for take *)
+
+let rec take_tac wits gls =
+  match wits with
+      [] -> tclIDTAC gls
+    | wit::rest ->  
+	let typ = pf_type_of gls wit in  
+	  tclTHEN (thus_tac wit typ) (take_tac rest)  gls
+
+
+(* tactics for define *)
+
+let rec build_function args body =
+  match args with 
+      st::rest -> 
+	let pfun= lift 1 (build_function rest body) in
+	let id = match st.st_label with
+	    Anonymous -> assert false
+	  | Name id -> id in
+	  mkLambda (Name id, st.st_it, subst_term (mkVar id) pfun)
+    | [] -> body 
+
+let define_tac id args body gls =
+  let t = build_function args body in
+    letin_tac true (Name id) t Tacexpr.nowhere gls
+
+(* tactics for reconsider *)
+
+let cast_tac id_or_thesis typ gls = 
+  let info = get_its_info gls in
+  match id_or_thesis with
+      This id ->
+	let (_,body,_) = pf_get_hyp gls id in
+	  convert_hyp (id,body,typ) gls
+    | Thesis (For _ ) -> 
+	error "\"thesis for ...\" is not applicable here" 
+    | Thesis (Sub n) ->
+	begin
+	  let old_typ = 
+	    try List.assoc n info.pm_subgoals 
+	    with Not_found -> error "No such part in thesis." in
+	  if is_conv_leq (pf_env gls) (sig_sig gls) typ old_typ then
+	    let new_sg = List.merge  
+	      (fun (n,_) (p,_) -> Pervasives.compare n p) 
+	      [n,typ] (List.remove_assoc n info.pm_subgoals) in
+	      tcl_change_info {info with pm_subgoals=new_sg} gls
+	  else 
+	    error "not convertible"
+	end
+    | Thesis Plain ->   
+	match info.pm_subgoals with 
+	    [m,c] -> 
+	      tclTHEN 
+		(convert_concl typ DEFAULTcast) 
+	        (tcl_change_info {info with pm_subgoals= [m,typ]}) gls
+	  | _ -> error 
+	      "\"thesis\" is split, please specify which part you refer to."
+  
+      
+(* per cases *)
+
+let start_tree env ind = 
+  let constrs = (snd (Inductive.lookup_mind_specif env ind)).mind_consnames in
+    Split (Idset.empty,ind,Array.map (fun _ -> None) constrs)
+
+let build_per_info etype casee gls = 
+  let concl=get_thesis gls in
+  let env=pf_env gls in
+  let ctyp=pf_type_of gls casee in
+  let is_dep = dependent casee concl in 
+  let hd,args = decompose_app (special_whd gls ctyp) in
+  let ind = 
+    try
+      destInd hd 
+    with _ -> 
+      error "Case analysis must be done on an inductive object" in
+  let nparams =
+    let mind = fst (Global.lookup_inductive ind) in
+     match etype with
+	 ET_Induction -> mind.mind_nparams_rec
+       | _ -> mind.mind_nparams in
+  let params,real_args = list_chop nparams args in
+  let abstract_obj body c = 
+    let typ=pf_type_of gls c in 
+      lambda_create env (typ,subst_term c body) in
+  let pred= List.fold_left abstract_obj    
+    (lambda_create env (ctyp,subst_term casee concl)) real_args in
+    is_dep,
+  {per_casee=casee;
+   per_ctype=ctyp;
+   per_ind=ind;
+   per_pred=pred;
+   per_args=real_args;
+   per_params=params;
+   per_nparams=nparams}
+
+let per_tac etype casee gls=
+  let env=pf_env gls in
+  let info = get_its_info gls in
+    match casee with
+	Real c ->
+	  let is_dep,per_info = build_per_info etype c gls in
+	  let ek = 
+	    if is_dep then
+	      EK_dep (start_tree env per_info.per_ind)
+	    else EK_unknown in
+	    tcl_change_info 
+	      {info with 
+		 pm_stack=
+		  Per(etype,per_info,ek,[])::info.pm_stack} gls
+      | Virtual cut ->
+	  assert (cut.cut_stat.st_label=Anonymous);
+	  let id = pf_get_new_id (id_of_string "_matched") gls in
+	  let c = mkVar id in
+	  let modified_cut = 
+	    {cut with cut_stat={cut.cut_stat with st_label=Name id}} in
+	    tclTHEN 
+	      (instr_cut (fun _ c -> c) false false modified_cut)
+	      (fun gls0 ->
+		 let is_dep,per_info = build_per_info etype c gls0 in
+		   assert (not is_dep);
+		   tcl_change_info 
+		     {info with pm_stack=
+			 Per(etype,per_info,EK_unknown,[])::info.pm_stack} gls0)
+	      gls
+
+(* suppose *)
+
+let rec build_product args body =
+  match args with 
+      (Hprop st| Hvar st )::rest -> 
+	let pprod= lift 1 (build_product rest body) in
+	let lbody =
+	  match st.st_label with
+	      Anonymous -> body
+	    | Name id -> subst_term (mkVar id) pprod in
+	  mkProd (st.st_label, st.st_it, lbody)
+    | [] -> body 
+
+let register_nodep_subcase id= function
+    Per(et,pi,ek,clauses)::s ->
+      begin
+	match ek with
+	    EK_unknown -> clauses,Per(et,pi,EK_nodep,id::clauses)::s
+	  | EK_nodep -> clauses,Per(et,pi,EK_nodep,id::clauses)::s
+	  | EK_dep _ -> error "Do not mix \"suppose\" with \"suppose it is\"."
+      end
+  | _ -> anomaly "wrong stack state"
+
+let suppose_tac hyps gls0 = 
+  let info = get_its_info gls0 in
+  let thesis = get_thesis gls0 in
+  let id = pf_get_new_id (id_of_string "_subcase") gls0 in
+  let clause = build_product hyps thesis in
+  let ninfo1 = {info with 
+		  pm_stack=Suppose_case::info.pm_stack;
+		  pm_partial_goal=mkMeta 1;
+		  pm_subgoals = [1,clause]} in
+  let old_clauses,stack = register_nodep_subcase id info.pm_stack in
+  let ninfo2 = {info with 
+		  pm_stack=stack} in
+    tclTHENS (internal_cut id clause) 
+      [tclTHENLIST [tcl_change_info ninfo1;
+		    assume_tac hyps;
+		    clear old_clauses];
+       tcl_change_info ninfo2] gls0
+
+(* suppose it is ... *) 
+
+(* pattern matching compiling *)
+
+let rec nb_prod_after n c=
+  match kind_of_term c with
+    | Prod (_,_,b) ->if n>0 then nb_prod_after (n-1) b else 
+	1+(nb_prod_after 0 b)
+    | _ -> 0
+
+let constructor_arities env ind =
+  let nparams = (fst (Global.lookup_inductive ind)).mind_nparams in
+  let constr_types = Inductiveops.arities_of_constructors env ind in 
+  let hyp = nb_prod_after nparams in	
+    Array.map hyp constr_types
+
+let rec n_push rest ids n = 
+  if n<=0 then Pop rest else Push (ids,n_push rest ids (pred n)) 
+
+let explode_branches ids env ind rest=
+  Array.map (fun n -> Some (Idset.empty,n_push rest ids n)) (constructor_arities env ind)
+
+let rec tree_of_pats env ((id,_) as cpl) pats =
+  match pats with 
+      [] -> End_of_branch cpl
+    | args::stack ->
+	match args with
+	    [] -> Pop (tree_of_pats env cpl stack)
+	  | patt :: rest_args ->
+	      match patt with
+		  PatVar (_,v) -> 
+		    Push (Idset.singleton id,
+			  tree_of_pats env cpl (rest_args::stack))
+		|  PatCstr (_,(ind,cnum),args,nam) ->
+		     let _,mind = Inductive.lookup_mind_specif env ind in
+		     let br= Array.map (fun _ -> None) mind.mind_consnames in
+		       br.(pred cnum) <- 
+			 Some (Idset.singleton id,
+			       tree_of_pats env cpl (args::rest_args::stack));
+		       Split(Idset.empty,ind,br)
+
+let rec add_branch env ((id,_) as cpl) pats tree=
+  match pats with 
+      [] -> 
+	begin
+	  match tree with
+	      End_of_branch cpl0 -> End_of_branch cpl0 
+		(* this ensures precedence *) 
+	    | _ -> anomaly "tree is expected to end here"
+	end
+    | args::stack ->
+	match args with 
+	    [] ->
+	      begin
+		match tree with 
+		    Pop t -> Pop (add_branch env cpl stack t)
+		  | _ -> anomaly "we should pop here" 
+	      end
+	  | patt :: rest_args ->
+	      match patt with
+		  PatVar (_,v) ->
+		    begin
+		      match tree with 
+			  Push (ids,t) -> 
+			    Push (Idset.add id ids,
+				  add_branch env cpl (rest_args::stack) t)
+			| Split (ids,ind,br) ->
+			    Split (Idset.add id ids,
+				   ind,array_map2 
+				     (append_branch env cpl 1 
+					(rest_args::stack)) 
+				     (constructor_arities env ind) br)
+			| _ -> anomaly "No pop/stop expected here"  
+		    end
+		| PatCstr (_,(ind,cnum),args,nam) ->
+		    match tree with
+			Push (ids,t) ->
+			  let br = explode_branches ids env ind t in
+			  let _ =
+			    br.(pred cnum)<- 
+			      option_map
+			      (fun (ids,tree) -> 
+				 Idset.add id ids,
+				 add_branch env cpl 
+				   (args::rest_args::stack) tree) 
+			      br.(pred cnum) in
+			    Split (ids,ind,br)
+		      | Split (ids,ind0,br0) ->
+			  if (ind <> ind0) then error
+			    (* this can happen with coercions *)
+	                      "Case pattern belongs to wrong inductive type";
+			  let br=Array.copy br0 in
+			  let ca = constructor_arities env ind in
+			  let _= br.(pred cnum)<-
+			    append_branch env cpl 0 (args::rest_args::stack) 
+			    ca.(pred cnum) br.(pred cnum) in 
+			    Split (ids,ind,br)
+		      | _ -> anomaly "No pop/stop expected here"
+and append_branch env ((id,_) as cpl) depth pats nargs = function
+    Some (ids,tree) -> 
+      Some (Idset.add id ids,append_tree env cpl depth pats tree)
+  | None ->
+      Some (* (n_push (tree_of_pats env cpl pats) 
+	      (Idset.singleton id) nargs) *)
+	   (Idset.singleton id,tree_of_pats env cpl pats)
+and append_tree env ((id,_) as cpl) depth pats tree =
+  if depth<=0 then add_branch env cpl pats tree
+  else match tree with
+      Pop t -> Pop (append_tree env cpl (pred depth) pats t)
+    | Push (ids,t) -> Push (Idset.add id ids,
+				   append_tree env cpl depth pats t)
+    | End_of_branch _ -> anomaly "Premature end of branch"
+    | Split (ids,ind,branches) -> 
+	Split (Idset.add id ids,ind,
+	       array_map2 
+		 (append_branch env cpl (succ depth) pats) 
+		 (constructor_arities env ind)
+		 branches)
+
+(* suppose it is *)
+
+let rec st_assoc id = function
+    [] -> raise Not_found
+  | st::_ when st.st_label = id  -> st.st_it
+  | _ :: rest -> st_assoc id rest
+
+let thesis_for obj typ per_info env=
+  let rc,hd1=decompose_prod typ in
+  let cind,all_args=decompose_app typ in
+  let ind = destInd cind in
+  let _ = if ind <> per_info.per_ind then
+    errorlabstrm "thesis_for" 
+      ((Printer.pr_constr_env env obj) ++ spc () ++ 
+	 str "cannot give an induction hypothesis (wrong inductive type)") in  
+  let params,args = list_chop per_info.per_nparams all_args in
+  let _ = if not (List.for_all2 eq_constr params per_info.per_params) then
+    errorlabstrm "thesis_for" 
+      ((Printer.pr_constr_env env obj) ++ spc () ++ 
+	 str "cannot give an induction hypothesis (wrong parameters)") in
+  let hd2 = (applist ((lift (List.length rc) per_info.per_pred),args@[obj])) in
+    compose_prod rc (whd_beta hd2)
+
+let rec build_product_dep pat_info per_info args body gls =
+  match args with 
+      (Hprop {st_label=nam;st_it=This c} 
+      | Hvar {st_label=nam;st_it=c})::rest -> 
+	let pprod= 
+	  lift 1 (build_product_dep pat_info per_info rest body gls) in
+	let lbody =
+	  match nam with
+	      Anonymous -> body
+	    | Name id -> subst_var id pprod in
+	  mkProd (nam,c,lbody)
+    | Hprop ({st_it=Thesis tk} as st)::rest ->
+	let pprod= 
+	  lift 1 (build_product_dep pat_info per_info rest body gls) in
+	let lbody =
+	  match st.st_label with
+	      Anonymous -> body
+	    | Name id -> subst_var id pprod in
+	let ptyp =
+	  match tk with
+	      For id ->
+		let obj = mkVar id in
+		let typ = 
+		  try st_assoc (Name id) pat_info.pat_vars 
+		  with Not_found -> 
+		    snd (st_assoc (Name id) pat_info.pat_aliases) in
+		  thesis_for obj typ per_info (pf_env gls)
+	    | Plain -> get_thesis gls 
+	    | Sub n -> anomaly "Subthesis in cases" in
+	  mkProd (st.st_label,ptyp,lbody)
+    | [] -> body 
+
+let build_dep_clause params pat_info per_info hyps gls =
+  let concl=
+    thesis_for pat_info.pat_constr pat_info.pat_typ per_info (pf_env gls) in
+  let open_clause =
+    build_product_dep pat_info per_info hyps concl gls in
+  let prod_one st body =
+    match st.st_label with
+	Anonymous -> mkProd(Anonymous,st.st_it,lift 1 body)
+      | Name id -> mkNamedProd id st.st_it (lift 1 body) in
+  let let_one_in st body =
+    match st.st_label with
+	Anonymous -> mkLetIn(Anonymous,fst st.st_it,snd st.st_it,lift 1 body)
+      | Name id -> 
+	  mkNamedLetIn id (fst st.st_it) (snd st.st_it) (lift 1 body) in
+  let aliased_clause = 
+    List.fold_right let_one_in pat_info.pat_aliases open_clause in
+    List.fold_right prod_one (params@pat_info.pat_vars) aliased_clause
+
+let rec register_dep_subcase id env per_info pat = function
+    EK_nodep -> error  "Only \"suppose it is\" can be used here."
+  | EK_unknown -> 
+      register_dep_subcase id env per_info pat
+	(EK_dep (start_tree env per_info.per_ind))
+  | EK_dep tree -> EK_dep (add_branch env id [[pat]] tree)
+  
+let case_tac params pat_info hyps gls0 =
+  let info = get_its_info gls0 in
+  let id = pf_get_new_id (id_of_string "_subcase") gls0 in
+  let et,per_info,ek,old_clauses,rest =
+    match info.pm_stack with
+	Per (et,pi,ek,old_clauses)::rest -> (et,pi,ek,old_clauses,rest) 
+      | _ -> anomaly "wrong place for cases" in
+  let clause = build_dep_clause params pat_info per_info hyps gls0 in
+  let ninfo1 = {info with 
+		  pm_stack=Suppose_case::info.pm_stack;
+		  pm_partial_goal=mkMeta 1;
+		  pm_subgoals = [1,clause]} in
+  let nek = 
+    register_dep_subcase (id,List.length hyps) (pf_env gls0) per_info 
+      pat_info.pat_pat ek in  
+  let ninfo2 = {info with 
+		  pm_stack=Per(et,per_info,nek,id::old_clauses)::rest} in
+    tclTHENS (internal_cut id clause) 
+      [tclTHENLIST 
+	 [tcl_change_info ninfo1; 
+	  assume_st (params@pat_info.pat_vars);
+	  assume_st_letin pat_info.pat_aliases;
+	  assume_hyps_or_theses hyps;
+	  clear old_clauses];
+       tcl_change_info ninfo2] gls0
+
+(* end cases *)
+
+type instance_stack =
+    (constr option*bool*(constr list) list) list
+
+let initial_instance_stack ids =
+  List.map (fun id -> id,[None,false,[]]) ids
+
+let push_one_arg arg = function 
+    [] -> anomaly "impossible"
+  | (head,is_rec,args) :: ctx -> 
+      ((head,is_rec,(arg::args)) :: ctx)
+
+let push_arg arg stacks =
+  List.map (fun (id,stack) -> (id,push_one_arg arg stack)) stacks
+  
+
+let push_one_head c is_rec ids (id,stack) = 
+  let head = if Idset.mem id ids then Some c else None in
+    id,(head,is_rec,[]) :: stack
+
+let push_head c is_rec ids stacks =
+  List.map (push_one_head c is_rec ids) stacks
+
+let pop_one rec_flag (id,stack) =  
+  let nstack=
+    match stack with
+	[] -> anomaly "impossible"
+      | [c] as l -> l
+      | (Some head,is_rec,args)::(head0,is_rec0,args0)::ctx ->
+	  let arg = applist (head,(List.rev args)) in
+	    rec_flag:= !rec_flag || is_rec;
+	    (head0,is_rec0,(arg::args0))::ctx
+     | (None,is_rec,args)::(head0,is_rec0,args0)::ctx ->
+	 rec_flag:= !rec_flag || is_rec;
+	 (head0,is_rec0,(args@args0))::ctx
+  in id,nstack
+
+let pop_stacks stacks =
+  let rec_flag= ref false in 
+  let nstacks = List.map (pop_one rec_flag) stacks in
+    !rec_flag , nstacks
+
+let patvar_base = id_of_string "__"
+
+let test_fun (str:string) = ()
+
+let hrec_for obj_id fix_id per_info gls=
+  let obj=mkVar obj_id in
+  let typ=pf_get_hyp_typ gls obj_id in
+  let rc,hd1=decompose_prod typ in
+  let cind,all_args=decompose_app typ in
+    match kind_of_term cind with
+	Ind ind when ind=per_info.per_ind ->
+	  let params,args= list_chop per_info.per_nparams all_args in 
+	    if try 
+	      (List.for_all2 eq_constr params per_info.per_params)
+	    with Invalid_argument _ -> false then
+	      let hd2 = applist (mkVar fix_id,args@[obj]) in
+		Some (compose_lam rc (whd_beta hd2))
+	    else None
+      | _ -> None
+
+let rec execute_cases at_top fix_name per_info kont0 stacks tree gls = 
+  match tree with
+      Pop t ->  
+	let is_rec,nstacks =  pop_stacks stacks in
+	  if is_rec then
+	    let _ = test_fun "is_rec=true" in
+	     let c_id = pf_get_new_id (id_of_string "_hrec") gls in
+	       tclTHEN 
+		 (intro_mustbe_force c_id)
+		 (execute_cases false fix_name per_info kont0 nstacks t) gls
+	  else
+	    execute_cases false fix_name per_info kont0 nstacks t gls
+    | Push (_,t) -> 
+	let id = pf_get_new_id patvar_base gls in
+	let nstacks = push_arg (mkVar id) stacks in
+	let kont = execute_cases false fix_name per_info kont0 nstacks t in
+	  tclTHEN
+	    (intro_mustbe_force id)
+	    begin
+	      match fix_name with
+		  Anonymous -> kont
+		| Name fix_id ->  
+		    (fun gls -> 
+		       if at_top then
+			 kont gls
+		       else
+			 match hrec_for id fix_id per_info gls with
+			     None -> kont gls
+			   | Some c_obj ->
+			       let c_id = 
+				 pf_get_new_id (id_of_string "_hrec") gls in
+				 tclTHENLIST 
+				   [generalize [c_obj];
+				    intro_mustbe_force c_id;
+				    kont] gls)
+	    end gls
+    | Split(ids,ind,br) ->
+	let (_,typ,_)=destProd (pf_concl gls) in
+	let hd,args=decompose_app (special_whd gls typ) in
+	let _ = assert (ind = destInd hd) in
+	let nparams = (fst (Global.lookup_inductive ind)).mind_nparams in
+	let params = list_firstn nparams args in
+	let constr i =applist (mkConstruct(ind,succ i),params) in
+	let next_tac is_rec i = function
+	    Some (sub_ids,tree) ->
+	      let br_stacks =
+		List.filter (fun (id,_) -> Idset.mem id sub_ids) stacks in
+	      let p_stacks = 
+		push_head (constr i) is_rec ids br_stacks in
+		execute_cases false fix_name per_info kont0 p_stacks tree 
+	  | None -> 
+	      msgnl (str "Warning : missing case");
+	      kont0 (mkMeta 1) 
+	in
+	let id = pf_get_new_id patvar_base gls in
+	let kont is_rec = 			
+	  tclTHENSV
+	    (general_case_analysis (mkVar id,NoBindings))
+	    (Array.mapi (next_tac is_rec) br) in
+	  tclTHEN 
+	    (intro_mustbe_force id)
+	    begin
+	      match fix_name with
+		  Anonymous -> kont false
+		| Name fix_id ->  
+		    (fun gls -> 
+		       if at_top then
+			 kont false gls
+		       else
+			 match hrec_for id fix_id per_info gls with
+			     None -> kont false gls
+			   | Some c_obj ->
+			       tclTHENLIST 
+				 [generalize [c_obj];
+				  kont true] gls)
+	    end gls
+    | End_of_branch (id,nhyps) -> 
+	  match List.assoc id stacks with
+	      [None,_,args] -> 
+		let metas = list_tabulate (fun n -> mkMeta (succ n)) nhyps in
+		  kont0 (applist (mkVar id,List.rev_append args metas)) gls
+	    | _ -> anomaly "wrong stack size"
+
+let end_tac et2 gls =
+  let info = get_its_info gls in
+  let et1,pi,ek,clauses = 
+    match info.pm_stack with
+	Suppose_case::_ -> 
+	  anomaly "This case should already be trapped"
+      | Claim::_ ->  
+	  error "\"end claim\" expected."
+      | Focus_claim::_ ->
+	  error "\"end focus\" expected."
+      | Per(et',pi,ek,clauses)::_ -> (et',pi,ek,clauses) 
+      | [] -> 
+	  anomaly "This case should already be trapped" in
+  let et = 
+    if et1 <> et2 then
+      match et1 with 
+	  ET_Case_analysis -> 
+	    error "\"end cases\" expected."
+	| ET_Induction ->
+	    error "\"end induction\" expected."
+    else et1 in
+    tclTHEN 
+      tcl_erase_info
+      begin
+	match et,ek with
+	    _,EK_unknown -> 
+	      tclSOLVE [simplest_elim pi.per_casee]	
+	  | ET_Case_analysis,EK_nodep ->
+	      tclTHEN 
+		(general_case_analysis (pi.per_casee,NoBindings))
+		(default_justification (List.map mkVar clauses))
+	  | ET_Induction,EK_nodep ->
+	      tclTHENLIST
+		[generalize (pi.per_args@[pi.per_casee]); 
+		 simple_induct (AnonHyp (succ (List.length pi.per_args)));
+		 default_justification (List.map mkVar clauses)]
+	  | ET_Case_analysis,EK_dep tree ->
+	      tclTHENLIST 
+		[generalize (pi.per_args@[pi.per_casee]);
+		 execute_cases true Anonymous pi 
+		   (fun c -> tclTHENLIST 
+		      [refine c;
+		       clear clauses;
+		       justification assumption])
+		   (initial_instance_stack clauses) tree]	
+	  | ET_Induction,EK_dep tree ->
+	      tclTHEN (generalize (pi.per_args@[pi.per_casee]))
+		begin
+		  fun gls0 -> 
+		    let fix_id = pf_get_new_id (id_of_string "_fix") gls0 in
+		      tclTHEN 
+			(fix (Some fix_id) (succ (List.length pi.per_args))) 
+			(execute_cases true (Name fix_id) pi 
+			   (fun c ->
+			      tclTHENLIST 
+				[clear [fix_id];
+				 refine c;
+				 clear clauses;
+				 justification assumption
+				 (* justification automation_tac *)])
+			   (initial_instance_stack clauses) tree) gls0
+		end	
+      end gls
+
+(* escape *)
+
+let rec abstract_metas n avoid head = function
+    [] -> 1,head,[]
+  | (meta,typ)::rest -> 
+      let id = Nameops.next_ident_away (id_of_string "_sbgl") avoid in
+      let p,term,args = abstract_metas (succ n) (id::avoid) head rest in 
+	succ p,mkLambda(Name id,typ,subst_meta [meta,mkRel p] term),
+      (mkMeta n)::args 
+
+let build_refining_context gls =
+  let info = get_its_info gls in
+  let avoid=pf_ids_of_hyps gls in
+  let _,fn,args=abstract_metas 1 avoid info.pm_partial_goal info.pm_subgoals in
+    applist (fn,args)
+    
+let escape_command pts =
+  let pts1 = nth_unproven 1 pts in
+  let gls = top_goal_of_pftreestate pts1 in
+  let term = build_refining_context gls in
+  let tac = tclTHEN 
+    (abstract_operation (Proof_instr (true,{emph=0;instr=Pescape})) tcl_erase_info)
+    (Tactics.refine term) in
+    traverse 1 (solve_pftreestate tac pts1)
+
+(* General instruction engine *)
+
+let rec do_proof_instr_gen _thus _then instr = 
+  match instr with 
+      Pthus i -> 
+	assert (not _thus);
+	do_proof_instr_gen true _then i
+    | Pthen i -> 	
+	assert (not _then);
+	do_proof_instr_gen _thus true i
+    | Phence i -> 
+	assert (not (_then || _thus));
+	do_proof_instr_gen true true i
+    | Pcut c ->
+	instr_cut mk_stat_or_thesis _thus _then c
+    | Prew (s,c) ->
+	assert (not _then);
+	instr_rew _thus s c
+    | Pconsider (c,hyps)    -> consider_tac c hyps
+    | Pgiven hyps            -> given_tac hyps
+    | Passume hyps           -> assume_tac hyps
+    | Plet hyps              -> assume_tac hyps
+    | Pclaim st              -> instr_claim false st 
+    | Pfocus st              -> instr_claim true st
+    | Ptake witl             -> take_tac witl
+    | Pdefine (id,args,body) -> define_tac id args body
+    | Pcast (id,typ)         -> cast_tac id typ 
+    | Pper (et,cs)           -> per_tac et cs 
+    | Psuppose hyps      -> suppose_tac hyps
+    | Pcase (params,pat_info,hyps) -> case_tac params pat_info hyps
+    | Pend (B_elim et) -> end_tac et
+    | Pend _ | Pescape -> anomaly "Not applicable"
+ 
+let eval_instr {instr=instr} =
+  do_proof_instr_gen false false instr   
+
+let rec preprocess pts instr =
+  match instr with
+    Phence i |Pthus i | Pthen i -> preprocess pts i
+  | Pcut _ |  Passume _ | Plet _ | Pclaim _ | Pfocus _ 
+  | Pconsider (_,_) | Pcast (_,_) | Pgiven _ | Ptake _ 
+  | Pdefine (_,_,_) | Pper _ | Prew _ ->
+      check_not_per pts;
+      true,pts
+  | Pescape -> 
+      check_not_per pts;
+      false,pts
+  | Pcase _ | Psuppose _ | Pend (B_elim _) -> 
+      true,close_previous_case pts
+  | Pend bt -> 
+      false,close_block bt pts 
+      
+let rec postprocess pts instr = 
+  match instr with
+      Phence i | Pthus i | Pthen i -> postprocess pts i
+    | Pcut _ | Passume _ | Plet _ | Pconsider (_,_) | Pcast (_,_)
+    | Pgiven _ | Ptake _ | Pdefine (_,_,_) | Prew (_,_) -> pts
+    | Pclaim _ | Pfocus _ | Psuppose _ | Pcase _ | Pper _ -> nth_unproven 1 pts
+    | Pescape ->
+	escape_command pts
+    | Pend _ -> 
+	goto_current_focus_or_top (mark_as_done pts)
+
+let do_instr raw_instr pts =
+  let has_tactic,pts1 = preprocess pts raw_instr.instr in
+  let pts2 = 
+    if has_tactic then
+      let gl = nth_goal_of_pftreestate 1 pts1 in
+      let env=  pf_env gl in
+      let sigma= project gl in
+      let ist = {ltacvars = ([],[]); ltacrecvars = []; 
+		 gsigma = sigma; genv = env} in
+      let glob_instr = intern_proof_instr ist raw_instr in
+      let instr = 
+	interp_proof_instr (get_its_info gl) sigma env glob_instr in
+      let lock_focus = is_focussing_instr instr.instr in
+      let marker= Proof_instr (lock_focus,instr) in
+	solve_nth_pftreestate 1 
+	  (abstract_operation marker (eval_instr instr)) pts1
+    else pts1 in
+      postprocess pts2 raw_instr.instr
+
+let proof_instr raw_instr =
+  Pfedit.mutate (do_instr raw_instr)
+
+(*
+
+(* STUFF FOR ITERATED RELATIONS *)
+let decompose_bin_app t= 
+  let hd,args = destApp 
+
+let identify_transitivity_lemma c =
+  let varx,tx,c1 = destProd c in
+  let vary,ty,c2 = destProd (pop c1) in
+  let varz,tz,c3 = destProd (pop c2) in
+  let _,p1,c4 = destProd (pop c3) in
+  let _,lp2,lp3 = destProd (pop c4) in
+  let p2=pop lp2 in
+  let p3=pop lp3 in
+*)
+    
diff --git a/tactics/decl_proof_instr.mli b/tactics/decl_proof_instr.mli
new file mode 100644
index 00000000..ba8dc7b6
--- /dev/null
+++ b/tactics/decl_proof_instr.mli
@@ -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        *)
+(************************************************************************)
+
+(* $Id:$ *)
+
+open Refiner
+open Names
+open Term
+open Tacmach
+
+val go_to_proof_mode: unit -> unit
+val return_from_tactic_mode: unit -> unit
+
+val register_automation_tac: tactic -> unit
+
+val automation_tac : tactic
+
+val daimon_subtree: pftreestate -> pftreestate
+
+val do_instr: Decl_expr.raw_proof_instr -> pftreestate -> pftreestate
+val proof_instr: Decl_expr.raw_proof_instr -> unit
+
+val tcl_change_info : Decl_mode.pm_info -> tactic
+
+val mark_proof_tree_as_done : Proof_type.proof_tree -> Proof_type.proof_tree
+
+val mark_as_done : pftreestate -> pftreestate
+
+val execute_cases : bool ->
+    Names.name ->
+    Decl_mode.per_info ->
+    (Term.constr -> Proof_type.tactic) ->
+    (Names.Idset.elt * (Term.constr option * bool * Term.constr list) list) 
+      list ->
+    Decl_mode.split_tree -> Proof_type.tactic
+
+val tree_of_pats :
+    Environ.env ->
+    Names.Idset.elt * int ->
+    Rawterm.cases_pattern list list -> Decl_mode.split_tree
+val add_branch :
+    Environ.env ->
+    Names.Idset.elt * int ->
+    Rawterm.cases_pattern list list ->
+    Decl_mode.split_tree -> Decl_mode.split_tree
+val append_branch :
+    Environ.env ->
+    Names.Idset.elt * int ->
+    int ->
+    Rawterm.cases_pattern list list ->
+    int ->
+    (Names.Idset.t * Decl_mode.split_tree) option ->
+    (Names.Idset.t * Decl_mode.split_tree) option
+
+val append_tree :   Environ.env ->
+    Names.Idset.elt * int ->
+    int ->
+    Rawterm.cases_pattern list list ->
+    Decl_mode.split_tree -> Decl_mode.split_tree
+
+val build_dep_clause :   Term.types Decl_expr.statement list ->
+    Decl_expr.proof_pattern ->
+    Decl_mode.per_info ->
+    (Term.types Decl_expr.statement, Term.types Decl_expr.or_thesis)
+    Decl_expr.hyp list -> Proof_type.goal Tacmach.sigma -> Term.types
+
+val register_dep_subcase :    
+    Names.identifier * int ->
+    Environ.env ->
+    Decl_mode.per_info ->
+    Rawterm.cases_pattern -> Decl_mode.elim_kind -> Decl_mode.elim_kind
+
+val thesis_for :     Term.constr ->
+    Term.constr -> Decl_mode.per_info -> Environ.env -> Term.constr
+
+val close_previous_case : pftreestate -> pftreestate
+
+val test_fun : string -> unit
+
+
+val pop_stacks :
+  (Names.identifier * 
+     (Term.constr option * bool * Term.constr list) list) list ->
+  bool * 
+    (Names.identifier * 
+       (Term.constr option * bool * Term.constr list) list) list
+
+
+val push_head :   Term.constr ->
+  bool ->
+  Names.Idset.t ->
+  (Names.identifier * 
+     (Term.constr option * bool * Term.constr list) list) list ->
+  (Names.identifier * 
+     (Term.constr option * bool * Term.constr list) list) list
+
+val push_arg : Term.constr ->
+  (Names.identifier * 
+     (Term.constr option * bool * Term.constr list) list) list ->
+  (Names.identifier * 
+     (Term.constr option * bool * Term.constr list) list) list
+
+val hrec_for: 
+    Names.identifier ->
+    Names.identifier ->
+    Decl_mode.per_info -> Proof_type.goal Tacmach.sigma -> Term.constr option
+
+val consider_match :
+   bool ->
+    Names.Idset.elt list ->
+    Names.Idset.elt list ->
+    (Term.types Decl_expr.statement, Term.types) Decl_expr.hyp list ->
+    Proof_type.tactic
diff --git a/tactics/eauto.ml4 b/tactics/eauto.ml4
index 32abc347..6da0dd49 100644
--- a/tactics/eauto.ml4
+++ b/tactics/eauto.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: eauto.ml4 8878 2006-05-30 16:44:25Z herbelin $ *)
+(* $Id: eauto.ml4 9277 2006-10-25 13:02:22Z herbelin $ *)
 
 open Pp
 open Util
@@ -46,7 +46,7 @@ END
 
 let e_resolve_with_bindings_tac  (c,lbind) gl = 
   let t = pf_hnf_constr gl (pf_type_of gl c) in 
-  let clause = make_clenv_binding_apply gl (-1) (c,t) lbind in 
+  let clause = make_clenv_binding_apply gl None (c,t) lbind in 
   Clenvtac.e_res_pf clause gl
 
 let e_resolve_constr c gls = e_resolve_with_bindings_tac (c,NoBindings) gls
diff --git a/tactics/equality.ml b/tactics/equality.ml
index f05c3882..2526c84e 100644
--- a/tactics/equality.ml
+++ b/tactics/equality.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: equality.ml 9010 2006-07-05 07:17:41Z jforest $ *)
+(* $Id: equality.ml 9211 2006-10-05 12:38:33Z letouzey $ *)
 
 open Pp
 open Util
@@ -82,34 +82,34 @@ let elimination_sort_of_clause = function
 *)
 
 let general_rewrite_bindings_clause cls lft2rgt (c,l) gl =
-  let ctype = pf_type_of gl c in 
+  let ctype = pf_apply get_type_of gl c in 
   (* A delta-reduction would be here too strong, since it would 
      break search for a defined setoid relation in head position. *)
   let t = snd (decompose_prod (whd_betaiotazeta ctype)) in 
   let head = if isApp t then fst (destApp t) else t in 
-  if relation_table_mem head && l = NoBindings then 
-    general_s_rewrite_clause cls lft2rgt c [] gl
-  else 
-    (* Original code. In particular, [splay_prod] performs delta-reduction. *)
-    let env = pf_env gl in
-    let sigma = project gl in 
-    let _,t = splay_prod env sigma t in
-    match match_with_equation t with
-      | None -> 
-	  if l = NoBindings
-	  then general_s_rewrite_clause cls lft2rgt c [] gl
-	  else error "The term provided does not end with an equation" 
-      | Some (hdcncl,_) -> 
-          let hdcncls = string_of_inductive hdcncl in 
-	  let suffix = elimination_suffix (elimination_sort_of_clause cls gl) in
-          let dir = if cls=None then lft2rgt else not lft2rgt in
-          let rwr_thm = if dir then hdcncls^suffix^"_r" else hdcncls^suffix in
-          let elim =
-	    try pf_global gl (id_of_string rwr_thm)
-            with Not_found ->
-              error ("Cannot find rewrite principle "^rwr_thm)
-          in 
-	  general_elim_clause cls (c,l) (elim,NoBindings) gl
+    if relation_table_mem head && l = NoBindings then 
+      general_s_rewrite_clause cls lft2rgt c [] gl
+    else 
+      (* Original code. In particular, [splay_prod] performs delta-reduction. *)
+      let env = pf_env gl in
+      let sigma = project gl in 
+      let _,t = splay_prod env sigma t in
+	match match_with_equation t with
+	  | None -> 
+	      if l = NoBindings
+	      then general_s_rewrite_clause cls lft2rgt c [] gl
+	      else error "The term provided does not end with an equation" 
+	  | Some (hdcncl,_) -> 
+              let hdcncls = string_of_inductive hdcncl in 
+	      let suffix = elimination_suffix (elimination_sort_of_clause cls gl) in
+              let dir = if cls=None then lft2rgt else not lft2rgt in
+              let rwr_thm = if dir then hdcncls^suffix^"_r" else hdcncls^suffix in
+              let elim =
+		try pf_global gl (id_of_string rwr_thm)
+		with Not_found ->
+		  error ("Cannot find rewrite principle "^rwr_thm)
+              in 
+		general_elim_clause cls (c,l) (elim,NoBindings) gl
 
 let general_rewrite_bindings = general_rewrite_bindings_clause None
 let general_rewrite l2r c = general_rewrite_bindings l2r (c,NoBindings)
@@ -119,36 +119,39 @@ let general_rewrite_bindings_in l2r id =
 let general_rewrite_in l2r id c = 
   general_rewrite_bindings_clause (Some id) l2r (c,NoBindings)
 
-
 let general_multi_rewrite l2r c cl = 
-  let rec do_hyps = function 
-    | [] -> tclIDTAC
-    | ((_,id),_) :: l -> 
-	tclTHENFIRST (general_rewrite_bindings_in l2r id c) (do_hyps l)
-  in 
-  let rec try_do_hyps = function 
-    | [] -> tclIDTAC 
-    | id :: l -> 
-	tclTHENFIRST 
-	  (tclTRY (general_rewrite_bindings_in l2r id c)) 
-	  (try_do_hyps l)
-  in 
   if cl.concl_occs <> [] then 
-    error "The \"at\" syntax isn't available yet for the rewrite tactic"
-  else 
-    tclTHENFIRST 
-      (if cl.onconcl then general_rewrite_bindings l2r c else tclIDTAC)
-      (match cl.onhyps with 
-	 | Some l -> do_hyps l
-	 | None -> 
-	     fun gl -> 
-	       (* try to rewrite in all hypothesis 
-		  (except maybe the rewritten one) *)
-	       let ids = match kind_of_term (fst c) with 
-		 | Var id -> list_remove id (pf_ids_of_hyps gl)
-		 | _ -> pf_ids_of_hyps gl
-	       in try_do_hyps ids gl)
-
+    error "The \"at\" syntax isn't available yet for the rewrite/replace tactic"
+  else match cl.onhyps with 
+    | Some l -> 
+	(* If a precise list of locations is given, success is mandatory for
+	   each of these locations. *)
+	let rec do_hyps = function 
+	  | [] -> tclIDTAC
+	  | ((_,id),_) :: l -> 
+	      tclTHENFIRST (general_rewrite_bindings_in l2r id c) (do_hyps l)
+	in 
+	if not cl.onconcl then do_hyps l 
+	else tclTHENFIRST (general_rewrite_bindings l2r c) (do_hyps l)
+    | None -> 
+	(* Otherwise, if we are told to rewrite in all hypothesis via the 
+           syntax "* |-", we fail iff all the different rewrites fail *) 
+	let rec do_hyps_atleastonce = function 
+	  | [] -> (fun gl -> error "Nothing to rewrite.")
+	  | id :: l -> 
+	      tclIFTHENTRYELSEMUST 
+		(general_rewrite_bindings_in l2r id c) 
+		(do_hyps_atleastonce l)
+	in 
+	let do_hyps gl = 
+	  (* If the term to rewrite is an hypothesis, don't rewrite in itself *)
+	  let ids = match kind_of_term (fst c) with 
+	    | Var id -> list_remove id (pf_ids_of_hyps gl)
+	    | _ -> pf_ids_of_hyps gl
+	  in do_hyps_atleastonce ids gl
+	in 
+	if not cl.onconcl then do_hyps 
+	else tclIFTHENTRYELSEMUST (general_rewrite_bindings l2r c) do_hyps
 
 (* Conditional rewriting, the success of a rewriting is related 
    to the resolution of the conditions by a given tactic *)
@@ -182,9 +185,14 @@ let rewriteRL_clause = function
    tac : Used to prove the equality c1 = c2 
    gl : goal *)
 
-let abstract_replace clause c2 c1 unsafe tac gl =
-  let t1 = pf_type_of gl c1 
-  and t2 = pf_type_of gl c2 in
+let multi_replace clause c2 c1 unsafe try_prove_eq_opt gl = 
+  let try_prove_eq = 
+    match try_prove_eq_opt with 
+      | None -> tclIDTAC
+      | Some tac ->  tclTRY (tclCOMPLETE tac)
+  in
+  let t1 = pf_apply get_type_of gl c1 
+  and t2 = pf_apply get_type_of gl c2 in
   if unsafe or (pf_conv_x gl t1 t2) then
     let e = build_coq_eq () in
     let sym = build_coq_sym_eq () in
@@ -192,34 +200,28 @@ let abstract_replace clause c2 c1 unsafe tac gl =
     tclTHENS (assert_tac false Anonymous eq)
       [onLastHyp (fun id -> 
 	tclTHEN 
-	  (tclTRY (rewriteRL_clause clause (mkVar id,NoBindings)))
+	  (tclTRY (general_multi_rewrite false (mkVar id,NoBindings) clause))
 	  (clear [id]));
        tclFIRST
 	 [assumption;
 	  tclTHEN (apply sym) assumption;
-	  tclTRY (tclCOMPLETE tac)
+	  try_prove_eq
 	 ]
       ] gl
   else
     error "terms do not have convertible types"
+  
 
+let replace c2 c1 gl = multi_replace onConcl c2 c1 false None gl
 
-let replace c2 c1 gl = abstract_replace None c2 c1 false tclIDTAC gl
-
-let replace_in id c2 c1 gl = abstract_replace (Some id) c2 c1 false tclIDTAC gl
+let replace_in id c2 c1 gl = multi_replace (onHyp id) c2 c1 false None gl
 
-let replace_by c2 c1 tac gl = abstract_replace None c2 c1 false tac gl
+let replace_by c2 c1 tac gl = multi_replace onConcl c2 c1 false (Some tac) gl
 
-let replace_in_by id c2 c1 tac gl = abstract_replace (Some id) c2 c1 false tac gl
+let replace_in_by id c2 c1 tac gl = multi_replace (onHyp id) c2 c1 false (Some tac) gl
 
-
-let new_replace c2 c1 id tac_opt gl = 
-  let tac = 
-    match tac_opt with 
-      | Some tac -> tac 
-      | _ -> tclIDTAC
-  in
-  abstract_replace id c2 c1 false tac gl
+let replace_in_clause_maybe_by c2 c1 cl tac_opt gl = 
+  multi_replace cl c2 c1 false tac_opt gl
 
 (* End of Eduardo's code. The rest of this file could be improved
    using the functions match_with_equation, etc that I defined
@@ -269,24 +271,27 @@ exception DiscrFound of
   (constructor * int) list * constructor * constructor
 
 let find_positions env sigma t1 t2 =
-  let rec findrec posn t1 t2 =
+  let rec findrec sorts posn t1 t2 =
     let hd1,args1 = whd_betadeltaiota_stack env sigma t1 in
     let hd2,args2 = whd_betadeltaiota_stack env sigma t2 in
     match (kind_of_term hd1, kind_of_term hd2) with
   	
       | Construct sp1, Construct sp2 
           when List.length args1 = mis_constructor_nargs_env env sp1
-          ->
-        (* both sides are fully applied constructors, so either we descend,
-           or we can discriminate here. *)
+            ->
+	  let sorts = list_intersect sorts (allowed_sorts env (fst sp1)) in
+          (* both sides are fully applied constructors, so either we descend,
+             or we can discriminate here. *)
 	  if sp1 = sp2 then
+	    let nrealargs = constructor_nrealargs env sp1 in
+	    let rargs1 = list_lastn nrealargs args1 in
+	    let rargs2 = list_lastn nrealargs args2 in
             List.flatten
-	      (list_map2_i
-		 (fun i arg1 arg2 ->
-		    findrec ((sp1,i)::posn) arg1 arg2)
-		 0 args1 args2)
-	  else
-	    raise (DiscrFound(List.rev posn,sp1,sp2))
+	      (list_map2_i (fun i -> findrec sorts ((sp1,i)::posn))
+		0 rargs1 rargs2)
+	  else if List.mem InType sorts then (* see build_discriminator *)
+	    raise (DiscrFound (List.rev posn,sp1,sp2))
+	  else []
 
       | _ ->
 	  let t1_0 = applist (hd1,args1) 
@@ -295,14 +300,13 @@ let find_positions env sigma t1 t2 =
 	    []
           else
 	    let ty1_0 = get_type_of env sigma t1_0 in
-	    match get_sort_family_of env sigma ty1_0 with
-	      | InSet | InType -> [(List.rev posn,t1_0,t2_0)]
-	      | InProp -> []
-	  in 
-	  (try 
-	     Inr(findrec [] t1 t2)
-	   with DiscrFound (path,c1,c2) -> 
-	     Inl (path,c1,c2))
+	    let s = get_sort_family_of env sigma ty1_0 in
+	    if List.mem s sorts then [(List.rev posn,t1_0,t2_0)] else [] in 
+  try
+    (* Rem: to allow injection on proofs objects, just add InProp *)
+    Inr (findrec [InSet;InType] [] t1 t2)
+  with DiscrFound (path,c1,c2) ->
+    Inl (path,c1,c2)
 
 let discriminable env sigma t1 t2 =
   match find_positions env sigma t1 t2 with
@@ -371,6 +375,7 @@ let discriminable env sigma t1 t2 =
 
    the continuation then constructs the case-split.
  *)
+
 let descend_then sigma env head dirn =
   let IndType (indf,_) =
     try find_rectype env sigma (get_type_of env sigma head)
@@ -383,9 +388,7 @@ let descend_then sigma env head dirn =
   (dirn_nlams,
    dirn_env,
    (fun dirnval (dfltval,resty) ->
-      let arsign,_ = get_arity env indf in
-      let depind = build_dependent_inductive env indf in
-      let deparsign = (Anonymous,None,depind)::arsign in
+      let deparsign = make_arity_signature env true indf in
       let p =
 	it_mkLambda_or_LetIn (lift (mip.mind_nrealargs+1) resty) deparsign in
       let build_branch i =
@@ -416,7 +419,7 @@ let descend_then sigma env head dirn =
 
 let construct_discriminator sigma env dirn c sort =
   let IndType(indf,_) =
-    try find_rectype env sigma (type_of env sigma c)
+    try find_rectype env sigma (get_type_of env sigma c)
     with Not_found ->
        (* one can find Rel(k) in case of dependent constructors 
           like T := c : (A:Set)A->T and a discrimination 
@@ -428,10 +431,8 @@ let construct_discriminator sigma env dirn c sort =
 		 dependent types") in
   let (ind,_) = dest_ind_family indf in
   let (mib,mip) = lookup_mind_specif env ind in
-  let arsign,arsort = get_arity env indf in
   let (true_0,false_0,sort_0) = build_coq_True(),build_coq_False(),Prop Null in
-  let depind = build_dependent_inductive env indf in
-  let deparsign = (Anonymous,None,depind)::arsign in
+  let deparsign = make_arity_signature env true indf in
   let p = it_mkLambda_or_LetIn (mkSort sort_0) deparsign in
   let cstrs = get_constructors env indf in
   let build_branch i =
@@ -445,17 +446,22 @@ let construct_discriminator sigma env dirn c sort =
 let rec build_discriminator sigma env dirn c sort = function
   | [] -> construct_discriminator sigma env dirn c sort
   | ((sp,cnum),argnum)::l ->
-      let cty = type_of env sigma c in
-      let IndType (indf,_) =
-	try find_rectype env sigma cty with Not_found -> assert false in
-      let (ind,_) = dest_ind_family indf in
-      let (mib,mip) = lookup_mind_specif env ind in
-      let nparams = mib.mind_nparams  in
       let (cnum_nlams,cnum_env,kont) = descend_then sigma env c cnum in
-      let newc = mkRel(cnum_nlams-(argnum-nparams)) in
+      let newc = mkRel(cnum_nlams-argnum) in
       let subval = build_discriminator sigma cnum_env dirn newc sort l  in
       kont subval (build_coq_False (),mkSort (Prop Null))
 
+(* Note: discrimination could be more clever: if some elimination is
+   not allowed because of a large impredicative constructor in the
+   path (see allowed_sorts in find_positions), the positions could
+   still be discrimated by projecting first instead of putting the
+   discrimination combinator inside the projecting combinator. Example
+   of relevant situation:
+
+   Inductive t:Set := c : forall A:Set, A -> nat -> t.
+   Goal ~ c _ 0 0 = c _ 0 1. intro. discriminate H.
+*)
+
 let gen_absurdity id gl =
   if is_empty_type (clause_type (onHyp id) gl)
   then
@@ -466,12 +472,12 @@ let gen_absurdity id gl =
 
 (* Precondition: eq is leibniz equality
  
-  returns ((eq_elim t t1 P i t2), absurd_term)
-  where  P=[e:t]discriminator 
-         absurd_term=False
+   returns ((eq_elim t t1 P i t2), absurd_term)
+   where  P=[e:t]discriminator 
+          absurd_term=False
 *)
 
-let discrimination_pf e (t,t1,t2) discriminator lbeq gls =
+let discrimination_pf e (t,t1,t2) discriminator lbeq =
   let i           = build_coq_I () in
   let absurd_term = build_coq_False () in
   let eq_elim     = lbeq.ind in
@@ -479,28 +485,28 @@ let discrimination_pf e (t,t1,t2) discriminator lbeq gls =
 
 exception NotDiscriminable
 
-let discrEq (lbeq,(t,t1,t2)) id gls =
-  let sort = pf_type_of gls (pf_concl gls) in 
+let eq_baseid = id_of_string "e"
+
+let discr_positions env sigma (lbeq,(t,t1,t2)) id cpath dirn sort =
+  let e = next_ident_away eq_baseid (ids_of_context env) in
+  let e_env = push_named (e,None,t) env in
+  let discriminator =
+    build_discriminator sigma e_env dirn (mkVar e) sort cpath in
+  let (pf, absurd_term) = discrimination_pf e (t,t1,t2) discriminator lbeq in
+  tclCOMPLETE 
+    ((tclTHENS (cut_intro absurd_term)
+      [onLastHyp gen_absurdity; 
+       refine (mkApp (pf,[|mkVar id|]))]))
+
+let discrEq (lbeq,(t,t1,t2) as u) id gls =
   let sigma = project gls in
   let env = pf_env gls in
-  (match find_positions env sigma t1 t2 with
-     | Inr _ ->
-	 errorlabstrm "discr" (str" Not a discriminable equality")
-     | Inl (cpath, (_,dirn), _) ->
-	 let e = pf_get_new_id (id_of_string "ee") gls in
-	 let e_env = push_named (e,None,t) env in
-	 let discriminator =
-	   build_discriminator sigma e_env dirn (mkVar e) sort cpath in
-	 let (pf, absurd_term) =
-	   discrimination_pf e (t,t1,t2) discriminator lbeq gls 
-	 in
-	 tclCOMPLETE((tclTHENS (cut_intro absurd_term)
-			([onLastHyp gen_absurdity;
-			  refine (mkApp (pf, [| mkVar id |]))]))) gls)
-
-let not_found_message id =
-  (str "The variable" ++ spc () ++ str (string_of_id id) ++ spc () ++
-    str" was not found in the current environment")
+  match find_positions env sigma t1 t2 with
+    | Inr _ ->
+	errorlabstrm "discr" (str" Not a discriminable equality")
+    | Inl (cpath, (_,dirn), _) ->
+	let sort = pf_apply get_type_of gls (pf_concl gls) in 
+	discr_positions env sigma u id cpath dirn sort gls
 
 let onEquality tac id gls =
   let eqn = pf_whd_betadeltaiota gls (pf_get_hyp_typ gls id) in
@@ -533,7 +539,7 @@ let discrEverywhere =
   tclORELSE
     (Tacticals.tryAllClauses discrSimpleClause)
     (fun gls -> 
-       errorlabstrm "DiscrEverywhere" (str" No discriminable equalities"))
+       errorlabstrm "DiscrEverywhere" (str"No discriminable equalities"))
 
 let discr_tac = function
   | None -> discrEverywhere
@@ -723,15 +729,9 @@ let make_iterated_tuple env sigma dflt (z,zty) =
 let rec build_injrec sigma env dflt c = function
   | [] -> make_iterated_tuple env sigma dflt (c,type_of env sigma c)
   | ((sp,cnum),argnum)::l ->
-      let cty = type_of env sigma c in
-      let (ity,_) = find_mrectype env sigma cty in
-      let (mib,mip) = lookup_mind_specif env ity in
-      let nparams = mib.mind_nparams in
       let (cnum_nlams,cnum_env,kont) = descend_then sigma env c cnum in
-      let newc = mkRel(cnum_nlams-(argnum-nparams)) in
-      let (subval,tuplety,dfltval) =
-      	build_injrec sigma cnum_env dflt newc l
-      in
+      let newc = mkRel(cnum_nlams-argnum) in
+      let (subval,tuplety,dfltval) = build_injrec sigma cnum_env dflt newc l in
       (kont subval (dfltval,tuplety),
        tuplety,dfltval)
 
@@ -739,6 +739,7 @@ let build_injector sigma env dflt c cpath =
   let (injcode,resty,_) = build_injrec sigma env dflt c cpath in
   (injcode,resty)
 
+(*
 let try_delta_expand env sigma t =
   let whdt = whd_betadeltaiota env sigma t  in 
   let rec hd_rec c  =
@@ -749,12 +750,39 @@ let try_delta_expand env sigma t =
       | _  -> t
   in 
   hd_rec whdt 
+*)
 
 (* Given t1=t2 Inj calculates the whd normal forms of t1 and t2 and it 
    expands then only when the whdnf has a constructor of an inductive type
    in hd position, otherwise delta expansion is not done *)
 
-let injEq (eq,(t,t1,t2)) id gls =
+let simplify_args env sigma t = 
+  (* Quick hack to reduce in arguments of eq only *)
+  match decompose_app t with
+    | eq, [t;c1;c2] -> applist (eq,[t;nf env sigma c1;nf env sigma c2])
+    | eq, [t1;c1;t2;c2] -> applist (eq,[t1;nf env sigma c1;t2;nf env sigma c2])
+    | _ -> t
+
+let inject_at_positions env sigma (eq,(t,t1,t2)) id posns =
+  let e = next_ident_away eq_baseid (ids_of_context env) in
+  let e_env = push_named (e,None,t) env in
+  let injectors =
+    map_succeed
+      (fun (cpath,t1',t2') ->
+        (* arbitrarily take t1' as the injector default value *)
+	let (injbody,resty) = build_injector sigma e_env t1' (mkVar e) cpath in
+	let injfun = mkNamedLambda e t injbody in
+	let pf = applist(eq.congr,[t;resty;injfun;t1;t2;mkVar id]) in
+	let ty = simplify_args env sigma (get_type_of env sigma pf) in
+	(pf,ty))
+      posns in
+  if injectors = [] then
+    errorlabstrm "Equality.inj" (str "Failed to decompose the equality");
+  tclMAP
+    (fun (pf,ty) -> tclTHENS (cut ty) [tclIDTAC; refine pf])
+    injectors
+
+let injEq ipats (eq,(t,t1,t2)) id gls =
   let sigma = project gls in
   let env = pf_env gls in
   match find_positions env sigma t1 t2 with
@@ -766,100 +794,38 @@ let injEq (eq,(t,t1,t2)) id gls =
 	errorlabstrm "Equality.inj" 
 	   (str"Nothing to do, it is an equality between convertible terms")
     | Inr posns ->
-	let e = pf_get_new_id (id_of_string "e") gls in
-	let e_env = push_named (e,None,t) env in
-	let injectors =
-	  map_succeed
-	    (fun (cpath,t1_0,t2_0) ->
-	      try 
-		let (injbody,resty) =
-                  (* take arbitrarily t1_0 as the injector default value *)
-		  build_injector sigma e_env t1_0 (mkVar e) cpath in
-		let injfun = mkNamedLambda e t injbody in
-		let _ = type_of env sigma injfun in (injfun,resty)
-	      with e when catchable_exception e ->
-		(* may fail because ill-typed or because of a Prop argument *)
-		(* error "find_sigma_data" *)
-		failwith "caught")
-            posns
-	in
-	if injectors = [] then
-	  errorlabstrm "Equality.inj" 
-	    (str "Failed to decompose the equality");
-	tclMAP 
-	  (fun (injfun,resty) ->
-	     let pf = applist(eq.congr,
-			      [t;resty;injfun;
-			       try_delta_expand env sigma t1;
-			       try_delta_expand env sigma t2;
-			       mkVar id]) 
-	     in
-	     let ty =
-	       try pf_nf gls (pf_type_of gls pf)
-               with
-		 | UserError("refiner__fail",_) -> 
-		     errorlabstrm "InjClause" 
-		(str (string_of_id id) ++ str" Not a projectable equality")
-	     in ((tclTHENS  (cut  ty) ([tclIDTAC;refine pf]))))
-	  injectors
+(* Est-ce utile à partir du moment où les arguments projetés subissent "nf" ?
+	let t1 = try_delta_expand env sigma t1 in
+	let t2 = try_delta_expand env sigma t2 in
+*)
+	tclTHEN 
+	  (inject_at_positions env sigma (eq,(t,t1,t2)) id posns)
+	  (intros_pattern None ipats)
 	  gls
 
-let inj = onEquality injEq
+let inj ipats = onEquality (injEq ipats)
 
-let injClause = function
-  | None -> onNegatedEquality injEq
-  | Some id -> try_intros_until inj id
+let injClause ipats = function
+  | None -> onNegatedEquality (injEq ipats)
+  | Some id -> try_intros_until (inj ipats) id
 
-let injConcl gls  = injClause None gls
-let injHyp id gls = injClause (Some id) gls
+let injConcl gls  = injClause [] None gls
+let injHyp id gls = injClause [] (Some id) gls
 
-let decompEqThen ntac (lbeq,(t,t1,t2)) id gls =
-  let sort = pf_type_of gls (pf_concl gls) in 
+let decompEqThen ntac (lbeq,(t,t1,t2) as u) id gls =
+  let sort = pf_apply get_type_of gls (pf_concl gls) in 
   let sigma = project gls in
   let env = pf_env gls in 
-  (match find_positions env sigma t1 t2 with
-     | Inl (cpath, (_,dirn), _) ->
-	 let e = pf_get_new_id (id_of_string "e") gls in
-	 let e_env = push_named (e,None,t) env in
-	 let discriminator =
-	   build_discriminator sigma e_env dirn (mkVar e) sort cpath in
-	 let (pf, absurd_term) =
-	   discrimination_pf e (t,t1,t2) discriminator lbeq gls in
-	 tclCOMPLETE
-	   ((tclTHENS (cut_intro absurd_term)
-	       ([onLastHyp gen_absurdity;
-		 refine (mkApp (pf, [| mkVar id |]))]))) gls
-     | Inr [] -> (* Change: do not fail, simplify clear this trivial hyp *)
-         ntac 0 gls
-     | Inr posns ->
-	 (let e = pf_get_new_id (id_of_string "e") gls in
-	  let e_env = push_named (e,None,t) env in
-	  let injectors =
-	    map_succeed
-	      (fun (cpath,t1_0,t2_0) ->
-		 let (injbody,resty) =
-                  (* take arbitrarily t1_0 as the injector default value *)
-		   build_injector sigma e_env t1_0 (mkVar e) cpath in
-		 let injfun = mkNamedLambda e t injbody in
-		 try 
-		   let _ = type_of env sigma injfun in (injfun,resty)
-		 with e when catchable_exception e -> failwith "caught")
-	      posns 
-	  in
-	  if injectors = [] then
-	    errorlabstrm "Equality.decompEqThen" 
-              (str "Discriminate failed to decompose the equality");
-	  (tclTHEN
-	      (tclMAP (fun (injfun,resty) ->
-			 let pf = applist(lbeq.congr,
-					  [t;resty;injfun;t1;t2;
-					   mkVar id]) in
-			 let ty = pf_nf gls (pf_type_of gls pf) in
-			 ((tclTHENS (cut ty) 
-			     ([tclIDTAC;refine pf]))))
-		 (List.rev injectors))
-	      (ntac (List.length injectors)))
-	  gls))
+  match find_positions env sigma t1 t2 with
+    | Inl (cpath, (_,dirn), _) ->
+	discr_positions env sigma u id cpath dirn sort gls
+    | Inr [] -> (* Change: do not fail, simplify clear this trivial hyp *)
+        ntac 0 gls
+    | Inr posns ->
+	tclTHEN
+	  (inject_at_positions env sigma (lbeq,(t,t1,t2)) id (List.rev posns))
+	  (ntac (List.length posns))
+	  gls
 
 let dEqThen ntac = function
   | None -> onNegatedEquality (decompEqThen ntac)
@@ -903,7 +869,7 @@ let find_elim sort_of_gl lbeq =
 
 let bareRevSubstInConcl lbeq body (t,e1,e2) gls =
   (* find substitution scheme *)
-  let eq_elim = find_elim (pf_type_of gls (pf_concl gls)) lbeq in
+  let eq_elim = find_elim (pf_apply get_type_of gls (pf_concl gls)) lbeq in
   (* build substitution predicate *)
   let p = lambda_create (pf_env gls) (t,body) in
   (* apply substitution scheme *)
@@ -1013,7 +979,7 @@ let cutRewriteInHyp l2r eqn id = cutRewriteClause l2r eqn (Some id)
 let cutRewriteInConcl l2r eqn = cutRewriteClause l2r eqn None
 
 let substClause l2r c cls gls =
-  let eq = pf_type_of gls c in
+  let eq = pf_apply get_type_of gls c in
   tclTHENS (cutSubstClause l2r eq cls) [tclIDTAC; exact_no_check c] gls
 
 let rewriteClause l2r c cls = try_rewrite (substClause l2r c cls)
@@ -1147,28 +1113,10 @@ let subst_all gl =
   let ids = list_uniquize ids in
   subst ids gl
 
+
 (* Rewrite the first assumption for which the condition faildir does not fail 
    and gives the direction of the rewrite *)
 
-let rewrite_assumption_cond faildir gl =
-   let rec arec = function
-      | [] -> error "No such assumption"
-      | (id,_,t)::rest -> 
-	  (try let dir = faildir t gl in 
-	       general_rewrite dir (mkVar id) gl
-	   with Failure _ | UserError _  ->  arec rest)
-   in arec (pf_hyps gl)
-
-
-let rewrite_assumption_cond_in faildir hyp gl =
-   let rec arec = function
-      | [] -> error "No such assumption"
-      | (id,_,t)::rest -> 
-	  (try let dir = faildir t gl in 
-	       general_rewrite_in dir hyp (mkVar id) gl
-	   with Failure _ | UserError _ ->  arec rest)
-   in arec (pf_hyps gl)
-
 let cond_eq_term_left c t gl =
   try
     let (_,x,_) = snd (find_eq_data_decompose t) in
@@ -1189,6 +1137,48 @@ let cond_eq_term c t gl =
     else failwith "not convertible"
   with PatternMatchingFailure -> failwith "not an equality"
 
+let rewrite_mutli_assumption_cond cond_eq_term cl gl = 
+  let rec arec = function 
+    | [] -> error "No such assumption"
+    | (id,_,t) ::rest -> 
+	begin 
+	  try 
+	    let dir = cond_eq_term t gl in 
+	    general_multi_rewrite dir (mkVar id,NoBindings) cl gl
+	  with | Failure _ | UserError _ -> arec rest
+	end
+  in 
+  arec (pf_hyps gl)
+
+let replace_multi_term dir_opt c  = 
+  let cond_eq_fun = 
+    match dir_opt with 
+      | None -> cond_eq_term c
+      | Some true -> cond_eq_term_left c
+      | Some false -> cond_eq_term_right c
+  in 
+  rewrite_mutli_assumption_cond cond_eq_fun 
+
+(* JF. old version 
+let rewrite_assumption_cond faildir gl =
+   let rec arec = function
+      | [] -> error "No such assumption"
+      | (id,_,t)::rest ->
+	  (try let dir = faildir t gl in
+	       general_rewrite dir (mkVar id) gl
+	   with Failure _ | UserError _  ->  arec rest)
+   in arec (pf_hyps gl)
+
+
+let rewrite_assumption_cond_in faildir hyp gl =
+   let rec arec = function
+      | [] -> error "No such assumption"
+      | (id,_,t)::rest ->
+	  (try let dir = faildir t gl in
+	       general_rewrite_in dir hyp (mkVar id) gl
+	   with Failure _ | UserError _ ->  arec rest)
+   in arec (pf_hyps gl)
+
 let replace_term_left t = rewrite_assumption_cond (cond_eq_term_left t)
 
 let replace_term_right t = rewrite_assumption_cond (cond_eq_term_right t)
@@ -1200,6 +1190,27 @@ let replace_term_in_left t = rewrite_assumption_cond_in (cond_eq_term_left t)
 let replace_term_in_right t = rewrite_assumption_cond_in (cond_eq_term_right t)
    
 let replace_term_in t = rewrite_assumption_cond_in (cond_eq_term t)
+*)
+
+let replace_term_left t = replace_multi_term (Some true) t Tacticals.onConcl
+
+let replace_term_right t = replace_multi_term (Some false) t Tacticals.onConcl
+
+let replace_term t = replace_multi_term None t Tacticals.onConcl
+
+let replace_term_in_left t hyp = replace_multi_term (Some true) t (Tacticals.onHyp hyp)
+
+let replace_term_in_right t hyp = replace_multi_term (Some false) t (Tacticals.onHyp hyp)
+
+let replace_term_in t hyp = replace_multi_term None t (Tacticals.onHyp hyp)
+
+
+
+
+
+
+
+
 
-let _ = Setoid_replace.register_replace replace
+let _ = Setoid_replace.register_replace (fun tac_opt c2 c1 gl ->  replace_in_clause_maybe_by c2 c1 onConcl tac_opt gl)
 let _ = Setoid_replace.register_general_rewrite general_rewrite
diff --git a/tactics/equality.mli b/tactics/equality.mli
index 9ee565c5..3d6a08b6 100644
--- a/tactics/equality.mli
+++ b/tactics/equality.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: equality.mli 8780 2006-05-02 21:58:58Z letouzey $ i*)
+(*i $Id: equality.mli 9195 2006-10-01 09:41:57Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -22,6 +22,7 @@ open Tacticals
 open Tactics
 open Tacexpr
 open Rawterm
+open Genarg
 (*i*)
 
 val general_rewrite_bindings : bool -> constr with_bindings -> tactic
@@ -50,19 +51,21 @@ val conditional_rewrite : bool -> tactic -> constr with_bindings -> tactic
 val conditional_rewrite_in :
   bool -> identifier -> tactic -> constr with_bindings -> tactic
 
+val replace_in_clause_maybe_by : constr -> constr -> clause -> tactic option -> tactic
 val replace    : constr -> constr -> tactic
 val replace_in : identifier -> constr -> constr -> tactic
-val replace_by : constr -> constr -> tactic -> tactic 
-val replace_in_by : identifier -> constr -> constr -> tactic -> tactic 
-val new_replace : constr -> constr -> identifier option -> tactic option -> tactic
+val replace_by : constr -> constr -> tactic -> tactic
+val replace_in_by : identifier -> constr -> constr -> tactic -> tactic
+
 val discr        : identifier -> tactic
 val discrConcl   : tactic
 val discrClause  : clause -> tactic
 val discrHyp     : identifier -> tactic
 val discrEverywhere     : tactic
 val discr_tac    : quantified_hypothesis option -> tactic
-val inj          : identifier -> tactic
-val injClause    : quantified_hypothesis option -> tactic
+val inj          : intro_pattern_expr list -> identifier -> tactic
+val injClause    : intro_pattern_expr list -> quantified_hypothesis option ->
+                   tactic
 
 val dEq : quantified_hypothesis option -> tactic
 val dEqThen : (int -> tactic) -> quantified_hypothesis option -> tactic
@@ -111,9 +114,8 @@ val subst : identifier list -> tactic
 val subst_all : tactic
 
 (* Replace term *)
-val replace_term_left : constr -> tactic
-val replace_term_right : constr -> tactic
-val replace_term : constr -> tactic
-val replace_term_in_left : constr -> identifier -> tactic
-val replace_term_in_right : constr -> identifier -> tactic
-val replace_term_in : constr -> identifier -> tactic
+(* [replace_multi_term dir_opt c cl] 
+   perfoms replacement of [c] by the first value found in context
+   (according to [dir] if given to get the rewrite direction)  in the clause [cl]
+*)
+val replace_multi_term : bool option -> constr -> clause -> tactic
diff --git a/tactics/evar_tactics.ml b/tactics/evar_tactics.ml
index 31c060f1..ed40af1c 100644
--- a/tactics/evar_tactics.ml
+++ b/tactics/evar_tactics.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: evar_tactics.ml 8759 2006-04-28 12:24:14Z herbelin $ *)
+(* $Id: evar_tactics.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Term
 open Util
@@ -51,7 +51,7 @@ let instantiate n rawc ido gl =
       error "not enough uninstantiated existential variables";
     if n <= 0 then error "incorrect existential variable index";
     let ev,_ =  destEvar (List.nth evl (n-1)) in
-    let evd' = w_refine (pf_env gl) ev rawc (create_evar_defs sigma)  in
+    let evd' = w_refine ev rawc (create_evar_defs sigma)  in
     Refiner.tclEVARS (evars_of evd') gl
 	
 (*
diff --git a/tactics/extraargs.ml4 b/tactics/extraargs.ml4
index 5a0b4b8c..3c7d76b2 100644
--- a/tactics/extraargs.ml4
+++ b/tactics/extraargs.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: extraargs.ml4 8739 2006-04-26 22:23:37Z herbelin $ *)
+(* $Id: extraargs.ml4 9076 2006-08-23 15:05:54Z jforest $ *)
 
 open Pp
 open Pcoq
@@ -124,3 +124,115 @@ ARGUMENT EXTEND hloc
    
  END
 
+
+
+
+
+
+
+(* Julien: Mise en commun des differentes version de replace with in by *)
+
+let pr_by_arg_tac _prc _prlc prtac opt_c = 
+  match opt_c with 
+    | None -> mt ()
+    | Some t -> spc () ++ hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t)
+
+ARGUMENT EXTEND by_arg_tac
+  TYPED AS tactic_opt
+  PRINTED BY pr_by_arg_tac
+| [ "by" tactic3(c) ] -> [ Some c ]
+| [ ] -> [ None ]
+END
+ 
+
+let pr_in_hyp  pr_id (lo,concl) :  Pp.std_ppcmds = 
+  match lo,concl with 
+    | Some [],true -> mt ()
+    | None,true -> str "in" ++ spc () ++ str "*"
+    | None,false -> str "in" ++ spc () ++ str "*" ++ spc () ++ str "|-" 
+    | Some l,_ -> 
+	str "in" ++ spc () ++ 
+	  Util.prlist_with_sep spc pr_id l ++ 
+	  match concl with 
+	    | true -> spc () ++ str "|-" ++ spc () ++ str "*"
+	    | _ -> mt ()
+
+
+let pr_in_arg_hyp _ _ _ = pr_in_hyp (fun (_,id) -> Ppconstr.pr_id id)
+
+let pr_in_arg_hyp_typed  _ _  _  = pr_in_hyp Ppconstr.pr_id 
+
+
+let pr_var_list_gen pr_id = Util.prlist_with_sep (fun () -> str ",") pr_id 
+
+let pr_var_list_typed _ _ _ =  pr_var_list_gen Ppconstr.pr_id 
+
+let pr_var_list _ _ _ = pr_var_list_gen (fun (_,id) -> Ppconstr.pr_id id)
+
+
+ARGUMENT EXTEND comma_var_lne 
+  TYPED AS var list 
+  PRINTED BY pr_var_list_typed
+  RAW_TYPED AS var list 
+  RAW_PRINTED BY pr_var_list
+  GLOB_TYPED AS var list
+  GLOB_PRINTED BY pr_var_list
+| [ var(x) ] -> [ [x] ]
+| [ var(x) "," comma_var_lne(l) ] -> [x::l]
+END
+
+ARGUMENT EXTEND comma_var_l 
+  TYPED AS var list 
+  PRINTED BY pr_var_list_typed
+  RAW_TYPED AS var list 
+  RAW_PRINTED BY pr_var_list
+  GLOB_TYPED AS var list
+  GLOB_PRINTED BY pr_var_list
+| [  comma_var_lne(l) ] -> [l]
+| [] -> [ [] ]
+END
+
+let pr_in_concl _ _ _ = function true -> str "|- " ++ spc () ++ str "*" | _ -> str "|-" 
+
+ARGUMENT EXTEND inconcl  
+  TYPED AS bool 
+  PRINTED BY pr_in_concl
+| [ "|-" "*" ] -> [ true ]
+| [ "|-" ] -> [ false ]
+END
+
+
+
+ARGUMENT EXTEND in_arg_hyp
+  TYPED AS var list option * bool
+  PRINTED BY pr_in_arg_hyp_typed
+  RAW_TYPED AS var list option * bool 
+  RAW_PRINTED BY pr_in_arg_hyp
+  GLOB_TYPED AS var list option * bool
+  GLOB_PRINTED BY pr_in_arg_hyp
+| [ "in" "*" ] -> [(None,true)]
+| [ "in" "*" inconcl_opt(b) ] -> [let onconcl = match b with Some b -> b | None -> true in (None,onconcl)]
+| [ "in" comma_var_l(l) inconcl_opt(b) ] -> [ let onconcl = match b with Some b -> b | None -> false in 
+					      Some l, onconcl
+					   ]
+| [ ] -> [ (Some [],true) ]
+END
+
+
+let gen_in_arg_hyp_to_clause trad_id (hyps ,concl) : Tacticals.clause = 
+  {Tacexpr.onhyps=
+   Util.option_map 
+     (fun l -> 
+	List.map 
+	  (fun id -> ( ([],trad_id id) ,Tacexpr.InHyp))
+	  l
+     )
+     hyps;
+   Tacexpr.onconcl=concl;
+   Tacexpr.concl_occs = []}
+
+
+let raw_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause snd 
+let glob_in_arg_hyp_to_clause = gen_in_arg_hyp_to_clause (fun x -> x) 
+
+
diff --git a/tactics/extraargs.mli b/tactics/extraargs.mli
index 004fef02..4a9a0c5f 100644
--- a/tactics/extraargs.mli
+++ b/tactics/extraargs.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extraargs.mli 6621 2005-01-21 17:24:37Z herbelin $ i*)
+(*i $Id: extraargs.mli 9076 2006-08-23 15:05:54Z jforest $ i*)
 
 open Tacexpr
 open Term
@@ -39,3 +39,14 @@ val rawwit_hloc : loc_place raw_abstract_argument_type
 val wit_hloc : place closed_abstract_argument_type
 val hloc : loc_place Pcoq.Gram.Entry.e
 
+
+val in_arg_hyp:  (Names.identifier Util.located list option * bool)  Pcoq.Gram.Entry.e
+val rawwit_in_arg_hyp : (Names.identifier Util.located list option * bool) raw_abstract_argument_type
+val wit_in_arg_hyp : (Names.identifier list option * bool) closed_abstract_argument_type
+val raw_in_arg_hyp_to_clause : (Names.identifier Util.located list option * bool) -> Tacticals.clause
+val glob_in_arg_hyp_to_clause :  (Names.identifier list option * bool)  -> Tacticals.clause
+
+
+val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.Entry.e
+val rawwit_by_arg_tac :  raw_tactic_expr option raw_abstract_argument_type
+val wit_by_arg_tac : glob_tactic_expr option closed_abstract_argument_type
diff --git a/tactics/extratactics.ml4 b/tactics/extratactics.ml4
index c2820c44..a8204665 100644
--- a/tactics/extratactics.ml4
+++ b/tactics/extratactics.ml4
@@ -8,7 +8,7 @@
 
 (*i camlp4deps: "parsing/grammar.cma" i*)
 
-(* $Id: extratactics.ml4 8979 2006-06-23 10:17:14Z herbelin $ *)
+(* $Id: extratactics.ml4 9266 2006-10-24 09:03:15Z herbelin $ *)
 
 open Pp
 open Pcoq
@@ -20,116 +20,25 @@ open Names
 (* Equality *)
 open Equality
 
-(* Pierre L: for an easy implementation of "rewrite ... in <clause>", rewrite
-  has moved to g_tactics.ml4
-
-TACTIC EXTEND rewrite
-| [ "rewrite" orient(b) constr_with_bindings(c) ] ->
-    [general_rewrite_bindings b c]
-END
-
-TACTIC EXTEND rewrite_in
-| [ "rewrite" orient(b) constr_with_bindings(c) "in" hyp(h) ] ->
-    [general_rewrite_bindings_in b h c]
-END
-
-let h_rewriteLR x = h_rewrite true (x,Rawterm.NoBindings) 
-*)
-
-(* Julien: Mise en commun des differentes version de replace with in by 
-   TODO: deplacer dans extraargs
-
-*)
-
-let pr_by_arg_tac _prc _prlc prtac opt_c = 
-  match opt_c with 
-    | None -> mt ()
-    | Some t -> spc () ++ hov 2 (str "by" ++ spc () ++ prtac (3,Ppextend.E) t)
-
-let pr_in_hyp = function
-  | None -> mt ()
-  | Some id -> spc () ++ hov 2 (str "in" ++ spc () ++ Nameops.pr_id id)
-
-let pr_in_arg_hyp _prc _prlc _prtac opt_c =
-  pr_in_hyp (Util.option_map snd opt_c)
-
-let pr_in_arg_hyp_typed _prc _prlc _prtac =
-  pr_in_hyp
-
-ARGUMENT EXTEND by_arg_tac
-  TYPED AS tactic_opt
-  PRINTED BY pr_by_arg_tac
-| [ "by" tactic3(c) ] -> [ Some c ]
-| [ ] -> [ None ]
-END
- 
-ARGUMENT EXTEND in_arg_hyp
-  TYPED AS var_opt
-  PRINTED BY pr_in_arg_hyp_typed
-  RAW_TYPED AS var_opt
-  RAW_PRINTED BY pr_in_arg_hyp
-  GLOB_TYPED AS var_opt
-  GLOB_PRINTED BY pr_in_arg_hyp
-| [ "in" hyp(c) ] -> [ Some (c) ]
-| [ ] -> [ None ]
-END
 
 TACTIC EXTEND replace 
    ["replace" constr(c1) "with" constr(c2) in_arg_hyp(in_hyp) by_arg_tac(tac) ]
--> [ new_replace c1 c2 in_hyp (Util.option_map Tacinterp.eval_tactic tac) ]
-END
-
-(* Julien:
-  old version  
-
-TACTIC EXTEND replace
-| [ "replace" constr(c1) "with" constr(c2) ] ->
-    [ replace c1 c2 ]
-END
-
-TACTIC EXTEND replace_by
-|  [ "replace" constr(c1) "with" constr(c2) "by" tactic(tac) ] ->
-    [ replace_by c1 c2 (snd tac)  ]
- 
-END
-
-TACTIC EXTEND replace_in
-| [ "replace" constr(c1) "with" constr(c2) "in" hyp(h) ] ->
-    [ replace_in h c1 c2 ]
-END
-
-TACTIC EXTEND replace_in_by
-| [ "replace" constr(c1) "with" constr(c2) "in" hyp(h) "by" tactic(tac) ] ->
-    [ replace_in_by h c1 c2 (snd tac) ]
+-> [ replace_in_clause_maybe_by c1 c2 (glob_in_arg_hyp_to_clause in_hyp) (Util.option_map Tacinterp.eval_tactic tac) ]
 END
 
-*)
-
 TACTIC EXTEND replace_term_left
-  [ "replace" "->" constr(c)  ] -> [ replace_term_left c ]
+  [ "replace"  "->" constr(c) in_arg_hyp(in_hyp) ]
+  -> [ replace_multi_term (Some true) c (glob_in_arg_hyp_to_clause in_hyp)]
 END
 
 TACTIC EXTEND replace_term_right
-  [ "replace" "<-" constr(c)  ] -> [ replace_term_right c ]
+  [ "replace"  "<-" constr(c) in_arg_hyp(in_hyp) ]
+  -> [replace_multi_term (Some false) c (glob_in_arg_hyp_to_clause in_hyp)]
 END
 
 TACTIC EXTEND replace_term
-  [ "replace" constr(c)  ] -> [ replace_term c ]
-END
-
-TACTIC EXTEND replace_term_in_left
-  [ "replace"  "->" constr(c) "in" hyp(h) ]
-  -> [ replace_term_in_left c h ]
-END
-
-TACTIC EXTEND replace_term_in_right
-  [ "replace"  "<-" constr(c) "in" hyp(h) ]
-  -> [ replace_term_in_right c h ]
-END
-
-TACTIC EXTEND replace_term_in
-  [ "replace" constr(c) "in" hyp(h) ]
-  -> [ replace_term_in c h ]
+  [ "replace" constr(c) in_arg_hyp(in_hyp) ]
+  -> [ replace_multi_term None c (glob_in_arg_hyp_to_clause in_hyp) ]
 END
 
 TACTIC EXTEND simplify_eq
@@ -143,7 +52,11 @@ END
 let h_discrHyp id = h_discriminate (Some id)
 
 TACTIC EXTEND injection
-  [ "injection" quantified_hypothesis_opt(h) ] -> [ injClause h ]
+  [ "injection" quantified_hypothesis_opt(h) ] -> [ injClause [] h ]
+END 
+TACTIC EXTEND injection_as
+  [ "injection" quantified_hypothesis_opt(h) 
+    "as" simple_intropattern_list(ipat)] -> [ injClause ipat h ]
 END
 
 let h_injHyp id = h_injection (Some id)
@@ -182,7 +95,7 @@ END
 (* AutoRewrite *)
 
 open Autorewrite
-
+(* J.F : old version 
 TACTIC EXTEND autorewrite
   [ "autorewrite" "with" ne_preident_list(l) ] ->
     [ autorewrite Refiner.tclIDTAC l ]
@@ -193,6 +106,21 @@ TACTIC EXTEND autorewrite
 | [ "autorewrite" "with" ne_preident_list(l) "in" hyp(id) "using" tactic(t) ] ->
     [ autorewrite_in id (snd t) l ]
 END
+*)
+
+TACTIC EXTEND autorewrite
+| [ "autorewrite" "with" ne_preident_list(l) in_arg_hyp(cl) ] ->
+    [ auto_multi_rewrite  l (glob_in_arg_hyp_to_clause  cl) ]
+| [ "autorewrite" "with" ne_preident_list(l) in_arg_hyp(cl) "using" tactic(t) ] ->
+    [ 
+      let cl =  glob_in_arg_hyp_to_clause cl in 
+      auto_multi_rewrite_with (snd t) l cl
+
+    ]
+END
+
+
+
 
 let add_rewrite_hint name ort t lcsr =
   let env = Global.env() and sigma = Evd.empty in
@@ -223,22 +151,22 @@ let refine_tac = h_refine
 open Setoid_replace
 
 TACTIC EXTEND setoid_replace
-   [ "setoid_replace" constr(c1) "with" constr(c2) ] ->
-     [ setoid_replace None c1 c2 ~new_goals:[] ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "using" "relation" constr(rel)] ->
-     [ setoid_replace (Some rel) c1 c2 ~new_goals:[] ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "generate" "side" "conditions" constr_list(l) ] ->
-     [ setoid_replace None c1 c2 ~new_goals:l ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "using" "relation" constr(rel) "generate" "side" "conditions" constr_list(l) ] ->
-     [ setoid_replace (Some rel) c1 c2 ~new_goals:l ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) ] ->
-     [ setoid_replace_in h None c1 c2 ~new_goals:[] ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "using" "relation" constr(rel)] ->
-     [ setoid_replace_in h (Some rel) c1 c2 ~new_goals:[] ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "generate" "side" "conditions" constr_list(l) ] ->
-     [ setoid_replace_in h None c1 c2 ~new_goals:l ]
- | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "using" "relation" constr(rel) "generate" "side" "conditions" constr_list(l) ] ->
-     [ setoid_replace_in h (Some rel) c1 c2 ~new_goals:l ]
+   [ "setoid_replace" constr(c1) "with" constr(c2) by_arg_tac(tac)] ->
+     [ setoid_replace  (Util.option_map Tacinterp.eval_tactic tac) None c1 c2 ~new_goals:[] ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "using" "relation" constr(rel) by_arg_tac(tac)] ->
+     [ setoid_replace  (Util.option_map Tacinterp.eval_tactic tac) (Some rel) c1 c2 ~new_goals:[] ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "generate" "side" "conditions" constr_list(l) by_arg_tac(tac) ] ->
+     [ setoid_replace  (Util.option_map Tacinterp.eval_tactic tac) None c1 c2 ~new_goals:l ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "using" "relation" constr(rel) "generate" "side" "conditions" constr_list(l) by_arg_tac(tac) ] ->
+     [ setoid_replace  (Util.option_map Tacinterp.eval_tactic tac) (Some rel) c1 c2 ~new_goals:l ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) by_arg_tac(tac) ] ->
+     [ setoid_replace_in  (Util.option_map Tacinterp.eval_tactic tac) h None c1 c2 ~new_goals:[] ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "using" "relation" constr(rel) by_arg_tac(tac)] ->
+     [ setoid_replace_in  (Util.option_map Tacinterp.eval_tactic tac) h (Some rel) c1 c2 ~new_goals:[] ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "generate" "side" "conditions" constr_list(l) by_arg_tac(tac)] ->
+     [ setoid_replace_in  (Util.option_map Tacinterp.eval_tactic tac) h None c1 c2 ~new_goals:l ]
+ | [ "setoid_replace" constr(c1) "with" constr(c2) "in" hyp(h) "using" "relation" constr(rel) "generate" "side" "conditions" constr_list(l) by_arg_tac(tac)] ->
+     [ setoid_replace_in  (Util.option_map Tacinterp.eval_tactic tac) h (Some rel) c1 c2 ~new_goals:l ]
 END
 
 TACTIC EXTEND setoid_rewrite
@@ -471,3 +399,9 @@ VERNAC COMMAND EXTEND ImplicitTactic
 | [ "Declare" "Implicit" "Tactic" tactic(tac) ] ->
     [ Tacinterp.declare_implicit_tactic (Tacinterp.interp tac) ]
 END
+
+TACTIC EXTEND apply_in
+| ["apply" constr_with_bindings(c) "in" hyp(id) ] -> [ apply_in id [c] ]
+| ["apply" constr_with_bindings(c) "," constr_with_bindings_list_sep(cl,",") 
+   "in" hyp(id) ] -> [ apply_in id (c::cl) ]
+END
diff --git a/tactics/extratactics.mli b/tactics/extratactics.mli
index 91766254..234c0161 100644
--- a/tactics/extratactics.mli
+++ b/tactics/extratactics.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: extratactics.mli 8977 2006-06-23 10:09:59Z herbelin $ i*)
+(*i $Id: extratactics.mli 9073 2006-08-22 08:54:29Z jforest $ i*)
 
 open Util
 open Names
@@ -22,21 +22,3 @@ val h_injHyp : quantified_hypothesis -> tactic
 
 val refine_tac : Genarg.open_constr -> tactic
 
-
-
-(* Julien: Mise en commun des differentes version de replace with in by 
-   TODO:  deplacer dans extraargs
-
-*)
-
-
-val rawwit_in_arg_hyp: identifier located option raw_abstract_argument_type
-
-val in_arg_hyp: identifier located option Pcoq.Gram.Entry.e
-
-
-
-val rawwit_by_arg_tac :
-  (raw_tactic_expr option, constr_expr, raw_tactic_expr) abstract_argument_type
-  
-val by_arg_tac : Tacexpr.raw_tactic_expr option Pcoq.Gram.Entry.e
diff --git a/tactics/leminv.ml b/tactics/leminv.ml
index 7974ce56..9507ce5f 100644
--- a/tactics/leminv.ml
+++ b/tactics/leminv.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: leminv.ml 7837 2006-01-11 09:47:32Z herbelin $ *)
+(* $Id: leminv.ml 9154 2006-09-20 17:18:18Z corbinea $ *)
 
 open Pp
 open Util
@@ -217,7 +217,7 @@ let inversion_scheme env sigma t sort dep_option inv_op =
     (str"Computed inversion goal was not closed in initial signature");
   *)
   let invSign = named_context_val invEnv in
-  let pfs = mk_pftreestate (mk_goal invSign invGoal) in
+  let pfs = mk_pftreestate (mk_goal invSign invGoal None) in
   let pfs = solve_pftreestate (tclTHEN intro (onLastHyp inv_op)) pfs in
   let (pfterm,meta_types) = extract_open_pftreestate pfs in
   let global_named_context = Global.named_context () in
diff --git a/tactics/setoid_replace.ml b/tactics/setoid_replace.ml
index 8c8d4d37..2727e669 100644
--- a/tactics/setoid_replace.ml
+++ b/tactics/setoid_replace.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: setoid_replace.ml 8900 2006-06-06 14:40:27Z letouzey $ *)
+(* $Id: setoid_replace.ml 9331 2006-11-01 09:36:06Z herbelin $ *)
 
 open Tacmach
 open Proof_type
@@ -33,7 +33,7 @@ open Decl_kinds
 open Constrintern
 open Mod_subst
 
-let replace = ref (fun _ _ -> assert false)
+let replace = ref (fun _ _ _ -> assert false)
 let register_replace f = replace := f
 
 let general_rewrite = ref (fun _ _ -> assert false)
@@ -155,7 +155,7 @@ let coq_MSCovariant = lazy(constant ["Setoid"] "MSCovariant")
 let coq_MSContravariant = lazy(constant ["Setoid"] "MSContravariant")
 
 let coq_singl = lazy(constant ["Setoid"] "singl")
-let coq_cons = lazy(constant ["Setoid"] "cons")
+let coq_cons = lazy(constant ["Setoid"] "necons")
 
 let coq_equality_morphism_of_asymmetric_areflexive_transitive_relation =
  lazy(constant ["Setoid"]
@@ -805,135 +805,140 @@ let new_morphism m signature id hook =
   let typeofm = Typing.type_of env Evd.empty m in
   let typ = clos_norm_flags Closure.betaiotazeta empty_env Evd.empty typeofm in
   let argsrev, output =
-   match signature with
-      None -> decompose_prod typ
-    | Some (_,output') ->
-       (* the carrier of the relation output' can be a Prod ==>
-          we must uncurry on the fly output.
-          E.g: A -> B -> C vs        A -> (B -> C)
-                args   output     args     output
-       *)
-       let rel = find_relation_class output' in
-       let rel_a,rel_quantifiers_no =
-        match rel with
-           Relation rel -> rel.rel_a, rel.rel_quantifiers_no
-         | Leibniz (Some t) -> t, 0
-         | Leibniz None -> assert false in
-       let rel_a_n =
-        clos_norm_flags Closure.betaiotazeta empty_env Evd.empty rel_a in
-       try
-        let _,output_rel_a_n = decompose_lam_n rel_quantifiers_no rel_a_n in
-        let argsrev,_ = decompose_prod output_rel_a_n in
-        let n = List.length argsrev in
-        let argsrev',_ = decompose_prod typ in
-        let m = List.length argsrev' in
-         decompose_prod_n (m - n) typ
-       with UserError(_,_) ->
-        (* decompose_lam_n failed. This may happen when rel_a is an axiom,
-           a constructor, an inductive type, etc. *)
-        decompose_prod typ
+    match signature with
+	None -> decompose_prod typ
+      | Some (_,output') ->
+	  (* the carrier of the relation output' can be a Prod ==>
+             we must uncurry on the fly output.
+             E.g: A -> B -> C vs        A -> (B -> C)
+             args   output     args     output
+	  *)
+	  let rel = 
+	    try find_relation_class output' 
+	    with Not_found -> errorlabstrm "Add Morphism"
+	      (str "Not a valid signature: " ++ pr_lconstr output' ++
+		  str " is neither a registered relation nor the Leibniz " ++
+		  str " equality.") in
+	  let rel_a,rel_quantifiers_no =
+            match rel with
+		Relation rel -> rel.rel_a, rel.rel_quantifiers_no
+              | Leibniz (Some t) -> t, 0
+              | Leibniz None -> assert false in
+	  let rel_a_n =
+            clos_norm_flags Closure.betaiotazeta empty_env Evd.empty rel_a in
+	    try
+              let _,output_rel_a_n = decompose_lam_n rel_quantifiers_no rel_a_n in
+              let argsrev,_ = decompose_prod output_rel_a_n in
+              let n = List.length argsrev in
+              let argsrev',_ = decompose_prod typ in
+              let m = List.length argsrev' in
+		decompose_prod_n (m - n) typ
+	    with UserError(_,_) ->
+              (* decompose_lam_n failed. This may happen when rel_a is an axiom,
+		 a constructor, an inductive type, etc. *)
+              decompose_prod typ
   in
   let args_ty = List.rev argsrev in
   let args_ty_len = List.length (args_ty) in
   let args_ty_quantifiers_rev,args,args_instance,output,output_instance =
-   match signature with
-      None ->
-       if args_ty = [] then
-        errorlabstrm "New Morphism"
-         (str "The term " ++ pr_lconstr m ++ str " has type " ++
-          pr_lconstr typeofm ++ str " that is not a product.") ;
-       ignore (check_is_dependent 0 args_ty output) ;
-       let args =
-        List.map
-         (fun (_,ty) -> None,default_relation_for_carrier ty) args_ty in
-       let output = default_relation_for_carrier output in
-        [],args,args,output,output
-    | Some (args,output') ->
-       assert (args <> []);
-       let number_of_arguments = List.length args in
-       let number_of_quantifiers = args_ty_len - number_of_arguments in
-       if number_of_quantifiers < 0 then
-        errorlabstrm "New Morphism"
-         (str "The morphism " ++ pr_lconstr m ++ str " has type " ++
-          pr_lconstr typeofm ++ str " that attends at most " ++ int args_ty_len ++
-          str " arguments. The signature that you specified requires " ++
-          int number_of_arguments ++ str " arguments.")
-       else
-        begin
-         (* the real_args_ty returned are already delifted *)
-         let args_ty_quantifiers_rev, real_args_ty, real_output =
-          check_is_dependent number_of_quantifiers args_ty output in
-         let quantifiers_rel_context =
-          List.map (fun (n,t) -> n,None,t) args_ty_quantifiers_rev in
-         let env = push_rel_context quantifiers_rel_context env in
-         let find_relation_class t real_t =
-          try
-           let rel = find_relation_class t in
-            rel, unify_relation_class_carrier_with_type env rel real_t
-          with Not_found ->
-           errorlabstrm "Add Morphism"
-            (str "Not a valid signature: " ++ pr_lconstr t ++
-             str " is neither a registered relation nor the Leibniz " ++
-             str " equality.")
-         in
-         let find_relation_class_v (variance,t) real_t =
-          let relation,relation_instance = find_relation_class t real_t in
-           match relation, variance with
-              Leibniz _, None
-            | Relation {rel_sym = Some _}, None
-            | Relation {rel_sym = None}, Some _ ->
-               (variance, relation), (variance, relation_instance)
-            | Relation {rel_sym = None},None ->
-               errorlabstrm "Add Morphism"
-                (str "You must specify the variance in each argument " ++
-                 str "whose relation is asymmetric.")
-            | Leibniz _, Some _
-            | Relation {rel_sym = Some _}, Some _ ->
-               errorlabstrm "Add Morphism"
-                (str "You cannot specify the variance of an argument " ++
-                 str "whose relation is symmetric.")
-         in
-          let args, args_instance =
-           List.split
-            (List.map2 find_relation_class_v args real_args_ty) in
-          let output,output_instance= find_relation_class output' real_output in
-           args_ty_quantifiers_rev, args, args_instance, output, output_instance
-        end
+    match signature with
+	None ->
+	  if args_ty = [] then
+            errorlabstrm "New Morphism"
+              (str "The term " ++ pr_lconstr m ++ str " has type " ++
+		  pr_lconstr typeofm ++ str " that is not a product.") ;
+	  ignore (check_is_dependent 0 args_ty output) ;
+	  let args =
+            List.map
+              (fun (_,ty) -> None,default_relation_for_carrier ty) args_ty in
+	  let output = default_relation_for_carrier output in
+            [],args,args,output,output
+      | Some (args,output') ->
+	  assert (args <> []);
+	  let number_of_arguments = List.length args in
+	  let number_of_quantifiers = args_ty_len - number_of_arguments in
+	    if number_of_quantifiers < 0 then
+              errorlabstrm "New Morphism"
+		(str "The morphism " ++ pr_lconstr m ++ str " has type " ++
+		    pr_lconstr typeofm ++ str " that attends at most " ++ int args_ty_len ++
+		    str " arguments. The signature that you specified requires " ++
+		    int number_of_arguments ++ str " arguments.")
+	    else
+              begin
+		(* the real_args_ty returned are already delifted *)
+		let args_ty_quantifiers_rev, real_args_ty, real_output =
+		  check_is_dependent number_of_quantifiers args_ty output in
+		let quantifiers_rel_context =
+		  List.map (fun (n,t) -> n,None,t) args_ty_quantifiers_rev in
+		let env = push_rel_context quantifiers_rel_context env in
+		let find_relation_class t real_t =
+		  try
+		    let rel = find_relation_class t in
+		      rel, unify_relation_class_carrier_with_type env rel real_t
+		  with Not_found ->
+		    errorlabstrm "Add Morphism"
+		      (str "Not a valid signature: " ++ pr_lconstr t ++
+			  str " is neither a registered relation nor the Leibniz " ++
+			  str " equality.")
+		in
+		let find_relation_class_v (variance,t) real_t =
+		  let relation,relation_instance = find_relation_class t real_t in
+		    match relation, variance with
+			Leibniz _, None
+		      | Relation {rel_sym = Some _}, None
+		      | Relation {rel_sym = None}, Some _ ->
+			  (variance, relation), (variance, relation_instance)
+		      | Relation {rel_sym = None},None ->
+			  errorlabstrm "Add Morphism"
+			    (str "You must specify the variance in each argument " ++
+				str "whose relation is asymmetric.")
+		      | Leibniz _, Some _
+		      | Relation {rel_sym = Some _}, Some _ ->
+			  errorlabstrm "Add Morphism"
+			    (str "You cannot specify the variance of an argument " ++
+				str "whose relation is symmetric.")
+		in
+		let args, args_instance =
+		  List.split
+		    (List.map2 find_relation_class_v args real_args_ty) in
+		let output,output_instance= find_relation_class output' real_output in
+		  args_ty_quantifiers_rev, args, args_instance, output, output_instance
+              end
   in
-   let argsconstr,outputconstr,lem =
+  let argsconstr,outputconstr,lem =
     gen_compat_lemma_statement args_ty_quantifiers_rev output_instance
-     args_instance (apply_to_rels m args_ty_quantifiers_rev) in
-   (* "unfold make_compatibility_goal" *)
-   let lem =
+      args_instance (apply_to_rels m args_ty_quantifiers_rev) in
+    (* "unfold make_compatibility_goal" *)
+  let lem =
     Reductionops.clos_norm_flags
-     (Closure.unfold_red (Lazy.force coq_make_compatibility_goal_eval_ref))
-     env Evd.empty lem in
-   (* "unfold make_compatibility_goal_aux" *)
-   let lem =
+      (Closure.unfold_red (Lazy.force coq_make_compatibility_goal_eval_ref))
+      env Evd.empty lem in
+    (* "unfold make_compatibility_goal_aux" *)
+  let lem =
     Reductionops.clos_norm_flags
-     (Closure.unfold_red(Lazy.force coq_make_compatibility_goal_aux_eval_ref))
-     env Evd.empty lem in
-   (* "simpl" *)
-   let lem = Tacred.nf env Evd.empty lem in
+      (Closure.unfold_red(Lazy.force coq_make_compatibility_goal_aux_eval_ref))
+      env Evd.empty lem in
+    (* "simpl" *)
+  let lem = Tacred.nf env Evd.empty lem in
     if Lib.is_modtype () then
-     begin
-      ignore
-       (Declare.declare_internal_constant id
-        (ParameterEntry lem, IsAssumption Logical)) ;
-      let mor_name = morphism_theory_id_of_morphism_proof_id id in
-      let lemma_infos = Some (id,argsconstr,outputconstr) in
-       add_morphism lemma_infos mor_name
-        (m,args_ty_quantifiers_rev,args,output)
-     end
+      begin
+	ignore
+	  (Declare.declare_internal_constant id
+              (ParameterEntry lem, IsAssumption Logical)) ;
+	let mor_name = morphism_theory_id_of_morphism_proof_id id in
+	let lemma_infos = Some (id,argsconstr,outputconstr) in
+	  add_morphism lemma_infos mor_name
+            (m,args_ty_quantifiers_rev,args,output)
+      end
     else
-     begin
-      new_edited id
-       (m,args_ty_quantifiers_rev,args,argsconstr,output,outputconstr);
-      Pfedit.start_proof id (Global, Proof Lemma) 
-       (Declare.clear_proofs (Global.named_context ()))
-       lem hook;
-      Options.if_verbose msg (Printer.pr_open_subgoals ());
-     end
+      begin
+	new_edited id
+	  (m,args_ty_quantifiers_rev,args,argsconstr,output,outputconstr);
+	Pfedit.start_proof id (Global, Proof Lemma) 
+	  (Declare.clear_proofs (Global.named_context ()))
+	  lem hook;
+	Options.if_verbose msg (Printer.pr_open_subgoals ());
+      end
 
 let morphism_hook _ ref =
   let pf_id = id_of_global ref in
@@ -1272,7 +1277,7 @@ let relation_class_that_matches_a_constr caller_name new_goals hypt =
     forall x1 x2, rel1 x1 x2 -> rel2 x1 x2
    The Coq part of the tactic, however, needs rel1 == rel2.
    Hence the third case commented out.
-   Note: accepting user-defined subtrelations seems to be the last
+   Note: accepting user-defined subrelations seems to be the last
    useful generalization that does not go against the original spirit of
    the tactic.
 *)
@@ -1351,9 +1356,9 @@ let cartesian_product gl a =
    (aux (List.map (elim_duplicates gl identity) (Array.to_list a)))
 
 let mark_occur gl ~new_goals t in_c input_relation input_direction =
- let rec aux output_relation output_direction in_c =
+ let rec aux output_relation output_directions in_c =
   if eq_constr t in_c then
-   if input_direction = output_direction
+   if List.mem input_direction output_directions
    && subrelation gl input_relation output_relation then
     [ToReplace]
    else []
@@ -1400,33 +1405,32 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
             (fun res (mor,c,al) ->
               let a =
                let arguments = Array.of_list mor.args in
-               let apply_variance_to_direction default_dir =
+               let apply_variance_to_direction =
                 function
-                   None -> default_dir
-                 | Some true -> output_direction
-                 | Some false -> opposite_direction output_direction
+                   None -> [Left2Right;Right2Left]
+                 | Some true -> output_directions
+                 | Some false -> List.map opposite_direction output_directions
                in
                 Util.array_map2
                  (fun a (variance,relation) ->
-                   (aux relation
-                     (apply_variance_to_direction Left2Right variance) a) @
-                   (aux relation
-                     (apply_variance_to_direction Right2Left variance) a)
+                   (aux relation (apply_variance_to_direction variance) a)
                  ) al arguments
               in
                let a' = cartesian_product gl a in
+	       List.flatten (List.map (fun output_direction ->
                 (List.map
                   (function a ->
                     if not (get_mark a) then
                      ToKeep (in_c,output_relation,output_direction)
                     else
-                     MApp (c,ACMorphism mor,a,output_direction)) a') @ res
+                     MApp (c,ACMorphism mor,a,output_direction)) a'))
+		 output_directions) @ res
             ) [] mors_and_cs_and_als in
           (* Then we look for well typed functions *)
           let res_functions =
            (* the tactic works only if the function type is
                made of non-dependent products only. However, here we
-               can cheat a bit by partially istantiating c to match
+               can cheat a bit by partially instantiating c to match
                the requirement when the arguments to be replaced are
                bound by non-dependent products only. *)
             let typeofc = Tacmach.pf_type_of gl c in
@@ -1437,7 +1441,9 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
              function
                 [] ->
                  if a_rev = [] then
-                  [ToKeep (in_c,output_relation,output_direction)]
+		  List.map (fun output_direction ->
+                   ToKeep (in_c,output_relation,output_direction))
+		   output_directions
                  else
                   let a' =
                    cartesian_product gl (Array.of_list (List.rev a_rev))
@@ -1445,7 +1451,9 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
                    List.fold_left
                     (fun res a ->
                       if not (get_mark a) then
-                       (ToKeep (in_c,output_relation,output_direction))::res
+			List.map (fun output_direction ->
+			 (ToKeep (in_c,output_relation,output_direction)))
+			 output_directions @ res
                       else
                        let err =
                         match output_relation with
@@ -1461,7 +1469,9 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
                          let mor =
                           ACFunction{f_args=List.rev f_args_rev;f_output=typ} in
                          let func = beta_expand c c_args_rev in
-                          (MApp (func,mor,a,output_direction))::res
+			 List.map (fun output_direction ->
+                          (MApp (func,mor,a,output_direction)))
+			  output_directions @ res
                     ) [] a'
               | (he::tl) as a->
                  let typnf = Reduction.whd_betadeltaiota env typ in
@@ -1472,8 +1482,7 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
                   | Prod (name,s,t) ->
                      let env' = push_rel (name,None,s) env in
                      let he =
-                      (aux (Leibniz (Some s)) Left2Right he) @
-                      (aux (Leibniz (Some s)) Right2Left he) in
+                      (aux (Leibniz (Some s)) [Left2Right;Right2Left] he) in
                      if he = [] then []
                      else
                       let he0 = List.hd he in
@@ -1515,41 +1524,48 @@ let mark_occur gl ~new_goals t in_c input_relation input_direction =
       | Prod (_, c1, c2) -> 
           if (dependent (mkRel 1) c2)
           then
-           errorlabstrm "Setoid_replace"
-            (str "Cannot rewrite in the type of a variable bound " ++
-             str "in a dependent product.")
+            if (occur_term t c2)
+	    then errorlabstrm "Setoid_replace"
+              (str "Cannot rewrite in the type of a variable bound " ++
+		  str "in a dependent product.")
+	    else
+	      List.map (fun output_direction ->
+	       ToKeep (in_c,output_relation,output_direction)) 
+	       output_directions
           else 
-           let typeofc1 = Tacmach.pf_type_of gl c1 in
-            if not (Tacmach.pf_conv_x gl typeofc1 mkProp) then
-             (* to avoid this error we should introduce an impl relation
-                whose first argument is Type instead of Prop. However,
-                the type of the new impl would be Type -> Prop -> Prop
-                that is no longer a Relation_Definitions.relation. Thus
-                the Coq part of the tactic should be heavily modified. *)
-             errorlabstrm "Setoid_replace"
-              (str "Rewriting in a product A -> B is possible only when A " ++
-               str "is a proposition (i.e. A is of type Prop). The type " ++
-               pr_lconstr c1 ++ str " has type " ++ pr_lconstr typeofc1 ++
-               str " that is not convertible to Prop.")
-            else
-             aux output_relation output_direction
-              (mkApp ((Lazy.force coq_impl),
-                [| c1 ; subst1 (mkRel 1 (*dummy*)) c2 |]))
+            let typeofc1 = Tacmach.pf_type_of gl c1 in
+              if not (Tacmach.pf_conv_x gl typeofc1 mkProp) then
+		(* to avoid this error we should introduce an impl relation
+                   whose first argument is Type instead of Prop. However,
+                   the type of the new impl would be Type -> Prop -> Prop
+                   that is no longer a Relation_Definitions.relation. Thus
+                   the Coq part of the tactic should be heavily modified. *)
+		errorlabstrm "Setoid_replace"
+		  (str "Rewriting in a product A -> B is possible only when A " ++
+		      str "is a proposition (i.e. A is of type Prop). The type " ++
+		      pr_lconstr c1 ++ str " has type " ++ pr_lconstr typeofc1 ++
+		      str " that is not convertible to Prop.")
+              else
+		aux output_relation output_directions
+		  (mkApp ((Lazy.force coq_impl),
+			 [| c1 ; subst1 (mkRel 1 (*dummy*)) c2 |]))
       | _ ->
-        if occur_term t in_c then
-         errorlabstrm "Setoid_replace"
-          (str "Trying to replace " ++ pr_lconstr t ++ str " in " ++ pr_lconstr in_c ++
-           str " that is not an applicative context.")
-        else
-         [ToKeep (in_c,output_relation,output_direction)]
+          if occur_term t in_c then
+            errorlabstrm "Setoid_replace"
+              (str "Trying to replace " ++ pr_lconstr t ++ str " in " ++ pr_lconstr in_c ++
+		  str " that is not an applicative context.")
+          else
+	    List.map (fun output_direction ->
+             ToKeep (in_c,output_relation,output_direction))
+	      output_directions
  in
   let aux2 output_relation output_direction =
    List.map
     (fun res -> output_relation,output_direction,res)
-     (aux output_relation output_direction in_c) in
+     (aux output_relation [output_direction] in_c) in
   let res =
    (aux2 (Lazy.force coq_iff_relation) Right2Left) @
-   (* This is the case of a proposition of signature A ++> iff or B --> iff *)
+   (* [Left2Right] is the case of a prop of signature A ++> iff or B --> iff *)
    (aux2 (Lazy.force coq_iff_relation) Left2Right) @
    (aux2 (Lazy.force coq_impl_relation) Right2Left) in
   let res = elim_duplicates gl (function (_,_,t) -> t) res in
@@ -1849,8 +1865,27 @@ let general_s_rewrite_in id lft2rgt c ~new_goals gl =
   else 
     relation_rewrite_in id c2 c1 (Right2Left,eqclause) ~new_goals gl
 
-let setoid_replace relation c1 c2 ~new_goals gl =
- try
+
+(* 
+   [general_setoid_replace rewrite_tac try_prove_eq_tac_opt relation c1 c2 ~new_goals ]
+   common part of [setoid_replace] and [setoid_replace_in]  (distinction is done using rewrite_tac). 
+
+   Algorith sketch: 
+   1- find the (setoid) relation [rel] between [c1] and [c2] using [relation]
+   2- assert [H:rel c2 c1] 
+   3- replace [c1] with [c2] using [rewrite_tac] (should be [general_s_rewrite] if we want to replace in the 
+      goal, and [general_s_rewrite_in id] if we want to replace in the hypothesis [id]). Possibly generate
+      new_goals if asked (cf general_s_rewrite)
+   4- if [try_prove_eq_tac_opt] is [Some tac] try to complete [rel c2 c1] using tac and do nothing if 
+      [try_prove_eq_tac_opt] is [None]
+*)
+let general_setoid_replace rewrite_tac try_prove_eq_tac_opt relation c1 c2 ~new_goals gl =
+  let try_prove_eq_tac = 
+    match try_prove_eq_tac_opt with 
+      | None -> Tacticals.tclIDTAC
+      | Some tac ->  Tacticals.tclTRY (Tacticals.tclCOMPLETE tac )
+  in 
+  try
   let relation =
    match relation with
       Some rel ->
@@ -1873,23 +1908,29 @@ let setoid_replace relation c1 c2 ~new_goals gl =
     tclTHENS (assert_tac false Anonymous eq)
       [onLastHyp (fun id ->
         tclTHEN
-          (general_s_rewrite dir (mkVar id) ~new_goals)
+          (rewrite_tac dir (mkVar id) ~new_goals)
           (clear [id]));
-       Tacticals.tclIDTAC]
+       try_prove_eq_tac]
    in
     tclORELSE
      (replace true eq_left_to_right) (replace false eq_right_to_left) gl
  with
-  Optimize -> (!replace c1 c2) gl
+  Optimize -> (* (!replace tac_opt c1 c2) gl *)
+    let eq =  mkApp (Lazy.force  coq_eq, [| pf_type_of gl c1;c2 ; c1 |]) in 
+    tclTHENS (assert_tac false Anonymous eq)
+      [onLastHyp (fun id ->
+		    tclTHEN
+		      (rewrite_tac false (mkVar id) ~new_goals)
+		      (clear [id]));
+       try_prove_eq_tac] gl
+      
+
 
-let setoid_replace_in id relation c1 c2 ~new_goals gl =
- let hyp = pf_type_of gl (mkVar id) in
- let new_hyp = Termops.replace_term c1 c2 hyp in
- cut_replacing id new_hyp
-   (fun exact -> tclTHENLASTn
-     (setoid_replace relation c2 c1 ~new_goals)
-     [| exact; tclIDTAC |]) gl
 
+let setoid_replace = general_setoid_replace general_s_rewrite
+let setoid_replace_in  tac_opt id relation c1 c2 ~new_goals gl = 
+  general_setoid_replace (general_s_rewrite_in id)  tac_opt relation c1 c2 ~new_goals gl
+ 
 (* [setoid_]{reflexivity,symmetry,transitivity} tactics *)
 
 let setoid_reflexivity gl =
diff --git a/tactics/setoid_replace.mli b/tactics/setoid_replace.mli
index 750addcc..eb71f68e 100644
--- a/tactics/setoid_replace.mli
+++ b/tactics/setoid_replace.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: setoid_replace.mli 8779 2006-05-02 20:59:21Z letouzey $ i*)
+(*i $Id: setoid_replace.mli 9073 2006-08-22 08:54:29Z jforest $ i*)
 
 open Term
 open Proof_type
@@ -39,7 +39,7 @@ type morphism_signature = (bool option * constr_expr) list * constr_expr
 
 val pr_morphism_signature : morphism_signature -> Pp.std_ppcmds
 
-val register_replace : (constr -> constr -> tactic) -> unit
+val register_replace : (tactic option -> constr -> constr -> tactic) -> unit
 val register_general_rewrite : (bool -> constr -> tactic) -> unit
 
 val print_setoids : unit -> unit
@@ -52,8 +52,9 @@ val default_morphism :
   ?filter:(constr morphism -> bool) -> constr -> relation morphism
 
 val setoid_replace :
- constr option -> constr -> constr -> new_goals:constr list -> tactic
+  tactic option -> constr option -> constr -> constr -> new_goals:constr list -> tactic
 val setoid_replace_in :
+  tactic option -> 
  identifier -> constr option -> constr -> constr -> new_goals:constr list ->
   tactic
 
diff --git a/tactics/tacinterp.ml b/tactics/tacinterp.ml
index 114968c8..1e8c55ef 100644
--- a/tactics/tacinterp.ml
+++ b/tactics/tacinterp.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacinterp.ml 8991 2006-06-27 11:59:50Z herbelin $ *)
+(* $Id: tacinterp.ml 9302 2006-10-27 21:21:17Z barras $ *)
 
 open Constrintern
 open Closure
@@ -48,6 +48,12 @@ open Pretyping
 open Pretyping.Default
 open Pcoq
 
+let safe_msgnl s =
+    try msgnl s with e -> 
+      msgnl 
+	(str "bug in the debugger : " ++
+         str "an exception is raised while printing debug information")
+
 let error_syntactic_metavariables_not_allowed loc =
   user_err_loc 
     (loc,"out_ident",
@@ -75,6 +81,7 @@ type value =
                         (* later, as in "tac" in "Intro H; tac" *)
   | VConstr of constr   (* includes idents known to be bound and references *)
   | VConstr_context of constr
+  | VList of value list
   | VRec of value ref
 
 let locate_tactic_call loc = function
@@ -112,13 +119,16 @@ let constr_of_VConstr_context = function
     errorlabstrm "constr_of_VConstr_context" (str "not a context variable")
 
 (* Displays a value *)
-let pr_value env = function
+let rec pr_value env = function
   | VVoid -> str "()"
   | VInteger n -> int n
   | VIntroPattern ipat -> pr_intro_pattern ipat
   | VConstr c | VConstr_context c ->
       (match env with Some env -> pr_lconstr_env env c | _ -> str "a term")
   | (VTactic _ | VRTactic _ | VFun _ | VRec _) -> str "a tactic"
+  | VList [] -> str "an empty list"
+  | VList (a::_) ->
+      str "a list (first element is " ++ pr_value env a ++ str")"
 
 (* Transforms a named_context into a (string * constr) list *)
 let make_hyps = List.map (fun (id,_,typ) -> (id, typ))
@@ -213,7 +223,7 @@ let _ =
       (fun (s,t) -> add_primitive_tactic s t)
       [ "idtac",TacId [];
         "fail", TacFail(ArgArg 0,[]);
-        "fresh", TacArg(TacFreshId None)
+        "fresh", TacArg(TacFreshId [])
       ]
  
 let lookup_atomic id = Idmap.find id !atomic_mactab
@@ -238,6 +248,34 @@ let _ =
       Summary.survive_module = false;
       Summary.survive_section   = false }
 
+(* Tactics table (TacExtend). *)
+
+let tac_tab = Hashtbl.create 17
+
+let add_tactic s t =
+  if Hashtbl.mem tac_tab s then
+    errorlabstrm ("Refiner.add_tactic: ") 
+      (str ("Cannot redeclare tactic "^s));
+  Hashtbl.add tac_tab s t
+
+let overwriting_add_tactic s t =
+  if Hashtbl.mem tac_tab s then begin
+    Hashtbl.remove tac_tab s;
+    warning ("Overwriting definition of tactic "^s)
+  end;
+  Hashtbl.add tac_tab s t
+
+let lookup_tactic s =
+  try 
+    Hashtbl.find tac_tab s
+  with Not_found -> 
+    errorlabstrm "Refiner.lookup_tactic"
+      (str"The tactic " ++ str s ++ str" is not installed")
+(*
+let vernac_tactic (s,args) =
+  let tacfun = lookup_tactic s args in
+  abstract_extended_tactic s args tacfun
+*)
 (* Interpretation of extra generic arguments *)
 type glob_sign = {
   ltacvars : identifier list * identifier list;
@@ -331,9 +369,9 @@ let intern_hyp ist (loc,id as locid) =
 
 let intern_hyp_or_metaid ist id = intern_hyp ist (skip_metaid id)
 
-let intern_int_or_var ist = function
+let intern_or_var ist = function
   | ArgVar locid -> ArgVar (intern_hyp ist locid)
-  | ArgArg n as x -> x
+  | ArgArg _ as x -> x
 
 let intern_inductive ist = function
   | Ident (loc,id) when find_var id ist -> ArgVar (loc,id)
@@ -495,7 +533,7 @@ let intern_inversion_strength lf ist = function
 
 (* Interprets an hypothesis name *)
 let intern_hyp_location ist ((occs,id),hl) =
-  ((List.map (intern_int_or_var ist) occs,intern_hyp ist (skip_metaid id)), hl)
+  ((List.map (intern_or_var ist) occs,intern_hyp ist (skip_metaid id)), hl)
 
 let interp_constrpattern_gen sigma env ltacvar c =
   let c = intern_gen false ~allow_soapp:true ~ltacvars:(ltacvar,[])
@@ -527,7 +565,7 @@ let internalise_tacarg ch = G_xml.parse_tactic_arg ch
 let extern_tacarg ch env sigma = function
   | VConstr c -> !print_xml_term ch env sigma c
   | VTactic _ | VRTactic _ | VFun _ | VVoid | VInteger _ | VConstr_context _
-  | VIntroPattern _  | VRec _ ->
+  | VIntroPattern _  | VRec _ | VList _ ->
       error "Only externing of terms is implemented"
 
 let extern_request ch req gl la =
@@ -625,13 +663,13 @@ let rec intern_atomic lf ist x =
   (* Automation tactics *)
   | TacTrivial (lems,l) -> TacTrivial (List.map (intern_constr ist) lems,l)
   | TacAuto (n,lems,l) ->
-      TacAuto (option_map (intern_int_or_var ist) n,
+      TacAuto (option_map (intern_or_var ist) n,
         List.map (intern_constr ist) lems,l)
   | TacAutoTDB n -> TacAutoTDB n
   | TacDestructHyp (b,id) -> TacDestructHyp(b,intern_hyp ist id)
   | TacDestructConcl -> TacDestructConcl
   | TacSuperAuto (n,l,b1,b2) -> TacSuperAuto (n,l,b1,b2)
-  | TacDAuto (n,p) -> TacDAuto (option_map (intern_int_or_var ist) n,p)
+  | TacDAuto (n,p) -> TacDAuto (option_map (intern_or_var ist) n,p)
 
   (* Derived basic tactics *)
   | TacSimpleInduction h ->
@@ -676,7 +714,8 @@ let rec intern_atomic lf ist x =
       TacReduce (intern_red_expr ist r, clause_app (intern_hyp_location ist) cl)
   | TacChange (occl,c,cl) ->
       TacChange (option_map (intern_constr_occurrence ist) occl,
-        intern_constr ist c, clause_app (intern_hyp_location ist) cl)
+        (if occl = None then intern_type ist c else intern_constr ist c),
+	clause_app (intern_hyp_location ist) cl)
 
   (* Equivalence relations *)
   | TacReflexivity -> TacReflexivity
@@ -728,7 +767,7 @@ and intern_tactic_seq ist = function
       ist.ltacvars, TacMatch (lz,intern_tactic ist c,intern_match_rule ist lmr)
   | TacId l -> ist.ltacvars, TacId (intern_message ist l)
   | TacFail (n,l) -> 
-      ist.ltacvars, TacFail (intern_int_or_var ist n,intern_message ist l)
+      ist.ltacvars, TacFail (intern_or_var ist n,intern_message ist l)
   | TacProgress tac -> ist.ltacvars, TacProgress (intern_tactic ist tac)
   | TacAbstract (tac,s) -> ist.ltacvars, TacAbstract (intern_tactic ist tac,s)
   | TacThen (t1,t2) ->
@@ -741,7 +780,7 @@ and intern_tactic_seq ist = function
       lfun',
       TacThens (t, List.map (intern_tactic { ist with ltacvars = lfun' }) tl)
   | TacDo (n,tac) -> 
-      ist.ltacvars, TacDo (intern_int_or_var ist n,intern_tactic ist tac)
+      ist.ltacvars, TacDo (intern_or_var ist n,intern_tactic ist tac)
   | TacTry tac -> ist.ltacvars, TacTry (intern_tactic ist tac)
   | TacInfo tac -> ist.ltacvars, TacInfo (intern_tactic ist tac)
   | TacRepeat tac -> ist.ltacvars, TacRepeat (intern_tactic ist tac)
@@ -776,7 +815,7 @@ and intern_tacarg strict ist = function
         List.map (intern_tacarg !strict_check ist) l)
   | TacExternal (loc,com,req,la) -> 
       TacExternal (loc,com,req,List.map (intern_tacarg !strict_check ist) la)
-  | TacFreshId _ as x -> x
+  | TacFreshId x -> TacFreshId (List.map (intern_or_var ist) x)
   | Tacexp t -> Tacexp (intern_tactic ist t)
   | TacDynamic(loc,t) as x ->
       (match tag t with
@@ -803,7 +842,7 @@ and intern_genarg ist x =
   | IntArgType -> in_gen globwit_int (out_gen rawwit_int x)
   | IntOrVarArgType ->
       in_gen globwit_int_or_var
-        (intern_int_or_var ist (out_gen rawwit_int_or_var x))
+        (intern_or_var ist (out_gen rawwit_int_or_var x))
   | StringArgType ->
       in_gen globwit_string (out_gen rawwit_string x)
   | PreIdentArgType ->
@@ -1045,6 +1084,19 @@ let interp_int_or_var ist = function
   | ArgVar locid -> interp_int ist locid
   | ArgArg n -> n
 
+let int_or_var_list_of_VList = function
+  | VList l -> List.map (fun n -> ArgArg (coerce_to_int n)) l
+  | _ -> raise Not_found
+
+let interp_int_or_var_as_list ist = function
+  | ArgVar (_,id as locid) -> 
+      (try int_or_var_list_of_VList (List.assoc id ist.lfun)
+       with Not_found | CannotCoerceTo _ -> [ArgArg (interp_int ist locid)])
+  | ArgArg n as x -> [x]
+
+let interp_int_or_var_list ist l =
+  List.flatten (List.map (interp_int_or_var_as_list ist) l)
+
 let constr_of_value env = function
   | VConstr csr -> csr
   | VIntroPattern (IntroIdentifier id) -> constr_of_id env id
@@ -1065,6 +1117,17 @@ let interp_hyp ist gl (loc,id as locid) =
   if is_variable env id then id
   else user_err_loc (loc,"eval_variable",pr_id id ++ str " not found")
 
+let hyp_list_of_VList env = function
+  | VList l -> List.map (coerce_to_hyp env) l
+  | _ -> raise Not_found
+
+let interp_hyp_list_as_list ist gl (loc,id as x) =
+  try hyp_list_of_VList (pf_env gl) (List.assoc id ist.lfun)
+  with Not_found | CannotCoerceTo _ -> [interp_hyp ist gl x]
+
+let interp_hyp_list ist gl l =
+  List.flatten (List.map (interp_hyp_list_as_list ist gl) l)
+
 let interp_clause_pattern ist gl (l,occl) =
   let rec check acc = function
     | (hyp,l) :: rest ->
@@ -1126,8 +1189,7 @@ let interp_evaluable ist env = function
 
 (* Interprets an hypothesis name *)
 let interp_hyp_location ist gl ((occs,id),hl) =
-  ((List.map (fun n -> ArgArg (interp_int_or_var ist n)) occs,
-    interp_hyp ist gl id),hl)
+  ((interp_int_or_var_list ist occs,interp_hyp ist gl id),hl)
 
 let interp_clause ist gl { onhyps=ol; onconcl=b; concl_occs=occs } =
   { onhyps=option_map(List.map (interp_hyp_location ist gl)) ol;
@@ -1157,11 +1219,25 @@ let rec intropattern_ids = function
       List.flatten (List.map intropattern_ids (List.flatten ll))
   | IntroWildcard | IntroAnonymous -> []
 
-let rec extract_ids = function
-  | (id,VIntroPattern ipat)::tl -> intropattern_ids ipat @ extract_ids tl
-  | _::tl -> extract_ids tl
+let rec extract_ids ids = function
+  | (id,VIntroPattern ipat)::tl when not (List.mem id ids) ->
+      intropattern_ids ipat @ extract_ids ids tl
+  | _::tl -> extract_ids ids tl
   | [] -> []
 
+let default_fresh_id = id_of_string "H"
+
+let interp_fresh_id ist gl l =
+  let ids = map_succeed (function ArgVar(_,id) -> id | _ -> failwith "") l in
+  let avoid = extract_ids ids ist.lfun in
+  let id = 
+    if l = [] then default_fresh_id 
+    else
+      id_of_string (String.concat "" (List.map (function
+	| ArgArg s -> s
+	| ArgVar (_,id) -> string_of_id (interp_ident ist gl id)) l)) in 
+  Tactics.fresh_id avoid id gl
+
 (* To retype a list of key*constr with undefined key *)
 let retype_list sigma env lst =
   List.fold_right (fun (x,csr) a ->
@@ -1210,7 +1286,7 @@ let solve_remaining_evars env initial_sigma evars c =
 	      Pretype_errors.error_unsolvable_implicit loc env sigma src)
       | _ -> map_constr proc_rec c      
   in
-  map_constr proc_rec c
+  proc_rec c
 
 let interp_gen kind ist sigma env (c,ce) =
   let (ltacvars,unbndltacvars) = constr_list ist env in
@@ -1254,20 +1330,33 @@ let pf_interp_open_constr casted ist gl cc =
 let pf_interp_constr ist gl =
   interp_constr ist (project gl) (pf_env gl)
 
+let constr_list_of_VList env = function
+  | VList l -> List.map (constr_of_value env) l
+  | _ -> raise Not_found
+      
+let pf_interp_constr_list_as_list ist gl (c,_ as x) =
+  match c with
+    | RVar (_,id) ->
+        (try constr_list_of_VList (pf_env gl) (List.assoc id ist.lfun)
+        with Not_found -> [interp_constr ist (project gl) (pf_env gl) x])
+    | _ -> [interp_constr ist (project gl) (pf_env gl) x]
+
+let pf_interp_constr_list ist gl l =
+  List.flatten (List.map (pf_interp_constr_list_as_list ist gl) l)
+
 (* Interprets a type expression *)
 let pf_interp_type ist gl =
   interp_type ist (project gl) (pf_env gl)
 
 (* Interprets a reduction expression *)
 let interp_unfold ist env (l,qid) =
-  (l,interp_evaluable ist env qid)
+  (interp_int_or_var_list ist l,interp_evaluable ist env qid)
 
 let interp_flag ist env red =
   { red with rConst = List.map (interp_evaluable ist env) red.rConst }
 
 let interp_pattern ist sigma env (l,c) = 
-  (List.map (fun n -> ArgArg (interp_int_or_var ist n)) l,
-   interp_constr ist sigma env c)
+  (interp_int_or_var_list ist l, interp_constr ist sigma env c)
 
 let pf_interp_pattern ist gl = interp_pattern ist (project gl) (pf_env gl)
 
@@ -1296,11 +1385,39 @@ let interp_may_eval f ist gl = function
 	    user_err_loc (loc, "interp_may_eval",
 	    str "Unbound context identifier" ++ pr_id s))
   | ConstrTypeOf c -> pf_type_of gl (f ist gl c)
-  | ConstrTerm c -> f ist gl c
+  | ConstrTerm c -> 
+     try 
+	f ist gl c
+     with e -> 
+	begin 
+	  match ist.debug with 
+	    DebugOn lev -> 
+	    safe_msgnl (str "Level " ++ int lev ++
+                          str ": interpretation of term " ++ 
+			   Printer.pr_rawconstr_env (pf_env gl) (fst c) ++
+			   str " raised an exception" ++
+			   fnl() ++
+			   !Tactic_debug.explain_logic_error_no_anomaly e)
+	| _ -> ()
+     end;
+     raise e  
 
 (* Interprets a constr expression possibly to first evaluate *)
 let interp_constr_may_eval ist gl c =
-  let csr = interp_may_eval pf_interp_constr ist gl c in
+  let csr = 
+    try
+      interp_may_eval pf_interp_constr ist gl c
+    with e -> 
+      begin match ist.debug with
+	  DebugOn lev -> 
+	    safe_msgnl (str "Level " ++ int lev ++
+                           str ": evaluation of term raised an exception" ++
+			   fnl() ++
+			   !Tactic_debug.explain_logic_error_no_anomaly e)
+	| _ -> ()
+      end;
+      raise e
+  in
   begin
     db_constr ist.debug (pf_env gl) csr;
     csr
@@ -1312,6 +1429,7 @@ let message_of_value = function
   | VIntroPattern ipat -> pr_intro_pattern ipat
   | VConstr_context c | VConstr c -> pr_constr c
   | VRec _ | VTactic _ | VRTactic _ | VFun _ -> str "<tactic>"
+  | VList _ -> str "<list>"
 
 let rec interp_message ist = function
   | [] -> mt()
@@ -1380,12 +1498,16 @@ let interp_binding ist gl (loc,b,c) =
 
 let interp_bindings ist gl = function
 | NoBindings -> NoBindings
-| ImplicitBindings l -> ImplicitBindings (List.map (pf_interp_constr ist gl) l)
+| ImplicitBindings l -> ImplicitBindings (pf_interp_constr_list ist gl l)
 | ExplicitBindings l -> ExplicitBindings (List.map (interp_binding ist gl) l)
 
 let interp_constr_with_bindings ist gl (c,bl) =
   (pf_interp_constr ist gl c, interp_bindings ist gl bl)
 
+let mk_constr_value ist gl c = VConstr (pf_interp_constr ist gl c)
+let mk_hyp_value ist gl c = VConstr (mkVar (interp_hyp ist gl c))
+let mk_int_or_var_value ist c = VInteger (interp_int_or_var ist c)
+
 (* Interprets an l-tac expression into a value *)
 let rec val_interp ist gl (tac:glob_tactic_expr) =
 
@@ -1453,9 +1575,8 @@ and interp_tacarg ist gl = function
       interp_app ist gl fv largs loc
   | TacExternal (loc,com,req,la) ->
       interp_external loc ist gl com req (List.map (interp_tacarg ist gl) la)
-  | TacFreshId idopt -> 
-      let s = match idopt with None -> "H" | Some s -> s in
-      let id = Tactics.fresh_id (extract_ids ist.lfun) (id_of_string s) gl in
+  | TacFreshId l -> 
+      let id = interp_fresh_id ist gl l in
       VIntroPattern (IntroIdentifier id)
   | Tacexp t -> val_interp ist gl t
   | TacDynamic(_,t) ->
@@ -1481,7 +1602,31 @@ and interp_app ist gl fv largs loc =
     | VFun(olfun,var,body) ->
       let (newlfun,lvar,lval)=head_with_value (var,largs) in
       if lvar=[] then
-	let v = val_interp { ist with lfun=newlfun@olfun } gl body in
+	let v = 
+          let res = 
+	    try
+	      val_interp { ist with lfun=newlfun@olfun } gl body
+	    with e ->
+	      begin match ist.debug with
+		  DebugOn lev -> 
+		    safe_msgnl 
+		      (str "Level " ++ int lev ++ 
+			  str ": evaluation raises an exception" ++
+                          fnl() ++
+			  !Tactic_debug.explain_logic_error_no_anomaly e)
+		| _ -> ()
+	      end;
+	      raise e
+	  in
+	    (match ist.debug with
+		DebugOn lev -> 
+		  safe_msgnl (str "Level " ++ int lev ++ 
+				 str ": evaluation returns" ++ fnl() ++
+				 pr_value (Some (pf_env gl)) res)
+	      | _ -> ());
+	    res
+	in
+
         if lval=[] then locate_tactic_call loc v
 	else interp_app ist gl v lval loc
       else
@@ -1559,52 +1704,52 @@ and interp_match_context ist g lz lr lmr =
   let rec apply_goal_sub ist env goal nocc (id,c) csr mt mhyps hyps =
     let (lgoal,ctxt) = match_subterm nocc c csr in
     let lctxt = give_context ctxt id in
-    try apply_hyps_context ist env lz goal mt lctxt lgoal mhyps hyps
-    with e when is_match_catchable e ->
-      apply_goal_sub ist env goal (nocc + 1) (id,c) csr mt mhyps hyps in
+      try apply_hyps_context ist env lz goal mt lctxt lgoal mhyps hyps
+      with e when is_match_catchable e ->
+	apply_goal_sub ist env goal (nocc + 1) (id,c) csr mt mhyps hyps in
   let rec apply_match_context ist env goal nrs lex lpt = 
     begin
-    if lex<>[] then db_pattern_rule ist.debug nrs (List.hd lex);
-    match lpt with
-    | (All t)::tl ->
-      begin
-        db_mc_pattern_success ist.debug;
-        try eval_with_fail ist lz goal t
-        with e when is_match_catchable e ->
-          apply_match_context ist env goal (nrs+1) (List.tl lex) tl
-      end
-    | (Pat (mhyps,mgoal,mt))::tl ->
-      let hyps = make_hyps (pf_hyps goal) in
-      let hyps = if lr then List.rev hyps else hyps in
-      let mhyps = List.rev mhyps (* Sens naturel *) in
-      let concl = pf_concl goal in
-      (match mgoal with
-      |	Term mg ->
-        (try
-           let lgoal = matches mg concl in
-           db_matched_concl ist.debug (pf_env goal) concl;
-           apply_hyps_context ist env lz goal mt [] lgoal mhyps hyps
-        with e when is_match_catchable e ->
-         (match e with
-            | PatternMatchingFailure -> db_matching_failure ist.debug
-            | Eval_fail s -> db_eval_failure ist.debug s
-            | _ -> db_logic_failure ist.debug e);
-          apply_match_context ist env goal (nrs+1) (List.tl lex) tl)
-      |	Subterm (id,mg) ->
-        (try apply_goal_sub ist env goal 0 (id,mg) concl mt mhyps hyps
-        with
-        | PatternMatchingFailure ->
-           apply_match_context ist env goal (nrs+1) (List.tl lex) tl))
-    | _ ->
-      errorlabstrm "Tacinterp.apply_match_context"
-        (v 0 (str "No matching clauses for match goal" ++
-        (if ist.debug=DebugOff then
-           fnl() ++ str "(use \"Debug On\" for more info)"
-         else mt())))
+      if lex<>[] then db_pattern_rule ist.debug nrs (List.hd lex);
+      match lpt with
+	| (All t)::tl ->
+	    begin
+              db_mc_pattern_success ist.debug;
+              try eval_with_fail ist lz goal t
+              with e when is_match_catchable e ->
+		apply_match_context ist env goal (nrs+1) (List.tl lex) tl
+	    end
+	| (Pat (mhyps,mgoal,mt))::tl ->
+	    let hyps = make_hyps (pf_hyps goal) in
+	    let hyps = if lr then List.rev hyps else hyps in
+	    let mhyps = List.rev mhyps (* Sens naturel *) in
+	    let concl = pf_concl goal in
+	      (match mgoal with
+		 | Term mg ->
+		     (try
+			let lgoal = matches mg concl in
+			  db_matched_concl ist.debug (pf_env goal) concl;
+			  apply_hyps_context ist env lz goal mt [] lgoal mhyps hyps
+		      with e when is_match_catchable e ->
+			(match e with
+			   | PatternMatchingFailure -> db_matching_failure ist.debug
+			   | Eval_fail s -> db_eval_failure ist.debug s
+			   | _ -> db_logic_failure ist.debug e);
+			apply_match_context ist env goal (nrs+1) (List.tl lex) tl)
+		 | Subterm (id,mg) ->
+		     (try apply_goal_sub ist env goal 0 (id,mg) concl mt mhyps hyps
+		      with
+			| PatternMatchingFailure ->
+			    apply_match_context ist env goal (nrs+1) (List.tl lex) tl))
+	| _ ->
+	    errorlabstrm "Tacinterp.apply_match_context"
+              (v 0 (str "No matching clauses for match goal" ++
+		      (if ist.debug=DebugOff then
+			 fnl() ++ str "(use \"Debug On\" for more info)"
+		       else mt())))
     end in
   let env = pf_env g in
-  apply_match_context ist env g 0 lmr
-    (read_match_rule (fst (constr_list ist env)) lmr)
+    apply_match_context ist env g 0 lmr
+      (read_match_rule (fst (constr_list ist env)) lmr)
 
 (* Tries to match the hypotheses in a Match Context *)
 and apply_hyps_context ist env lz goal mt lctxt lgmatch mhyps hyps =
@@ -1679,6 +1824,8 @@ and interp_genarg ist gl x =
   | BindingsArgType ->
       in_gen wit_bindings
         (interp_bindings ist gl (out_gen globwit_bindings x))
+  | List0ArgType ConstrArgType -> interp_genarg_constr_list0 ist gl x
+  | List1ArgType ConstrArgType -> interp_genarg_constr_list1 ist gl x
   | List0ArgType _ -> app_list0 (interp_genarg ist gl) x
   | List1ArgType _ -> app_list1 (interp_genarg ist gl) x
   | OptArgType _ -> app_opt (interp_genarg ist gl) x
@@ -1691,6 +1838,16 @@ and interp_genarg ist gl x =
       | None -> 
           lookup_interp_genarg s ist gl x
 
+and interp_genarg_constr_list0 ist gl x =
+  let lc = out_gen (wit_list0 globwit_constr) x in
+  let lc = pf_interp_constr_list ist gl lc in
+  in_gen (wit_list0 wit_constr) lc
+
+and interp_genarg_constr_list1 ist gl x =
+  let lc = out_gen (wit_list1 globwit_constr) x in
+  let lc = pf_interp_constr_list ist gl lc in
+  in_gen (wit_list1 wit_constr) lc
+
 (* Interprets the Match expressions *)
 and interp_match ist g lz constr lmr =
   let rec apply_match_subterm ist nocc (id,c) csr mt =
@@ -1706,26 +1863,115 @@ and interp_match ist g lz constr lmr =
         (try eval_with_fail ist lz g t
          with e when is_match_catchable e -> apply_match ist csr [])
     | (Pat ([],Term c,mt))::tl ->
-        (try
-	  let lm = matches c csr in
-	  let lm = List.map (fun (id,c) -> (id,VConstr c)) lm in
-          eval_with_fail { ist with lfun=lm@ist.lfun } lz g mt
-         with e when is_match_catchable e -> apply_match ist csr tl)
+        (try let lm = 
+              (try matches c csr with 
+                e -> 
+                  (match ist.debug with
+                    DebugOn lev ->
+                      safe_msgnl (str "Level " ++ int lev ++
+                             str ": matching with pattern" ++ fnl() ++
+                         Printer.pr_constr_pattern_env (pf_env g) c ++ fnl() ++
+                         str "raised the exception" ++ fnl() ++
+                         !Tactic_debug.explain_logic_error_no_anomaly e)
+                  | _ -> ()); raise e) in
+            (try let lm = List.map (fun (id,c) -> (id,VConstr c)) lm in
+               eval_with_fail { ist with lfun=lm@ist.lfun } lz g mt
+            with e ->
+               (match ist.debug with
+                  DebugOn lev -> 
+                    safe_msgnl (str "rule body for pattern" ++ fnl() ++
+                    Printer.pr_constr_pattern_env (pf_env g) c ++ fnl() ++
+                    str "raised the exception" ++ fnl() ++
+                    !Tactic_debug.explain_logic_error_no_anomaly e)
+                | _ -> ()); raise e)
+         with e when is_match_catchable e ->
+            (match ist.debug with
+               DebugOn lev ->
+                 safe_msgnl (str "Level " ++ int lev ++ 
+                       str ":switching to the next rule");
+             | DebugOff -> ());
+            apply_match ist csr tl)
+
     | (Pat ([],Subterm (id,c),mt))::tl ->
         (try apply_match_subterm ist 0 (id,c) csr mt
          with PatternMatchingFailure -> apply_match ist csr tl)
     | _ ->
       errorlabstrm "Tacinterp.apply_match" (str
         "No matching clauses for match") in
-  let csr = interp_ltac_constr ist g constr in
+  let csr = 
+      try interp_ltac_constr ist g constr with
+        e -> (match ist.debug with
+               DebugOn lev ->
+               safe_msgnl (str "Level " ++ int lev ++ 
+                      str ": evaluation of the matched expression raised " ++
+                      str "the exception" ++ fnl() ++
+                      !Tactic_debug.explain_logic_error e)
+             | _ -> ()); raise e in
   let ilr = read_match_rule (fst (constr_list ist (pf_env g))) lmr in
-  apply_match ist csr ilr
+  let res = 
+     try apply_match ist csr ilr with
+       e -> 
+           begin match ist.debug with
+             DebugOn lev ->
+                safe_msgnl (str "Level " ++ int lev ++ 
+                        str ": match expression failed with error" ++ fnl() ++
+                    !Tactic_debug.explain_logic_error e)
+           | _ -> ()
+           end;
+           raise e in
+     (if ist.debug <> DebugOff then
+     safe_msgnl (str "match expression returns " ++
+            pr_value (Some (pf_env g)) res));
+     res
 
 (* Interprets tactic expressions : returns a "constr" *)
 and interp_ltac_constr ist gl e =
-  try constr_of_value (pf_env gl) (val_interp ist gl e)
+  let result = 
+  try (val_interp ist gl e) with Not_found -> 
+    begin match ist.debug with
+      DebugOn lev ->
+       safe_msgnl (str "Level " ++ int lev ++ 
+                   str ": evaluation failed for" ++ fnl() ++
+                       Pptactic.pr_glob_tactic (pf_env gl) e)
+    | _ -> ()
+    end;
+    raise Not_found in
+  try let cresult = constr_of_value (pf_env gl) result in
+    (if !debug <> DebugOff then 
+        safe_msgnl (Pptactic.pr_glob_tactic (pf_env gl) e ++ fnl() ++
+        str " has value " ++ fnl() ++ print_constr_env (pf_env gl) cresult);
+     cresult)
+        
   with Not_found ->
-    errorlabstrm "" (str "Must evaluate to a term")
+    errorlabstrm ""
+      (str "Must evaluate to a term" ++ fnl() ++ 
+	  str "offending expression: " ++ fnl() ++
+          Pptactic.pr_glob_tactic (pf_env gl) e ++ fnl() ++ str "this is a " ++
+          (match result with
+              VTactic _ -> str "VTactic"
+            | VRTactic _ -> str "VRTactic"
+            | VFun (il,ul,b) ->
+                (str "VFun with body " ++ fnl() ++
+                    Pptactic.pr_glob_tactic (pf_env gl) b ++ fnl() ++
+		    str "instantiated arguments " ++ fnl() ++
+                    List.fold_right 
+                    (fun p s ->
+                      let (i,v) = p in str (string_of_id i) ++ str ", " ++ s)
+                    il (str "") ++
+                    str "uninstantiated arguments " ++ fnl() ++
+                    List.fold_right
+                    (fun opt_id s ->
+                      (match opt_id with
+                          Some id -> str (string_of_id id)
+                        | None -> str "_") ++ str ", " ++ s)
+                    ul (str ""))
+            | VVoid -> str "VVoid"
+            | VInteger _ -> str "VInteger"
+            | VConstr _ -> str "VConstr"
+            | VIntroPattern _ -> str "VIntroPattern"
+            | VConstr_context _ -> str "VConstrr_context"
+            | VRec _ -> str "VRec"
+            | VList _ -> str "VList"))
 
 (* Interprets tactic expressions : returns a "tactic" *)
 and interp_tactic ist tac gl =
@@ -1767,7 +2013,7 @@ and interp_atomic ist gl = function
       abstract_tactic (TacAssert (t,ipat,c))
         (Tactics.forward (option_map (interp_tactic ist) t)
 	  (interp_intro_pattern ist gl ipat) c)
-  | TacGeneralize cl -> h_generalize (List.map (pf_interp_constr ist gl) cl)
+  | TacGeneralize cl -> h_generalize (pf_interp_constr_list ist gl cl)
   | TacGeneralizeDep c -> h_generalize_dep (pf_interp_constr ist gl c)
   | TacLetTac (na,c,clp) ->
       let clp = interp_clause ist gl clp in
@@ -1781,11 +2027,11 @@ and interp_atomic ist gl = function
 *)
   (* Automation tactics *)
   | TacTrivial (lems,l) -> 
-      Auto.h_trivial (List.map (pf_interp_constr ist gl) lems)
+      Auto.h_trivial (pf_interp_constr_list ist gl lems)
 	(option_map (List.map (interp_hint_base ist)) l)
   | TacAuto (n,lems,l) ->
       Auto.h_auto (option_map (interp_int_or_var ist) n)
-      (List.map (pf_interp_constr ist gl) lems)
+      (pf_interp_constr_list ist gl lems)
       (option_map (List.map (interp_hint_base ist)) l)
   | TacAutoTDB n -> Dhyp.h_auto_tdb n
   | TacDestructHyp (b,id) -> Dhyp.h_destructHyp b (interp_hyp ist gl id)
@@ -1820,8 +2066,8 @@ and interp_atomic ist gl = function
   | TacLApply c -> h_lapply (pf_interp_constr ist gl c)
 
   (* Context management *)
-  | TacClear (b,l) -> h_clear b (List.map (interp_hyp ist gl) l)
-  | TacClearBody l -> h_clear_body (List.map (interp_hyp ist gl) l)
+  | TacClear (b,l) -> h_clear b (interp_hyp_list ist gl l)
+  | TacClearBody l -> h_clear_body (interp_hyp_list ist gl l)
   | TacMove (dep,id1,id2) ->
       h_move dep (interp_hyp ist gl id1) (interp_hyp ist gl id2)
   | TacRename (id1,id2) ->
@@ -1842,7 +2088,9 @@ and interp_atomic ist gl = function
       h_reduce (pf_interp_red_expr ist gl r) (interp_clause ist gl cl)
   | TacChange (occl,c,cl) ->
       h_change (option_map (pf_interp_pattern ist gl) occl)
-        (pf_interp_constr ist gl c) (interp_clause ist gl cl)
+        (if occl = None then pf_interp_type ist gl c 
+	 else pf_interp_constr ist gl c)
+        (interp_clause ist gl cl)
 
   (* Equivalence relations *)
   | TacReflexivity -> h_reflexivity
@@ -1861,21 +2109,25 @@ and interp_atomic ist gl = function
   | TacInversion (NonDepInversion (k,idl,ids),hyp) ->
       Inv.inv_clause k 
         (interp_intro_pattern ist gl ids)
-        (List.map (interp_hyp ist gl) idl)
+        (interp_hyp_list ist gl idl)
         (interp_declared_or_quantified_hypothesis ist gl hyp)
   | TacInversion (InversionUsing (c,idl),hyp) ->
       Leminv.lemInv_clause (interp_declared_or_quantified_hypothesis ist gl hyp)
         (pf_interp_constr ist gl c)
-        (List.map (interp_hyp ist gl) idl)
+        (interp_hyp_list ist gl idl)
 
   (* For extensions *)
   | TacExtend (loc,opn,l) ->
-      fun gl -> vernac_tactic (opn,List.map (interp_genarg ist gl) l) gl
+      let tac = lookup_tactic opn in
+      fun gl ->
+        let args = List.map (interp_genarg ist gl) l in
+        abstract_extended_tactic opn args (tac args) gl
   | TacAlias (loc,_,l,(_,body)) -> fun gl ->
     let rec f x = match genarg_tag x with
-    | IntArgType -> VInteger (out_gen globwit_int x)
-    | IntOrVarArgType -> 
-	VInteger (interp_int_or_var ist (out_gen globwit_int_or_var x))
+    | IntArgType -> 
+        VInteger (out_gen globwit_int x)
+    | IntOrVarArgType ->
+        mk_int_or_var_value ist (out_gen globwit_int_or_var x)
     | PreIdentArgType ->
 	failwith "pre-identifiers cannot be bound"
     | IntroPatternArgType ->
@@ -1885,14 +2137,14 @@ and interp_atomic ist gl = function
         VIntroPattern 
 	  (IntroIdentifier (interp_ident ist gl (out_gen globwit_ident x)))
     | VarArgType ->
-	VConstr (mkVar (interp_hyp ist gl (out_gen globwit_var x)))
+        mk_hyp_value ist gl (out_gen globwit_var x)
     | RefArgType -> 
         VConstr (constr_of_global 
           (pf_interp_reference ist gl (out_gen globwit_ref x)))
-    | SortArgType ->
-	VConstr (mkSort (interp_sort (out_gen globwit_sort x)))
+    | SortArgType -> 
+        VConstr (mkSort (interp_sort (out_gen globwit_sort x)))
     | ConstrArgType ->
-        VConstr (pf_interp_constr ist gl (out_gen globwit_constr x))
+        mk_constr_value ist gl (out_gen globwit_constr x)
     | ConstrMayEvalArgType ->
 	VConstr
           (interp_constr_may_eval ist gl (out_gen globwit_constr_may_eval x))
@@ -1900,11 +2152,36 @@ and interp_atomic ist gl = function
           (* Special treatment of tactic arguments *)
 	val_interp ist gl 
           (out_gen (globwit_tactic (out_some (tactic_genarg_level s))) x)
+    | List0ArgType ConstrArgType -> 
+        let wit = wit_list0 globwit_constr in
+        VList (List.map (mk_constr_value ist gl) (out_gen wit x))
+    | List0ArgType VarArgType -> 
+        let wit = wit_list0 globwit_var in
+        VList (List.map (mk_hyp_value ist gl) (out_gen wit x))
+    | List0ArgType IntArgType -> 
+        let wit = wit_list0 globwit_int in
+        VList (List.map (fun x -> VInteger x) (out_gen wit x))
+    | List0ArgType IntOrVarArgType -> 
+        let wit = wit_list0 globwit_int_or_var in
+        VList (List.map (mk_int_or_var_value ist) (out_gen wit x))
+    | List1ArgType ConstrArgType -> 
+        let wit = wit_list1 globwit_constr in
+        VList (List.map (mk_constr_value ist gl) (out_gen wit x))
+    | List1ArgType VarArgType -> 
+        let wit = wit_list1 globwit_var in
+        VList (List.map (mk_hyp_value ist gl) (out_gen wit x))
+    | List1ArgType IntArgType -> 
+        let wit = wit_list1 globwit_int in
+        VList (List.map (fun x -> VInteger x) (out_gen wit x))
+    | List1ArgType IntOrVarArgType -> 
+        let wit = wit_list1 globwit_int_or_var in
+        VList (List.map (mk_int_or_var_value ist) (out_gen wit x))
     | StringArgType | BoolArgType
     | QuantHypArgType | RedExprArgType 
     | OpenConstrArgType _ | ConstrWithBindingsArgType 
     | ExtraArgType _ | BindingsArgType 
-    | List0ArgType _ | List1ArgType _ | OptArgType _ | PairArgType _ 
+    | OptArgType _ | PairArgType _ 
+    | List0ArgType _ | List1ArgType _ 
 	-> error "This generic type is not supported in alias"
         
     in
@@ -1925,7 +2202,7 @@ let interp_tac_gen lfun debug t gl =
       ltacvars = (List.map fst lfun, []); ltacrecvars = [];
       gsigma = project gl; genv = pf_env gl } t) gl
 
-let eval_tactic t = interp_tactic { lfun=[]; debug=get_debug() } t
+let eval_tactic t gls = interp_tactic { lfun=[]; debug=get_debug() } t gls
 
 let interp t = interp_tac_gen [] (get_debug()) t
 
@@ -1941,7 +2218,8 @@ let hide_interp t ot gl =
   let t = eval_tactic te in
   match ot with 
   | None -> abstract_tactic_expr (TacArg (Tacexp te)) t gl
-  | Some t' -> abstract_tactic_expr (TacArg (Tacexp te)) (tclTHEN t t') gl
+  | Some t' ->
+      abstract_tactic_expr ~dflt:true (TacArg (Tacexp te)) (tclTHEN t t') gl
 
 (***************************************************************************)
 (* Substitution at module closing time *)
@@ -1973,7 +2251,7 @@ let subst_induction_arg subst = function
   | ElimOnIdent id as x -> x
 
 let subst_and_short_name f (c,n) =
-  assert (n=None); (* since tacdef are strictly globalized *)
+(*  assert (n=None); *)(* since tacdef are strictly globalized *)
   (f c,None)
 
 let subst_or_var f =  function
@@ -2170,9 +2448,11 @@ and subst_tacarg subst = function
       TacExternal (_loc,com,req,List.map (subst_tacarg subst) la)
   | (TacVoid | IntroPattern _ | Integer _ | TacFreshId _) as x -> x
   | Tacexp t -> Tacexp (subst_tactic subst t)
-  | TacDynamic(_,t) as x ->
+  | TacDynamic(the_loc,t) as x ->
       (match tag t with
-	| "tactic" | "value" | "constr" -> x
+	| "tactic" | "value" -> x
+        | "constr" -> 
+          TacDynamic(the_loc, constr_in (subst_mps subst (constr_out t)))
 	| s -> anomaly_loc (dloc, "Tacinterp.val_interp",
                  str "Unknown dynamic: <" ++ str s ++ str ">"))
 
diff --git a/tactics/tacinterp.mli b/tactics/tacinterp.mli
index 7c0180a6..01e7750a 100644
--- a/tactics/tacinterp.mli
+++ b/tactics/tacinterp.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacinterp.mli 8975 2006-06-23 08:52:53Z herbelin $ i*)
+(*i $Id: tacinterp.mli 9178 2006-09-26 11:18:22Z barras $ i*)
 
 (*i*)
 open Dyn
@@ -34,6 +34,7 @@ type value =
   | VIntroPattern of intro_pattern_expr
   | VConstr of constr
   | VConstr_context of constr
+  | VList of value list
   | VRec of value ref
 
 (* Signature for interpretation: val\_interp and interpretation functions *)
@@ -63,6 +64,14 @@ val add_tacdef :
   bool -> (identifier Util.located * raw_tactic_expr) list -> unit
 val add_primitive_tactic : string -> glob_tactic_expr -> unit
 
+(* Tactic extensions *)
+val add_tactic :
+  string -> (closed_generic_argument list -> tactic) -> unit
+val overwriting_add_tactic :
+  string -> (closed_generic_argument list -> tactic) -> unit
+val lookup_tactic :
+  string -> (closed_generic_argument list) -> tactic
+
 (* Adds an interpretation function for extra generic arguments *)
 type glob_sign = {
   ltacvars : identifier list * identifier list;
@@ -84,6 +93,9 @@ val interp_genarg :
 val intern_genarg :
   glob_sign -> raw_generic_argument -> glob_generic_argument
 
+val intern_tactic : 
+  glob_sign -> raw_tactic_expr -> glob_tactic_expr
+
 val intern_constr :
   glob_sign -> constr_expr -> rawconstr_and_expr
 
diff --git a/tactics/tacticals.ml b/tactics/tacticals.ml
index ff6ac41a..06289169 100644
--- a/tactics/tacticals.ml
+++ b/tactics/tacticals.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tacticals.ml 8878 2006-05-30 16:44:25Z herbelin $ *)
+(* $Id: tacticals.ml 9211 2006-10-05 12:38:33Z letouzey $ *)
 
 open Pp
 open Util
@@ -68,6 +68,7 @@ let tclTHENTRY       = tclTHENTRY
 let tclIFTHENELSE    = tclIFTHENELSE
 let tclIFTHENSELSE   = tclIFTHENSELSE
 let tclIFTHENSVELSE   = tclIFTHENSVELSE
+let tclIFTHENTRYELSEMUST = tclIFTHENTRYELSEMUST
 
 let unTAC            = unTAC
 
diff --git a/tactics/tacticals.mli b/tactics/tacticals.mli
index 7ceddc8b..458ab732 100644
--- a/tactics/tacticals.mli
+++ b/tactics/tacticals.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tacticals.mli 7909 2006-01-21 11:09:18Z herbelin $ i*)
+(*i $Id: tacticals.mli 9211 2006-10-05 12:38:33Z letouzey $ i*)
 
 (*i*)
 open Pp
@@ -64,7 +64,7 @@ val tclIFTHENELSE    : tactic -> tactic -> tactic -> tactic
 val tclIFTHENSELSE   : tactic -> tactic list -> tactic -> tactic
 val tclIFTHENSVELSE  : tactic -> tactic array -> tactic -> tactic
 
-
+val tclIFTHENTRYELSEMUST : tactic -> tactic -> tactic
 
 val unTAC            : tactic -> goal sigma -> proof_tree sigma
 
diff --git a/tactics/tactics.ml b/tactics/tactics.ml
index 4eaf0259..f77814de 100644
--- a/tactics/tactics.ml
+++ b/tactics/tactics.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: tactics.ml 8878 2006-05-30 16:44:25Z herbelin $ *)
+(* $Id: tactics.ml 9281 2006-10-26 07:52:31Z herbelin $ *)
 
 open Pp
 open Util
@@ -245,20 +245,22 @@ let unfold_constr = function
 (*         Introduction tactics            *)
 (*******************************************)
 
+let fresh_id_avoid avoid id =
+  next_global_ident_away true id avoid
+
 let fresh_id avoid id gl =
-  next_global_ident_away true id (avoid@(pf_ids_of_hyps gl))
+  fresh_id_avoid (avoid@(pf_ids_of_hyps gl)) id
 
 let id_of_name_with_default s = function
   | Anonymous -> id_of_string s
   | Name id   -> id
 
-let default_id gl = function
+let default_id env sigma = function
   | (name,None,t) ->
-      (match kind_of_term (pf_whd_betadeltaiota gl (pf_type_of gl t)) with
-	| Sort (Prop _) -> (id_of_name_with_default "H" name)
-	| Sort (Type _) -> (id_of_name_with_default "X" name)
-	| _                   -> anomaly "Wrong sort")
-  | (name,Some b,_) -> id_of_name_using_hdchar (pf_env gl) b name
+      (match Typing.sort_of env sigma t with
+	| Prop _ -> (id_of_name_with_default "H" name)
+	| Type _ -> (id_of_name_with_default "X" name))
+  | (name,Some b,_) -> id_of_name_using_hdchar env b name
 
 (* Non primitive introduction tactics are treated by central_intro
    There is possibly renaming, with possibly names to avoid and 
@@ -270,14 +272,32 @@ type intro_name_flag =
   | IntroMustBe of identifier
 
 let find_name decl gl = function
-  | IntroAvoid idl        -> 
-      let id = fresh_id idl (default_id gl decl) gl in id
+  | IntroAvoid idl -> 
+      (* this case must be compatible with [find_intro_names] below. *)
+      let id = fresh_id idl (default_id (pf_env gl) gl.sigma decl) gl in id
   | IntroBasedOn (id,idl) -> fresh_id idl id gl
   | IntroMustBe id        -> 
       let id' = fresh_id [] id gl in
       if id' <> id then error ((string_of_id id)^" is already used");
       id'
 
+(* Returns the names that would be created by intros, without doing
+   intros.  This function is supposed to be compatible with an
+   iteration of [find_name] above. As [default_id] checks the sort of
+   the type to build hyp names, we maintain an environment to be able
+   to type dependent hyps. *)
+let find_intro_names ctxt gl = 
+  let _, res = List.fold_right 
+    (fun decl acc -> 
+      let wantedname,x,typdecl = decl in
+      let env,idl = acc in
+      let name = fresh_id idl (default_id env gl.sigma decl) gl in
+      let newenv = push_rel (wantedname,x,typdecl) env in
+      (newenv,(name::idl)))
+    ctxt (pf_env gl , []) in
+  List.rev res 
+
+
 let build_intro_tac id = function
   | None      -> introduction id
   | Some dest -> tclTHEN (introduction id) (move_hyp true id dest)
@@ -427,12 +447,9 @@ let rec intros_rmove = function
  		    move_to_rhyp destopt;
 		    intros_rmove rest ]
 
-(****************************************************)
-(*            Resolution tactics                    *)
-(****************************************************)
-
-(*  Refinement tactic: unification with the head of the head normal form
- *  of the type of a term. *)
+(**************************)
+(*  Refinement tactics    *)
+(**************************)
 
 let apply_type hdcty argl gl =
   refine (applist (mkCast (Evarutil.mk_new_meta(),DEFAULTcast, hdcty),argl)) gl
@@ -448,6 +465,48 @@ let bring_hyps hyps =
       let f = mkCast (Evarutil.mk_new_meta(),DEFAULTcast, newcl) in
       refine_no_check (mkApp (f, instance_from_named_context hyps)) gl)
 
+(**************************)
+(*     Cut tactics        *)
+(**************************)
+
+let cut c gl =
+  match kind_of_term (hnf_type_of gl c) with
+    | Sort _ ->
+        let id=next_name_away_with_default "H" Anonymous (pf_ids_of_hyps gl) in
+        let t = mkProd (Anonymous, c, pf_concl gl) in
+          tclTHENFIRST
+            (internal_cut_rev id c)
+            (tclTHEN (apply_type t [mkVar id]) (thin [id]))
+            gl
+    | _  -> error "Not a proposition or a type"
+
+let cut_intro t = tclTHENFIRST (cut t) intro
+
+(* let cut_replacing id t tac = 
+  tclTHENS (cut t)
+    [tclORELSE
+	(intro_replacing id) 
+	(tclORELSE (intro_erasing id) (intro_using id));
+     tac (refine_no_check (mkVar id)) ] *)
+
+(* cut_replacing échoue si l'hypothèse à remplacer apparaît dans le
+   but, ou dans une autre hypothèse *)
+let cut_replacing id t tac = 
+  tclTHENS (cut t) [
+      tclORELSE (intro_replacing id) (intro_erasing id); 
+      tac (refine_no_check (mkVar id)) ]
+
+let cut_in_parallel l = 
+  let rec prec = function
+    | [] -> tclIDTAC 
+    | h::t -> tclTHENFIRST (cut h) (prec t)
+  in 
+    prec (List.rev l)
+
+(****************************************************)
+(*            Resolution tactics                    *)
+(****************************************************)
+
 (* Resolution with missing arguments *)
 
 let apply_with_bindings (c,lbind) gl = 
@@ -459,7 +518,7 @@ let apply_with_bindings (c,lbind) gl =
     try
       let n = nb_prod thm_ty - nb_prod (pf_concl gl) in
       if n<0 then error "Apply: theorem has not enough premisses.";
-      let clause = make_clenv_binding_apply gl n (c,thm_ty) lbind in
+      let clause = make_clenv_binding_apply gl (Some n) (c,thm_ty) lbind in
       Clenvtac.res_pf clause gl
     with (Pretype_errors.PretypeError _|RefinerError _|UserError _|Failure _) as exn ->
       let red_thm =
@@ -470,7 +529,7 @@ let apply_with_bindings (c,lbind) gl =
   with (Pretype_errors.PretypeError _|RefinerError _|UserError _|Failure _) ->
     (* Last chance: if the head is a variable, apply may try
        second order unification *)
-    let clause = make_clenv_binding_apply gl (-1) (c,thm_ty0) lbind in 
+    let clause = make_clenv_binding_apply gl None (c,thm_ty0) lbind in 
     Clenvtac.res_pf clause gl
 
 let apply c = apply_with_bindings (c,NoBindings)
@@ -485,6 +544,44 @@ let apply_without_reduce c gl =
   let clause = mk_clenv_type_of gl c in 
   res_pf clause gl
 
+(* [apply_in hyp c] replaces
+
+   hyp : forall y1, ti -> t             hyp : rho(u)
+   ========================    with     ============  and the =======
+   goal                                 goal                  rho(ti)
+
+   assuming that [c] has type [forall x1..xn -> t' -> u] for some [t]
+   unifiable with [t'] with unifier [rho]
+*)
+
+let find_matching_clause unifier clause =
+  let rec find clause =
+    try unifier clause
+    with exn when catchable_exception exn ->
+    try find (clenv_push_prod clause)
+    with NotExtensibleClause -> failwith "Cannot apply"
+  in find clause
+
+let apply_in_once gls innerclause (d,lbind) =
+  let thm = nf_betaiota (pf_type_of gls d) in
+  let clause = make_clenv_binding gls (d,thm) lbind in
+  let ordered_metas = List.rev (clenv_independent clause) in
+  if ordered_metas = [] then error "Statement without assumptions";
+  let f mv = find_matching_clause (clenv_fchain mv clause) innerclause in
+  try list_try_find f ordered_metas
+  with Failure _ -> error "Unable to unify"
+
+let apply_in id lemmas gls =
+  let t' = pf_get_hyp_typ gls id in
+  let innermostclause = mk_clenv_from_n gls (Some 0) (mkVar id,t') in
+  let clause = List.fold_left (apply_in_once gls) innermostclause lemmas in
+  let new_hyp_prf  = clenv_value clause in
+  let new_hyp_typ  = clenv_type clause in
+  tclTHEN
+    (tclEVARS (evars_of clause.env))
+    (cut_replacing id new_hyp_typ
+      (fun x gls -> refine_no_check new_hyp_prf gls)) gls
+
 (* A useful resolution tactic which, if c:A->B, transforms |- C into
    |- B -> C and |- A
 
@@ -502,45 +599,14 @@ let apply_without_reduce c gl =
   end.
 *)
 
-(**************************)
-(*     Cut tactics        *)
-(**************************)
-
 let cut_and_apply c gl =
   let goal_constr = pf_concl gl in 
-  match kind_of_term (pf_hnf_constr gl (pf_type_of gl c)) with
-    | Prod (_,c1,c2) when not (dependent (mkRel 1) c2) ->
-	tclTHENLAST
-	  (apply_type (mkProd (Anonymous,c2,goal_constr)) [mkMeta(new_meta())])
-	  (apply_term c [mkMeta (new_meta())]) gl
-    | _ -> error "Imp_elim needs a non-dependent product"
-
-let cut c gl =
-  match kind_of_term (hnf_type_of gl c) with
-    | Sort _ ->
-        let id=next_name_away_with_default "H" Anonymous (pf_ids_of_hyps gl) in
-        let t = mkProd (Anonymous, c, pf_concl gl) in
-        tclTHENFIRST
-          (internal_cut_rev id c)
-          (tclTHEN (apply_type t [mkVar id]) (thin [id]))
-          gl
-    | _  -> error "Not a proposition or a type"
-
-let cut_intro t = tclTHENFIRST (cut t) intro
-
-let cut_replacing id t tac = 
-  tclTHENS (cut t)
-    [tclORELSE
-      (intro_replacing id) 
-      (tclORELSE (intro_erasing id) (intro_using id));
-     tac (refine_no_check (mkVar id)) ]
-
-let cut_in_parallel l = 
-  let rec prec = function
-    | [] -> tclIDTAC 
-    | h::t -> tclTHENFIRST (cut h) (prec t)
-  in 
-  prec (List.rev l)
+    match kind_of_term (pf_hnf_constr gl (pf_type_of gl c)) with
+      | Prod (_,c1,c2) when not (dependent (mkRel 1) c2) ->
+	  tclTHENLAST
+	    (apply_type (mkProd (Anonymous,c2,goal_constr)) [mkMeta(new_meta())])
+	    (apply_term c [mkMeta (new_meta())]) gl
+      | _ -> error "Imp_elim needs a non-dependent product"
 
 (********************************************************************)
 (*               Exact tactics                                      *)
@@ -717,7 +783,7 @@ let general_elim_clause elimtac (c,lbindc) (elimc,lbindelimc) gl =
   let indclause  = make_clenv_binding gl (c,t) lbindc  in
   let elimt      = pf_type_of gl elimc in
   let elimclause = make_clenv_binding gl (elimc,elimt) lbindelimc in 
-  elimtac elimclause indclause gl
+    elimtac elimclause indclause gl
 
 let general_elim c e ?(allow_K=true) =
   general_elim_clause (elimination_clause_scheme allow_K) c e
@@ -747,6 +813,14 @@ let elim (c,lbindc as cx) elim =
 let simplest_elim c = default_elim (c,NoBindings)
 
 (* Elimination in hypothesis *)
+(* Typically, elimclause := (eq_ind ?x ?P ?H ?y ?Heq : ?P ?y)
+              indclause : forall ..., hyps -> a=b    (to take place of ?Heq)
+              id : phi(a)                            (to take place of ?H)
+      and the result is to overwrite id with the proof of phi(b)
+
+   but this generalizes to any elimination scheme with one constructor
+   (e.g. it could replace id:A->B->C by id:C, knowing A/\B)
+*)
 
 let elimination_in_clause_scheme id elimclause indclause gl =
   let (hypmv,indmv) = 
@@ -757,8 +831,7 @@ let elimination_in_clause_scheme id elimclause indclause gl =
   let elimclause'  = clenv_fchain indmv elimclause indclause in 
   let hyp = mkVar id in
   let hyp_typ = pf_type_of gl hyp in
-  let hypclause =
-    mk_clenv_from_n gl (Some 0) (hyp, hyp_typ) in
+  let hypclause = mk_clenv_from_n gl (Some 0) (hyp, hyp_typ) in
   let elimclause'' = clenv_fchain hypmv elimclause' hypclause in  
   let new_hyp_prf  = clenv_value elimclause'' in
   let new_hyp_typ  = clenv_type elimclause'' in
@@ -1145,13 +1218,18 @@ let consume_pattern avoid id gl = function
       (IntroIdentifier (fresh_id avoid id gl), names)
   | pat::names -> (pat,names)
 
+let re_intro_dependent_hypotheses tophyp (lstatus,rstatus) =
+  let newlstatus = (* if some IH has taken place at the top of hyps *)
+    List.map (function (hyp,None) -> (hyp,tophyp) | x -> x) lstatus in
+  tclTHEN
+    (intros_rmove rstatus)
+    (intros_move newlstatus)
+
 type elim_arg_kind = RecArg | IndArg | OtherArg
 
 let induct_discharge statuslists destopt avoid' (avoid,ra) names gl =
   let avoid = avoid @ avoid' in
-  let (lstatus,rstatus) = statuslists in
-  let tophyp = ref None in
-  let rec peel_tac ra names gl = match ra with
+  let rec peel_tac ra names tophyp gl = match ra with
     | (RecArg,recvarname) ::
         (IndArg,hyprecname) :: ra' ->
         let recpat,names = match names with
@@ -1160,36 +1238,35 @@ let induct_discharge statuslists destopt avoid' (avoid,ra) names gl =
 	      (pat, [IntroIdentifier id])
           | _ -> consume_pattern avoid recvarname gl names in
         let hyprec,names = consume_pattern avoid hyprecname gl names in
-	(* This is buggy for intro-or-patterns with different first hypnames *)
-	if !tophyp=None then tophyp := first_name_buggy hyprec;
+        (* IH stays at top: we need to update tophyp *)
+        (* This is buggy for intro-or-patterns with different first hypnames *)
+        (* Would need to pass peel_tac as a continuation of intros_patterns *)
+        (* (or to have hypotheses classified by blocks...) *)
+        let tophyp = if tophyp=None then first_name_buggy hyprec else tophyp in
         tclTHENLIST
 	  [ intros_patterns avoid [] destopt [recpat];
 	    intros_patterns avoid [] None [hyprec];
-	    peel_tac ra' names ] gl
+	    peel_tac ra' names tophyp] gl
     | (IndArg,hyprecname) :: ra' ->
 	(* Rem: does not happen in Coq schemes, only in user-defined schemes *)
         let pat,names = consume_pattern avoid hyprecname gl names in
-	tclTHEN (intros_patterns avoid [] destopt [pat]) (peel_tac ra' names) gl
+	tclTHEN (intros_patterns avoid [] destopt [pat])
+          (peel_tac ra' names tophyp) gl
     | (RecArg,recvarname) :: ra' ->
         let pat,names = consume_pattern avoid recvarname gl names in
-	tclTHEN (intros_patterns avoid [] destopt [pat]) (peel_tac ra' names) gl
+	tclTHEN (intros_patterns avoid [] destopt [pat]) 
+          (peel_tac ra' names tophyp) gl
     | (OtherArg,_) :: ra' ->
         let pat,names = match names with
           | [] -> IntroAnonymous, []
           | pat::names -> pat,names in
-	tclTHEN (intros_patterns avoid [] destopt [pat]) (peel_tac ra' names) gl
+	tclTHEN (intros_patterns avoid [] destopt [pat])
+          (peel_tac ra' names tophyp) gl
     | [] ->
         check_unused_names names;
-        tclIDTAC gl
+        re_intro_dependent_hypotheses tophyp statuslists gl
   in
-  let intros_move lstatus =
-    let newlstatus = (* if some IH has taken place at the top of hyps *)
-      List.map (function (hyp,None) -> (hyp,!tophyp) | x -> x) lstatus in
-    intros_move newlstatus
-  in 
-  tclTHENLIST [ peel_tac ra names;
-		intros_rmove rstatus;
-		intros_move lstatus ] gl
+  peel_tac ra names None gl
 
 (* - le recalcul de indtyp à chaque itération de atomize_one est pour ne pas
      s'embêter à regarder si un letin_tac ne fait pas des
@@ -1648,8 +1725,13 @@ let compute_elim_sig ?elimc elimt =
 	| hiname,Some _,hi -> error "cannot recognize an induction schema"
 	| hiname,None,hi -> 
 	    let hi_ind, hi_args = decompose_app hi in
-	    let hi_is_ind = (* hi est d'un type inductif *)
-	      match kind_of_term hi_ind with | Ind (mind,_)  -> true | _ -> false in
+	    let hi_is_ind = (* hi est d'un type globalisable *)
+	      match kind_of_term hi_ind with
+		| Ind (mind,_)  -> true 
+		| Var _ -> true 
+		| Const _ -> true 
+		| Construct _ -> true 
+		| _ -> false in
 	    let hi_args_enough = (* hi a le bon nbre d'arguments *)
 	      List.length hi_args = List.length params + !res.nargs -1 in
 	    (* FIXME: Ces deux tests ne sont pas suffisants. *)
@@ -1827,6 +1909,7 @@ let recolle_clenv scheme lid elimclause gl =
     elimclause
 
 
+
 (* Unification of the goal and the principle applied to meta variables:
    (elimc ?i ?j ?k...?l). This solves partly meta variables (and may
     produce new ones). Then refine with the resulting term with holes.
@@ -1858,7 +1941,7 @@ let induction_from_context_l isrec elim_info lid names gl =
     + (if scheme.indarg <> None then 1 else 0) in
   (* Number of given induction args must be exact. *)
   if List.length lid <> nargs_indarg_farg + scheme.nparams then 
-    error "not the right number of arguments given to induction scheme";  
+      error "not the right number of arguments given to induction scheme";  
   let env = pf_env gl in
   (* hyp0 is used for re-introducing hyps at the right place afterward.
      We chose the first element of the list of variables on which to
diff --git a/tactics/tactics.mli b/tactics/tactics.mli
index aaacee8f..48b9f432 100644
--- a/tactics/tactics.mli
+++ b/tactics/tactics.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: tactics.mli 8878 2006-05-30 16:44:25Z herbelin $ i*)
+(*i $Id: tactics.mli 9266 2006-10-24 09:03:15Z herbelin $ i*)
 
 (*i*)
 open Names
@@ -58,6 +58,7 @@ val cofix           : identifier option -> tactic
 (*s Introduction tactics. *)
 
 val fresh_id : identifier list -> identifier -> goal sigma -> identifier
+val find_intro_names : rel_context -> goal sigma -> identifier list
 
 val intro                : tactic
 val introf               : tactic
@@ -168,6 +169,8 @@ val apply_with_bindings   : constr with_bindings -> tactic
 
 val cut_and_apply         : constr -> tactic
 
+val apply_in              : identifier -> constr with_bindings list -> tactic
+
 (*s Elimination tactics. *)
 
 
diff --git a/test-suite/check b/test-suite/check
index 99893f88..06904846 100755
--- a/test-suite/check
+++ b/test-suite/check
@@ -103,6 +103,36 @@ test_interactive() {
     done
 }
 
+# La fonction suivante teste en interactif 
+# It expects a line "(* Expected time < XXX.YYs *)" in the .v file 
+# with exactly two digits after the dot
+test_complexity() {
+    if [ -f /proc/cpuinfo ]; then
+        bogomips=`sed -n -e "s/bogomips.*: \([0-9]*\).*/\1/p" /proc/cpuinfo | head -1`
+    else
+        bogomips=6120 # assume a i386 3Gz
+    fi
+    for f in $1/*.v; do 
+	nbtests=`expr $nbtests + 1`
+	printf "    "$f"..."
+        # compute effective user time * 100
+	res=`$command $f 2>&1 | sed -n -e "s/Finished transaction in .*(\([0-9]*\)\.\([0-9][0-9]\).*/\1\2/p" | head -1`
+	if [ $? != 0 ]; then
+ 	    echo "Error! (should be accepted)"
+        else 
+          # find expected time * 100
+          exp=`sed -n -e "s/(\*.*Expected time < \([0-9]\).\([0-9][0-9]\)s.*\*)/\1\2/p" $f`
+          ok=`expr \( $res \* $bogomips \) "<=" \( $exp \* 6120 \)`
+          if [ $ok = 1 ]; then
+              echo "Ok"
+              nbtestsok=`expr $nbtestsok + 1`
+          else
+              echo "Error! (should run faster)"
+          fi
+        fi
+    done
+}
+
 # Programme principal
 
 echo "Success tests"
@@ -115,6 +145,8 @@ echo "Parser tests"
 test_parser parser
 echo "Interactive tests"
 test_interactive interactive
+echo "Complexity tests"
+test_complexity complexity
 echo "Module tests"
 $coqtop -compile modules/Nat
 $coqtop -compile modules/plik
diff --git a/test-suite/complexity/pretyping.v b/test-suite/complexity/pretyping.v
new file mode 100644
index 00000000..c271fb50
--- /dev/null
+++ b/test-suite/complexity/pretyping.v
@@ -0,0 +1,2660 @@
+(* Test parsing/interpretation/pretyping on a large example *)
+(* Expected time < 1.50s *)
+
+Require Import Reals.
+Require Import Ring_tac.
+
+Open Scope R_scope.
+
+Time Goal forall x1 x2 x3 y1 y2 y3 e1 e2 e3 e4 e5 e6 e7: R,
+(e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) *
+((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) * 1) *
+((- (y1 - y2) * (e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x1) -
+  e2 * y1 - e2 * y3) *
+ ((- (y1 - y2) * (e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x1) -
+   e2 * y1 - e2 * y3) * 1)) * e3 -
+(e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) *
+((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) * 1) *
+((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) *
+ ((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) * 1)) *
+(e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1) * e3 -
+(e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) *
+((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) * 1) *
+((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) *
+ ((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) * 1)) * x3 * e1 * e3 -
+(- (y2 - y3) * (e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x2) -
+ e4 * y2 - e4 * y1) *
+((- (y2 - y3) * (e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x2) -
+  e4 * y2 - e4 * y1) * 1) *
+((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) *
+ ((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) * 1)) * e1 +
+(e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) *
+((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) * 1) *
+((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) *
+ ((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) * 1)) *
+(e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3) * e1 +
+(e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) *
+((e5 + e6 - 2 * y1 * y2 - x1 * e1 - x2 * e1 - e1 * x3) * 1) *
+((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) *
+ ((e6 + e7 - 2 * y2 * y3 - x2 * e3 - x3 * e3 - e3 * x1) * 1)) * x1 * e1 * e3 =
+3 * e1 * e6 ^ 4 * e7 + e1 * e6 ^ 2 * e7 ^ 3 + e3 * e6 ^ 4 * y1 ^ 2 +
+3 * e1 * e6 ^ 3 * e7 ^ 2 - 2 * e6 ^ 4 * x2 * e1 ^ 2 + 2 * e1 * e6 ^ 4 * e5 -
+2 * e3 * e6 ^ 4 * e7 - 2 * e6 ^ 4 * x1 * e1 ^ 2 + e1 ^ 3 * x3 ^ 2 * e6 ^ 3 -
+2 * e6 ^ 4 * e1 ^ 2 * x3 + x2 ^ 4 * e3 ^ 3 * y1 ^ 2 * e1 ^ 2 +
+x2 ^ 4 * e3 ^ 3 * y2 ^ 2 * e1 ^ 2 + x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 ^ 2 +
+x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 ^ 2 + 4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 4 * y2 ^ 2 +
+x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 ^ 2 + x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 ^ 2 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 4 * y2 ^ 2 + 4 * e3 ^ 3 * x1 ^ 4 * y1 ^ 2 * e1 ^ 2 +
+4 * e3 ^ 3 * x1 ^ 4 * y2 ^ 2 * e1 ^ 2 + e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 ^ 2 +
+e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e6 ^ 2 + 4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 ^ 2 + x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * e6 ^ 2 +
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 ^ 4 + x2 ^ 2 * e3 ^ 3 * e2 ^ 2 * y1 ^ 2 +
+x2 ^ 2 * e3 ^ 3 * e2 ^ 2 * y3 ^ 2 + x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 ^ 2 +
+x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e6 ^ 2 + 4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 ^ 4 +
+x3 ^ 2 * e3 ^ 3 * e2 ^ 2 * y1 ^ 2 + x3 ^ 2 * e3 ^ 3 * e2 ^ 2 * y3 ^ 2 +
+e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e5 ^ 2 + e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e6 ^ 2 +
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * y2 ^ 4 + e3 ^ 3 * x1 ^ 2 * e2 ^ 2 * y1 ^ 2 +
+e3 ^ 3 * x1 ^ 2 * e2 ^ 2 * y3 ^ 2 - 2 * e6 ^ 3 * x2 * e3 ^ 2 * y1 ^ 2 -
+2 * e6 ^ 3 * x3 * e3 ^ 2 * y1 ^ 2 - 2 * e6 ^ 3 * e3 ^ 2 * x1 * y1 ^ 2 -
+2 * e6 ^ 3 * x2 * e3 ^ 2 * y2 ^ 2 - 2 * e6 ^ 3 * x3 * e3 ^ 2 * y2 ^ 2 -
+2 * e6 ^ 3 * e3 ^ 2 * x1 * y2 ^ 2 + 2 * e3 * e6 ^ 3 * y1 ^ 2 * e5 -
+4 * e3 * e6 ^ 3 * y1 ^ 3 * y2 + 4 * e3 * e6 ^ 4 * y1 * y2 -
+4 * e3 * e6 ^ 3 * y1 ^ 2 * y2 ^ 2 + 2 * e3 * e6 ^ 3 * y1 ^ 2 * e2 +
+2 * e3 * e6 ^ 3 * y2 ^ 2 * e5 - 4 * e3 * e6 ^ 3 * y2 ^ 3 * y1 +
+e3 * e6 ^ 2 * y1 ^ 2 * e5 ^ 2 + 4 * e3 * e6 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+2 * e3 * e6 ^ 3 * e7 * y1 ^ 2 + e3 * e7 ^ 2 * y1 ^ 2 * e5 ^ 2 +
+e3 * e7 ^ 2 * y1 ^ 2 * e6 ^ 2 + 4 * e3 * e7 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+16 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 4 + e3 * e6 ^ 2 * y2 ^ 2 * e5 ^ 2 +
+4 * e3 * e6 ^ 2 * y1 ^ 2 * y2 ^ 4 + e3 * e6 ^ 2 * e2 ^ 2 * y1 ^ 2 +
+e3 * e6 ^ 2 * e2 ^ 2 * y3 ^ 2 + 2 * e3 * e6 ^ 3 * e7 * y2 ^ 2 +
+e3 * e7 ^ 2 * y2 ^ 2 * e5 ^ 2 + e3 * e7 ^ 2 * y2 ^ 2 * e6 ^ 2 +
+x1 ^ 2 * e1 ^ 3 * e6 ^ 3 + x2 ^ 2 * e1 ^ 3 * e6 ^ 3 + e1 * e5 ^ 2 * e7 ^ 3 +
+e3 * e6 ^ 4 * y2 ^ 2 - 24 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 -
+8 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e5 * e1 +
+32 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 * e5 * e6 +
+8 * y2 * y3 ^ 2 * x2 * e3 ^ 2 * y1 * e5 * e2 -
+24 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e6 * x1 * e1 -
+8 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e6 * e1 +
+16 * y2 ^ 2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 ^ 3 * e1 +
+8 * y2 * y3 ^ 2 * x2 * e3 ^ 2 * y1 * e6 * e2 +
+48 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 ^ 3 * x1 * e1 -
+16 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * x1 * e1 +
+24 * y2 ^ 3 * y3 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e1 -
+16 * y2 ^ 2 * y3 ^ 2 * x2 * e3 ^ 2 * y1 ^ 2 * e2 +
+8 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * e6 -
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 ^ 3 * e5 +
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 * e5 ^ 2 -
+16 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e5 +
+8 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * e2 -
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 ^ 3 * e6 +
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 * e6 ^ 2 -
+16 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e6 +
+16 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e6 * e2 -
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 ^ 3 * e2 +
+32 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * y2 * y3 * x2 ^ 3 * e3 ^ 2 * y1 ^ 2 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * e5 * e6 -
+16 * y2 ^ 4 * y3 * x2 * e3 ^ 2 * e5 * y1 -
+16 * y2 ^ 4 * y3 * x2 * e3 ^ 2 * e6 * y1 +
+16 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e2 +
+32 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * y2 ^ 3 * y3 * x2 ^ 3 * e3 ^ 2 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * x2 * e3 ^ 2 * e2 ^ 2 * y1 +
+4 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 +
+4 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * e6 ^ 2 +
+16 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * y1 ^ 4 -
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 -
+8 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x2 * e1 +
+32 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e5 * e6 +
+8 * y2 * y3 ^ 2 * x3 * e3 ^ 2 * y1 * e5 * e2 -
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * x1 * e1 -
+8 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * x2 * e1 +
+8 * y2 * y3 ^ 2 * x3 * e3 ^ 2 * y1 * e6 * e2 +
+32 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 ^ 3 * x1 * e1 +
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 ^ 3 * x2 * e1 -
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 +
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x2 * e1 -
+16 * y2 ^ 2 * y3 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * e2 +
+8 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * e6 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 ^ 3 * e5 +
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e5 ^ 2 -
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 +
+8 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * e2 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 ^ 3 * e6 +
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e6 ^ 2 -
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e6 +
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * e2 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 ^ 3 * e2 +
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e5 * e6 -
+16 * y2 ^ 4 * y3 * x3 * e3 ^ 2 * e5 * y1 -
+16 * y2 ^ 4 * y3 * x3 * e3 ^ 2 * e6 * y1 +
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e2 +
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * x3 * e3 ^ 2 * e2 ^ 2 * y1 +
+4 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 +
+4 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * e6 ^ 2 +
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * y1 ^ 4 -
+16 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e5 * e1 +
+32 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 * e5 * e6 +
+8 * y2 * y3 ^ 2 * e3 ^ 2 * x1 * y1 * e5 * e2 -
+16 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e6 * e1 +
+8 * y2 * y3 ^ 2 * e3 ^ 2 * x1 * y1 * e6 * e2 +
+32 * y2 ^ 2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 ^ 3 * e1 -
+8 * y2 ^ 3 * y3 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e1 -
+16 * y2 ^ 2 * y3 ^ 2 * e3 ^ 2 * x1 * y1 ^ 2 * e2 +
+8 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * e6 -
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 ^ 3 * e5 +
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 * e5 ^ 2 -
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e5 +
+8 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * e2 -
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 ^ 3 * e6 +
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 * e6 ^ 2 -
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e6 +
+16 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e6 * e2 -
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 ^ 3 * e2 +
+16 * y2 * y3 * e3 ^ 2 * x1 ^ 3 * y1 ^ 2 * e1 ^ 2 +
+20 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * e5 * e6 -
+16 * y2 ^ 4 * y3 * e3 ^ 2 * x1 * e5 * y1 -
+16 * y2 ^ 4 * y3 * e3 ^ 2 * x1 * e6 * y1 +
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e2 +
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 ^ 3 * e1 ^ 2 +
+20 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * x2 ^ 2 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * e3 ^ 2 * x1 * e2 ^ 2 * y1 +
+4 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e5 ^ 2 +
+4 * y2 * y3 * e3 ^ 2 * x1 * y1 ^ 2 * e6 ^ 2 +
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * y1 ^ 4 -
+8 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * x1 * e1 -
+2 * x2 ^ 3 * e3 ^ 3 * y1 ^ 2 * e5 * e1 +
+8 * x2 ^ 2 * e3 ^ 3 * y1 * e5 * y2 * e6 +
+2 * x2 ^ 2 * e3 ^ 3 * y1 * e5 * e2 * y3 -
+8 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * x1 * e1 -
+2 * x2 ^ 3 * e3 ^ 3 * y1 ^ 2 * e6 * e1 +
+2 * x2 ^ 2 * e3 ^ 3 * y1 * e6 * e2 * y3 +
+16 * x2 ^ 2 * e3 ^ 3 * y1 ^ 3 * y2 * x1 * e1 +
+4 * x2 ^ 3 * e3 ^ 3 * y1 ^ 3 * y2 * e1 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 * e2 * y3 +
+2 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * e6 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 3 * e5 * y2 +
+4 * x2 ^ 2 * e3 ^ 3 * y1 * e5 ^ 2 * y2 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * y2 ^ 2 +
+2 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * e2 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 3 * e6 * y2 +
+4 * x2 ^ 2 * e3 ^ 3 * y1 * e6 ^ 2 * y2 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * y2 ^ 2 +
+2 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * e2 -
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 3 * y2 * e2 +
+13 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+2 * x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 * e6 -
+4 * x2 ^ 2 * e3 ^ 3 * y2 ^ 3 * e5 * y1 -
+4 * x2 ^ 2 * e3 ^ 3 * y2 ^ 3 * e6 * y1 +
+4 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 ^ 2 * e2 +
+13 * x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+2 * x2 ^ 2 * e3 ^ 3 * e2 ^ 2 * y1 * y3 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * x1 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * x2 * e1 +
+8 * x3 ^ 2 * e3 ^ 3 * y1 * e5 * y2 * e6 +
+2 * x3 ^ 2 * e3 ^ 3 * y1 * e5 * e2 * y3 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * x1 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * x2 * e1 +
+2 * x3 ^ 2 * e3 ^ 3 * y1 * e6 * e2 * y3 +
+8 * x3 ^ 2 * e3 ^ 3 * y1 ^ 3 * y2 * x1 * e1 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 3 * y2 * x2 * e1 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 * e2 * y3 +
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * e6 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 3 * e5 * y2 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 * e5 ^ 2 * y2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * y2 ^ 2 +
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e5 * e2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 3 * e6 * y2 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 * e6 ^ 2 * y2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * y2 ^ 2 +
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * e6 * e2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 3 * y2 * e2 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+2 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 * e6 -
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 3 * e5 * y1 -
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 3 * e6 * y1 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * y2 ^ 2 * e2 +
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+2 * x3 ^ 2 * e3 ^ 3 * e2 ^ 2 * y1 * y3 -
+4 * e3 ^ 3 * x1 ^ 3 * y1 ^ 2 * e5 * e1 -
+10 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 * x2 * e1 +
+8 * e3 ^ 3 * x1 ^ 2 * y1 * e5 * y2 * e6 +
+2 * e3 ^ 3 * x1 ^ 2 * y1 * e5 * e2 * y3 -
+4 * e3 ^ 3 * x1 ^ 3 * y1 ^ 2 * e6 * e1 -
+10 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e6 * x2 * e1 +
+2 * e3 ^ 3 * x1 ^ 2 * y1 * e6 * e2 * y3 +
+8 * e3 ^ 3 * x1 ^ 3 * y1 ^ 3 * y2 * e1 +
+20 * e3 ^ 3 * x1 ^ 2 * y1 ^ 3 * y2 * x2 * e1 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * y2 * e2 * y3 +
+2 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 * e6 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 3 * e5 * y2 +
+4 * e3 ^ 3 * x1 ^ 2 * y1 * e5 ^ 2 * y2 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 +
+2 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 * e2 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 3 * e6 * y2 +
+4 * e3 ^ 3 * x1 ^ 2 * y1 * e6 ^ 2 * y2 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e6 * y2 ^ 2 +
+2 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e6 * e2 -
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 3 * y2 * e2 +
+2 * e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e5 * e6 -
+4 * e3 ^ 3 * x1 ^ 2 * y2 ^ 3 * e5 * y1 -
+4 * e3 ^ 3 * x1 ^ 2 * y2 ^ 3 * e6 * y1 +
+4 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 +
+2 * e3 ^ 3 * x1 ^ 2 * e2 ^ 2 * y1 * y3 +
+4 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * e5 ^ 2 +
+4 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * e6 ^ 2 +
+16 * y2 ^ 5 * y3 * x2 * e3 ^ 2 * y1 ^ 2 +
+4 * y2 * y3 * x2 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 +
+4 * y2 * y3 ^ 3 * x2 * e3 ^ 2 * e2 ^ 2 -
+32 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 * e5 * x1 * e1 -
+40 * y2 ^ 2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 * e5 * e1 -
+32 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 * e6 * x1 * e1 -
+40 * y2 ^ 2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 * e6 * e1 -
+24 * y2 * y3 * x2 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+24 * y2 ^ 2 * y3 * x2 ^ 3 * e3 ^ 2 * y1 * e1 ^ 2 -
+8 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e1 * e2 -
+24 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * e5 * x1 * e1 -
+8 * y2 ^ 3 * y3 * x2 ^ 2 * e3 ^ 2 * e5 * e1 -
+8 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * e5 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * x2 * e3 ^ 2 * e5 * e2 -
+24 * y2 ^ 3 * y3 * x2 * e3 ^ 2 * e6 * x1 * e1 -
+8 * y2 ^ 3 * y3 * x2 ^ 2 * e3 ^ 2 * e6 * e1 -
+16 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * e6 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * x2 * e3 ^ 2 * e6 * e2 +
+48 * y2 ^ 4 * y3 * x2 * e3 ^ 2 * y1 * x1 * e1 +
+16 * y2 ^ 4 * y3 * x2 ^ 2 * e3 ^ 2 * y1 * e1 +
+16 * y2 ^ 3 * y3 ^ 2 * x2 * e3 ^ 2 * y1 * e2 +
+24 * y2 ^ 2 * y3 * x2 ^ 2 * e3 ^ 2 * y1 * x1 * e1 ^ 2 -
+24 * y2 * y3 ^ 2 * x2 * e3 ^ 2 * y1 * x1 * e1 * e2 -
+8 * y2 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 * e1 * e2 +
+24 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * x1 * e1 * e2 * y1 +
+24 * y2 ^ 2 * y3 ^ 2 * x2 * e3 ^ 2 * x1 * e1 * e2 +
+8 * y2 ^ 2 * y3 * x2 ^ 2 * e3 ^ 2 * e1 * e2 * y1 +
+8 * y2 ^ 2 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e1 * e2 +
+4 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e5 ^ 2 +
+4 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e6 ^ 2 +
+16 * y2 ^ 5 * y3 * x3 * e3 ^ 2 * y1 ^ 2 +
+4 * y2 * y3 * x3 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 +
+4 * y2 * y3 ^ 3 * x3 * e3 ^ 2 * e2 ^ 2 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e5 * x1 * e1 -
+32 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e5 * x2 * e1 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e6 * x1 * e1 -
+32 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * e6 * x2 * e1 +
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 -
+16 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+24 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 -
+8 * y2 * y3 * x3 * e3 ^ 2 * y1 ^ 2 * x2 * e1 * e2 -
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e5 * x1 * e1 -
+8 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e5 * x2 * e1 -
+8 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * e5 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * x3 * e3 ^ 2 * e5 * e2 -
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e6 * x1 * e1 -
+8 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * e6 * x2 * e1 -
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * e6 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * x3 * e3 ^ 2 * e6 * e2 +
+32 * y2 ^ 4 * y3 * x3 * e3 ^ 2 * y1 * x1 * e1 +
+16 * y2 ^ 4 * y3 * x3 * e3 ^ 2 * y1 * x2 * e1 +
+16 * y2 ^ 3 * y3 ^ 2 * x3 * e3 ^ 2 * y1 * e2 +
+16 * y2 ^ 3 * y3 * x3 * e3 ^ 2 * x1 * e1 ^ 2 * x2 -
+16 * y2 * y3 ^ 2 * x3 * e3 ^ 2 * y1 * x1 * e1 * e2 -
+8 * y2 * y3 ^ 2 * x3 * e3 ^ 2 * y1 * x2 * e1 * e2 +
+16 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * x1 * e1 * e2 * y1 +
+16 * y2 ^ 2 * y3 ^ 2 * x3 * e3 ^ 2 * x1 * e1 * e2 +
+8 * y2 ^ 2 * y3 * x3 * e3 ^ 2 * x2 * e1 * e2 * y1 +
+8 * y2 ^ 2 * y3 ^ 2 * x3 * e3 ^ 2 * x2 * e1 * e2 +
+4 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * e5 ^ 2 +
+4 * y2 ^ 3 * y3 * e3 ^ 2 * x1 * e6 ^ 2 +
+16 * y2 ^ 5 * y3 * e3 ^ 2 * x1 * y1 ^ 2 +
+4 * y2 * y3 * e3 ^ 2 * x1 * e2 ^ 2 * y1 ^ 2 +
+4 * y2 * y3 ^ 3 * e3 ^ 2 * x1 * e2 ^ 2 -
+24 * y2 ^ 2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 * e5 * e1 -
+24 * y2 ^ 2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 * e6 * e1 -
+16 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e1 * e2 -
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 ^ 2 * e5 * e1 -
+8 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * e5 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * e3 ^ 2 * x1 * e5 * e2 -
+16 * y2 ^ 3 * y3 * e3 ^ 2 * x1 ^ 2 * e6 * e1 -
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * e6 * e2 * y1 -
+8 * y2 ^ 2 * y3 ^ 2 * e3 ^ 2 * x1 * e6 * e2 +
+32 * y2 ^ 4 * y3 * e3 ^ 2 * x1 ^ 2 * y1 * e1 +
+16 * y2 ^ 3 * y3 ^ 2 * e3 ^ 2 * x1 * y1 * e2 -
+16 * y2 * y3 ^ 2 * e3 ^ 2 * x1 ^ 2 * y1 * e1 * e2 +
+16 * y2 ^ 2 * y3 * e3 ^ 2 * x1 ^ 2 * e1 * e2 * y1 +
+16 * y2 ^ 2 * y3 ^ 2 * e3 ^ 2 * x1 ^ 2 * e1 * e2 -
+16 * x2 ^ 2 * e3 ^ 3 * y1 * e5 * y2 * x1 * e1 -
+4 * x2 ^ 3 * e3 ^ 3 * y1 * e5 * y2 * e1 -
+16 * x2 ^ 2 * e3 ^ 3 * y1 * e6 * y2 * x1 * e1 -
+4 * x2 ^ 3 * e3 ^ 3 * y1 * e6 * y2 * e1 +
+6 * x2 ^ 3 * e3 ^ 3 * y1 ^ 2 * x1 * e1 ^ 2 +
+10 * x2 ^ 2 * e3 ^ 3 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+8 * x2 ^ 2 * e3 ^ 3 * y1 ^ 2 * x1 * e1 * e2 -
+2 * x2 ^ 3 * e3 ^ 3 * y1 ^ 2 * e1 * e2 -
+8 * x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 * x1 * e1 -
+2 * x2 ^ 3 * e3 ^ 3 * y2 ^ 2 * e5 * e1 -
+2 * x2 ^ 2 * e3 ^ 3 * y2 * e5 * e2 * y1 -
+2 * x2 ^ 2 * e3 ^ 3 * y2 * e5 * e2 * y3 -
+8 * x2 ^ 2 * e3 ^ 3 * y2 ^ 2 * e6 * x1 * e1 -
+2 * x2 ^ 3 * e3 ^ 3 * y2 ^ 2 * e6 * e1 -
+2 * x2 ^ 2 * e3 ^ 3 * y2 * e6 * e2 * y1 -
+2 * x2 ^ 2 * e3 ^ 3 * y2 * e6 * e2 * y3 +
+16 * x2 ^ 2 * e3 ^ 3 * y1 * y2 ^ 3 * x1 * e1 +
+4 * x2 ^ 3 * e3 ^ 3 * y1 * y2 ^ 3 * e1 +
+4 * x2 ^ 2 * e3 ^ 3 * y1 * y2 ^ 2 * e2 * y3 +
+6 * x2 ^ 3 * e3 ^ 3 * y2 ^ 2 * x1 * e1 ^ 2 +
+4 * x2 ^ 3 * e3 ^ 3 * y1 * x1 * e1 ^ 2 * y2 -
+8 * x2 ^ 2 * e3 ^ 3 * y1 * x1 * e1 * e2 * y3 -
+2 * x2 ^ 3 * e3 ^ 3 * y1 * e1 * e2 * y3 +
+8 * x2 ^ 2 * e3 ^ 3 * y2 * x1 * e1 * e2 * y1 +
+8 * x2 ^ 2 * e3 ^ 3 * y2 * x1 * e1 * e2 * y3 +
+2 * x2 ^ 3 * e3 ^ 3 * y2 * e1 * e2 * y1 +
+2 * x2 ^ 3 * e3 ^ 3 * y2 * e1 * e2 * y3 -
+8 * x3 ^ 2 * e3 ^ 3 * y1 * e5 * y2 * x1 * e1 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 * e5 * y2 * x2 * e1 -
+8 * x3 ^ 2 * e3 ^ 3 * y1 * e6 * y2 * x1 * e1 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 * e6 * y2 * x2 * e1 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * x1 * e1 ^ 2 * x2 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * x1 * e1 * e2 -
+14 * x3 ^ 2 * e3 ^ 3 * y1 * x2 ^ 2 * e1 ^ 2 * y2 -
+2 * x3 ^ 2 * e3 ^ 3 * y1 ^ 2 * x2 * e1 * e2 -
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 * x1 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e5 * x2 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 * e5 * e2 * y1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 * e5 * e2 * y3 -
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e6 * x1 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * e6 * x2 * e1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 * e6 * e2 * y1 -
+2 * x3 ^ 2 * e3 ^ 3 * y2 * e6 * e2 * y3 +
+8 * x3 ^ 2 * e3 ^ 3 * y1 * y2 ^ 3 * x1 * e1 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 * y2 ^ 3 * x2 * e1 +
+4 * x3 ^ 2 * e3 ^ 3 * y1 * y2 ^ 2 * e2 * y3 +
+4 * x3 ^ 2 * e3 ^ 3 * y2 ^ 2 * x1 * e1 ^ 2 * x2 -
+8 * x3 ^ 2 * e3 ^ 3 * y1 * x1 * e1 ^ 2 * y2 * x2 -
+4 * x3 ^ 2 * e3 ^ 3 * y1 * x1 * e1 * e2 * y3 -
+2 * x3 ^ 2 * e3 ^ 3 * y1 * x2 * e1 * e2 * y3 +
+4 * x3 ^ 2 * e3 ^ 3 * y2 * x1 * e1 * e2 * y1 +
+4 * x3 ^ 2 * e3 ^ 3 * y2 * x1 * e1 * e2 * y3 +
+2 * x3 ^ 2 * e3 ^ 3 * y2 * x2 * e1 * e2 * y1 +
+2 * x3 ^ 2 * e3 ^ 3 * y2 * x2 * e1 * e2 * y3 -
+8 * e3 ^ 3 * x1 ^ 3 * y1 * e5 * y2 * e1 -
+20 * e3 ^ 3 * x1 ^ 2 * y1 * e5 * y2 * x2 * e1 -
+8 * e3 ^ 3 * x1 ^ 3 * y1 * e6 * y2 * e1 -
+20 * e3 ^ 3 * x1 ^ 2 * y1 * e6 * y2 * x2 * e1 +
+12 * e3 ^ 3 * x1 ^ 3 * y1 ^ 2 * e1 ^ 2 * x2 +
+2 * e3 ^ 3 * x1 ^ 4 * y1 * e1 ^ 2 * y2 -
+4 * e3 ^ 3 * x1 ^ 3 * y1 ^ 2 * e1 * e2 -
+10 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * x2 * e1 * e2 -
+4 * e3 ^ 3 * x1 ^ 3 * y2 ^ 2 * e5 * e1 -
+10 * e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e5 * x2 * e1 -
+2 * e3 ^ 3 * x1 ^ 2 * y2 * e5 * e2 * y1 -
+2 * e3 ^ 3 * x1 ^ 2 * y2 * e5 * e2 * y3 -
+4 * e3 ^ 3 * x1 ^ 3 * y2 ^ 2 * e6 * e1 -
+10 * e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e6 * x2 * e1 -
+2 * e3 ^ 3 * x1 ^ 2 * y2 * e6 * e2 * y1 -
+2 * e3 ^ 3 * x1 ^ 2 * y2 * e6 * e2 * y3 +
+8 * e3 ^ 3 * x1 ^ 3 * y1 * y2 ^ 3 * e1 +
+20 * e3 ^ 3 * x1 ^ 2 * y1 * y2 ^ 3 * x2 * e1 +
+4 * e3 ^ 3 * x1 ^ 2 * y1 * y2 ^ 2 * e2 * y3 +
+12 * e3 ^ 3 * x1 ^ 3 * y2 ^ 2 * e1 ^ 2 * x2 +
+8 * e3 ^ 3 * x1 ^ 3 * y1 * e1 ^ 2 * y2 * x2 -
+4 * e3 ^ 3 * x1 ^ 3 * y1 * e1 * e2 * y3 -
+10 * e3 ^ 3 * x1 ^ 2 * y1 * x2 * e1 * e2 * y3 +
+4 * e3 ^ 3 * x1 ^ 3 * y2 * e1 * e2 * y1 +
+4 * e3 ^ 3 * x1 ^ 3 * y2 * e1 * e2 * y3 +
+10 * e3 ^ 3 * x1 ^ 2 * y2 * x2 * e1 * e2 * y1 +
+10 * e3 ^ 3 * x1 ^ 2 * y2 * x2 * e1 * e2 * y3 +
+2 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * e5 ^ 2 -
+12 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 * x1 * e1 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 * e1 +
+16 * x2 * e3 ^ 3 * x3 * y1 * e5 * y2 * e6 +
+4 * x2 * e3 ^ 3 * x3 * y1 * e5 * e2 * y3 -
+12 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e6 * x1 * e1 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y1 ^ 2 * e6 * e1 +
+4 * x2 * e3 ^ 3 * x3 * y1 * e6 * e2 * y3 +
+24 * x2 * e3 ^ 3 * x3 * y1 ^ 3 * y2 * x1 * e1 +
+8 * x2 ^ 2 * e3 ^ 3 * x3 * y1 ^ 3 * y2 * e1 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * y2 * e2 * y3 +
+4 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 * e6 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 3 * e5 * y2 +
+8 * x2 * e3 ^ 3 * x3 * y1 * e5 ^ 2 * y2 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 * y2 ^ 2 +
+4 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 * e2 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 3 * e6 * y2 +
+8 * x2 * e3 ^ 3 * x3 * y1 * e6 ^ 2 * y2 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e6 * y2 ^ 2 +
+4 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e6 * e2 -
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 3 * y2 * e2 +
+16 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+2 * x2 ^ 3 * e3 ^ 3 * x3 * y1 ^ 2 * e1 ^ 2 +
+4 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * e5 * e6 -
+8 * x2 * e3 ^ 3 * x3 * y2 ^ 3 * e5 * y1 -
+8 * x2 * e3 ^ 3 * x3 * y2 ^ 3 * e6 * y1 +
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * y2 ^ 2 * e2 +
+16 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+2 * x2 ^ 3 * e3 ^ 3 * x3 * y2 ^ 2 * e1 ^ 2 +
+4 * x2 * e3 ^ 3 * x3 * e2 ^ 2 * y1 * y3 +
+2 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e5 ^ 2 +
+2 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * e6 ^ 2 +
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 4 * y2 ^ 2 +
+16 * x2 * e3 ^ 3 * x1 * y1 * e5 * y2 * e6 +
+4 * x2 * e3 ^ 3 * x1 * y1 * e5 * e2 * y3 +
+4 * x2 * e3 ^ 3 * x1 * y1 * e6 * e2 * y3 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * y2 * e2 * y3 +
+4 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * e6 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 3 * e5 * y2 +
+8 * x2 * e3 ^ 3 * x1 * y1 * e5 ^ 2 * y2 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * y2 ^ 2 +
+4 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * e2 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 3 * e6 * y2 +
+8 * x2 * e3 ^ 3 * x1 * y1 * e6 ^ 2 * y2 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e6 * y2 ^ 2 +
+4 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e6 * e2 -
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 3 * y2 * e2 +
+4 * x2 * e3 ^ 3 * x1 * y2 ^ 2 * e5 * e6 -
+8 * x2 * e3 ^ 3 * x1 * y2 ^ 3 * e5 * y1 -
+8 * x2 * e3 ^ 3 * x1 * y2 ^ 3 * e6 * y1 +
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * y2 ^ 2 * e2 +
+4 * x2 * e3 ^ 3 * x1 * e2 ^ 2 * y1 * y3 +
+2 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e5 ^ 2 +
+2 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * e6 ^ 2 +
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 4 * y2 ^ 2 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e5 * e1 +
+16 * x3 * e3 ^ 3 * x1 * y1 * e5 * y2 * e6 +
+4 * x3 * e3 ^ 3 * x1 * y1 * e5 * e2 * y3 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e6 * e1 +
+4 * x3 * e3 ^ 3 * x1 * y1 * e6 * e2 * y3 +
+16 * x3 * e3 ^ 3 * x1 ^ 2 * y1 ^ 3 * y2 * e1 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * y2 * e2 * y3 +
+4 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * e6 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 3 * e5 * y2 +
+8 * x3 * e3 ^ 3 * x1 * y1 * e5 ^ 2 * y2 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * y2 ^ 2 +
+4 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e5 * e2 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 3 * e6 * y2 +
+8 * x3 * e3 ^ 3 * x1 * y1 * e6 ^ 2 * y2 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e6 * y2 ^ 2 +
+4 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e6 * e2 -
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 3 * y2 * e2 +
+8 * x3 * e3 ^ 3 * x1 ^ 3 * y1 ^ 2 * e1 ^ 2 +
+10 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+4 * x3 * e3 ^ 3 * x1 * y2 ^ 2 * e5 * e6 -
+8 * x3 * e3 ^ 3 * x1 * y2 ^ 3 * e5 * y1 -
+8 * x3 * e3 ^ 3 * x1 * y2 ^ 3 * e6 * y1 +
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * y2 ^ 2 * e2 +
+8 * x3 * e3 ^ 3 * x1 ^ 3 * y2 ^ 2 * e1 ^ 2 +
+10 * x3 * e3 ^ 3 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+4 * x3 * e3 ^ 3 * x1 * e2 ^ 2 * y1 * y3 +
+2 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e5 ^ 2 +
+2 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * e6 ^ 2 +
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 4 * y2 ^ 2 +
+12 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e5 * e1 -
+16 * e6 ^ 2 * x2 * e3 ^ 2 * y1 * e5 * y2 -
+4 * e6 * x2 * e3 ^ 2 * y1 * e5 * e2 * y3 +
+12 * e6 ^ 2 * x2 * e3 ^ 2 * y1 ^ 2 * x1 * e1 +
+4 * e6 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e1 -
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y1 * e2 * y3 -
+24 * e6 * x2 * e3 ^ 2 * y1 ^ 3 * y2 * x1 * e1 -
+8 * e6 * x2 ^ 2 * e3 ^ 2 * y1 ^ 3 * y2 * e1 +
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e1 -
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y1 ^ 2 * e5 +
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 3 * e5 * y2 -
+8 * e6 * x2 * e3 ^ 2 * y1 * e5 ^ 2 * y2 +
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * e2 +
+8 * e6 ^ 2 * x2 * e3 ^ 2 * y1 ^ 3 * y2 - 8 * e6 ^ 3 * x2 * e3 ^ 2 * y1 * y2 +
+8 * e6 ^ 2 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 -
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y1 ^ 2 * e2 +
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 3 * y2 * e2 -
+16 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e6 * x2 ^ 3 * e3 ^ 2 * y1 ^ 2 * e1 ^ 2 -
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y2 ^ 2 * e5 +
+8 * e6 * x2 * e3 ^ 2 * y2 ^ 3 * e5 * y1 +
+8 * e6 ^ 2 * x2 * e3 ^ 2 * y2 ^ 3 * y1 -
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 -
+16 * e6 * x2 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+6 * e6 * x2 ^ 3 * e3 ^ 2 * y2 ^ 2 * e1 ^ 2 -
+4 * e6 * x2 * e3 ^ 2 * e2 ^ 2 * y1 * y3 -
+2 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 -
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 +
+4 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x2 * e1 -
+16 * e6 ^ 2 * x3 * e3 ^ 2 * y1 * e5 * y2 -
+4 * e6 * x3 * e3 ^ 2 * y1 * e5 * e2 * y3 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 +
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * x2 * e1 -
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y1 * e2 * y3 -
+16 * e6 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * x1 * e1 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * x2 * e1 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x2 * e1 -
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * e5 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 3 * e5 * y2 -
+8 * e6 * x3 * e3 ^ 2 * y1 * e5 ^ 2 * y2 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * e2 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 3 * y2 - 8 * e6 ^ 3 * x3 * e3 ^ 2 * y1 * y2 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 -
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y1 ^ 2 * e2 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * e2 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y2 ^ 2 * e5 +
+8 * e6 * x3 * e3 ^ 2 * y2 ^ 3 * e5 * y1 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y2 ^ 3 * y1 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 -
+8 * e6 * x3 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+14 * e6 * x3 * e3 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e6 * x3 * e3 ^ 2 * e2 ^ 2 * y1 * y3 -
+2 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e5 * e1 -
+16 * e6 ^ 2 * e3 ^ 2 * x1 * y1 * e5 * y2 -
+4 * e6 * e3 ^ 2 * x1 * y1 * e5 * e2 * y3 +
+8 * e6 ^ 2 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e1 -
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y1 * e2 * y3 -
+16 * e6 * e3 ^ 2 * x1 ^ 2 * y1 ^ 3 * y2 * e1 +
+4 * e6 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * y2 ^ 2 * e1 -
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y1 ^ 2 * e5 +
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 3 * e5 * y2 -
+8 * e6 * e3 ^ 2 * x1 * y1 * e5 ^ 2 * y2 +
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * e2 +
+8 * e6 ^ 2 * e3 ^ 2 * x1 * y1 ^ 3 * y2 - 8 * e6 ^ 3 * e3 ^ 2 * x1 * y1 * y2 +
+8 * e6 ^ 2 * e3 ^ 2 * x1 * y1 ^ 2 * y2 ^ 2 -
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y1 ^ 2 * e2 +
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 3 * y2 * e2 -
+8 * e6 * e3 ^ 2 * x1 ^ 3 * y1 ^ 2 * e1 ^ 2 -
+10 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y2 ^ 2 * e5 +
+8 * e6 * e3 ^ 2 * x1 * y2 ^ 3 * e5 * y1 +
+8 * e6 ^ 2 * e3 ^ 2 * x1 * y2 ^ 3 * y1 -
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * y2 ^ 2 * e2 -
+8 * e6 * e3 ^ 2 * x1 ^ 3 * y2 ^ 2 * e1 ^ 2 -
+2 * e6 * e3 ^ 2 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e6 * e3 ^ 2 * x1 * e2 ^ 2 * y1 * y3 -
+2 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * e5 ^ 2 -
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 4 * y2 ^ 2 +
+12 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e5 * e1 -
+16 * e7 * x2 * e3 ^ 2 * y1 * e5 * y2 * e6 -
+4 * e7 * x2 * e3 ^ 2 * y1 * e5 * e2 * y3 +
+12 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e6 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e6 * e1 -
+4 * e7 * x2 * e3 ^ 2 * y1 * e6 * e2 * y3 -
+24 * e7 * x2 * e3 ^ 2 * y1 ^ 3 * y2 * x1 * e1 -
+8 * e7 * x2 ^ 2 * e3 ^ 2 * y1 ^ 3 * y2 * e1 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e1 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * y2 * e2 * y3 -
+4 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * e6 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 3 * e5 * y2 -
+8 * e7 * x2 * e3 ^ 2 * y1 * e5 ^ 2 * y2 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e5 * e2 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 3 * e6 * y2 -
+8 * e7 * x2 * e3 ^ 2 * y1 * e6 ^ 2 * y2 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e6 * y2 ^ 2 -
+4 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e6 * e2 +
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 3 * y2 * e2 -
+16 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e7 * x2 ^ 3 * e3 ^ 2 * y1 ^ 2 * e1 ^ 2 -
+4 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * e5 * e6 +
+8 * e7 * x2 * e3 ^ 2 * y2 ^ 3 * e5 * y1 +
+8 * e7 * x2 * e3 ^ 2 * y2 ^ 3 * e6 * y1 -
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 -
+16 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e7 * x2 ^ 3 * e3 ^ 2 * y2 ^ 2 * e1 ^ 2 -
+4 * e7 * x2 * e3 ^ 2 * e2 ^ 2 * y1 * y3 -
+2 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 -
+2 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * e6 ^ 2 -
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * x2 * e1 -
+16 * e7 * x3 * e3 ^ 2 * y1 * e5 * y2 * e6 -
+4 * e7 * x3 * e3 ^ 2 * y1 * e5 * e2 * y3 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * x1 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * x2 * e1 -
+4 * e7 * x3 * e3 ^ 2 * y1 * e6 * e2 * y3 -
+16 * e7 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * x1 * e1 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * x2 * e1 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * x2 * e1 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * y2 * e2 * y3 -
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * e6 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 3 * e5 * y2 -
+8 * e7 * x3 * e3 ^ 2 * y1 * e5 ^ 2 * y2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 * e2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 3 * e6 * y2 -
+8 * e7 * x3 * e3 ^ 2 * y1 * e6 ^ 2 * y2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * y2 ^ 2 -
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e6 * e2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 3 * y2 * e2 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e5 * e6 +
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 3 * e5 * y1 +
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 3 * e6 * y1 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 -
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+2 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e7 * x3 * e3 ^ 2 * e2 ^ 2 * y1 * y3 -
+2 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e5 ^ 2 -
+2 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * e6 ^ 2 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 4 * y2 ^ 2 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e5 * e1 -
+16 * e7 * e3 ^ 2 * x1 * y1 * e5 * y2 * e6 -
+4 * e7 * e3 ^ 2 * x1 * y1 * e5 * e2 * y3 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e6 * e1 -
+4 * e7 * e3 ^ 2 * x1 * y1 * e6 * e2 * y3 -
+16 * e7 * e3 ^ 2 * x1 ^ 2 * y1 ^ 3 * y2 * e1 +
+4 * e7 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * y2 ^ 2 * e1 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * y2 * e2 * y3 -
+4 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * e6 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 3 * e5 * y2 -
+8 * e7 * e3 ^ 2 * x1 * y1 * e5 ^ 2 * y2 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * y2 ^ 2 -
+4 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e5 * e2 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 3 * e6 * y2 -
+8 * e7 * e3 ^ 2 * x1 * y1 * e6 ^ 2 * y2 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e6 * y2 ^ 2 -
+4 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e6 * e2 +
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 3 * y2 * e2 -
+8 * e7 * e3 ^ 2 * x1 ^ 3 * y1 ^ 2 * e1 ^ 2 -
+10 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e7 * e3 ^ 2 * x1 * y2 ^ 2 * e5 * e6 +
+8 * e7 * e3 ^ 2 * x1 * y2 ^ 3 * e5 * y1 +
+8 * e7 * e3 ^ 2 * x1 * y2 ^ 3 * e6 * y1 -
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * y2 ^ 2 * e2 -
+8 * e7 * e3 ^ 2 * x1 ^ 3 * y2 ^ 2 * e1 ^ 2 -
+10 * e7 * e3 ^ 2 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+4 * e7 * e3 ^ 2 * x1 * e2 ^ 2 * y1 * y3 -
+2 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e5 ^ 2 -
+2 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * e6 ^ 2 -
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 4 * y2 ^ 2 +
+2 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * e6 ^ 2 +
+8 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * y2 ^ 4 +
+2 * x2 * e3 ^ 3 * x3 * e2 ^ 2 * y1 ^ 2 +
+2 * x2 * e3 ^ 3 * x3 * e2 ^ 2 * y3 ^ 2 -
+24 * x2 * e3 ^ 3 * x3 * y1 * e5 * y2 * x1 * e1 -
+8 * x2 ^ 2 * e3 ^ 3 * x3 * y1 * e5 * y2 * e1 -
+24 * x2 * e3 ^ 3 * x3 * y1 * e6 * y2 * x1 * e1 -
+8 * x2 ^ 2 * e3 ^ 3 * x3 * y1 * e6 * y2 * e1 +
+16 * x2 * e3 ^ 3 * x3 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+12 * x2 * e3 ^ 3 * x3 * y1 ^ 2 * x1 * e1 * e2 -
+4 * x2 ^ 3 * e3 ^ 3 * x3 * y1 * e1 ^ 2 * y2 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y1 ^ 2 * e1 * e2 -
+12 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * e5 * x1 * e1 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y2 ^ 2 * e5 * e1 -
+4 * x2 * e3 ^ 3 * x3 * y2 * e5 * e2 * y1 -
+4 * x2 * e3 ^ 3 * x3 * y2 * e5 * e2 * y3 -
+12 * x2 * e3 ^ 3 * x3 * y2 ^ 2 * e6 * x1 * e1 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y2 ^ 2 * e6 * e1 -
+4 * x2 * e3 ^ 3 * x3 * y2 * e6 * e2 * y1 -
+4 * x2 * e3 ^ 3 * x3 * y2 * e6 * e2 * y3 +
+24 * x2 * e3 ^ 3 * x3 * y1 * y2 ^ 3 * x1 * e1 +
+8 * x2 ^ 2 * e3 ^ 3 * x3 * y1 * y2 ^ 3 * e1 +
+8 * x2 * e3 ^ 3 * x3 * y1 * y2 ^ 2 * e2 * y3 +
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y1 * x1 * e1 ^ 2 * y2 -
+12 * x2 * e3 ^ 3 * x3 * y1 * x1 * e1 * e2 * y3 -
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y1 * e1 * e2 * y3 +
+12 * x2 * e3 ^ 3 * x3 * y2 * x1 * e1 * e2 * y1 +
+12 * x2 * e3 ^ 3 * x3 * y2 * x1 * e1 * e2 * y3 +
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y2 * e1 * e2 * y1 +
+4 * x2 ^ 2 * e3 ^ 3 * x3 * y2 * e1 * e2 * y3 +
+2 * x2 * e3 ^ 3 * x1 * y2 ^ 2 * e5 ^ 2 +
+2 * x2 * e3 ^ 3 * x1 * y2 ^ 2 * e6 ^ 2 +
+8 * x2 * e3 ^ 3 * x1 * y1 ^ 2 * y2 ^ 4 +
+2 * x2 * e3 ^ 3 * x1 * e2 ^ 2 * y1 ^ 2 +
+2 * x2 * e3 ^ 3 * x1 * e2 ^ 2 * y3 ^ 2 -
+4 * x2 * e3 ^ 3 * x1 * y2 * e5 * e2 * y1 -
+4 * x2 * e3 ^ 3 * x1 * y2 * e5 * e2 * y3 -
+4 * x2 * e3 ^ 3 * x1 * y2 * e6 * e2 * y1 -
+4 * x2 * e3 ^ 3 * x1 * y2 * e6 * e2 * y3 +
+8 * x2 * e3 ^ 3 * x1 * y1 * y2 ^ 2 * e2 * y3 +
+2 * x3 * e3 ^ 3 * x1 * y2 ^ 2 * e5 ^ 2 +
+2 * x3 * e3 ^ 3 * x1 * y2 ^ 2 * e6 ^ 2 +
+8 * x3 * e3 ^ 3 * x1 * y1 ^ 2 * y2 ^ 4 +
+2 * x3 * e3 ^ 3 * x1 * e2 ^ 2 * y1 ^ 2 +
+2 * x3 * e3 ^ 3 * x1 * e2 ^ 2 * y3 ^ 2 -
+16 * x3 * e3 ^ 3 * x1 ^ 2 * y1 * e5 * y2 * e1 -
+16 * x3 * e3 ^ 3 * x1 ^ 2 * y1 * e6 * y2 * e1 +
+8 * x3 * e3 ^ 3 * x1 ^ 3 * y1 * e1 ^ 2 * y2 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y1 ^ 2 * e1 * e2 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e5 * e1 -
+4 * x3 * e3 ^ 3 * x1 * y2 * e5 * e2 * y1 -
+4 * x3 * e3 ^ 3 * x1 * y2 * e5 * e2 * y3 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y2 ^ 2 * e6 * e1 -
+4 * x3 * e3 ^ 3 * x1 * y2 * e6 * e2 * y1 -
+4 * x3 * e3 ^ 3 * x1 * y2 * e6 * e2 * y3 +
+16 * x3 * e3 ^ 3 * x1 ^ 2 * y1 * y2 ^ 3 * e1 +
+8 * x3 * e3 ^ 3 * x1 * y1 * y2 ^ 2 * e2 * y3 -
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y1 * e1 * e2 * y3 +
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y2 * e1 * e2 * y1 +
+8 * x3 * e3 ^ 3 * x1 ^ 2 * y2 * e1 * e2 * y3 -
+2 * e6 * x2 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+8 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 -
+2 * e6 * x2 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 -
+2 * e6 * x2 * e3 ^ 2 * e2 ^ 2 * y3 ^ 2 +
+16 * e6 * x2 * e3 ^ 2 * y1 * e5 * y2 * x1 * e1 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 * e5 * y2 * e1 +
+16 * e6 ^ 2 * x2 * e3 ^ 2 * y1 * y2 * x1 * e1 +
+4 * e6 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 * y2 * e1 +
+12 * e6 * x2 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+4 * e6 * x2 ^ 3 * e3 ^ 2 * y1 * e1 ^ 2 * y2 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e1 * e2 +
+12 * e6 * x2 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 -
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * e1 +
+4 * e6 * x2 * e3 ^ 2 * y2 * e5 * e2 * y1 +
+4 * e6 * x2 * e3 ^ 2 * y2 * e5 * e2 * y3 +
+12 * e6 ^ 2 * x2 * e3 ^ 2 * y2 ^ 2 * x1 * e1 +
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y2 * e2 * y1 +
+4 * e6 ^ 2 * x2 * e3 ^ 2 * y2 * e2 * y3 -
+24 * e6 * x2 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 +
+8 * e6 * x2 ^ 2 * e3 ^ 2 * y1 * y2 ^ 3 * e1 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 * x1 * e1 ^ 2 * y2 +
+12 * e6 * x2 * e3 ^ 2 * y1 * x1 * e1 * e2 * y3 +
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y1 * e1 * e2 * y3 -
+12 * e6 * x2 * e3 ^ 2 * y2 * x1 * e1 * e2 * y1 -
+12 * e6 * x2 * e3 ^ 2 * y2 * x1 * e1 * e2 * y3 -
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y2 * e1 * e2 * y1 -
+4 * e6 * x2 ^ 2 * e3 ^ 2 * y2 * e1 * e2 * y3 -
+2 * e6 * x3 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 -
+2 * e6 * x3 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 -
+2 * e6 * x3 * e3 ^ 2 * e2 ^ 2 * y3 ^ 2 +
+8 * e6 * x3 * e3 ^ 2 * y1 * e5 * y2 * x1 * e1 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y1 * y2 * x1 * e1 -
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 +
+8 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+20 * e6 * x3 * e3 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 * y2 +
+4 * e6 * x3 * e3 ^ 2 * y1 ^ 2 * x2 * e1 * e2 +
+8 * e6 * x3 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 -
+4 * e6 * x3 * e3 ^ 2 * y2 ^ 2 * e5 * x2 * e1 +
+4 * e6 * x3 * e3 ^ 2 * y2 * e5 * e2 * y1 +
+4 * e6 * x3 * e3 ^ 2 * y2 * e5 * e2 * y3 +
+8 * e6 ^ 2 * x3 * e3 ^ 2 * y2 ^ 2 * x1 * e1 +
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y2 * e2 * y1 +
+4 * e6 ^ 2 * x3 * e3 ^ 2 * y2 * e2 * y3 -
+16 * e6 * x3 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 +
+8 * e6 * x3 * e3 ^ 2 * y1 * y2 ^ 3 * x2 * e1 +
+16 * e6 * x3 * e3 ^ 2 * y1 * x1 * e1 ^ 2 * y2 * x2 +
+8 * e6 * x3 * e3 ^ 2 * y1 * x1 * e1 * e2 * y3 +
+4 * e6 * x3 * e3 ^ 2 * y1 * x2 * e1 * e2 * y3 -
+8 * e6 * x3 * e3 ^ 2 * y2 * x1 * e1 * e2 * y1 -
+8 * e6 * x3 * e3 ^ 2 * y2 * x1 * e1 * e2 * y3 -
+4 * e6 * x3 * e3 ^ 2 * y2 * x2 * e1 * e2 * y1 -
+4 * e6 * x3 * e3 ^ 2 * y2 * x2 * e1 * e2 * y3 -
+2 * e6 * e3 ^ 2 * x1 * y2 ^ 2 * e5 ^ 2 -
+8 * e6 * e3 ^ 2 * x1 * y1 ^ 2 * y2 ^ 4 -
+2 * e6 * e3 ^ 2 * x1 * e2 ^ 2 * y1 ^ 2 -
+2 * e6 * e3 ^ 2 * x1 * e2 ^ 2 * y3 ^ 2 +
+12 * e6 * e3 ^ 2 * x1 ^ 2 * y1 * e5 * y2 * e1 +
+12 * e6 ^ 2 * e3 ^ 2 * x1 ^ 2 * y1 * y2 * e1 +
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e1 * e2 +
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y2 ^ 2 * e5 * e1 +
+4 * e6 * e3 ^ 2 * x1 * y2 * e5 * e2 * y1 +
+4 * e6 * e3 ^ 2 * x1 * y2 * e5 * e2 * y3 +
+8 * e6 ^ 2 * e3 ^ 2 * x1 ^ 2 * y2 ^ 2 * e1 +
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y2 * e2 * y1 +
+4 * e6 ^ 2 * e3 ^ 2 * x1 * y2 * e2 * y3 -
+16 * e6 * e3 ^ 2 * x1 ^ 2 * y1 * y2 ^ 3 * e1 +
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y1 * e1 * e2 * y3 -
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y2 * e1 * e2 * y1 -
+8 * e6 * e3 ^ 2 * x1 ^ 2 * y2 * e1 * e2 * y3 -
+2 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+2 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * e6 ^ 2 -
+8 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 -
+2 * e7 * x2 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 -
+2 * e7 * x2 * e3 ^ 2 * e2 ^ 2 * y3 ^ 2 +
+16 * e7 * x2 * e3 ^ 2 * y1 * e5 * y2 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 * e5 * y2 * e1 +
+16 * e7 * x2 * e3 ^ 2 * y1 * e6 * y2 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 * e6 * y2 * e1 +
+12 * e7 * x2 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+4 * e7 * x2 ^ 3 * e3 ^ 2 * y1 * e1 ^ 2 * y2 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * e1 * e2 +
+12 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * e1 +
+4 * e7 * x2 * e3 ^ 2 * y2 * e5 * e2 * y1 +
+4 * e7 * x2 * e3 ^ 2 * y2 * e5 * e2 * y3 +
+12 * e7 * x2 * e3 ^ 2 * y2 ^ 2 * e6 * x1 * e1 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * e6 * e1 +
+4 * e7 * x2 * e3 ^ 2 * y2 * e6 * e2 * y1 +
+4 * e7 * x2 * e3 ^ 2 * y2 * e6 * e2 * y3 -
+24 * e7 * x2 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 -
+8 * e7 * x2 ^ 2 * e3 ^ 2 * y1 * y2 ^ 3 * e1 -
+8 * e7 * x2 * e3 ^ 2 * y1 * y2 ^ 2 * e2 * y3 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 * x1 * e1 ^ 2 * y2 +
+12 * e7 * x2 * e3 ^ 2 * y1 * x1 * e1 * e2 * y3 +
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y1 * e1 * e2 * y3 -
+12 * e7 * x2 * e3 ^ 2 * y2 * x1 * e1 * e2 * y1 -
+12 * e7 * x2 * e3 ^ 2 * y2 * x1 * e1 * e2 * y3 -
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y2 * e1 * e2 * y1 -
+4 * e7 * x2 ^ 2 * e3 ^ 2 * y2 * e1 * e2 * y3 -
+2 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+2 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e6 ^ 2 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 -
+2 * e7 * x3 * e3 ^ 2 * e2 ^ 2 * y1 ^ 2 -
+2 * e7 * x3 * e3 ^ 2 * e2 ^ 2 * y3 ^ 2 +
+8 * e7 * x3 * e3 ^ 2 * y1 * e5 * y2 * x1 * e1 +
+8 * e7 * x3 * e3 ^ 2 * y1 * e6 * y2 * x1 * e1 -
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 +
+8 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+20 * e7 * x3 * e3 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 * y2 +
+4 * e7 * x3 * e3 ^ 2 * y1 ^ 2 * x2 * e1 * e2 +
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e5 * x2 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y2 * e5 * e2 * y1 +
+4 * e7 * x3 * e3 ^ 2 * y2 * e5 * e2 * y3 +
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e6 * x1 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * e6 * x2 * e1 +
+4 * e7 * x3 * e3 ^ 2 * y2 * e6 * e2 * y1 +
+4 * e7 * x3 * e3 ^ 2 * y2 * e6 * e2 * y3 -
+16 * e7 * x3 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 -
+8 * e7 * x3 * e3 ^ 2 * y1 * y2 ^ 3 * x2 * e1 -
+8 * e7 * x3 * e3 ^ 2 * y1 * y2 ^ 2 * e2 * y3 -
+8 * e7 * x3 * e3 ^ 2 * y2 ^ 2 * x1 * e1 ^ 2 * x2 +
+16 * e7 * x3 * e3 ^ 2 * y1 * x1 * e1 ^ 2 * y2 * x2 +
+8 * e7 * x3 * e3 ^ 2 * y1 * x1 * e1 * e2 * y3 +
+4 * e7 * x3 * e3 ^ 2 * y1 * x2 * e1 * e2 * y3 -
+8 * e7 * x3 * e3 ^ 2 * y2 * x1 * e1 * e2 * y1 -
+8 * e7 * x3 * e3 ^ 2 * y2 * x1 * e1 * e2 * y3 -
+4 * e7 * x3 * e3 ^ 2 * y2 * x2 * e1 * e2 * y1 -
+4 * e7 * x3 * e3 ^ 2 * y2 * x2 * e1 * e2 * y3 -
+2 * e7 * e3 ^ 2 * x1 * y2 ^ 2 * e5 ^ 2 -
+2 * e7 * e3 ^ 2 * x1 * y2 ^ 2 * e6 ^ 2 -
+8 * e7 * e3 ^ 2 * x1 * y1 ^ 2 * y2 ^ 4 -
+2 * e7 * e3 ^ 2 * x1 * e2 ^ 2 * y1 ^ 2 -
+2 * e7 * e3 ^ 2 * x1 * e2 ^ 2 * y3 ^ 2 +
+12 * e7 * e3 ^ 2 * x1 ^ 2 * y1 * e5 * y2 * e1 +
+12 * e7 * e3 ^ 2 * x1 ^ 2 * y1 * e6 * y2 * e1 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y1 ^ 2 * e1 * e2 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y2 ^ 2 * e5 * e1 +
+4 * e7 * e3 ^ 2 * x1 * y2 * e5 * e2 * y1 +
+4 * e7 * e3 ^ 2 * x1 * y2 * e5 * e2 * y3 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y2 ^ 2 * e6 * e1 +
+4 * e7 * e3 ^ 2 * x1 * y2 * e6 * e2 * y1 +
+4 * e7 * e3 ^ 2 * x1 * y2 * e6 * e2 * y3 -
+16 * e7 * e3 ^ 2 * x1 ^ 2 * y1 * y2 ^ 3 * e1 -
+8 * e7 * e3 ^ 2 * x1 * y1 * y2 ^ 2 * e2 * y3 +
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y1 * e1 * e2 * y3 -
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y2 * e1 * e2 * y1 -
+8 * e7 * e3 ^ 2 * x1 ^ 2 * y2 * e1 * e2 * y3 + 8 * e3 * e6 ^ 3 * y1 * e5 * y2 -
+4 * e3 * e6 ^ 3 * y1 ^ 2 * x1 * e1 - 2 * e3 * e6 ^ 3 * y1 ^ 2 * x2 * e1 +
+2 * e3 * e6 ^ 3 * y1 * e2 * y3 - 4 * e3 * e6 ^ 2 * y1 ^ 3 * e5 * y2 +
+x1 ^ 2 * e1 ^ 3 * e7 ^ 3 + 4 * e3 * e6 ^ 2 * y1 * e5 ^ 2 * y2 -
+4 * e3 * e6 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 + 2 * e3 * e6 ^ 2 * y1 ^ 2 * e5 * e2 -
+4 * e3 * e6 ^ 2 * y1 ^ 3 * y2 * e2 +
+4 * e3 * e6 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+e3 * e6 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 - 4 * e3 * e6 ^ 2 * y2 ^ 3 * e5 * y1 +
+4 * e3 * e6 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 +
+4 * e3 * e6 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+7 * e3 * e6 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+2 * e3 * e6 ^ 2 * e2 ^ 2 * y1 * y3 + 4 * e3 * e6 ^ 2 * e7 * y1 ^ 2 * e5 -
+8 * e3 * e6 ^ 2 * e7 * y1 ^ 3 * y2 + 8 * e3 * e6 ^ 3 * e7 * y1 * y2 -
+8 * e3 * e6 ^ 2 * e7 * y1 ^ 2 * y2 ^ 2 + 4 * e3 * e6 ^ 2 * e7 * y1 ^ 2 * e2 +
+4 * e3 * e6 ^ 2 * e7 * y2 ^ 2 * e5 - 8 * e3 * e6 ^ 2 * e7 * y2 ^ 3 * y1 +
+2 * e3 * e6 * e7 * y1 ^ 2 * e5 ^ 2 + 8 * e3 * e6 * e7 * y1 ^ 4 * y2 ^ 2 +
+2 * e3 * e7 ^ 2 * y1 ^ 2 * e5 * e6 - 4 * e3 * e7 ^ 2 * y1 ^ 3 * e5 * y2 +
+4 * e3 * e7 ^ 2 * y1 * e5 ^ 2 * y2 - 4 * e3 * e6 ^ 2 * y1 ^ 2 * e5 * x1 * e1 -
+2 * e3 * e6 ^ 2 * y1 ^ 2 * e5 * x2 * e1 + 2 * e3 * e6 ^ 2 * y1 * e5 * e2 * y3 +
+8 * e3 * e6 ^ 2 * y1 ^ 3 * y2 * x1 * e1 +
+4 * e3 * e6 ^ 2 * y1 ^ 3 * y2 * x2 * e1 -
+8 * e3 * e6 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 -
+8 * e3 * e6 ^ 2 * y1 ^ 2 * y2 ^ 2 * x2 * e1 -
+12 * e3 * e6 ^ 2 * y1 ^ 2 * y2 * e2 * y3 + e1 * e5 ^ 2 * e6 ^ 3 -
+8 * e3 * e6 * e7 * y1 ^ 2 * e5 * x1 * e1 -
+4 * e3 * e6 * e7 * y1 ^ 2 * e5 * x2 * e1 +
+16 * e3 * e6 ^ 2 * e7 * y1 * e5 * y2 + 4 * e3 * e6 * e7 * y1 * e5 * e2 * y3 -
+8 * e3 * e6 ^ 2 * e7 * y1 ^ 2 * x1 * e1 -
+4 * e3 * e6 ^ 2 * e7 * y1 ^ 2 * x2 * e1 + 4 * e3 * e6 ^ 2 * e7 * y1 * e2 * y3 +
+16 * e3 * e6 * e7 * y1 ^ 3 * y2 * x1 * e1 +
+8 * e3 * e6 * e7 * y1 ^ 3 * y2 * x2 * e1 -
+16 * e3 * e6 * e7 * y1 ^ 2 * y2 ^ 2 * x1 * e1 -
+16 * e3 * e6 * e7 * y1 ^ 2 * y2 ^ 2 * x2 * e1 -
+16 * e3 * e6 * e7 * y1 ^ 2 * y2 * e2 * y3 -
+8 * e3 * e6 * e7 * y1 ^ 3 * e5 * y2 + 8 * e3 * e6 * e7 * y1 * e5 ^ 2 * y2 -
+8 * e3 * e6 * e7 * y1 ^ 2 * e5 * y2 ^ 2 + 4 * e3 * e6 * e7 * y1 ^ 2 * e5 * e2 -
+8 * e3 * e6 * e7 * y1 ^ 3 * y2 * e2 +
+8 * e3 * e6 * e7 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+2 * e3 * e6 * e7 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+8 * e3 * e6 * e7 * y2 ^ 3 * e5 * y1 + 8 * e3 * e6 * e7 * y1 ^ 2 * y2 ^ 2 * e2 +
+8 * e3 * e6 * e7 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+6 * e3 * e6 * e7 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+4 * e3 * e6 * e7 * e2 ^ 2 * y1 * y3 - 4 * e3 * e7 ^ 2 * y1 ^ 2 * e5 * x1 * e1 -
+2 * e3 * e7 ^ 2 * y1 ^ 2 * e5 * x2 * e1 + 8 * e3 * e7 ^ 2 * y1 * e5 * y2 * e6 +
+2 * e3 * e7 ^ 2 * y1 * e5 * e2 * y3 - 4 * e3 * e7 ^ 2 * y1 ^ 2 * e6 * x1 * e1 -
+2 * e3 * e7 ^ 2 * y1 ^ 2 * e6 * x2 * e1 + 2 * e3 * e7 ^ 2 * y1 * e6 * e2 * y3 +
+8 * e3 * e7 ^ 2 * y1 ^ 3 * y2 * x1 * e1 +
+4 * e3 * e7 ^ 2 * y1 ^ 3 * y2 * x2 * e1 -
+8 * e3 * e7 ^ 2 * y1 ^ 2 * y2 ^ 2 * x1 * e1 -
+8 * e3 * e7 ^ 2 * y1 ^ 2 * y2 ^ 2 * x2 * e1 -
+4 * e3 * e7 ^ 2 * y1 ^ 2 * y2 * e2 * y3 -
+4 * e3 * e7 ^ 2 * y1 ^ 2 * e5 * y2 ^ 2 + 2 * e3 * e7 ^ 2 * y1 ^ 2 * e5 * e2 -
+4 * e3 * e7 ^ 2 * y1 ^ 3 * e6 * y2 + 4 * e3 * e7 ^ 2 * y1 * e6 ^ 2 * y2 -
+4 * e3 * e7 ^ 2 * y1 ^ 2 * e6 * y2 ^ 2 + 2 * e3 * e7 ^ 2 * y1 ^ 2 * e6 * e2 -
+4 * e3 * e7 ^ 2 * y1 ^ 3 * y2 * e2 +
+4 * e3 * e7 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+e3 * e7 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 + 2 * e3 * e7 ^ 2 * y2 ^ 2 * e5 * e6 -
+4 * e3 * e7 ^ 2 * y2 ^ 3 * e5 * y1 - 4 * e3 * e7 ^ 2 * y2 ^ 3 * e6 * y1 +
+4 * e3 * e7 ^ 2 * y1 ^ 2 * y2 ^ 2 * e2 +
+4 * e3 * e7 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+e3 * e7 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 2 + 2 * e3 * e7 ^ 2 * e2 ^ 2 * y1 * y3 -
+16 * e3 * y2 ^ 3 * y3 ^ 3 * y1 ^ 2 * e2 -
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 ^ 3 * e5 +
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * e5 ^ 2 -
+16 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * e5 -
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 ^ 3 * e6 +
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * e6 ^ 2 -
+16 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * e6 -
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 ^ 3 * e2 + 8 * e3 * y2 ^ 4 * y3 ^ 2 * e5 * e6 -
+16 * e3 * y2 ^ 5 * y3 ^ 2 * e5 * y1 - 16 * e3 * y2 ^ 5 * y3 ^ 2 * e6 * y1 +
+16 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * e2 +
+16 * e3 * y2 ^ 4 * y3 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * e3 * y2 ^ 4 * y3 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+8 * e3 * y2 ^ 2 * y3 ^ 3 * e2 ^ 2 * y1 +
+4 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e5 ^ 2 +
+4 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e6 ^ 2 -
+4 * e3 * e6 ^ 3 * y2 ^ 2 * x1 * e1 + 2 * e3 * e6 ^ 3 * y2 ^ 2 * x2 * e1 -
+2 * e3 * e6 ^ 3 * y2 * e2 * y1 - 2 * e3 * e6 ^ 3 * y2 * e2 * y3 +
+2 * e3 * e6 * e7 * y2 ^ 2 * e5 ^ 2 + 8 * e3 * e6 * e7 * y1 ^ 2 * y2 ^ 4 +
+2 * e3 * e6 * e7 * e2 ^ 2 * y1 ^ 2 + 2 * e3 * e6 * e7 * e2 ^ 2 * y3 ^ 2 +
+4 * e3 * y2 ^ 2 * y3 ^ 2 * e2 ^ 2 * y1 ^ 2 -
+8 * e3 * y2 ^ 3 * y3 ^ 3 * e5 * e2 - 8 * e3 * y2 ^ 3 * y3 ^ 3 * e6 * e2 +
+16 * e3 * y2 ^ 4 * y3 ^ 3 * y1 * e2 + 16 * e3 * e6 ^ 2 * y2 ^ 2 * y3 * y1 ^ 3 -
+16 * e3 * e6 ^ 3 * y2 ^ 2 * y3 * y1 + 16 * e3 * e6 ^ 2 * y2 ^ 3 * y3 * y1 ^ 2 -
+8 * e3 * e6 ^ 2 * y2 ^ 3 * y3 * e5 -
+16 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e5 * x1 * e1 -
+8 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e5 * x2 * e1 +
+32 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * e5 * e6 +
+8 * e3 * y2 ^ 2 * y3 ^ 3 * y1 * e5 * e2 -
+16 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e6 * x1 * e1 +
+8 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e6 * x2 * e1 +
+8 * e3 * y2 ^ 2 * y3 ^ 3 * y1 * e6 * e2 +
+32 * e3 * y2 ^ 3 * y3 ^ 2 * y1 ^ 3 * x1 * e1 +
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 ^ 3 * x2 * e1 -
+32 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * x1 * e1 +
+32 * e3 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * x2 * e1 +
+8 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e5 * e6 +
+8 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e5 * e2 + x2 ^ 2 * e1 ^ 3 * e7 ^ 3 +
+24 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e6 * e2 +
+16 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 +
+4 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+4 * e3 * e7 ^ 2 * y1 ^ 2 * y2 ^ 4 + e3 * e7 ^ 2 * e2 ^ 2 * y1 ^ 2 +
+e3 * e7 ^ 2 * e2 ^ 2 * y3 ^ 2 + 4 * e3 * y2 ^ 4 * y3 ^ 2 * e5 ^ 2 +
+4 * e3 * y2 ^ 4 * y3 ^ 2 * e6 ^ 2 + 16 * e3 * y2 ^ 6 * y3 ^ 2 * y1 ^ 2 +
+4 * e3 * y2 ^ 2 * y3 ^ 4 * e2 ^ 2 - 4 * e3 * e6 ^ 3 * y2 ^ 3 * y3 +
+4 * e3 * e6 ^ 2 * y1 * e5 * y2 * x2 * e1 +
+4 * e3 * e6 ^ 3 * y1 * y2 * x2 * e1 +
+4 * e3 * e6 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 -
+6 * e3 * e6 ^ 2 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+4 * e3 * e6 ^ 2 * y1 ^ 2 * x1 * e1 * e2 -
+8 * e3 * e6 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 * y2 -
+2 * e3 * e6 ^ 2 * y1 ^ 2 * x2 * e1 * e2 -
+4 * e3 * e6 ^ 2 * y2 ^ 2 * e5 * x1 * e1 +
+6 * e3 * e6 ^ 2 * y2 ^ 2 * e5 * x2 * e1 - 2 * e3 * e6 ^ 2 * y2 * e5 * e2 * y1 -
+2 * e3 * e6 ^ 2 * y2 * e5 * e2 * y3 + 8 * e3 * e6 ^ 2 * y1 * y2 ^ 3 * x1 * e1 -
+12 * e3 * e6 ^ 2 * y1 * y2 ^ 3 * x2 * e1 +
+12 * e3 * e6 ^ 2 * y1 * y2 ^ 2 * e2 * y3 -
+4 * e3 * e6 ^ 2 * y2 ^ 2 * x1 * e1 ^ 2 * x2 -
+12 * e3 * e6 ^ 2 * y1 * x1 * e1 ^ 2 * y2 * x2 -
+4 * e3 * e6 ^ 2 * y1 * x1 * e1 * e2 * y3 -
+2 * e3 * e6 ^ 2 * y1 * x2 * e1 * e2 * y3 +
+4 * e3 * e6 ^ 2 * y2 * x1 * e1 * e2 * y1 +
+4 * e3 * e6 ^ 2 * y2 * x1 * e1 * e2 * y3 +
+2 * e3 * e6 ^ 2 * y2 * x2 * e1 * e2 * y1 +
+2 * e3 * e6 ^ 2 * y2 * x2 * e1 * e2 * y3 +
+8 * e3 * e6 * e7 * y1 * e5 * y2 * x2 * e1 +
+8 * e3 * e6 ^ 2 * e7 * y1 * y2 * x2 * e1 +
+8 * e3 * e6 * e7 * y1 ^ 2 * x1 * e1 ^ 2 * x2 -
+12 * e3 * e6 * e7 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+8 * e3 * e6 * e7 * y1 ^ 2 * x1 * e1 * e2 -
+16 * e3 * e6 * e7 * y1 * x2 ^ 2 * e1 ^ 2 * y2 -
+4 * e3 * e6 * e7 * y1 ^ 2 * x2 * e1 * e2 -
+8 * e3 * e6 * e7 * y2 ^ 2 * e5 * x1 * e1 +
+4 * e3 * e6 * e7 * y2 ^ 2 * e5 * x2 * e1 -
+4 * e3 * e6 * e7 * y2 * e5 * e2 * y1 - 4 * e3 * e6 * e7 * y2 * e5 * e2 * y3 -
+8 * e3 * e6 ^ 2 * e7 * y2 ^ 2 * x1 * e1 - 4 * e3 * e6 ^ 2 * e7 * y2 * e2 * y1 -
+4 * e3 * e6 ^ 2 * e7 * y2 * e2 * y3 +
+16 * e3 * e6 * e7 * y1 * y2 ^ 3 * x1 * e1 -
+8 * e3 * e6 * e7 * y1 * y2 ^ 3 * x2 * e1 +
+16 * e3 * e6 * e7 * y1 * y2 ^ 2 * e2 * y3 -
+24 * e3 * e6 * e7 * y1 * x1 * e1 ^ 2 * y2 * x2 -
+8 * e3 * e6 * e7 * y1 * x1 * e1 * e2 * y3 -
+4 * e3 * e6 * e7 * y1 * x2 * e1 * e2 * y3 +
+8 * e3 * e6 * e7 * y2 * x1 * e1 * e2 * y1 +
+8 * e3 * e6 * e7 * y2 * x1 * e1 * e2 * y3 +
+4 * e3 * e6 * e7 * y2 * x2 * e1 * e2 * y1 +
+4 * e3 * e6 * e7 * y2 * x2 * e1 * e2 * y3 +
+4 * e3 * e7 ^ 2 * y1 * e5 * y2 * x2 * e1 +
+4 * e3 * e7 ^ 2 * y1 * e6 * y2 * x2 * e1 +
+4 * e3 * e7 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 -
+6 * e3 * e7 ^ 2 * y1 * x1 ^ 2 * e1 ^ 2 * y2 -
+4 * e3 * e7 ^ 2 * y1 ^ 2 * x1 * e1 * e2 -
+8 * e3 * e7 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 * y2 -
+2 * e3 * e7 ^ 2 * y1 ^ 2 * x2 * e1 * e2 -
+4 * e3 * e7 ^ 2 * y2 ^ 2 * e5 * x1 * e1 -
+2 * e3 * e7 ^ 2 * y2 ^ 2 * e5 * x2 * e1 - 2 * e3 * e7 ^ 2 * y2 * e5 * e2 * y1 -
+2 * e3 * e7 ^ 2 * y2 * e5 * e2 * y3 - 4 * e3 * e7 ^ 2 * y2 ^ 2 * e6 * x1 * e1 -
+2 * e3 * e7 ^ 2 * y2 ^ 2 * e6 * x2 * e1 - 2 * e3 * e7 ^ 2 * y2 * e6 * e2 * y1 -
+2 * e3 * e7 ^ 2 * y2 * e6 * e2 * y3 + 8 * e3 * e7 ^ 2 * y1 * y2 ^ 3 * x1 * e1 +
+4 * e3 * e7 ^ 2 * y1 * y2 ^ 3 * x2 * e1 +
+4 * e3 * e7 ^ 2 * y1 * y2 ^ 2 * e2 * y3 +
+4 * e3 * e7 ^ 2 * y2 ^ 2 * x1 * e1 ^ 2 * x2 -
+12 * e3 * e7 ^ 2 * y1 * x1 * e1 ^ 2 * y2 * x2 -
+4 * e3 * e7 ^ 2 * y1 * x1 * e1 * e2 * y3 -
+2 * e3 * e7 ^ 2 * y1 * x2 * e1 * e2 * y3 +
+4 * e3 * e7 ^ 2 * y2 * x1 * e1 * e2 * y1 +
+4 * e3 * e7 ^ 2 * y2 * x1 * e1 * e2 * y3 +
+2 * e3 * e7 ^ 2 * y2 * x2 * e1 * e2 * y1 +
+2 * e3 * e7 ^ 2 * y2 * x2 * e1 * e2 * y3 -
+48 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * e5 * x2 * e1 -
+48 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * e6 * x2 * e1 +
+16 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 * x2 -
+24 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * x1 ^ 2 * e1 ^ 2 -
+16 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * x1 * e1 * e2 +
+32 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * x2 ^ 2 * e1 ^ 2 -
+8 * e3 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * x2 * e1 * e2 -
+16 * e3 * y2 ^ 4 * y3 ^ 2 * e5 * x1 * e1 -
+8 * e3 * y2 ^ 4 * y3 ^ 2 * e5 * x2 * e1 -
+8 * e3 * y2 ^ 3 * y3 ^ 2 * e5 * e2 * y1 -
+16 * e3 * y2 ^ 4 * y3 ^ 2 * e6 * x1 * e1 -
+8 * e3 * y2 ^ 4 * y3 ^ 2 * e6 * x2 * e1 -
+24 * e3 * y2 ^ 3 * y3 ^ 2 * e6 * e2 * y1 +
+32 * e3 * y2 ^ 5 * y3 ^ 2 * y1 * x1 * e1 +
+16 * e3 * y2 ^ 5 * y3 ^ 2 * y1 * x2 * e1 +
+16 * e3 * y2 ^ 4 * y3 ^ 2 * x1 * e1 ^ 2 * x2 +
+16 * e3 * y2 ^ 3 * y3 ^ 2 * y1 * x1 * e1 ^ 2 * x2 -
+16 * e3 * y2 ^ 2 * y3 ^ 3 * y1 * x1 * e1 * e2 -
+8 * e3 * y2 ^ 2 * y3 ^ 3 * y1 * x2 * e1 * e2 +
+16 * e3 * y2 ^ 3 * y3 ^ 2 * x1 * e1 * e2 * y1 +
+16 * e3 * y2 ^ 3 * y3 ^ 3 * x1 * e1 * e2 +
+8 * e3 * y2 ^ 3 * y3 ^ 2 * x2 * e1 * e2 * y1 +
+8 * e3 * y2 ^ 3 * y3 ^ 3 * x2 * e1 * e2 - e3 * e6 ^ 3 * e7 ^ 2 +
+16 * e3 * e6 * y2 * y3 * y1 ^ 2 * e5 * x1 * e1 +
+8 * e3 * e6 * y2 * y3 * y1 ^ 2 * e5 * x2 * e1 -
+32 * e3 * e6 ^ 2 * y2 ^ 2 * y3 * y1 * e5 -
+8 * e3 * e6 * y2 * y3 ^ 2 * y1 * e5 * e2 +
+16 * e3 * e6 ^ 2 * y2 * y3 * y1 ^ 2 * x1 * e1 +
+8 * e3 * e6 ^ 2 * y2 * y3 * y1 ^ 2 * x2 * e1 -
+8 * e3 * e6 ^ 2 * y2 * y3 ^ 2 * y1 * e2 -
+32 * e3 * e6 * y2 ^ 2 * y3 * y1 ^ 3 * x1 * e1 -
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 ^ 3 * x2 * e1 +
+32 * e3 * e6 * y2 ^ 3 * y3 * y1 ^ 2 * x1 * e1 -
+8 * e3 * e6 ^ 2 * y2 * y3 * y1 ^ 2 * e5 +
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 ^ 3 * e5 -
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 * e5 ^ 2 +
+16 * e3 * e6 * y2 ^ 3 * y3 * y1 ^ 2 * e5 -
+8 * e3 * e6 * y2 * y3 * y1 ^ 2 * e5 * e2 +
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 ^ 3 * e2 -
+16 * e3 * e6 * y2 * y3 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+4 * e3 * e6 * y2 * y3 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 +
+16 * e3 * e6 * y2 ^ 4 * y3 * e5 * y1 + 16 * e3 * e6 ^ 2 * y2 ^ 4 * y3 * y1 -
+4 * e3 * e6 ^ 3 * y2 * y3 * y1 ^ 2 - 16 * e3 * e6 * y2 ^ 3 * y3 * y1 ^ 4 -
+16 * e3 * e7 * y2 ^ 3 * y3 * y1 ^ 4 - 4 * e3 * e6 * y2 ^ 3 * y3 * e5 ^ 2 -
+16 * e3 * e6 * y2 ^ 5 * y3 * y1 ^ 2 - 4 * e3 * e6 * y2 * y3 ^ 3 * e2 ^ 2 +
+8 * e3 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 * e2 - 4 * e3 * e7 * y2 ^ 3 * y3 * e5 ^ 2 -
+4 * e3 * e7 * y2 ^ 3 * y3 * e6 ^ 2 - 16 * e3 * e7 * y2 ^ 5 * y3 * y1 ^ 2 -
+4 * e3 * e7 * y2 * y3 ^ 3 * e2 ^ 2 - 16 * e3 * e6 * y2 ^ 3 * y3 * y1 ^ 2 * e2 -
+16 * e3 * e6 * y2 ^ 3 * y3 * x1 ^ 2 * e1 ^ 2 +
+12 * e3 * e6 * y2 ^ 3 * y3 * x2 ^ 2 * e1 ^ 2 -
+8 * e3 * e6 * y2 * y3 ^ 2 * e2 ^ 2 * y1 -
+4 * e3 * e6 * y2 * y3 * y1 ^ 2 * e5 ^ 2 +
+16 * e3 * e7 * y2 * y3 * y1 ^ 2 * e5 * x1 * e1 +
+8 * e3 * e7 * y2 * y3 * y1 ^ 2 * e5 * x2 * e1 -
+32 * e3 * e7 * y2 ^ 2 * y3 * y1 * e5 * e6 -
+8 * e3 * e7 * y2 * y3 ^ 2 * y1 * e5 * e2 +
+16 * e3 * e7 * y2 * y3 * y1 ^ 2 * e6 * x1 * e1 +
+8 * e3 * e7 * y2 * y3 * y1 ^ 2 * e6 * x2 * e1 -
+8 * e3 * e7 * y2 * y3 ^ 2 * y1 * e6 * e2 -
+32 * e3 * e7 * y2 ^ 2 * y3 * y1 ^ 3 * x1 * e1 -
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 ^ 3 * x2 * e1 +
+32 * e3 * e7 * y2 ^ 3 * y3 * y1 ^ 2 * x1 * e1 +
+16 * e3 * e7 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e2 -
+8 * e3 * e7 * y2 * y3 * y1 ^ 2 * e5 * e6 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 ^ 3 * e5 -
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 * e5 ^ 2 +
+16 * e3 * e7 * y2 ^ 3 * y3 * y1 ^ 2 * e5 -
+8 * e3 * e7 * y2 * y3 * y1 ^ 2 * e5 * e2 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 ^ 3 * e6 -
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 * e6 ^ 2 +
+16 * e3 * e7 * y2 ^ 3 * y3 * y1 ^ 2 * e6 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 ^ 3 * e2 -
+16 * e3 * e7 * y2 * y3 * y1 ^ 2 * x1 ^ 2 * e1 ^ 2 -
+4 * e3 * e7 * y2 * y3 * y1 ^ 2 * x2 ^ 2 * e1 ^ 2 -
+8 * e3 * e7 * y2 ^ 3 * y3 * e5 * e6 + 16 * e3 * e7 * y2 ^ 4 * y3 * e5 * y1 +
+16 * e3 * e7 * y2 ^ 4 * y3 * e6 * y1 -
+16 * e3 * e7 * y2 ^ 3 * y3 * y1 ^ 2 * e2 -
+16 * e3 * e7 * y2 ^ 3 * y3 * x1 ^ 2 * e1 ^ 2 -
+4 * e3 * e7 * y2 ^ 3 * y3 * x2 ^ 2 * e1 ^ 2 -
+8 * e3 * e7 * y2 * y3 ^ 2 * e2 ^ 2 * y1 -
+4 * e3 * e7 * y2 * y3 * y1 ^ 2 * e5 ^ 2 -
+4 * e3 * e7 * y2 * y3 * y1 ^ 2 * e6 ^ 2 + e1 ^ 3 * x3 ^ 2 * e7 ^ 3 -
+4 * e3 * e6 * y2 * y3 * e2 ^ 2 * y1 ^ 2 +
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 * e5 * x2 * e1 +
+16 * e3 * e6 ^ 2 * y2 ^ 2 * y3 * y1 * x2 * e1 -
+16 * e3 * e6 * y2 * y3 * y1 ^ 2 * x1 * e1 ^ 2 * x2 +
+24 * e3 * e6 * y2 ^ 2 * y3 * y1 * x1 ^ 2 * e1 ^ 2 +
+16 * e3 * e6 * y2 * y3 * y1 ^ 2 * x1 * e1 * e2 +
+8 * e3 * e6 * y2 * y3 * y1 ^ 2 * x2 * e1 * e2 +
+16 * e3 * e6 * y2 ^ 3 * y3 * e5 * x1 * e1 -
+8 * e3 * e6 * y2 ^ 3 * y3 * e5 * x2 * e1 +
+8 * e3 * e6 * y2 ^ 2 * y3 * e5 * e2 * y1 +
+8 * e3 * e6 * y2 ^ 2 * y3 ^ 2 * e5 * e2 +
+16 * e3 * e6 ^ 2 * y2 ^ 3 * y3 * x1 * e1 -
+32 * e3 * e6 * y2 ^ 4 * y3 * y1 * x1 * e1 +
+16 * e3 * e6 * y2 ^ 4 * y3 * y1 * x2 * e1 +
+16 * e3 * e6 * y2 ^ 2 * y3 * y1 * x1 * e1 ^ 2 * x2 +
+16 * e3 * e6 * y2 * y3 ^ 2 * y1 * x1 * e1 * e2 +
+8 * e3 * e6 * y2 * y3 ^ 2 * y1 * x2 * e1 * e2 -
+16 * e3 * e6 * y2 ^ 2 * y3 * x1 * e1 * e2 * y1 -
+16 * e3 * e6 * y2 ^ 2 * y3 ^ 2 * x1 * e1 * e2 -
+8 * e3 * e6 * y2 ^ 2 * y3 * x2 * e1 * e2 * y1 -
+8 * e3 * e6 * y2 ^ 2 * y3 ^ 2 * x2 * e1 * e2 - e1 * y3 ^ 2 * e6 ^ 4 -
+4 * e3 * e7 * y2 * y3 * e2 ^ 2 * y1 ^ 2 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 * e5 * x2 * e1 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 * e6 * x2 * e1 -
+16 * e3 * e7 * y2 * y3 * y1 ^ 2 * x1 * e1 ^ 2 * x2 +
+24 * e3 * e7 * y2 ^ 2 * y3 * y1 * x1 ^ 2 * e1 ^ 2 +
+16 * e3 * e7 * y2 * y3 * y1 ^ 2 * x1 * e1 * e2 +
+8 * e3 * e7 * y2 * y3 * y1 ^ 2 * x2 * e1 * e2 +
+16 * e3 * e7 * y2 ^ 3 * y3 * e5 * x1 * e1 +
+8 * e3 * e7 * y2 ^ 3 * y3 * e5 * x2 * e1 +
+8 * e3 * e7 * y2 ^ 2 * y3 * e5 * e2 * y1 +
+8 * e3 * e7 * y2 ^ 2 * y3 ^ 2 * e5 * e2 +
+16 * e3 * e7 * y2 ^ 3 * y3 * e6 * x1 * e1 +
+8 * e3 * e7 * y2 ^ 3 * y3 * e6 * x2 * e1 +
+8 * e3 * e7 * y2 ^ 2 * y3 ^ 2 * e6 * e2 -
+32 * e3 * e7 * y2 ^ 4 * y3 * y1 * x1 * e1 -
+16 * e3 * e7 * y2 ^ 4 * y3 * y1 * x2 * e1 -
+16 * e3 * e7 * y2 ^ 3 * y3 ^ 2 * y1 * e2 -
+16 * e3 * e7 * y2 ^ 3 * y3 * x1 * e1 ^ 2 * x2 +
+16 * e3 * e7 * y2 ^ 2 * y3 * y1 * x1 * e1 ^ 2 * x2 +
+16 * e3 * e7 * y2 * y3 ^ 2 * y1 * x1 * e1 * e2 +
+8 * e3 * e7 * y2 * y3 ^ 2 * y1 * x2 * e1 * e2 -
+16 * e3 * e7 * y2 ^ 2 * y3 * x1 * e1 * e2 * y1 -
+16 * e3 * e7 * y2 ^ 2 * y3 ^ 2 * x1 * e1 * e2 -
+8 * e3 * e7 * y2 ^ 2 * y3 * x2 * e1 * e2 * y1 -
+8 * e3 * e7 * y2 ^ 2 * y3 ^ 2 * x2 * e1 * e2 - e6 ^ 3 * x3 ^ 2 * e3 ^ 3 -
+16 * e1 * y2 ^ 3 * y3 ^ 2 * e4 * y1 ^ 3 - e6 ^ 3 * e3 ^ 3 * x1 ^ 2 +
+2 * e6 ^ 4 * x2 * e3 ^ 2 + 2 * e6 ^ 4 * x3 * e3 ^ 2 +
+2 * e6 ^ 4 * e3 ^ 2 * x1 - e5 ^ 3 * x2 ^ 2 * e3 ^ 3 -
+e5 ^ 3 * x3 ^ 2 * e3 ^ 3 - e5 ^ 3 * e3 ^ 3 * x1 ^ 2 +
+2 * x1 ^ 5 * e1 ^ 3 * e3 ^ 3 - 3 * e3 * e6 ^ 4 * e5 - e3 * e5 ^ 3 * e6 ^ 2 -
+3 * e3 * e5 ^ 2 * e6 ^ 3 - e3 * e5 ^ 3 * e7 ^ 2 - e6 ^ 3 * x2 ^ 2 * e3 ^ 3 -
+2 * e6 ^ 3 * x2 * e3 ^ 3 * x3 - 2 * e6 ^ 3 * x2 * e3 ^ 3 * x1 -
+2 * e6 ^ 3 * x3 * e3 ^ 3 * x1 + 2 * e6 ^ 3 * e7 * x2 * e3 ^ 2 +
+2 * e6 ^ 3 * e7 * x3 * e3 ^ 2 + 2 * e6 ^ 3 * e7 * e3 ^ 2 * x1 -
+2 * e5 ^ 3 * x2 * e3 ^ 3 * x3 - 2 * e5 ^ 3 * x2 * e3 ^ 3 * x1 -
+2 * e5 ^ 3 * x3 * e3 ^ 3 * x1 + 2 * e5 ^ 3 * e6 * x2 * e3 ^ 2 +
+6 * e5 ^ 2 * e6 ^ 2 * x2 * e3 ^ 2 + 2 * e5 ^ 3 * e6 * x3 * e3 ^ 2 +
+6 * e5 ^ 2 * e6 ^ 2 * x3 * e3 ^ 2 + 2 * e5 ^ 3 * e6 * e3 ^ 2 * x1 +
+6 * e5 ^ 2 * e6 ^ 2 * e3 ^ 2 * x1 + 2 * e5 ^ 3 * e7 * x2 * e3 ^ 2 +
+2 * e5 ^ 3 * e7 * x3 * e3 ^ 2 + 2 * e5 ^ 3 * e7 * e3 ^ 2 * x1 -
+3 * e5 ^ 2 * e6 * x2 ^ 2 * e3 ^ 3 - 3 * e5 * e6 ^ 2 * x2 ^ 2 * e3 ^ 3 -
+3 * e5 ^ 2 * e6 * x3 ^ 2 * e3 ^ 3 - 3 * e5 * e6 ^ 2 * x3 ^ 2 * e3 ^ 3 -
+3 * e5 ^ 2 * e6 * e3 ^ 3 * x1 ^ 2 - 3 * e5 * e6 ^ 2 * e3 ^ 3 * x1 ^ 2 +
+6 * e5 * e6 ^ 3 * x2 * e3 ^ 2 + 6 * e5 * e6 ^ 3 * x3 * e3 ^ 2 +
+6 * e5 * e6 ^ 3 * e3 ^ 2 * x1 + 8 * x1 ^ 3 * e1 ^ 2 * e6 ^ 2 * e3 ^ 2 -
+8 * e1 ^ 2 * x3 ^ 3 * e6 ^ 2 * e3 ^ 2 + 4 * e5 ^ 2 * x1 ^ 3 * e1 * e3 ^ 3 +
+2 * e5 ^ 2 * x2 ^ 3 * e1 * e3 ^ 3 - 5 * x1 ^ 4 * e1 ^ 2 * e3 ^ 3 * e5 -
+5 * x1 ^ 4 * e1 ^ 2 * e3 ^ 3 * e6 - x2 ^ 4 * e1 ^ 2 * e3 ^ 3 * e5 -
+x2 ^ 4 * e1 ^ 2 * e3 ^ 3 * e6 + 3 * e1 ^ 2 * x3 ^ 4 * e3 ^ 3 * e5 +
+3 * e1 ^ 2 * x3 ^ 4 * e3 ^ 3 * e6 + 8 * x1 ^ 2 * e1 ^ 3 * x2 ^ 3 * e3 ^ 3 +
+2 * x1 * e1 ^ 3 * x2 ^ 4 * e3 ^ 3 + 8 * x1 ^ 4 * e1 ^ 3 * x2 * e3 ^ 3 +
+12 * x1 ^ 3 * e1 ^ 3 * x2 ^ 2 * e3 ^ 3 +
+4 * x1 ^ 3 * e1 ^ 3 * x3 ^ 2 * e3 ^ 3 + 6 * x1 ^ 4 * e1 ^ 3 * x3 * e3 ^ 3 -
+3 * x1 ^ 4 * e1 ^ 3 * e6 * e3 ^ 2 - 3 * x1 ^ 4 * e1 ^ 3 * e7 * e3 ^ 2 -
+8 * x2 ^ 3 * e1 ^ 3 * x3 ^ 2 * e3 ^ 3 - 2 * x2 ^ 4 * e1 ^ 3 * e3 ^ 3 * x3 +
+x2 ^ 4 * e1 ^ 3 * e6 * e3 ^ 2 + x2 ^ 4 * e1 ^ 3 * e7 * e3 ^ 2 -
+12 * e1 ^ 3 * x3 ^ 3 * x2 ^ 2 * e3 ^ 3 -
+4 * e1 ^ 3 * x3 ^ 3 * e3 ^ 3 * x1 ^ 2 + 2 * e6 ^ 2 * x2 ^ 3 * e3 ^ 3 * e1 +
+4 * e6 ^ 2 * e3 ^ 3 * x1 ^ 3 * e1 - 3 * e6 ^ 3 * x2 ^ 2 * e3 ^ 2 * e1 -
+7 * e6 ^ 3 * e3 ^ 2 * x1 ^ 2 * e1 - 6 * e1 ^ 3 * x3 ^ 4 * e3 ^ 3 * x1 -
+8 * e1 ^ 3 * x3 ^ 4 * e3 ^ 3 * x2 + e6 ^ 3 * e1 * x3 ^ 2 * e3 ^ 2 -
+6 * e3 * e6 ^ 3 * e7 * e5 - 4 * e3 * e6 ^ 3 * y2 ^ 2 * y3 ^ 2 +
+4 * e3 * e6 ^ 4 * y2 * y3 - 2 * e3 * e5 ^ 3 * e6 * e7 -
+6 * e3 * e5 ^ 2 * e6 ^ 2 * e7 - 4 * e3 * e5 ^ 3 * y2 ^ 2 * y3 ^ 2 -
+3 * e3 * e5 ^ 2 * e6 * e7 ^ 2 - 3 * e3 * e5 * e6 ^ 2 * e7 ^ 2 - e3 * e6 ^ 5 +
+12 * e6 ^ 2 * x2 * e3 ^ 3 * x3 * x1 * e1 +
+4 * e6 ^ 2 * x2 ^ 2 * e3 ^ 3 * x3 * e1 +
+10 * e6 ^ 2 * x2 * e3 ^ 3 * x1 ^ 2 * e1 +
+8 * e6 ^ 2 * x2 ^ 2 * e3 ^ 3 * x1 * e1 - 4 * e6 ^ 3 * y2 * y3 * x2 * e3 ^ 2 -
+4 * e6 ^ 3 * y2 * y3 * x3 * e3 ^ 2 - 4 * e6 ^ 3 * y2 * y3 * e3 ^ 2 * x1 +
+8 * x1 * e1 ^ 2 * x2 ^ 2 * e6 ^ 2 * e3 ^ 2 +
+16 * x1 ^ 2 * e1 ^ 2 * x2 * e6 ^ 2 * e3 ^ 2 -
+4 * e5 ^ 3 * y2 * y3 * x2 * e3 ^ 2 - 4 * e5 ^ 3 * y2 * y3 * x3 * e3 ^ 2 -
+4 * e5 ^ 3 * y2 * y3 * e3 ^ 2 * x1 +
+8 * x1 ^ 2 * e1 ^ 2 * e6 ^ 2 * x3 * e3 ^ 2 -
+8 * x2 ^ 2 * e1 ^ 2 * e6 ^ 2 * x3 * e3 ^ 2 -
+16 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * x2 * e3 ^ 2 -
+6 * e6 ^ 2 * x2 * e3 ^ 3 * x3 * e5 - 6 * e6 ^ 2 * x2 * e3 ^ 3 * x1 * e5 -
+6 * e6 ^ 2 * x3 * e3 ^ 3 * x1 * e5 + 6 * e6 ^ 2 * e7 * x2 * e3 ^ 2 * e5 +
+6 * e6 ^ 2 * e7 * x3 * e3 ^ 2 * e5 + 6 * e6 ^ 2 * e7 * e3 ^ 2 * x1 * e5 -
+8 * x1 * e1 ^ 2 * x2 ^ 3 * e3 ^ 3 * e5 -
+8 * x1 * e1 ^ 2 * x2 ^ 3 * e3 ^ 3 * e6 -
+16 * x1 ^ 3 * e1 ^ 2 * x2 * e3 ^ 3 * e5 -
+16 * x1 ^ 3 * e1 ^ 2 * x2 * e3 ^ 3 * e6 -
+18 * x1 ^ 2 * e1 ^ 2 * x2 ^ 2 * e3 ^ 3 * e5 -
+18 * x1 ^ 2 * e1 ^ 2 * x2 ^ 2 * e3 ^ 3 * e6 -
+6 * e5 ^ 2 * x2 * e3 ^ 3 * x3 * e6 - 6 * e5 ^ 2 * x2 * e3 ^ 3 * x1 * e6 -
+6 * e5 ^ 2 * x3 * e3 ^ 3 * x1 * e6 + 6 * e5 ^ 2 * e7 * x2 * e3 ^ 2 * e6 +
+6 * e5 ^ 2 * e7 * x3 * e3 ^ 2 * e6 + 6 * e5 ^ 2 * e7 * e3 ^ 2 * x1 * e6 -
+6 * x1 ^ 2 * e1 ^ 2 * x3 ^ 2 * e3 ^ 3 * e5 -
+6 * x1 ^ 2 * e1 ^ 2 * x3 ^ 2 * e3 ^ 3 * e6 -
+12 * x1 ^ 3 * e1 ^ 2 * x3 * e3 ^ 3 * e5 -
+12 * x1 ^ 3 * e1 ^ 2 * x3 * e3 ^ 3 * e6 +
+8 * x1 ^ 3 * e1 ^ 2 * e6 * e3 ^ 2 * e5 +
+8 * x1 ^ 3 * e1 ^ 2 * e7 * e3 ^ 2 * e5 +
+8 * x1 ^ 3 * e1 ^ 2 * e7 * e3 ^ 2 * e6 +
+6 * x2 ^ 2 * e1 ^ 2 * x3 ^ 2 * e3 ^ 3 * e5 +
+6 * x2 ^ 2 * e1 ^ 2 * x3 ^ 2 * e3 ^ 3 * e6 +
+8 * e1 ^ 2 * x3 ^ 3 * x2 * e3 ^ 3 * e5 +
+8 * e1 ^ 2 * x3 ^ 3 * x2 * e3 ^ 3 * e6 +
+4 * e1 ^ 2 * x3 ^ 3 * e3 ^ 3 * x1 * e5 +
+4 * e1 ^ 2 * x3 ^ 3 * e3 ^ 3 * x1 * e6 -
+12 * e6 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * e5 -
+12 * e6 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e5 -
+12 * e6 ^ 2 * y2 * y3 * e3 ^ 2 * x1 * e5 -
+32 * x1 * e1 ^ 2 * x2 ^ 2 * y2 * y3 * e3 ^ 2 * e5 -
+32 * x1 * e1 ^ 2 * x2 ^ 2 * y2 * y3 * e3 ^ 2 * e6 -
+16 * x1 * e1 ^ 2 * x2 * y2 * y3 * x3 * e3 ^ 2 * e5 -
+16 * x1 * e1 ^ 2 * x2 * y2 * y3 * x3 * e3 ^ 2 * e6 -
+32 * x1 ^ 2 * e1 ^ 2 * x2 * y2 * y3 * e3 ^ 2 * e5 -
+32 * x1 ^ 2 * e1 ^ 2 * x2 * y2 * y3 * e3 ^ 2 * e6 -
+12 * x1 * e1 ^ 2 * x2 ^ 2 * e3 ^ 3 * x3 * e5 -
+12 * x1 * e1 ^ 2 * x2 ^ 2 * e3 ^ 3 * x3 * e6 -
+24 * x1 ^ 2 * e1 ^ 2 * x2 * x3 * e3 ^ 3 * e5 -
+24 * x1 ^ 2 * e1 ^ 2 * x2 * x3 * e3 ^ 3 * e6 +
+8 * x1 * e1 ^ 2 * x2 ^ 2 * e6 * e3 ^ 2 * e5 +
+16 * x1 ^ 2 * e1 ^ 2 * x2 * e6 * e3 ^ 2 * e5 +
+8 * x1 * e1 ^ 2 * x2 ^ 2 * e7 * e3 ^ 2 * e5 +
+8 * x1 * e1 ^ 2 * x2 ^ 2 * e7 * e3 ^ 2 * e6 +
+16 * x1 ^ 2 * e1 ^ 2 * x2 * e7 * e3 ^ 2 * e5 +
+16 * x1 ^ 2 * e1 ^ 2 * x2 * e7 * e3 ^ 2 * e6 -
+12 * e5 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * e6 -
+12 * e5 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e6 -
+12 * e5 ^ 2 * y2 * y3 * e3 ^ 2 * x1 * e6 -
+16 * x1 ^ 2 * e1 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e5 -
+16 * x1 ^ 2 * e1 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e6 -
+16 * x1 ^ 3 * e1 ^ 2 * y2 * y3 * e3 ^ 2 * e5 -
+16 * x1 ^ 3 * e1 ^ 2 * y2 * y3 * e3 ^ 2 * e6 +
+8 * x1 ^ 2 * e1 ^ 2 * e6 * x3 * e3 ^ 2 * e5 +
+8 * x1 ^ 2 * e1 ^ 2 * e7 * x3 * e3 ^ 2 * e5 +
+8 * x1 ^ 2 * e1 ^ 2 * e7 * x3 * e3 ^ 2 * e6 -
+16 * x2 ^ 3 * e1 ^ 2 * y2 * y3 * e3 ^ 2 * e5 -
+16 * x2 ^ 3 * e1 ^ 2 * y2 * y3 * e3 ^ 2 * e6 -
+16 * x2 ^ 2 * e1 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e5 -
+16 * x2 ^ 2 * e1 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * e6 -
+8 * x2 ^ 2 * e1 ^ 2 * e6 * x3 * e3 ^ 2 * e5 -
+8 * x2 ^ 2 * e1 ^ 2 * e7 * x3 * e3 ^ 2 * e5 -
+8 * x2 ^ 2 * e1 ^ 2 * e7 * x3 * e3 ^ 2 * e6 +
+12 * e1 ^ 2 * x3 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * e5 +
+12 * e1 ^ 2 * x3 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * e6 +
+12 * e1 ^ 2 * x3 ^ 3 * y2 * y3 * e3 ^ 2 * e5 +
+12 * e1 ^ 2 * x3 ^ 3 * y2 * y3 * e3 ^ 2 * e6 +
+12 * e1 ^ 2 * x3 ^ 2 * y2 * y3 * e3 ^ 2 * x1 * e5 +
+12 * e1 ^ 2 * x3 ^ 2 * y2 * y3 * e3 ^ 2 * x1 * e6 -
+16 * e1 ^ 2 * x3 ^ 2 * e6 * x2 * e3 ^ 2 * e5 -
+8 * e1 ^ 2 * x3 ^ 3 * e6 * e3 ^ 2 * e5 -
+8 * e1 ^ 2 * x3 ^ 3 * e7 * e3 ^ 2 * e5 -
+8 * e1 ^ 2 * x3 ^ 3 * e7 * e3 ^ 2 * e6 + 8 * e5 * x1 ^ 3 * e1 * e3 ^ 3 * e6 +
+4 * e5 * x2 ^ 3 * e1 * e3 ^ 3 * e6 -
+8 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * e3 ^ 2 * x1 +
+8 * e6 ^ 2 * x3 * e3 ^ 3 * x1 ^ 2 * e1 -
+10 * e6 ^ 2 * e7 * x2 * e3 ^ 2 * x1 * e1 -
+3 * e6 ^ 2 * e7 * x2 ^ 2 * e3 ^ 2 * e1 -
+6 * e6 ^ 2 * e7 * x3 * e3 ^ 2 * x1 * e1 -
+2 * e6 ^ 2 * e7 * x3 * e3 ^ 2 * x2 * e1 -
+7 * e6 ^ 2 * e7 * e3 ^ 2 * x1 ^ 2 * e1 +
+12 * e5 ^ 2 * x2 * e3 ^ 3 * x3 * x1 * e1 +
+4 * e5 ^ 2 * x2 ^ 2 * e3 ^ 3 * x3 * e1 +
+10 * e5 ^ 2 * x2 * e3 ^ 3 * x1 ^ 2 * e1 +
+8 * e5 ^ 2 * x2 ^ 2 * e3 ^ 3 * x1 * e1 +
+8 * e5 ^ 2 * x3 * e3 ^ 3 * x1 ^ 2 * e1 -
+10 * e5 ^ 2 * e6 * x2 * e3 ^ 2 * x1 * e1 -
+3 * e5 ^ 2 * e6 * x2 ^ 2 * e3 ^ 2 * e1 -
+6 * e5 ^ 2 * e6 * x3 * e3 ^ 2 * x1 * e1 -
+2 * e5 ^ 2 * e6 * x3 * e3 ^ 2 * x2 * e1 -
+7 * e5 ^ 2 * e6 * e3 ^ 2 * x1 ^ 2 * e1 -
+10 * e5 ^ 2 * e7 * x2 * e3 ^ 2 * x1 * e1 -
+3 * e5 ^ 2 * e7 * x2 ^ 2 * e3 ^ 2 * e1 -
+6 * e5 ^ 2 * e7 * x3 * e3 ^ 2 * x1 * e1 -
+2 * e5 ^ 2 * e7 * x3 * e3 ^ 2 * x2 * e1 -
+7 * e5 ^ 2 * e7 * e3 ^ 2 * x1 ^ 2 * e1 +
+16 * e5 * e6 * x2 ^ 2 * e3 ^ 3 * x1 * e1 +
+8 * e5 * e6 * x3 ^ 2 * e3 ^ 3 * x1 * e1 +
+4 * e5 * e6 * x3 ^ 2 * e3 ^ 3 * x2 * e1 +
+20 * e5 * e6 * e3 ^ 3 * x1 ^ 2 * x2 * e1 -
+20 * e5 * e6 ^ 2 * x2 * e3 ^ 2 * x1 * e1 -
+6 * e5 * e6 ^ 2 * x2 ^ 2 * e3 ^ 2 * e1 -
+12 * e5 * e6 ^ 2 * x3 * e3 ^ 2 * x1 * e1 -
+4 * e5 * e6 ^ 2 * x3 * e3 ^ 2 * x2 * e1 -
+14 * e5 * e6 ^ 2 * e3 ^ 2 * x1 ^ 2 * e1 +
+16 * x1 ^ 3 * e1 ^ 3 * x3 * e3 ^ 3 * x2 -
+8 * x1 ^ 3 * e1 ^ 3 * e6 * e3 ^ 2 * x2 -
+8 * x1 ^ 3 * e1 ^ 3 * e7 * e3 ^ 2 * x2 -
+12 * x2 ^ 2 * e1 ^ 3 * x3 ^ 2 * e3 ^ 3 * x1 -
+16 * e1 ^ 2 * x3 ^ 3 * x2 * e3 ^ 3 * y1 * y2 -
+16 * e1 ^ 3 * x3 ^ 3 * x2 * e3 ^ 3 * x1 -
+8 * e1 ^ 2 * x3 ^ 3 * e3 ^ 3 * x1 * y1 * y2 +
+20 * e6 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * x1 * e1 +
+14 * e6 ^ 2 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * e1 +
+12 * e6 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * x1 * e1 +
+12 * e6 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * x2 * e1 +
+4 * e6 ^ 2 * x3 ^ 2 * e3 ^ 3 * x1 * e1 +
+2 * e6 ^ 2 * x3 ^ 2 * e3 ^ 3 * x2 * e1 - 10 * e6 ^ 3 * x2 * e3 ^ 2 * x1 * e1 -
+6 * e6 ^ 3 * x3 * e3 ^ 2 * x1 * e1 - 2 * e6 ^ 3 * x3 * e3 ^ 2 * x2 * e1 +
+4 * e5 ^ 2 * x3 ^ 2 * e3 ^ 3 * x1 * e1 +
+2 * e5 ^ 2 * x3 ^ 2 * e3 ^ 3 * x2 * e1 -
+6 * e1 ^ 2 * x3 ^ 4 * e3 ^ 3 * y1 * y2 +
+14 * e6 ^ 2 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * e1 +
+20 * x1 ^ 2 * e1 ^ 3 * x2 ^ 2 * y2 * y3 * e3 ^ 2 +
+16 * x1 * e1 ^ 3 * x2 ^ 3 * y2 * y3 * e3 ^ 2 +
+8 * x1 ^ 2 * e1 ^ 3 * x2 * y2 * y3 * x3 * e3 ^ 2 +
+8 * x1 * e1 ^ 3 * x2 ^ 2 * y2 * y3 * x3 * e3 ^ 2 +
+16 * x1 ^ 3 * e1 ^ 3 * x2 * y2 * y3 * e3 ^ 2 +
+12 * x1 ^ 2 * e1 ^ 3 * x2 ^ 2 * e3 ^ 3 * x3 -
+6 * x1 ^ 2 * e1 ^ 3 * x2 ^ 2 * e6 * e3 ^ 2 +
+12 * x1 * e1 ^ 3 * x2 ^ 2 * e6 * x3 * e3 ^ 2 -
+6 * x1 ^ 2 * e1 ^ 3 * x2 ^ 2 * e7 * e3 ^ 2 +
+12 * x1 * e1 ^ 3 * x2 ^ 2 * e7 * x3 * e3 ^ 2 +
+20 * e5 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * x1 * e1 +
+14 * e5 ^ 2 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * e1 +
+12 * e5 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * x1 * e1 +
+12 * e5 ^ 2 * y2 * y3 * x3 * e3 ^ 2 * x2 * e1 +
+14 * e5 ^ 2 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * e1 +
+40 * e5 * e6 * y2 * y3 * x2 * e3 ^ 2 * x1 * e1 +
+28 * e5 * e6 * y2 * y3 * x2 ^ 2 * e3 ^ 2 * e1 +
+24 * e5 * e6 * y2 * y3 * x3 * e3 ^ 2 * x1 * e1 +
+24 * e5 * e6 * y2 * y3 * x3 * e3 ^ 2 * x2 * e1 +
+28 * e5 * e6 * y2 * y3 * e3 ^ 2 * x1 ^ 2 * e1 +
+24 * e5 * e6 * x2 * e3 ^ 3 * x3 * x1 * e1 +
+8 * e5 * e6 * x2 ^ 2 * e3 ^ 3 * x3 * e1 +
+16 * e5 * e6 * x3 * e3 ^ 3 * x1 ^ 2 * e1 -
+20 * e5 * e6 * e7 * x2 * e3 ^ 2 * x1 * e1 -
+6 * e5 * e6 * e7 * x2 ^ 2 * e3 ^ 2 * e1 -
+12 * e5 * e6 * e7 * x3 * e3 ^ 2 * x1 * e1 -
+4 * e5 * e6 * e7 * x3 * e3 ^ 2 * x2 * e1 -
+14 * e5 * e6 * e7 * e3 ^ 2 * x1 ^ 2 * e1 +
+8 * x1 ^ 3 * e1 ^ 3 * y2 * y3 * x3 * e3 ^ 2 +
+6 * x1 ^ 4 * e1 ^ 3 * y2 * y3 * e3 ^ 2 -
+4 * x1 ^ 3 * e1 ^ 3 * e6 * x3 * e3 ^ 2 -
+4 * x1 ^ 3 * e1 ^ 3 * e7 * x3 * e3 ^ 2 +
+6 * x2 ^ 4 * e1 ^ 3 * y2 * y3 * e3 ^ 2 +
+8 * x2 ^ 3 * e1 ^ 3 * y2 * y3 * x3 * e3 ^ 2 +
+8 * x2 ^ 3 * e1 ^ 3 * e6 * x3 * e3 ^ 2 +
+8 * x2 ^ 3 * e1 ^ 3 * e7 * x3 * e3 ^ 2 -
+24 * e1 ^ 2 * x3 ^ 2 * y2 ^ 2 * y3 * x2 * e3 ^ 2 * y1 -
+28 * e1 ^ 3 * x3 ^ 2 * y2 * y3 * x2 * e3 ^ 2 * x1 -
+10 * e1 ^ 3 * x3 ^ 2 * y2 * y3 * x2 ^ 2 * e3 ^ 2 -
+24 * e1 ^ 2 * x3 ^ 3 * y2 ^ 2 * y3 * e3 ^ 2 * y1 -
+20 * e1 ^ 3 * x3 ^ 3 * y2 * y3 * e3 ^ 2 * x1 -
+20 * e1 ^ 3 * x3 ^ 3 * y2 * y3 * e3 ^ 2 * x2 -
+24 * e1 ^ 2 * x3 ^ 2 * y2 ^ 2 * y3 * e3 ^ 2 * x1 * y1 -
+10 * e1 ^ 3 * x3 ^ 2 * y2 * y3 * e3 ^ 2 * x1 ^ 2 +
+32 * e1 ^ 2 * x3 ^ 2 * e6 * x2 * e3 ^ 2 * y1 * y2 +
+24 * e1 ^ 3 * x3 ^ 2 * e6 * x2 * e3 ^ 2 * x1 +
+18 * e1 ^ 3 * x3 ^ 2 * e6 * x2 ^ 2 * e3 ^ 2 +
+16 * e1 ^ 2 * x3 ^ 3 * e6 * e3 ^ 2 * y1 * y2 +
+12 * e1 ^ 3 * x3 ^ 3 * e6 * e3 ^ 2 * x1 +
+16 * e1 ^ 3 * x3 ^ 3 * e6 * e3 ^ 2 * x2 +
+16 * e1 ^ 2 * x3 ^ 3 * e7 * e3 ^ 2 * y1 * y2 +
+12 * e1 ^ 3 * x3 ^ 3 * e7 * e3 ^ 2 * x1 +
+16 * e1 ^ 3 * x3 ^ 3 * e7 * e3 ^ 2 * x2 -
+4 * y1 * y2 * e1 * x3 ^ 2 * e6 ^ 2 * e3 ^ 2 +
+e5 ^ 2 * e1 * x3 ^ 2 * e6 * e3 ^ 2 + e5 ^ 2 * e1 * x3 ^ 2 * e7 * e3 ^ 2 +
+e6 ^ 2 * e1 * x3 ^ 2 * e7 * e3 ^ 2 + 2 * e6 ^ 2 * e1 * x3 ^ 2 * e3 ^ 2 * e5 -
+8 * e1 ^ 2 * x3 ^ 2 * e6 * e3 ^ 2 * x1 * e5 -
+16 * e1 ^ 2 * x3 ^ 2 * e7 * x2 * e3 ^ 2 * e5 -
+16 * e1 ^ 2 * x3 ^ 2 * e7 * x2 * e3 ^ 2 * e6 -
+8 * e1 ^ 2 * x3 ^ 2 * e7 * e3 ^ 2 * x1 * e5 -
+8 * e1 ^ 2 * x3 ^ 2 * e7 * e3 ^ 2 * x1 * e6 -
+4 * y1 * y2 * e1 * x3 ^ 2 * e6 * e3 ^ 2 * e5 -
+4 * y1 * y2 * e1 * x3 ^ 2 * e7 * e3 ^ 2 * e5 -
+4 * y1 * y2 * e1 * x3 ^ 2 * e7 * e3 ^ 2 * e6 +
+2 * e5 * e1 * x3 ^ 2 * e7 * e3 ^ 2 * e6 +
+16 * e1 ^ 2 * x3 ^ 2 * e6 * e3 ^ 2 * x1 * y1 * y2 +
+6 * e1 ^ 3 * x3 ^ 2 * e6 * e3 ^ 2 * x1 ^ 2 +
+32 * e1 ^ 2 * x3 ^ 2 * e7 * x2 * e3 ^ 2 * y1 * y2 +
+24 * e1 ^ 3 * x3 ^ 2 * e7 * x2 * e3 ^ 2 * x1 +
+18 * e1 ^ 3 * x3 ^ 2 * e7 * x2 ^ 2 * e3 ^ 2 +
+16 * e1 ^ 2 * x3 ^ 2 * e7 * e3 ^ 2 * x1 * y1 * y2 +
+6 * e1 ^ 3 * x3 ^ 2 * e7 * e3 ^ 2 * x1 ^ 2 +
+4 * y1 ^ 2 * y2 ^ 2 * e1 * x3 ^ 2 * e6 * e3 ^ 2 +
+4 * y1 ^ 2 * y2 ^ 2 * e1 * x3 ^ 2 * e7 * e3 ^ 2 +
+4 * e3 * e6 ^ 3 * e7 * y2 * y3 + 2 * e3 * x1 * e1 ^ 2 * x2 * e6 ^ 3 +
+4 * e3 * e5 ^ 3 * e6 * y2 * y3 + 12 * e3 * e5 ^ 2 * e6 ^ 2 * y2 * y3 +
+4 * e3 * e5 ^ 3 * e7 * y2 * y3 - 12 * e3 * e5 ^ 2 * e6 * y2 ^ 2 * y3 ^ 2 -
+12 * e3 * e5 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 + 12 * e3 * e5 * e6 ^ 3 * y2 * y3 -
+e3 * x1 ^ 2 * e1 ^ 2 * e6 ^ 3 + 3 * e3 * x2 ^ 2 * e1 ^ 2 * e6 ^ 3 +
+7 * e3 * e1 ^ 2 * x3 ^ 2 * e6 ^ 3 + 2 * e3 * e6 ^ 4 * x1 * e1 -
+2 * e3 * e6 ^ 4 * e1 * x3 - 2 * e3 * x2 ^ 3 * e1 ^ 3 * e6 ^ 2 -
+2 * e3 * x2 ^ 3 * e1 ^ 3 * e7 ^ 2 - 2 * e3 * x1 ^ 2 * e1 ^ 2 * e6 ^ 2 * e7 +
+6 * e3 * x2 ^ 2 * e1 ^ 2 * e6 ^ 2 * e7 +
+14 * e3 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * e7 + 6 * e3 * x1 * e1 ^ 2 * x3 * e6 ^ 3 +
+10 * e3 * x2 * e1 ^ 2 * x3 * e6 ^ 3 + 2 * e3 * e5 ^ 2 * x1 * e1 * e6 ^ 2 +
+2 * e3 * e5 ^ 2 * x1 * e1 * e7 ^ 2 - 2 * e3 * e5 ^ 2 * e1 * x3 * e6 ^ 2 -
+2 * e3 * e5 ^ 2 * e1 * x3 * e7 ^ 2 - e3 * x1 ^ 2 * e1 ^ 2 * e6 ^ 2 * e5 -
+e3 * x1 ^ 2 * e1 ^ 2 * e7 ^ 2 * e5 - e3 * x1 ^ 2 * e1 ^ 2 * e7 ^ 2 * e6 +
+3 * e3 * x2 ^ 2 * e1 ^ 2 * e6 ^ 2 * e5 +
+3 * e3 * x2 ^ 2 * e1 ^ 2 * e7 ^ 2 * e5 +
+3 * e3 * x2 ^ 2 * e1 ^ 2 * e7 ^ 2 * e6 +
+7 * e3 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * e5 +
+7 * e3 * e1 ^ 2 * x3 ^ 2 * e7 ^ 2 * e5 +
+7 * e3 * e1 ^ 2 * x3 ^ 2 * e7 ^ 2 * e6 + 4 * e3 * e6 ^ 3 * x1 * e1 * e5 -
+4 * e3 * e6 ^ 3 * e1 * x3 * e5 - 2 * e3 * x1 ^ 2 * e1 ^ 3 * x2 * e6 ^ 2 -
+4 * e3 * x1 * e1 ^ 3 * x2 ^ 2 * e6 ^ 2 -
+2 * e3 * x1 ^ 2 * e1 ^ 3 * x2 * e7 ^ 2 -
+4 * e3 * x1 * e1 ^ 3 * x2 ^ 2 * e7 ^ 2 +
+4 * e3 * x1 * e1 ^ 2 * x2 * e6 ^ 2 * e7 +
+8 * e3 * x1 * e1 ^ 2 * x2 * e6 ^ 2 * y2 * y3 +
+4 * e3 * x1 ^ 2 * e1 ^ 2 * e6 ^ 2 * y2 * y3 +
+4 * e3 * x2 ^ 2 * e1 ^ 2 * e6 ^ 2 * y2 * y3 -
+20 * e3 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * y2 * y3 +
+12 * e3 * e6 ^ 2 * e7 * y2 * y3 * e5 +
+2 * e3 * x1 * e1 ^ 2 * x2 * e6 ^ 2 * e5 +
+2 * e3 * x1 * e1 ^ 2 * x2 * e7 ^ 2 * e5 +
+2 * e3 * x1 * e1 ^ 2 * x2 * e7 ^ 2 * e6 +
+12 * e3 * e5 ^ 2 * e7 * y2 * y3 * e6 -
+2 * e3 * x1 ^ 2 * e1 ^ 2 * e6 * e7 * e5 -
+4 * e3 * x1 ^ 2 * e1 ^ 2 * y2 ^ 2 * y3 ^ 2 * e5 -
+4 * e3 * x1 ^ 2 * e1 ^ 2 * y2 ^ 2 * y3 ^ 2 * e6 +
+6 * e3 * x2 ^ 2 * e1 ^ 2 * e6 * e7 * e5 -
+20 * e3 * x2 ^ 2 * e1 ^ 2 * y2 ^ 2 * y3 ^ 2 * e5 -
+20 * e3 * x2 ^ 2 * e1 ^ 2 * y2 ^ 2 * y3 ^ 2 * e6 +
+14 * e3 * e1 ^ 2 * x3 ^ 2 * e6 * e7 * e5 +
+12 * e3 * e1 ^ 2 * x3 ^ 2 * y2 ^ 2 * y3 ^ 2 * e5 +
+12 * e3 * e1 ^ 2 * x3 ^ 2 * y2 ^ 2 * y3 ^ 2 * e6 +
+4 * e3 * x1 * e1 ^ 2 * x2 * e6 * e7 * e5 -
+24 * e3 * x1 * e1 ^ 2 * x2 * y2 ^ 2 * y3 ^ 2 * e5 -
+24 * e3 * x1 * e1 ^ 2 * x2 * y2 ^ 2 * y3 ^ 2 * e6 +
+8 * e3 * x1 * e1 ^ 2 * x2 * e6 * y2 * y3 * e5 +
+8 * e3 * x1 * e1 ^ 2 * x2 * e7 * y2 * y3 * e5 +
+8 * e3 * x1 * e1 ^ 2 * x2 * e7 * y2 * y3 * e6 +
+4 * e3 * x1 ^ 2 * e1 ^ 2 * e6 * y2 * y3 * e5 +
+4 * e3 * x1 ^ 2 * e1 ^ 2 * e7 * y2 * y3 * e5 +
+4 * e3 * x1 ^ 2 * e1 ^ 2 * e7 * y2 * y3 * e6 +
+4 * e3 * x2 ^ 2 * e1 ^ 2 * e6 * y2 * y3 * e5 +
+4 * e3 * x2 ^ 2 * e1 ^ 2 * e7 * y2 * y3 * e5 +
+4 * e3 * x2 ^ 2 * e1 ^ 2 * e7 * y2 * y3 * e6 -
+20 * e3 * e1 ^ 2 * x3 ^ 2 * e6 * y2 * y3 * e5 +
+6 * e3 * x1 * e1 ^ 2 * x3 * e6 ^ 2 * e5 +
+6 * e3 * x1 * e1 ^ 2 * x3 * e7 ^ 2 * e5 +
+6 * e3 * x1 * e1 ^ 2 * x3 * e7 ^ 2 * e6 +
+10 * e3 * x2 * e1 ^ 2 * x3 * e6 ^ 2 * e5 +
+10 * e3 * x2 * e1 ^ 2 * x3 * e7 ^ 2 * e5 +
+10 * e3 * x2 * e1 ^ 2 * x3 * e7 ^ 2 * e6 +
+4 * e3 * e5 * x1 * e1 * e7 ^ 2 * e6 - 4 * e3 * e5 * e1 * x3 * e7 ^ 2 * e6 -
+8 * e3 * e6 ^ 2 * e7 * y2 * y3 * x1 * e1 -
+8 * e3 * e6 ^ 2 * e7 * y2 * y3 * x2 * e1 -
+8 * e3 * e5 ^ 2 * e6 * y2 * y3 * x1 * e1 -
+8 * e3 * e5 ^ 2 * e6 * y2 * y3 * x2 * e1 -
+8 * e3 * e5 ^ 2 * e7 * y2 * y3 * x1 * e1 -
+8 * e3 * e5 ^ 2 * e7 * y2 * y3 * x2 * e1 +
+16 * e3 * e5 * e6 * y2 ^ 2 * y3 ^ 2 * x1 * e1 +
+32 * e3 * e5 * e6 * y2 ^ 2 * y3 ^ 2 * x2 * e1 -
+16 * e3 * e5 * e6 ^ 2 * y2 * y3 * x1 * e1 -
+16 * e3 * e5 * e6 ^ 2 * y2 * y3 * x2 * e1 -
+4 * e3 * x1 ^ 2 * e1 ^ 3 * e6 * e7 * x2 +
+8 * e3 * x1 ^ 2 * e1 ^ 3 * y2 ^ 2 * y3 ^ 2 * x2 -
+4 * e3 * x2 ^ 3 * e1 ^ 3 * e6 * e7 +
+8 * e3 * x2 ^ 3 * e1 ^ 3 * y2 ^ 2 * y3 ^ 2 + 4 * e3 * e6 ^ 3 * e7 * x1 * e1 -
+8 * e3 * e1 ^ 3 * x3 ^ 2 * e6 ^ 2 * x1 -
+10 * e3 * e1 ^ 3 * x3 ^ 2 * e6 ^ 2 * x2 -
+8 * e3 * e1 ^ 3 * x3 ^ 2 * e7 ^ 2 * x1 -
+10 * e3 * e1 ^ 3 * x3 ^ 2 * e7 ^ 2 * x2 + 2 * e3 * e6 ^ 2 * e7 ^ 2 * x1 * e1 -
+4 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * e6 ^ 2 -
+4 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * e7 ^ 2 -
+8 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * e6 ^ 2 -
+8 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * e7 ^ 2 - 4 * e3 * e6 ^ 3 * e1 * x3 * e7 -
+2 * e3 * e6 ^ 2 * e1 * x3 * e7 ^ 2 - 8 * e3 * x2 ^ 2 * e1 ^ 3 * e6 * e7 * x1 +
+16 * e3 * x2 ^ 2 * e1 ^ 3 * y2 ^ 2 * y3 ^ 2 * x1 -
+28 * e3 * e1 ^ 2 * x3 ^ 2 * e6 * e7 * y1 * y2 -
+16 * e3 * e1 ^ 3 * x3 ^ 2 * e6 * e7 * x1 -
+20 * e3 * e1 ^ 3 * x3 ^ 2 * e6 * e7 * x2 -
+24 * e3 * e1 ^ 2 * x3 ^ 2 * y2 ^ 3 * y3 ^ 2 * y1 -
+16 * e3 * e1 ^ 3 * x3 ^ 2 * y2 ^ 2 * y3 ^ 2 * x1 -
+8 * e3 * e1 ^ 3 * x3 ^ 2 * y2 ^ 2 * y3 ^ 2 * x2 +
+8 * e3 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 * x1 * e1 +
+16 * e3 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 * x2 * e1 -
+8 * e3 * e6 ^ 3 * y2 * y3 * x1 * e1 - 8 * e3 * e6 ^ 3 * y2 * y3 * x2 * e1 +
+4 * e3 * e5 ^ 2 * e6 * e7 * x1 * e1 +
+8 * e3 * e5 ^ 2 * y2 ^ 2 * y3 ^ 2 * x1 * e1 +
+16 * e3 * e5 ^ 2 * y2 ^ 2 * y3 ^ 2 * x2 * e1 +
+8 * e3 * e5 * e6 ^ 2 * e7 * x1 * e1 -
+14 * e3 * e1 ^ 2 * x3 ^ 2 * e6 ^ 2 * y1 * y2 -
+14 * e3 * e1 ^ 2 * x3 ^ 2 * e7 ^ 2 * y1 * y2 +
+8 * e3 * e6 ^ 3 * e1 * x3 * y1 * y2 -
+16 * e3 * e5 * e6 * e7 * y2 * y3 * x1 * e1 -
+16 * e3 * e5 * e6 * e7 * y2 * y3 * x2 * e1 +
+40 * e3 * e1 ^ 2 * x3 ^ 2 * e6 * y2 ^ 2 * y3 * y1 +
+24 * e3 * e1 ^ 3 * x3 ^ 2 * e6 * y2 * y3 * x1 +
+24 * e3 * e1 ^ 3 * x3 ^ 2 * e6 * y2 * y3 * x2 -
+12 * e3 * x1 * e1 ^ 2 * x3 * e6 ^ 2 * y1 * y2 -
+12 * e3 * x1 * e1 ^ 3 * x3 * e6 ^ 2 * x2 -
+12 * e3 * x1 * e1 ^ 2 * x3 * e7 ^ 2 * y1 * y2 -
+12 * e3 * x1 * e1 ^ 3 * x3 * e7 ^ 2 * x2 -
+20 * e3 * x2 * e1 ^ 2 * x3 * e6 ^ 2 * y1 * y2 -
+20 * e3 * x2 * e1 ^ 2 * x3 * e7 ^ 2 * y1 * y2 +
+8 * e3 * e5 * e1 * x3 * e6 ^ 2 * y1 * y2 +
+8 * e3 * e5 * e1 * x3 * e7 ^ 2 * y1 * y2 +
+16 * e3 * y1 * y2 * e1 * x3 * e6 ^ 2 * e7 -
+16 * e3 * y1 * y2 ^ 2 * e1 * x3 * e6 ^ 2 * y3 +
+12 * e3 * x1 * e1 ^ 2 * x3 * e6 ^ 2 * e7 -
+16 * e3 * x1 * e1 ^ 2 * x3 * e6 ^ 2 * y2 * y3 +
+20 * e3 * x2 * e1 ^ 2 * x3 * e6 ^ 2 * e7 -
+16 * e3 * x2 * e1 ^ 2 * x3 * e6 ^ 2 * y2 * y3 -
+4 * e3 * e5 ^ 2 * e1 * x3 * e6 * e7 +
+4 * e3 * e5 ^ 2 * e1 * x3 * e6 * y2 * y3 +
+8 * e3 * e5 * e1 * x3 * e6 ^ 2 * y2 * y3 +
+4 * e3 * e5 ^ 2 * e1 * x3 * e7 * y2 * y3 +
+4 * e3 * e6 ^ 3 * e1 * x3 * y2 * y3 +
+4 * e3 * e6 ^ 2 * e1 * x3 * e7 * y2 * y3 -
+8 * e3 * e6 ^ 2 * e1 * x3 * e7 * e5 -
+20 * e3 * e1 ^ 2 * x3 ^ 2 * e7 * y2 * y3 * e5 -
+20 * e3 * e1 ^ 2 * x3 ^ 2 * e7 * y2 * y3 * e6 +
+16 * e3 * y1 * y2 * e1 * x3 * e6 * e7 * e5 +
+8 * e3 * y1 * y2 * e1 * x3 * e7 ^ 2 * e6 -
+16 * e3 * y1 * y2 ^ 2 * e1 * x3 * e6 * y3 * e5 -
+16 * e3 * y1 * y2 ^ 2 * e1 * x3 * e7 * y3 * e5 -
+16 * e3 * y1 * y2 ^ 2 * e1 * x3 * e7 * y3 * e6 +
+12 * e3 * x1 * e1 ^ 2 * x3 * e6 * e7 * e5 +
+8 * e3 * x1 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 * e5 +
+8 * e3 * x1 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 * e6 -
+16 * e3 * x1 * e1 ^ 2 * x3 * e6 * y2 * y3 * e5 -
+16 * e3 * x1 * e1 ^ 2 * x3 * e7 * y2 * y3 * e5 -
+16 * e3 * x1 * e1 ^ 2 * x3 * e7 * y2 * y3 * e6 +
+20 * e3 * x2 * e1 ^ 2 * x3 * e6 * e7 * e5 -
+8 * e3 * x2 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 * e5 -
+8 * e3 * x2 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 * e6 -
+16 * e3 * x2 * e1 ^ 2 * x3 * e6 * y2 * y3 * e5 -
+16 * e3 * x2 * e1 ^ 2 * x3 * e7 * y2 * y3 * e5 -
+16 * e3 * x2 * e1 ^ 2 * x3 * e7 * y2 * y3 * e6 +
+8 * e3 * e5 * e1 * x3 * e7 * y2 * y3 * e6 +
+40 * e3 * e1 ^ 2 * x3 ^ 2 * e7 * y2 ^ 2 * y3 * y1 +
+24 * e3 * e1 ^ 3 * x3 ^ 2 * e7 * y2 * y3 * x1 +
+24 * e3 * e1 ^ 3 * x3 ^ 2 * e7 * y2 * y3 * x2 -
+8 * e3 * y1 ^ 2 * y2 ^ 2 * e1 * x3 * e6 ^ 2 -
+16 * e3 * y1 ^ 2 * y2 ^ 2 * e1 * x3 * e6 * e7 -
+24 * e3 * y1 * y2 * e1 ^ 2 * x3 * e6 * e7 * x1 -
+40 * e3 * y1 * y2 * e1 ^ 2 * x3 * e6 * e7 * x2 -
+8 * e3 * y1 ^ 2 * y2 ^ 2 * e1 * x3 * e7 ^ 2 -
+16 * e3 * y1 * y2 ^ 3 * e1 ^ 2 * x3 * y3 ^ 2 * x1 +
+16 * e3 * y1 * y2 ^ 3 * e1 ^ 2 * x3 * y3 ^ 2 * x2 +
+16 * e3 * y1 ^ 2 * y2 ^ 3 * e1 * x3 * e6 * y3 +
+32 * e3 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e6 * y3 * x1 +
+32 * e3 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e6 * y3 * x2 +
+16 * e3 * y1 ^ 2 * y2 ^ 3 * e1 * x3 * e7 * y3 +
+32 * e3 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e7 * y3 * x1 +
+32 * e3 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e7 * y3 * x2 -
+8 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * e6 * e7 -
+24 * e3 * x1 * e1 ^ 3 * x3 * e6 * e7 * x2 -
+8 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * y2 ^ 2 * y3 ^ 2 +
+12 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * e6 * y2 * y3 +
+24 * e3 * x1 * e1 ^ 3 * x3 * e6 * y2 * y3 * x2 +
+12 * e3 * x1 ^ 2 * e1 ^ 3 * x3 * e7 * y2 * y3 +
+24 * e3 * x1 * e1 ^ 3 * x3 * e7 * y2 * y3 * x2 -
+16 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * e6 * e7 +
+8 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * y2 ^ 2 * y3 ^ 2 +
+12 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * e6 * y2 * y3 +
+12 * e3 * x2 ^ 2 * e1 ^ 3 * x3 * e7 * y2 * y3 - 2 * x3 ^ 5 * e1 ^ 3 * e3 ^ 3 -
+4 * x3 ^ 3 * e1 ^ 3 * e3 * e6 ^ 2 - 4 * x3 ^ 3 * e1 ^ 3 * e3 * e7 ^ 2 +
+5 * x3 ^ 4 * e1 ^ 3 * e3 ^ 2 * e6 + 5 * x3 ^ 4 * e1 ^ 3 * e3 ^ 2 * e7 -
+8 * x3 ^ 3 * e1 ^ 3 * e3 * e6 * e7 -
+8 * x3 ^ 3 * e1 ^ 3 * e3 * y2 ^ 2 * y3 ^ 2 -
+8 * x3 ^ 4 * e1 ^ 3 * e3 ^ 2 * y2 * y3 +
+12 * x3 ^ 3 * e1 ^ 3 * e3 * e6 * y2 * y3 +
+12 * x3 ^ 3 * e1 ^ 3 * e3 * e7 * y2 * y3 -
+8 * y2 ^ 3 * y3 * x2 * e3 * x1 ^ 2 * e1 ^ 3 -
+e6 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 - e6 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+e7 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 - e7 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+4 * y2 ^ 4 * y3 ^ 2 * x1 ^ 2 * e1 ^ 3 - 4 * y2 ^ 4 * y3 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+4 * x2 ^ 4 * e3 ^ 2 * y2 ^ 2 * e1 ^ 3 + 2 * e6 ^ 3 * y2 ^ 2 * x1 * e1 ^ 2 +
+2 * e6 ^ 3 * y2 ^ 2 * x2 * e1 ^ 2 - y2 ^ 2 * e7 ^ 2 * e1 ^ 3 * x3 ^ 2 -
+4 * y2 ^ 4 * y3 ^ 2 * e1 ^ 3 * x3 ^ 2 - y3 ^ 2 * e6 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+y3 ^ 2 * e6 ^ 2 * x2 ^ 2 * e1 ^ 3 - y3 ^ 2 * e6 ^ 2 * e1 ^ 3 * x3 ^ 2 -
+y3 ^ 2 * e7 ^ 2 * x1 ^ 2 * e1 ^ 3 - y3 ^ 2 * e7 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+y3 ^ 2 * e7 ^ 2 * e1 ^ 3 * x3 ^ 2 - 4 * y2 ^ 2 * y3 ^ 4 * x1 ^ 2 * e1 ^ 3 -
+4 * y2 ^ 2 * y3 ^ 4 * x2 ^ 2 * e1 ^ 3 - 4 * y2 ^ 2 * y3 ^ 4 * e1 ^ 3 * x3 ^ 2 -
+e4 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 - e4 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+e4 ^ 2 * y2 ^ 2 * e1 ^ 3 * x3 ^ 2 - e4 ^ 2 * y1 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+e4 ^ 2 * y1 ^ 2 * x2 ^ 2 * e1 ^ 3 - e4 ^ 2 * y1 ^ 2 * e1 ^ 3 * x3 ^ 2 -
+y2 ^ 2 * x3 ^ 4 * e3 ^ 2 * e1 ^ 3 - 4 * y3 ^ 2 * x2 ^ 4 * e3 ^ 2 * e1 ^ 3 -
+y3 ^ 2 * x3 ^ 4 * e3 ^ 2 * e1 ^ 3 + 2 * y2 ^ 2 * e6 ^ 3 * e1 ^ 2 * x3 +
+2 * y3 ^ 2 * e6 ^ 3 * x1 * e1 ^ 2 + 2 * y3 ^ 2 * e6 ^ 3 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * e6 ^ 3 * e1 ^ 2 * x3 - 2 * e1 * e6 ^ 3 * y2 ^ 2 * e5 +
+4 * e1 * e6 ^ 3 * y2 ^ 3 * y1 - e1 * e6 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+4 * e1 * e6 ^ 2 * y1 ^ 2 * y2 ^ 4 - 2 * e1 * e6 ^ 3 * e7 * y2 ^ 2 -
+e1 * e7 ^ 2 * y2 ^ 2 * e5 ^ 2 - e1 * e7 ^ 2 * y2 ^ 2 * e6 ^ 2 -
+4 * e1 * e7 ^ 2 * y1 ^ 2 * y2 ^ 4 - 4 * e1 * y2 ^ 4 * y3 ^ 2 * e5 ^ 2 -
+4 * e1 * y2 ^ 4 * y3 ^ 2 * e6 ^ 2 - 16 * e1 * y2 ^ 6 * y3 ^ 2 * y1 ^ 2 +
+4 * e1 * e6 ^ 3 * y2 ^ 3 * y3 - 8 * e1 * e4 ^ 2 * y2 ^ 3 * y1 ^ 3 +
+4 * e1 * e6 ^ 3 * y2 ^ 2 * y3 ^ 2 - 4 * e1 * e6 ^ 4 * y2 * y3 -
+e1 * y3 ^ 2 * e6 ^ 2 * e5 ^ 2 - 2 * e1 * y3 ^ 2 * e6 ^ 3 * e5 -
+e1 * y3 ^ 2 * e7 ^ 2 * e6 ^ 2 - e1 * y3 ^ 2 * e7 ^ 2 * e5 ^ 2 -
+4 * e1 * y2 ^ 2 * y3 ^ 4 * e6 ^ 2 - 4 * e1 * y2 ^ 2 * y3 ^ 4 * e5 ^ 2 -
+8 * y2 ^ 3 * y3 * x2 ^ 3 * e3 * e1 ^ 3 - e1 * e6 ^ 4 * y2 ^ 2 -
+4 * y2 ^ 3 * y3 * x3 * e3 * x1 ^ 2 * e1 ^ 3 -
+20 * y2 ^ 3 * y3 * x3 * e3 * x2 ^ 2 * e1 ^ 3 -
+16 * y2 ^ 3 * y3 * e3 * x1 * x2 ^ 2 * e1 ^ 3 -
+2 * e6 * e7 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+2 * e6 * e7 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 -
+4 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+13 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+16 * y2 ^ 3 * y3 * x2 * e3 * e5 * x1 * e1 ^ 2 +
+16 * y2 ^ 3 * y3 * x2 ^ 2 * e3 * e5 * e1 ^ 2 +
+2 * e6 ^ 2 * y2 ^ 2 * e5 * x1 * e1 ^ 2 -
+32 * y2 ^ 4 * y3 * x2 * e3 * y1 * x1 * e1 ^ 2 -
+32 * y2 ^ 4 * y3 * x2 ^ 2 * e3 * y1 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * x3 * e3 * e5 * x1 * e1 ^ 2 +
+24 * y2 ^ 3 * y3 * x3 * e3 * e5 * x2 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * x3 * e3 * e6 * x1 * e1 ^ 2 +
+24 * y2 ^ 3 * y3 * x3 * e3 * e6 * x2 * e1 ^ 2 -
+16 * y2 ^ 4 * y3 * x3 * e3 * y1 * x1 * e1 ^ 2 -
+48 * y2 ^ 4 * y3 * x3 * e3 * y1 * x2 * e1 ^ 2 -
+24 * y2 ^ 3 * y3 * x3 * e3 * x1 * e1 ^ 3 * x2 +
+2 * e6 ^ 2 * y2 ^ 2 * e5 * x2 * e1 ^ 2 -
+4 * e6 ^ 2 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+4 * e6 ^ 2 * y1 * y2 ^ 3 * x2 * e1 ^ 2 -
+2 * e6 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 * x2 +
+4 * e6 * e7 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+4 * e6 * e7 * y2 ^ 2 * e5 * x2 * e1 ^ 2 +
+4 * e6 ^ 2 * e7 * y2 ^ 2 * x1 * e1 ^ 2 +
+4 * e6 ^ 2 * e7 * y2 ^ 2 * x2 * e1 ^ 2 -
+8 * e6 * e7 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+8 * e6 * e7 * y1 * y2 ^ 3 * x2 * e1 ^ 2 -
+4 * e6 * e7 * y2 ^ 2 * x1 * e1 ^ 3 * x2 +
+2 * e7 ^ 2 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+2 * e7 ^ 2 * y2 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * e7 ^ 2 * y2 ^ 2 * e6 * x1 * e1 ^ 2 +
+2 * e7 ^ 2 * y2 ^ 2 * e6 * x2 * e1 ^ 2 - y2 ^ 2 * e6 ^ 2 * e1 ^ 3 * x3 ^ 2 -
+4 * e7 ^ 2 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+4 * e7 ^ 2 * y1 * y2 ^ 3 * x2 * e1 ^ 2 -
+2 * e7 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 * x2 +
+16 * y2 ^ 3 * y3 ^ 2 * y1 * e6 * x1 * e1 ^ 2 +
+16 * y2 ^ 3 * y3 ^ 2 * y1 * e6 * x2 * e1 ^ 2 +
+8 * y2 ^ 4 * y3 ^ 2 * e5 * x1 * e1 ^ 2 +
+8 * y2 ^ 4 * y3 ^ 2 * e5 * x2 * e1 ^ 2 +
+8 * y2 ^ 4 * y3 ^ 2 * e6 * x1 * e1 ^ 2 +
+8 * y2 ^ 4 * y3 ^ 2 * e6 * x2 * e1 ^ 2 -
+16 * y2 ^ 5 * y3 ^ 2 * y1 * x1 * e1 ^ 2 -
+16 * y2 ^ 5 * y3 ^ 2 * y1 * x2 * e1 ^ 2 -
+8 * y2 ^ 4 * y3 ^ 2 * x1 * e1 ^ 3 * x2 +
+8 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+8 * x2 ^ 3 * e3 ^ 2 * y2 ^ 2 * e5 * e1 ^ 2 -
+16 * x2 ^ 2 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+16 * x2 ^ 3 * e3 ^ 2 * y1 * y2 ^ 3 * e1 ^ 2 -
+8 * x2 ^ 3 * e3 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 +
+2 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+10 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e6 * x1 * e1 ^ 2 +
+10 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e6 * x2 * e1 ^ 2 -
+4 * x3 ^ 2 * e3 ^ 2 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+20 * x3 ^ 2 * e3 ^ 2 * y1 * y2 ^ 3 * x2 * e1 ^ 2 -
+10 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 * x2 -
+4 * x2 * e3 ^ 2 * x3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+12 * x2 ^ 3 * e3 ^ 2 * x3 * y2 ^ 2 * e1 ^ 3 -
+16 * x3 * e3 ^ 2 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+4 * e6 * y2 ^ 3 * y3 * x1 ^ 2 * e1 ^ 3 +
+4 * e6 * y2 ^ 3 * y3 * x2 ^ 2 * e1 ^ 3 +
+4 * e6 * x2 * e3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 +
+4 * e6 * x2 ^ 3 * e3 * y2 ^ 2 * e1 ^ 3 +
+2 * e6 * x3 * e3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 +
+10 * e6 * x3 * e3 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+8 * e6 * e3 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+4 * e7 * y2 ^ 3 * y3 * x1 ^ 2 * e1 ^ 3 +
+4 * e7 * y2 ^ 3 * y3 * x2 ^ 2 * e1 ^ 3 +
+4 * e7 * x2 * e3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 +
+4 * e7 * x2 ^ 3 * e3 * y2 ^ 2 * e1 ^ 3 +
+2 * e7 * x3 * e3 * y2 ^ 2 * x1 ^ 2 * e1 ^ 3 +
+10 * e7 * x3 * e3 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+8 * e7 * e3 * x1 * y2 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+8 * x2 * e3 ^ 2 * x3 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+16 * x2 ^ 2 * e3 ^ 2 * x3 * y2 ^ 2 * e5 * e1 ^ 2 -
+16 * x2 * e3 ^ 2 * x3 * y1 * y2 ^ 3 * x1 * e1 ^ 2 -
+32 * x2 ^ 2 * e3 ^ 2 * x3 * y1 * y2 ^ 3 * e1 ^ 2 -
+16 * e6 ^ 2 * y2 ^ 2 * y3 * y1 * x1 * e1 ^ 2 -
+16 * e6 ^ 2 * y2 ^ 2 * y3 * y1 * x2 * e1 ^ 2 -
+8 * e6 * y2 ^ 3 * y3 * e5 * x1 * e1 ^ 2 -
+8 * e6 * y2 ^ 3 * y3 * e5 * x2 * e1 ^ 2 -
+8 * e6 ^ 2 * y2 ^ 3 * y3 * x1 * e1 ^ 2 -
+8 * e6 ^ 2 * y2 ^ 3 * y3 * x2 * e1 ^ 2 +
+16 * e6 * y2 ^ 4 * y3 * y1 * x1 * e1 ^ 2 +
+16 * e6 * y2 ^ 4 * y3 * y1 * x2 * e1 ^ 2 +
+8 * e6 * y2 ^ 3 * y3 * x1 * e1 ^ 3 * x2 -
+8 * e6 * x2 * e3 * y2 ^ 2 * e5 * x1 * e1 ^ 2 -
+8 * e6 * x2 ^ 2 * e3 * y2 ^ 2 * e5 * e1 ^ 2 +
+16 * e6 * x2 * e3 * y1 * y2 ^ 3 * x1 * e1 ^ 2 +
+16 * e6 * x2 ^ 2 * e3 * y1 * y2 ^ 3 * e1 ^ 2 -
+4 * e6 * x3 * e3 * y2 ^ 2 * e5 * x1 * e1 ^ 2 -
+12 * e6 * x3 * e3 * y2 ^ 2 * e5 * x2 * e1 ^ 2 -
+4 * e6 ^ 2 * x3 * e3 * y2 ^ 2 * x1 * e1 ^ 2 -
+12 * e6 ^ 2 * x3 * e3 * y2 ^ 2 * x2 * e1 ^ 2 +
+8 * e6 * x3 * e3 * y1 * y2 ^ 3 * x1 * e1 ^ 2 +
+24 * e6 * x3 * e3 * y1 * y2 ^ 3 * x2 * e1 ^ 2 +
+12 * e6 * x3 * e3 * y2 ^ 2 * x1 * e1 ^ 3 * x2 -
+32 * e7 * y2 ^ 2 * y3 * y1 * e6 * x1 * e1 ^ 2 -
+32 * e7 * y2 ^ 2 * y3 * y1 * e6 * x2 * e1 ^ 2 -
+8 * e7 * y2 ^ 3 * y3 * e5 * x1 * e1 ^ 2 -
+8 * e7 * y2 ^ 3 * y3 * e5 * x2 * e1 ^ 2 -
+8 * e7 * y2 ^ 3 * y3 * e6 * x1 * e1 ^ 2 -
+8 * e7 * y2 ^ 3 * y3 * e6 * x2 * e1 ^ 2 +
+16 * e7 * y2 ^ 4 * y3 * y1 * x1 * e1 ^ 2 +
+16 * e7 * y2 ^ 4 * y3 * y1 * x2 * e1 ^ 2 +
+8 * e7 * y2 ^ 3 * y3 * x1 * e1 ^ 3 * x2 -
+8 * e7 * x2 * e3 * y2 ^ 2 * e5 * x1 * e1 ^ 2 -
+8 * e7 * x2 ^ 2 * e3 * y2 ^ 2 * e5 * e1 ^ 2 +
+16 * e7 * x2 * e3 * y1 * y2 ^ 3 * x1 * e1 ^ 2 +
+16 * e7 * x2 ^ 2 * e3 * y1 * y2 ^ 3 * e1 ^ 2 -
+4 * e7 * x3 * e3 * y2 ^ 2 * e5 * x1 * e1 ^ 2 -
+12 * e7 * x3 * e3 * y2 ^ 2 * e5 * x2 * e1 ^ 2 -
+4 * e7 * x3 * e3 * y2 ^ 2 * e6 * x1 * e1 ^ 2 -
+12 * e7 * x3 * e3 * y2 ^ 2 * e6 * x2 * e1 ^ 2 +
+8 * e7 * x3 * e3 * y1 * y2 ^ 3 * x1 * e1 ^ 2 +
+24 * e7 * x3 * e3 * y1 * y2 ^ 3 * x2 * e1 ^ 2 +
+12 * e7 * x3 * e3 * y2 ^ 2 * x1 * e1 ^ 3 * x2 -
+8 * x1 * e1 ^ 3 * x2 * e6 ^ 2 * y2 * y3 -
+4 * x1 ^ 2 * e1 ^ 3 * e6 ^ 2 * y2 * y3 -
+4 * x2 ^ 2 * e1 ^ 3 * e6 ^ 2 * y2 * y3 -
+4 * e1 ^ 3 * x3 ^ 2 * e6 ^ 2 * y2 * y3 +
+4 * x1 ^ 2 * e1 ^ 3 * y2 ^ 2 * y3 ^ 2 * e6 +
+4 * x2 ^ 2 * e1 ^ 3 * y2 ^ 2 * y3 ^ 2 * e6 +
+4 * e1 ^ 3 * x3 ^ 2 * y2 ^ 2 * y3 ^ 2 * e6 +
+8 * x1 * e1 ^ 3 * x2 * y2 ^ 2 * y3 ^ 2 * e6 -
+16 * x1 * e1 ^ 3 * x2 * e7 * y2 * y3 * e6 -
+8 * x1 ^ 2 * e1 ^ 3 * e7 * y2 * y3 * e6 -
+8 * x2 ^ 2 * e1 ^ 3 * e7 * y2 * y3 * e6 +
+16 * e6 ^ 2 * e7 * y2 * y3 * x1 * e1 ^ 2 +
+16 * e6 ^ 2 * e7 * y2 * y3 * x2 * e1 ^ 2 -
+8 * e5 * e6 * y2 ^ 2 * y3 ^ 2 * x1 * e1 ^ 2 -
+8 * e5 * e6 * y2 ^ 2 * y3 ^ 2 * x2 * e1 ^ 2 +
+8 * e5 * e6 ^ 2 * y2 * y3 * x1 * e1 ^ 2 +
+8 * e5 * e6 ^ 2 * y2 * y3 * x2 * e1 ^ 2 -
+8 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 * x1 * e1 ^ 2 -
+8 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 * x2 * e1 ^ 2 +
+8 * e6 ^ 3 * y2 * y3 * x1 * e1 ^ 2 + 8 * e6 ^ 3 * y2 * y3 * x2 * e1 ^ 2 +
+16 * e5 * e6 * e7 * y2 * y3 * x1 * e1 ^ 2 +
+16 * e5 * e6 * e7 * y2 * y3 * x2 * e1 ^ 2 -
+16 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e6 ^ 2 * y3 -
+8 * x1 * e1 ^ 3 * x3 * e6 ^ 2 * y2 * y3 -
+8 * x2 * e1 ^ 3 * x3 * e6 ^ 2 * y2 * y3 +
+8 * e5 * e1 ^ 2 * x3 * e6 ^ 2 * y2 * y3 -
+8 * e6 ^ 2 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 +
+8 * e6 ^ 3 * e1 ^ 2 * x3 * y2 * y3 + 16 * e6 ^ 2 * e1 ^ 2 * x3 * e7 * y2 * y3 -
+8 * e1 ^ 3 * x3 ^ 2 * e7 * y2 * y3 * e6 +
+16 * y1 * y2 ^ 3 * e1 ^ 2 * x3 * y3 ^ 2 * e6 -
+32 * y1 * y2 ^ 2 * e1 ^ 2 * x3 * e7 * y3 * e6 +
+8 * x1 * e1 ^ 3 * x3 * y2 ^ 2 * y3 ^ 2 * e6 -
+16 * x1 * e1 ^ 3 * x3 * e7 * y2 * y3 * e6 +
+8 * x2 * e1 ^ 3 * x3 * y2 ^ 2 * y3 ^ 2 * e6 -
+16 * x2 * e1 ^ 3 * x3 * e7 * y2 * y3 * e6 -
+8 * e5 * e1 ^ 2 * x3 * y2 ^ 2 * y3 ^ 2 * e6 +
+16 * e5 * e1 ^ 2 * x3 * e7 * y2 * y3 * e6 -
+2 * y3 ^ 2 * e6 ^ 2 * x1 * e1 ^ 3 * x2 -
+4 * y3 ^ 2 * e6 ^ 2 * y1 * y2 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e6 ^ 2 * y1 * y2 * x2 * e1 ^ 2 -
+2 * y3 ^ 2 * e7 ^ 2 * x1 * e1 ^ 3 * x2 -
+4 * y3 ^ 2 * e7 ^ 2 * y1 * y2 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e7 ^ 2 * y1 * y2 * x2 * e1 ^ 2 -
+8 * y2 ^ 2 * y3 ^ 4 * x1 * e1 ^ 3 * x2 -
+16 * y2 ^ 3 * y3 ^ 4 * y1 * x1 * e1 ^ 2 -
+16 * y2 ^ 3 * y3 ^ 4 * y1 * x2 * e1 ^ 2 -
+2 * e4 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 * x2 -
+4 * e4 ^ 2 * y2 ^ 3 * y1 * x1 * e1 ^ 2 -
+4 * e4 ^ 2 * y2 ^ 3 * y1 * x2 * e1 ^ 2 -
+2 * e4 ^ 2 * y1 ^ 2 * x1 * e1 ^ 3 * x2 -
+4 * e4 ^ 2 * y1 ^ 3 * y2 * x1 * e1 ^ 2 -
+4 * e4 ^ 2 * y1 ^ 3 * y2 * x2 * e1 ^ 2 -
+2 * y2 ^ 2 * e6 * e7 * e1 ^ 3 * x3 ^ 2 +
+4 * y2 ^ 3 * e6 * y3 * e1 ^ 3 * x3 ^ 2 -
+4 * y2 ^ 2 * e6 * e4 * x1 * e1 ^ 3 * x2 -
+2 * y2 ^ 2 * e6 * e4 * x1 ^ 2 * e1 ^ 3 -
+2 * y2 ^ 2 * e6 * e4 * x2 ^ 2 * e1 ^ 3 -
+2 * y2 ^ 2 * e6 * e4 * e1 ^ 3 * x3 ^ 2 -
+8 * y2 ^ 3 * e6 * e4 * y1 * x1 * e1 ^ 2 -
+8 * y2 ^ 3 * e6 * e4 * y1 * x2 * e1 ^ 2 +
+4 * y2 ^ 3 * e7 * y3 * e1 ^ 3 * x3 ^ 2 -
+8 * y2 * e7 ^ 2 * y3 * x1 * e1 ^ 3 * x2 -
+4 * y2 * e7 ^ 2 * y3 * x1 ^ 2 * e1 ^ 3 -
+4 * y2 * e7 ^ 2 * y3 * x2 ^ 2 * e1 ^ 3 -
+4 * y2 * e7 ^ 2 * y3 * e1 ^ 3 * x3 ^ 2 -
+16 * y2 ^ 2 * e7 ^ 2 * y3 * y1 * x1 * e1 ^ 2 -
+16 * y2 ^ 2 * e7 ^ 2 * y3 * y1 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * e7 * y3 ^ 2 * x1 * e1 ^ 3 * x2 +
+4 * y2 ^ 2 * e7 * y3 ^ 2 * x1 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 2 * e7 * y3 ^ 2 * x2 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 2 * e7 * y3 ^ 2 * e1 ^ 3 * x3 ^ 2 +
+16 * y2 ^ 3 * e7 * y3 ^ 2 * y1 * x1 * e1 ^ 2 +
+16 * y2 ^ 3 * e7 * y3 ^ 2 * y1 * x2 * e1 ^ 2 -
+4 * y2 ^ 2 * e7 * e4 * x1 * e1 ^ 3 * x2 -
+2 * y2 ^ 2 * e7 * e4 * x1 ^ 2 * e1 ^ 3 -
+2 * y2 ^ 2 * e7 * e4 * x2 ^ 2 * e1 ^ 3 -
+2 * y2 ^ 2 * e7 * e4 * e1 ^ 3 * x3 ^ 2 -
+8 * y2 ^ 3 * e7 * e4 * y1 * x1 * e1 ^ 2 -
+8 * y2 ^ 3 * e7 * e4 * y1 * x2 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * e4 * x1 * e1 ^ 3 * x2 +
+4 * y2 ^ 3 * y3 * e4 * x1 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 3 * y3 * e4 * x2 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 3 * y3 * e4 * e1 ^ 3 * x3 ^ 2 +
+16 * y2 ^ 4 * y3 * e4 * y1 * x1 * e1 ^ 2 +
+16 * y2 ^ 4 * y3 * e4 * y1 * x2 * e1 ^ 2 -
+4 * y3 ^ 2 * e6 * e7 * x1 * e1 ^ 3 * x2 -
+2 * y3 ^ 2 * e6 * e7 * x1 ^ 2 * e1 ^ 3 -
+2 * y3 ^ 2 * e6 * e7 * x2 ^ 2 * e1 ^ 3 -
+2 * y3 ^ 2 * e6 * e7 * e1 ^ 3 * x3 ^ 2 -
+8 * y3 ^ 2 * e6 * e7 * y1 * y2 * x1 * e1 ^ 2 -
+8 * y3 ^ 2 * e6 * e7 * y1 * y2 * x2 * e1 ^ 2 +
+8 * y3 ^ 3 * e6 * y2 * x1 * e1 ^ 3 * x2 +
+4 * y3 ^ 3 * e6 * y2 * x1 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 3 * e6 * y2 * x2 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 3 * e6 * y2 * e1 ^ 3 * x3 ^ 2 +
+16 * y3 ^ 3 * e6 * y2 ^ 2 * y1 * x1 * e1 ^ 2 +
+16 * y3 ^ 3 * e6 * y2 ^ 2 * y1 * x2 * e1 ^ 2 +
+8 * y3 ^ 3 * e7 * y2 * x1 * e1 ^ 3 * x2 +
+4 * y3 ^ 3 * e7 * y2 * x1 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 3 * e7 * y2 * x2 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 3 * e7 * y2 * e1 ^ 3 * x3 ^ 2 +
+16 * y3 ^ 3 * e7 * y2 ^ 2 * y1 * x1 * e1 ^ 2 +
+16 * y3 ^ 3 * e7 * y2 ^ 2 * y1 * x2 * e1 ^ 2 -
+8 * y2 ^ 2 * y3 ^ 2 * e4 * x1 * e1 ^ 3 * x2 -
+4 * y2 ^ 2 * y3 ^ 2 * e4 * x1 ^ 2 * e1 ^ 3 -
+4 * y2 ^ 2 * y3 ^ 2 * e4 * x2 ^ 2 * e1 ^ 3 -
+4 * y2 ^ 2 * y3 ^ 2 * e4 * e1 ^ 3 * x3 ^ 2 -
+16 * y2 ^ 3 * y3 ^ 2 * e4 * y1 * x1 * e1 ^ 2 -
+16 * y2 ^ 3 * y3 ^ 2 * e4 * y1 * x2 * e1 ^ 2 -
+8 * y3 ^ 2 * x2 ^ 3 * e3 ^ 2 * x1 * e1 ^ 3 -
+4 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+13 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e1 ^ 3 * x3 ^ 2 -
+16 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 * y2 * x1 * e1 ^ 2 -
+16 * y3 ^ 2 * x2 ^ 3 * e3 ^ 2 * y1 * y2 * e1 ^ 2 -
+10 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * x1 * e1 ^ 3 * x2 -
+y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * x1 ^ 2 * e1 ^ 3 -
+4 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * y1 * y2 * x1 * e1 ^ 2 -
+20 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * y1 * y2 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * e6 * x2 * e3 * e1 ^ 3 * x3 ^ 2 +
+2 * y2 ^ 2 * e6 * x3 ^ 3 * e3 * e1 ^ 3 -
+4 * y2 * e6 * e4 * y1 * x1 * e1 ^ 3 * x2 -
+2 * y2 * e6 * e4 * y1 * x1 ^ 2 * e1 ^ 3 -
+2 * y2 * e6 * e4 * y1 * x2 ^ 2 * e1 ^ 3 -
+2 * y2 * e6 * e4 * y1 * e1 ^ 3 * x3 ^ 2 -
+8 * y2 ^ 2 * e6 * e4 * y1 ^ 2 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * e6 * e4 * y1 ^ 2 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * e7 * x2 * e3 * e1 ^ 3 * x3 ^ 2 +
+2 * y2 ^ 2 * e7 * x3 ^ 3 * e3 * e1 ^ 3 -
+4 * y2 * e7 * e4 * y1 * x1 * e1 ^ 3 * x2 -
+2 * y2 * e7 * e4 * y1 * x1 ^ 2 * e1 ^ 3 -
+2 * y2 * e7 * e4 * y1 * x2 ^ 2 * e1 ^ 3 -
+2 * y2 * e7 * e4 * y1 * e1 ^ 3 * x3 ^ 2 -
+8 * y2 ^ 2 * e7 * e4 * y1 ^ 2 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * e4 * y1 ^ 2 * x2 * e1 ^ 2 -
+4 * y2 ^ 3 * e6 ^ 2 * y1 * e1 ^ 2 * x3 -
+2 * y2 ^ 2 * e6 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * y2 ^ 2 * e6 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * y2 ^ 2 * e6 ^ 2 * e5 * e1 ^ 2 * x3 -
+4 * y2 ^ 3 * e7 ^ 2 * y1 * e1 ^ 2 * x3 -
+2 * y2 ^ 2 * e7 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * y2 ^ 2 * e7 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * y2 ^ 2 * e7 ^ 2 * e5 * e1 ^ 2 * x3 +
+2 * y2 ^ 2 * e7 ^ 2 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 5 * y3 ^ 2 * y1 * e1 ^ 2 * x3 -
+8 * y2 ^ 4 * y3 ^ 2 * x1 * e1 ^ 3 * x3 -
+8 * y2 ^ 4 * y3 ^ 2 * x2 * e1 ^ 3 * x3 +
+8 * y2 ^ 4 * y3 ^ 2 * e5 * e1 ^ 2 * x3 +
+8 * y2 ^ 4 * y3 ^ 2 * e6 * e1 ^ 2 * x3 -
+4 * y3 ^ 2 * e6 ^ 2 * y1 * y2 * e1 ^ 2 * x3 -
+2 * y3 ^ 2 * e6 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * y3 ^ 2 * e6 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * y3 ^ 2 * e6 ^ 2 * e5 * x1 * e1 ^ 2 +
+2 * y3 ^ 2 * e6 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * e6 ^ 2 * e5 * e1 ^ 2 * x3 -
+4 * y3 ^ 2 * e7 ^ 2 * y1 * y2 * e1 ^ 2 * x3 -
+2 * y3 ^ 2 * e7 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * y3 ^ 2 * e7 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * y3 ^ 2 * e7 ^ 2 * e5 * x1 * e1 ^ 2 +
+2 * y3 ^ 2 * e7 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * e7 ^ 2 * e5 * e1 ^ 2 * x3 +
+2 * y3 ^ 2 * e7 ^ 2 * e6 * x1 * e1 ^ 2 +
+2 * y3 ^ 2 * e7 ^ 2 * e6 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * e7 ^ 2 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 3 * y3 ^ 4 * y1 * e1 ^ 2 * x3 -
+8 * y2 ^ 2 * y3 ^ 4 * x1 * e1 ^ 3 * x3 -
+8 * y2 ^ 2 * y3 ^ 4 * x2 * e1 ^ 3 * x3 +
+8 * y2 ^ 2 * y3 ^ 4 * e5 * x1 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 4 * e5 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 4 * e5 * e1 ^ 2 * x3 +
+8 * y2 ^ 2 * y3 ^ 4 * e6 * x1 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 4 * e6 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 4 * e6 * e1 ^ 2 * x3 -
+4 * e4 ^ 2 * y2 ^ 3 * y1 * e1 ^ 2 * x3 -
+2 * e4 ^ 2 * y2 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * e4 ^ 2 * y2 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * e4 ^ 2 * y2 ^ 2 * e5 * x1 * e1 ^ 2 +
+2 * e4 ^ 2 * y2 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * e4 ^ 2 * y2 ^ 2 * e5 * e1 ^ 2 * x3 +
+2 * e4 ^ 2 * y2 ^ 2 * e6 * x1 * e1 ^ 2 +
+2 * e4 ^ 2 * y2 ^ 2 * e6 * x2 * e1 ^ 2 +
+2 * e4 ^ 2 * y2 ^ 2 * e6 * e1 ^ 2 * x3 -
+4 * e4 ^ 2 * y1 ^ 3 * y2 * e1 ^ 2 * x3 -
+2 * e4 ^ 2 * y1 ^ 2 * x1 * e1 ^ 3 * x3 -
+2 * e4 ^ 2 * y1 ^ 2 * x2 * e1 ^ 3 * x3 +
+2 * e4 ^ 2 * y1 ^ 2 * e5 * x1 * e1 ^ 2 +
+2 * e4 ^ 2 * y1 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * e4 ^ 2 * y1 ^ 2 * e5 * e1 ^ 2 * x3 +
+2 * e4 ^ 2 * y1 ^ 2 * e6 * x1 * e1 ^ 2 +
+2 * e4 ^ 2 * y1 ^ 2 * e6 * x2 * e1 ^ 2 +
+2 * e4 ^ 2 * y1 ^ 2 * e6 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * e6 * e7 * y1 * e1 ^ 2 * x3 -
+4 * y2 ^ 2 * e6 * e7 * x1 * e1 ^ 3 * x3 -
+4 * y2 ^ 2 * e6 * e7 * x2 * e1 ^ 3 * x3 +
+4 * y2 ^ 2 * e6 * e7 * e5 * e1 ^ 2 * x3 +
+4 * y2 ^ 2 * e6 ^ 2 * e7 * e1 ^ 2 * x3 +
+16 * y2 ^ 4 * e6 * y3 * y1 * e1 ^ 2 * x3 +
+8 * y2 ^ 3 * e6 * y3 * x1 * e1 ^ 3 * x3 +
+8 * y2 ^ 3 * e6 * y3 * x2 * e1 ^ 3 * x3 -
+8 * y2 ^ 3 * e6 * y3 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * e6 ^ 2 * y3 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * e6 * e4 * y1 * e1 ^ 2 * x3 -
+4 * y2 ^ 2 * e6 * e4 * x1 * e1 ^ 3 * x3 -
+4 * y2 ^ 2 * e6 * e4 * x2 * e1 ^ 3 * x3 +
+4 * y2 ^ 2 * e6 * e4 * e5 * x1 * e1 ^ 2 +
+4 * y2 ^ 2 * e6 * e4 * e5 * x2 * e1 ^ 2 +
+4 * y2 ^ 2 * e6 * e4 * e5 * e1 ^ 2 * x3 +
+4 * y2 ^ 2 * e6 ^ 2 * e4 * x1 * e1 ^ 2 +
+4 * y2 ^ 2 * e6 ^ 2 * e4 * x2 * e1 ^ 2 +
+4 * y2 ^ 2 * e6 ^ 2 * e4 * e1 ^ 2 * x3 +
+16 * y2 ^ 4 * e7 * y3 * y1 * e1 ^ 2 * x3 +
+8 * y2 ^ 3 * e7 * y3 * x1 * e1 ^ 3 * x3 +
+8 * y2 ^ 3 * e7 * y3 * x2 * e1 ^ 3 * x3 -
+8 * y2 ^ 3 * e7 * y3 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * e7 * y3 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 2 * e7 ^ 2 * y3 * y1 * e1 ^ 2 * x3 -
+8 * y2 * e7 ^ 2 * y3 * x1 * e1 ^ 3 * x3 -
+8 * y2 * e7 ^ 2 * y3 * x2 * e1 ^ 3 * x3 +
+8 * y2 * e7 ^ 2 * y3 * e5 * x1 * e1 ^ 2 +
+8 * y2 * e7 ^ 2 * y3 * e5 * x2 * e1 ^ 2 +
+8 * y2 * e7 ^ 2 * y3 * e5 * e1 ^ 2 * x3 +
+8 * y2 * e7 ^ 2 * y3 * e6 * x1 * e1 ^ 2 +
+8 * y2 * e7 ^ 2 * y3 * e6 * x2 * e1 ^ 2 +
+8 * y2 * e7 ^ 2 * y3 * e6 * e1 ^ 2 * x3 +
+16 * y2 ^ 3 * e7 * y3 ^ 2 * y1 * e1 ^ 2 * x3 +
+8 * y2 ^ 2 * e7 * y3 ^ 2 * x1 * e1 ^ 3 * x3 +
+8 * y2 ^ 2 * e7 * y3 ^ 2 * x2 * e1 ^ 3 * x3 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e5 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e5 * x2 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e6 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e6 * x2 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * y3 ^ 2 * e6 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * e7 * e4 * y1 * e1 ^ 2 * x3 -
+4 * y2 ^ 2 * e7 * e4 * x1 * e1 ^ 3 * x3 -
+4 * y2 ^ 2 * e7 * e4 * x2 * e1 ^ 3 * x3 +
+4 * y2 ^ 2 * e7 * e4 * e5 * x1 * e1 ^ 2 +
+4 * y2 ^ 2 * e7 * e4 * e5 * x2 * e1 ^ 2 +
+4 * y2 ^ 2 * e7 * e4 * e5 * e1 ^ 2 * x3 +
+4 * y2 ^ 2 * e7 * e4 * e6 * x1 * e1 ^ 2 +
+4 * y2 ^ 2 * e7 * e4 * e6 * x2 * e1 ^ 2 +
+4 * y2 ^ 2 * e7 * e4 * e6 * e1 ^ 2 * x3 +
+16 * y2 ^ 4 * y3 * e4 * y1 * e1 ^ 2 * x3 +
+8 * y2 ^ 3 * y3 * e4 * x1 * e1 ^ 3 * x3 +
+8 * y2 ^ 3 * y3 * e4 * x2 * e1 ^ 3 * x3 -
+8 * y2 ^ 3 * y3 * e4 * e5 * x1 * e1 ^ 2 -
+8 * y2 ^ 3 * y3 * e4 * e5 * x2 * e1 ^ 2 -
+8 * y2 ^ 3 * y3 * e4 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 3 * y3 * e4 * e6 * x1 * e1 ^ 2 -
+8 * y2 ^ 3 * y3 * e4 * e6 * x2 * e1 ^ 2 -
+8 * y2 ^ 3 * y3 * e4 * e6 * e1 ^ 2 * x3 -
+4 * y2 ^ 3 * x3 ^ 3 * e3 ^ 2 * y1 * e1 ^ 2 -
+2 * y2 ^ 2 * x3 ^ 3 * e3 ^ 2 * x1 * e1 ^ 3 -
+6 * y2 ^ 2 * x3 ^ 3 * e3 ^ 2 * x2 * e1 ^ 3 +
+2 * y2 ^ 2 * x3 ^ 3 * e3 ^ 2 * e5 * e1 ^ 2 +
+2 * y2 ^ 2 * x3 ^ 3 * e3 ^ 2 * e6 * e1 ^ 2 -
+8 * y3 ^ 2 * e6 * e7 * y1 * y2 * e1 ^ 2 * x3 -
+4 * y3 ^ 2 * e6 * e7 * x1 * e1 ^ 3 * x3 -
+4 * y3 ^ 2 * e6 * e7 * x2 * e1 ^ 3 * x3 +
+4 * y3 ^ 2 * e6 * e7 * e5 * x1 * e1 ^ 2 +
+4 * y3 ^ 2 * e6 * e7 * e5 * x2 * e1 ^ 2 +
+4 * y3 ^ 2 * e6 * e7 * e5 * e1 ^ 2 * x3 +
+4 * y3 ^ 2 * e6 ^ 2 * e7 * x1 * e1 ^ 2 +
+4 * y3 ^ 2 * e6 ^ 2 * e7 * x2 * e1 ^ 2 +
+4 * y3 ^ 2 * e6 ^ 2 * e7 * e1 ^ 2 * x3 +
+16 * y3 ^ 3 * e6 * y2 ^ 2 * y1 * e1 ^ 2 * x3 +
+8 * y3 ^ 3 * e6 * y2 * x1 * e1 ^ 3 * x3 +
+8 * y3 ^ 3 * e6 * y2 * x2 * e1 ^ 3 * x3 -
+8 * y3 ^ 3 * e6 * y2 * e5 * x1 * e1 ^ 2 -
+8 * y3 ^ 3 * e6 * y2 * e5 * x2 * e1 ^ 2 -
+8 * y3 ^ 3 * e6 * y2 * e5 * e1 ^ 2 * x3 -
+8 * y3 ^ 3 * e6 ^ 2 * y2 * x1 * e1 ^ 2 -
+8 * y3 ^ 3 * e6 ^ 2 * y2 * x2 * e1 ^ 2 -
+8 * y3 ^ 3 * e6 ^ 2 * y2 * e1 ^ 2 * x3 +
+16 * y3 ^ 3 * e7 * y2 ^ 2 * y1 * e1 ^ 2 * x3 +
+8 * y3 ^ 3 * e7 * y2 * x1 * e1 ^ 3 * x3 +
+8 * y3 ^ 3 * e7 * y2 * x2 * e1 ^ 3 * x3 -
+8 * y3 ^ 3 * e7 * y2 * e5 * x1 * e1 ^ 2 -
+8 * y3 ^ 3 * e7 * y2 * e5 * x2 * e1 ^ 2 -
+8 * y3 ^ 3 * e7 * y2 * e5 * e1 ^ 2 * x3 -
+8 * y3 ^ 3 * e7 * y2 * e6 * x1 * e1 ^ 2 -
+8 * y3 ^ 3 * e7 * y2 * e6 * x2 * e1 ^ 2 -
+8 * y3 ^ 3 * e7 * y2 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 3 * y3 ^ 2 * e4 * y1 * e1 ^ 2 * x3 -
+8 * y2 ^ 2 * y3 ^ 2 * e4 * x1 * e1 ^ 3 * x3 -
+8 * y2 ^ 2 * y3 ^ 2 * e4 * x2 * e1 ^ 3 * x3 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e5 * x1 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e5 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e5 * e1 ^ 2 * x3 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e6 * x1 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e6 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * y3 ^ 2 * e4 * e6 * e1 ^ 2 * x3 -
+32 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 * y2 * e1 ^ 2 * x3 -
+16 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * x1 * e1 ^ 3 * x3 -
+12 * y3 ^ 2 * x2 ^ 3 * e3 ^ 2 * e1 ^ 3 * x3 +
+8 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e5 * x1 * e1 ^ 2 +
+8 * y3 ^ 2 * x2 ^ 3 * e3 ^ 2 * e5 * e1 ^ 2 +
+16 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e5 * e1 ^ 2 * x3 +
+8 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e6 * x1 * e1 ^ 2 +
+8 * y3 ^ 2 * x2 ^ 3 * e3 ^ 2 * e6 * e1 ^ 2 +
+16 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e6 * e1 ^ 2 * x3 -
+4 * y3 ^ 2 * x3 ^ 3 * e3 ^ 2 * y1 * y2 * e1 ^ 2 -
+2 * y3 ^ 2 * x3 ^ 3 * e3 ^ 2 * x1 * e1 ^ 3 -
+6 * y3 ^ 2 * x3 ^ 3 * e3 ^ 2 * x2 * e1 ^ 3 +
+2 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e5 * x1 * e1 ^ 2 +
+10 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e5 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * x3 ^ 3 * e3 ^ 2 * e5 * e1 ^ 2 +
+2 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e6 * x1 * e1 ^ 2 +
+10 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e6 * x2 * e1 ^ 2 +
+2 * y3 ^ 2 * x3 ^ 3 * e3 ^ 2 * e6 * e1 ^ 2 +
+8 * y2 ^ 3 * e6 * x3 ^ 2 * e3 * y1 * e1 ^ 2 +
+4 * y2 ^ 2 * e6 * x3 ^ 2 * e3 * x1 * e1 ^ 3 -
+4 * y2 ^ 2 * e6 * x3 ^ 2 * e3 * e5 * e1 ^ 2 -
+4 * y2 ^ 2 * e6 ^ 2 * x3 ^ 2 * e3 * e1 ^ 2 -
+8 * y2 ^ 2 * e6 * e4 * y1 ^ 2 * e1 ^ 2 * x3 -
+4 * y2 * e6 * e4 * y1 * x1 * e1 ^ 3 * x3 -
+4 * y2 * e6 * e4 * y1 * x2 * e1 ^ 3 * x3 +
+4 * y2 * e6 * e4 * y1 * e5 * x1 * e1 ^ 2 +
+4 * y2 * e6 * e4 * y1 * e5 * x2 * e1 ^ 2 +
+4 * y2 * e6 * e4 * y1 * e5 * e1 ^ 2 * x3 +
+4 * y2 * e6 ^ 2 * e4 * y1 * x1 * e1 ^ 2 +
+4 * y2 * e6 ^ 2 * e4 * y1 * x2 * e1 ^ 2 +
+4 * y2 * e6 ^ 2 * e4 * y1 * e1 ^ 2 * x3 +
+8 * y2 ^ 3 * e7 * x3 ^ 2 * e3 * y1 * e1 ^ 2 +
+4 * y2 ^ 2 * e7 * x3 ^ 2 * e3 * x1 * e1 ^ 3 -
+4 * y2 ^ 2 * e7 * x3 ^ 2 * e3 * e5 * e1 ^ 2 -
+4 * y2 ^ 2 * e7 * x3 ^ 2 * e3 * e6 * e1 ^ 2 -
+8 * y2 ^ 2 * e7 * e4 * y1 ^ 2 * e1 ^ 2 * x3 -
+4 * y2 * e7 * e4 * y1 * x1 * e1 ^ 3 * x3 -
+4 * y2 * e7 * e4 * y1 * x2 * e1 ^ 3 * x3 +
+4 * y2 * e7 * e4 * y1 * e5 * x1 * e1 ^ 2 +
+4 * y2 * e7 * e4 * y1 * e5 * x2 * e1 ^ 2 +
+4 * y2 * e7 * e4 * y1 * e5 * e1 ^ 2 * x3 +
+4 * y2 * e7 * e4 * y1 * e6 * x1 * e1 ^ 2 +
+4 * y2 * e7 * e4 * y1 * e6 * x2 * e1 ^ 2 +
+4 * y2 * e7 * e4 * y1 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 3 * y3 * x2 * e3 * e1 ^ 3 * x3 ^ 2 -
+4 * y2 ^ 3 * y3 * x3 ^ 3 * e3 * e1 ^ 3 +
+8 * y2 ^ 2 * y3 * e4 * y1 * x1 * e1 ^ 3 * x2 +
+4 * y2 ^ 2 * y3 * e4 * y1 * x1 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 2 * y3 * e4 * y1 * x2 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 2 * y3 * e4 * y1 * e1 ^ 3 * x3 ^ 2 +
+16 * y2 ^ 3 * y3 * e4 * y1 ^ 2 * x1 * e1 ^ 2 +
+16 * y2 ^ 3 * y3 * e4 * y1 ^ 2 * x2 * e1 ^ 2 +
+8 * y2 ^ 2 * x2 ^ 2 * e3 * e4 * x1 * e1 ^ 3 +
+4 * y2 ^ 2 * x2 * e3 * e4 * x1 ^ 2 * e1 ^ 3 +
+4 * y2 ^ 2 * x2 ^ 3 * e3 * e4 * e1 ^ 3 +
+8 * y2 ^ 2 * x2 * e3 * e4 * e1 ^ 3 * x3 ^ 2 +
+16 * y2 ^ 3 * x2 * e3 * e4 * y1 * x1 * e1 ^ 2 +
+16 * y2 ^ 3 * x2 ^ 2 * e3 * e4 * y1 * e1 ^ 2 +
+8 * y2 * x2 ^ 2 * e3 * e4 * y1 * x1 * e1 ^ 3 +
+4 * y2 * x2 * e3 * e4 * y1 * x1 ^ 2 * e1 ^ 3 +
+4 * y2 * x2 ^ 3 * e3 * e4 * y1 * e1 ^ 3 +
+8 * y2 * x2 * e3 * e4 * y1 * e1 ^ 3 * x3 ^ 2 +
+16 * y2 ^ 2 * x2 * e3 * e4 * y1 ^ 2 * x1 * e1 ^ 2 +
+16 * y2 ^ 2 * x2 ^ 2 * e3 * e4 * y1 ^ 2 * e1 ^ 2 +
+12 * y2 ^ 2 * x3 * e3 * e4 * x1 * e1 ^ 3 * x2 +
+2 * y2 ^ 2 * x3 * e3 * e4 * x1 ^ 2 * e1 ^ 3 +
+10 * y2 ^ 2 * x3 * e3 * e4 * x2 ^ 2 * e1 ^ 3 +
+2 * y2 ^ 2 * x3 ^ 3 * e3 * e4 * e1 ^ 3 +
+8 * y2 ^ 3 * x3 * e3 * e4 * y1 * x1 * e1 ^ 2 +
+24 * y2 ^ 3 * x3 * e3 * e4 * y1 * x2 * e1 ^ 2 +
+8 * y3 ^ 2 * e6 * x2 ^ 2 * e3 * x1 * e1 ^ 3 +
+4 * y3 ^ 2 * e6 * x2 * e3 * x1 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 2 * e6 * x2 ^ 3 * e3 * e1 ^ 3 +
+8 * y3 ^ 2 * e6 * x2 * e3 * e1 ^ 3 * x3 ^ 2 +
+16 * y3 ^ 2 * e6 * x2 * e3 * y1 * y2 * x1 * e1 ^ 2 +
+16 * y3 ^ 2 * e6 * x2 ^ 2 * e3 * y1 * y2 * e1 ^ 2 +
+12 * y3 ^ 2 * e6 * x3 * e3 * x1 * e1 ^ 3 * x2 +
+2 * y3 ^ 2 * e6 * x3 * e3 * x1 ^ 2 * e1 ^ 3 +
+10 * y3 ^ 2 * e6 * x3 * e3 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 ^ 2 * e6 * x3 ^ 3 * e3 * e1 ^ 3 +
+8 * y3 ^ 2 * e6 * x3 * e3 * y1 * y2 * x1 * e1 ^ 2 +
+24 * y3 ^ 2 * e6 * x3 * e3 * y1 * y2 * x2 * e1 ^ 2 +
+4 * y3 * e6 * e4 * y2 * x1 * e1 ^ 3 * x2 +
+2 * y3 * e6 * e4 * y2 * x1 ^ 2 * e1 ^ 3 +
+2 * y3 * e6 * e4 * y2 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 * e6 * e4 * y2 * e1 ^ 3 * x3 ^ 2 +
+4 * y3 * e6 * e4 * y1 * x1 * e1 ^ 3 * x2 +
+2 * y3 * e6 * e4 * y1 * x1 ^ 2 * e1 ^ 3 +
+2 * y3 * e6 * e4 * y1 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 * e6 * e4 * y1 * e1 ^ 3 * x3 ^ 2 +
+8 * y3 * e6 * e4 * y1 ^ 2 * y2 * x1 * e1 ^ 2 +
+8 * y3 * e6 * e4 * y1 ^ 2 * y2 * x2 * e1 ^ 2 +
+8 * y3 ^ 2 * e7 * x2 ^ 2 * e3 * x1 * e1 ^ 3 +
+4 * y3 ^ 2 * e7 * x2 * e3 * x1 ^ 2 * e1 ^ 3 +
+4 * y3 ^ 2 * e7 * x2 ^ 3 * e3 * e1 ^ 3 +
+8 * y3 ^ 2 * e7 * x2 * e3 * e1 ^ 3 * x3 ^ 2 +
+16 * y3 ^ 2 * e7 * x2 * e3 * y1 * y2 * x1 * e1 ^ 2 +
+16 * y3 ^ 2 * e7 * x2 ^ 2 * e3 * y1 * y2 * e1 ^ 2 +
+12 * y3 ^ 2 * e7 * x3 * e3 * x1 * e1 ^ 3 * x2 +
+2 * y3 ^ 2 * e7 * x3 * e3 * x1 ^ 2 * e1 ^ 3 +
+10 * y3 ^ 2 * e7 * x3 * e3 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 ^ 2 * e7 * x3 ^ 3 * e3 * e1 ^ 3 +
+8 * y3 ^ 2 * e7 * x3 * e3 * y1 * y2 * x1 * e1 ^ 2 +
+24 * y3 ^ 2 * e7 * x3 * e3 * y1 * y2 * x2 * e1 ^ 2 +
+4 * y3 * e7 * e4 * y2 * x1 * e1 ^ 3 * x2 +
+2 * y3 * e7 * e4 * y2 * x1 ^ 2 * e1 ^ 3 +
+2 * y3 * e7 * e4 * y2 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 * e7 * e4 * y2 * e1 ^ 3 * x3 ^ 2 +
+8 * y3 * e7 * e4 * y2 ^ 2 * y1 * x1 * e1 ^ 2 +
+8 * y3 * e7 * e4 * y2 ^ 2 * y1 * x2 * e1 ^ 2 +
+4 * y3 * e7 * e4 * y1 * x1 * e1 ^ 3 * x2 +
+2 * y3 * e7 * e4 * y1 * x1 ^ 2 * e1 ^ 3 +
+2 * y3 * e7 * e4 * y1 * x2 ^ 2 * e1 ^ 3 +
+2 * y3 * e7 * e4 * y1 * e1 ^ 3 * x3 ^ 2 +
+8 * y3 * e7 * e4 * y1 ^ 2 * y2 * x1 * e1 ^ 2 +
+8 * y3 * e7 * e4 * y1 ^ 2 * y2 * x2 * e1 ^ 2 -
+16 * y2 * y3 ^ 3 * x2 ^ 2 * e3 * x1 * e1 ^ 3 -
+8 * y2 * y3 ^ 3 * x2 * e3 * x1 ^ 2 * e1 ^ 3 -
+8 * y2 * y3 ^ 3 * x2 ^ 3 * e3 * e1 ^ 3 -
+16 * y2 * y3 ^ 3 * x2 * e3 * e1 ^ 3 * x3 ^ 2 -
+32 * y2 ^ 2 * y3 ^ 3 * x2 * e3 * y1 * x1 * e1 ^ 2 -
+32 * y2 ^ 2 * y3 ^ 3 * x2 ^ 2 * e3 * y1 * e1 ^ 2 -
+24 * y2 * y3 ^ 3 * x3 * e3 * x1 * e1 ^ 3 * x2 -
+4 * y2 * y3 ^ 3 * x3 * e3 * x1 ^ 2 * e1 ^ 3 -
+20 * y2 * y3 ^ 3 * x3 * e3 * x2 ^ 2 * e1 ^ 3 -
+4 * y2 * y3 ^ 3 * x3 ^ 3 * e3 * e1 ^ 3 -
+16 * y2 ^ 2 * y3 ^ 3 * x3 * e3 * y1 * x1 * e1 ^ 2 -
+48 * y2 ^ 2 * y3 ^ 3 * x3 * e3 * y1 * x2 * e1 ^ 2 -
+8 * y2 * y3 ^ 2 * e4 * y1 * x1 * e1 ^ 3 * x2 -
+4 * y2 * y3 ^ 2 * e4 * y1 * x1 ^ 2 * e1 ^ 3 -
+4 * y2 * y3 ^ 2 * e4 * y1 * x2 ^ 2 * e1 ^ 3 -
+4 * y2 * y3 ^ 2 * e4 * y1 * e1 ^ 3 * x3 ^ 2 -
+16 * y2 ^ 2 * y3 ^ 2 * e4 * y1 ^ 2 * x1 * e1 ^ 2 -
+16 * y2 ^ 2 * y3 ^ 2 * e4 * y1 ^ 2 * x2 * e1 ^ 2 -
+4 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * x1 ^ 2 * e1 ^ 3 -
+16 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * y1 * y2 * x1 * e1 ^ 2 +
+12 * y2 * x3 * e3 * e4 * y1 * x1 * e1 ^ 3 * x2 +
+2 * y2 * x3 * e3 * e4 * y1 * x1 ^ 2 * e1 ^ 3 +
+10 * y2 * x3 * e3 * e4 * y1 * x2 ^ 2 * e1 ^ 3 +
+2 * y2 * x3 ^ 3 * e3 * e4 * y1 * e1 ^ 3 +
+8 * y2 ^ 2 * x3 * e3 * e4 * y1 ^ 2 * x1 * e1 ^ 2 +
+24 * y2 ^ 2 * x3 * e3 * e4 * y1 ^ 2 * x2 * e1 ^ 2 -
+8 * y3 * x2 ^ 2 * e3 * e4 * y2 * x1 * e1 ^ 3 -
+4 * y3 * x2 * e3 * e4 * y2 * x1 ^ 2 * e1 ^ 3 -
+4 * y3 * x2 ^ 3 * e3 * e4 * y2 * e1 ^ 3 -
+8 * y3 * x2 * e3 * e4 * y2 * e1 ^ 3 * x3 ^ 2 -
+16 * y3 * x2 * e3 * e4 * y2 ^ 2 * y1 * x1 * e1 ^ 2 -
+16 * y3 * x2 ^ 2 * e3 * e4 * y2 ^ 2 * y1 * e1 ^ 2 -
+8 * y3 * x2 ^ 2 * e3 * e4 * y1 * x1 * e1 ^ 3 -
+4 * y3 * x2 * e3 * e4 * y1 * x1 ^ 2 * e1 ^ 3 -
+4 * y3 * x2 ^ 3 * e3 * e4 * y1 * e1 ^ 3 -
+8 * y3 * x2 * e3 * e4 * y1 * e1 ^ 3 * x3 ^ 2 -
+16 * y3 * x2 * e3 * e4 * y1 ^ 2 * y2 * x1 * e1 ^ 2 -
+16 * y3 * x2 ^ 2 * e3 * e4 * y1 ^ 2 * y2 * e1 ^ 2 -
+12 * y3 * x3 * e3 * e4 * y2 * x1 * e1 ^ 3 * x2 -
+2 * y3 * x3 * e3 * e4 * y2 * x1 ^ 2 * e1 ^ 3 -
+10 * y3 * x3 * e3 * e4 * y2 * x2 ^ 2 * e1 ^ 3 -
+2 * y3 * x3 ^ 3 * e3 * e4 * y2 * e1 ^ 3 -
+8 * y3 * x3 * e3 * e4 * y2 ^ 2 * y1 * x1 * e1 ^ 2 -
+24 * y3 * x3 * e3 * e4 * y2 ^ 2 * y1 * x2 * e1 ^ 2 -
+12 * y3 * x3 * e3 * e4 * y1 * x1 * e1 ^ 3 * x2 -
+2 * y3 * x3 * e3 * e4 * y1 * x1 ^ 2 * e1 ^ 3 -
+10 * y3 * x3 * e3 * e4 * y1 * x2 ^ 2 * e1 ^ 3 -
+2 * y3 * x3 ^ 3 * e3 * e4 * y1 * e1 ^ 3 -
+8 * y3 * x3 * e3 * e4 * y1 ^ 2 * y2 * x1 * e1 ^ 2 -
+24 * y3 * x3 * e3 * e4 * y1 ^ 2 * y2 * x2 * e1 ^ 2 -
+4 * e4 ^ 2 * y2 * y1 * x1 * e1 ^ 3 * x2 -
+2 * e4 ^ 2 * y2 * y1 * x1 ^ 2 * e1 ^ 3 -
+2 * e4 ^ 2 * y2 * y1 * x2 ^ 2 * e1 ^ 3 -
+2 * e4 ^ 2 * y2 * y1 * e1 ^ 3 * x3 ^ 2 -
+8 * e4 ^ 2 * y2 ^ 2 * y1 ^ 2 * x1 * e1 ^ 2 -
+8 * e4 ^ 2 * y2 ^ 2 * y1 ^ 2 * x2 * e1 ^ 2 -
+16 * y2 ^ 4 * y3 * x3 ^ 2 * e3 * y1 * e1 ^ 2 -
+8 * y2 ^ 3 * y3 * x3 ^ 2 * e3 * x1 * e1 ^ 3 +
+8 * y2 ^ 3 * y3 * x3 ^ 2 * e3 * e5 * e1 ^ 2 +
+8 * y2 ^ 3 * y3 * x3 ^ 2 * e3 * e6 * e1 ^ 2 +
+16 * y2 ^ 3 * y3 * e4 * y1 ^ 2 * e1 ^ 2 * x3 +
+8 * y2 ^ 2 * y3 * e4 * y1 * x1 * e1 ^ 3 * x3 +
+8 * y2 ^ 2 * y3 * e4 * y1 * x2 * e1 ^ 3 * x3 -
+8 * y2 ^ 2 * y3 * e4 * y1 * e5 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * y3 * e4 * y1 * e5 * x2 * e1 ^ 2 -
+8 * y2 ^ 2 * y3 * e4 * y1 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 2 * x2 * e3 * e4 * e5 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * x2 ^ 2 * e3 * e4 * e5 * e1 ^ 2 -
+12 * y2 ^ 2 * x2 * e3 * e4 * e5 * e1 ^ 2 * x3 -
+8 * y2 ^ 2 * x2 * e3 * e4 * e6 * x1 * e1 ^ 2 -
+8 * y2 ^ 2 * x2 ^ 2 * e3 * e4 * e6 * e1 ^ 2 -
+12 * y2 ^ 2 * x2 * e3 * e4 * e6 * e1 ^ 2 * x3 -
+8 * y2 * x2 * e3 * e4 * y1 * e5 * x1 * e1 ^ 2 -
+8 * y2 * x2 ^ 2 * e3 * e4 * y1 * e5 * e1 ^ 2 -
+12 * y2 * x2 * e3 * e4 * y1 * e5 * e1 ^ 2 * x3 -
+8 * y2 * x2 * e3 * e4 * y1 * e6 * x1 * e1 ^ 2 -
+8 * y2 * x2 ^ 2 * e3 * e4 * y1 * e6 * e1 ^ 2 -
+12 * y2 * x2 * e3 * e4 * y1 * e6 * e1 ^ 2 * x3 +
+8 * y2 ^ 3 * x3 ^ 2 * e3 * e4 * y1 * e1 ^ 2 +
+4 * y2 ^ 2 * x3 ^ 2 * e3 * e4 * x1 * e1 ^ 3 -
+4 * y2 ^ 2 * x3 * e3 * e4 * e5 * x1 * e1 ^ 2 -
+4 * y2 ^ 2 * x3 ^ 2 * e3 * e4 * e5 * e1 ^ 2 -
+4 * y2 ^ 2 * x3 * e3 * e4 * e6 * x1 * e1 ^ 2 -
+4 * y2 ^ 2 * x3 ^ 2 * e3 * e4 * e6 * e1 ^ 2 -
+8 * y3 ^ 2 * e6 * x2 * e3 * e5 * x1 * e1 ^ 2 -
+8 * y3 ^ 2 * e6 * x2 ^ 2 * e3 * e5 * e1 ^ 2 -
+12 * y3 ^ 2 * e6 * x2 * e3 * e5 * e1 ^ 2 * x3 -
+8 * y3 ^ 2 * e6 ^ 2 * x2 * e3 * x1 * e1 ^ 2 -
+8 * y3 ^ 2 * e6 ^ 2 * x2 ^ 2 * e3 * e1 ^ 2 -
+12 * y3 ^ 2 * e6 ^ 2 * x2 * e3 * e1 ^ 2 * x3 +
+8 * y3 ^ 2 * e6 * x3 ^ 2 * e3 * y1 * y2 * e1 ^ 2 +
+4 * y3 ^ 2 * e6 * x3 ^ 2 * e3 * x1 * e1 ^ 3 -
+4 * y3 ^ 2 * e6 * x3 * e3 * e5 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e6 * x3 ^ 2 * e3 * e5 * e1 ^ 2 -
+4 * y3 ^ 2 * e6 ^ 2 * x3 * e3 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e6 ^ 2 * x3 ^ 2 * e3 * e1 ^ 2 +
+4 * y3 * e6 * e4 * y2 * x1 * e1 ^ 3 * x3 +
+4 * y3 * e6 * e4 * y2 * x2 * e1 ^ 3 * x3 -
+4 * y3 * e6 * e4 * y2 * e5 * x1 * e1 ^ 2 -
+4 * y3 * e6 * e4 * y2 * e5 * x2 * e1 ^ 2 -
+4 * y3 * e6 * e4 * y2 * e5 * e1 ^ 2 * x3 -
+4 * y3 * e6 ^ 2 * e4 * y2 * x1 * e1 ^ 2 -
+4 * y3 * e6 ^ 2 * e4 * y2 * x2 * e1 ^ 2 -
+4 * y3 * e6 ^ 2 * e4 * y2 * e1 ^ 2 * x3 +
+8 * y3 * e6 * e4 * y1 ^ 2 * y2 * e1 ^ 2 * x3 +
+4 * y3 * e6 * e4 * y1 * x1 * e1 ^ 3 * x3 +
+4 * y3 * e6 * e4 * y1 * x2 * e1 ^ 3 * x3 -
+4 * y3 * e6 * e4 * y1 * e5 * x1 * e1 ^ 2 -
+4 * y3 * e6 * e4 * y1 * e5 * x2 * e1 ^ 2 -
+4 * y3 * e6 * e4 * y1 * e5 * e1 ^ 2 * x3 -
+4 * y3 * e6 ^ 2 * e4 * y1 * x1 * e1 ^ 2 -
+4 * y3 * e6 ^ 2 * e4 * y1 * x2 * e1 ^ 2 -
+4 * y3 * e6 ^ 2 * e4 * y1 * e1 ^ 2 * x3 -
+8 * y3 ^ 2 * e7 * x2 * e3 * e5 * x1 * e1 ^ 2 -
+8 * y3 ^ 2 * e7 * x2 ^ 2 * e3 * e5 * e1 ^ 2 -
+12 * y3 ^ 2 * e7 * x2 * e3 * e5 * e1 ^ 2 * x3 -
+8 * y3 ^ 2 * e7 * x2 * e3 * e6 * x1 * e1 ^ 2 -
+8 * y3 ^ 2 * e7 * x2 ^ 2 * e3 * e6 * e1 ^ 2 -
+12 * y3 ^ 2 * e7 * x2 * e3 * e6 * e1 ^ 2 * x3 +
+8 * y3 ^ 2 * e7 * x3 ^ 2 * e3 * y1 * y2 * e1 ^ 2 +
+4 * y3 ^ 2 * e7 * x3 ^ 2 * e3 * x1 * e1 ^ 3 -
+4 * y3 ^ 2 * e7 * x3 * e3 * e5 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e7 * x3 ^ 2 * e3 * e5 * e1 ^ 2 -
+4 * y3 ^ 2 * e7 * x3 * e3 * e6 * x1 * e1 ^ 2 -
+4 * y3 ^ 2 * e7 * x3 ^ 2 * e3 * e6 * e1 ^ 2 +
+8 * y3 * e7 * e4 * y2 ^ 2 * y1 * e1 ^ 2 * x3 +
+4 * y3 * e7 * e4 * y2 * x1 * e1 ^ 3 * x3 +
+4 * y3 * e7 * e4 * y2 * x2 * e1 ^ 3 * x3 -
+4 * y3 * e7 * e4 * y2 * e5 * x1 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y2 * e5 * x2 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y2 * e5 * e1 ^ 2 * x3 -
+4 * y3 * e7 * e4 * y2 * e6 * x1 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y2 * e6 * x2 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y2 * e6 * e1 ^ 2 * x3 +
+8 * y3 * e7 * e4 * y1 ^ 2 * y2 * e1 ^ 2 * x3 +
+4 * y3 * e7 * e4 * y1 * x1 * e1 ^ 3 * x3 +
+4 * y3 * e7 * e4 * y1 * x2 * e1 ^ 3 * x3 -
+4 * y3 * e7 * e4 * y1 * e5 * x1 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y1 * e5 * x2 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y1 * e5 * e1 ^ 2 * x3 -
+4 * y3 * e7 * e4 * y1 * e6 * x1 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y1 * e6 * x2 * e1 ^ 2 -
+4 * y3 * e7 * e4 * y1 * e6 * e1 ^ 2 * x3 +
+16 * y2 * y3 ^ 3 * x2 * e3 * e5 * x1 * e1 ^ 2 +
+16 * y2 * y3 ^ 3 * x2 ^ 2 * e3 * e5 * e1 ^ 2 +
+24 * y2 * y3 ^ 3 * x2 * e3 * e5 * e1 ^ 2 * x3 +
+16 * y2 * y3 ^ 3 * x2 * e3 * e6 * x1 * e1 ^ 2 +
+16 * y2 * y3 ^ 3 * x2 ^ 2 * e3 * e6 * e1 ^ 2 +
+24 * y2 * y3 ^ 3 * x2 * e3 * e6 * e1 ^ 2 * x3 -
+16 * y2 ^ 2 * y3 ^ 3 * x3 ^ 2 * e3 * y1 * e1 ^ 2 -
+8 * y2 * y3 ^ 3 * x3 ^ 2 * e3 * x1 * e1 ^ 3 +
+8 * y2 * y3 ^ 3 * x3 * e3 * e5 * x1 * e1 ^ 2 +
+8 * y2 * y3 ^ 3 * x3 ^ 2 * e3 * e5 * e1 ^ 2 +
+8 * y2 * y3 ^ 3 * x3 * e3 * e6 * x1 * e1 ^ 2 +
+8 * y2 * y3 ^ 3 * x3 ^ 2 * e3 * e6 * e1 ^ 2 -
+16 * y2 ^ 2 * y3 ^ 2 * e4 * y1 ^ 2 * e1 ^ 2 * x3 -
+8 * y2 * y3 ^ 2 * e4 * y1 * x1 * e1 ^ 3 * x3 -
+8 * y2 * y3 ^ 2 * e4 * y1 * x2 * e1 ^ 3 * x3 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e5 * x1 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e5 * x2 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e5 * e1 ^ 2 * x3 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e6 * x1 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e6 * x2 * e1 ^ 2 +
+8 * y2 * y3 ^ 2 * e4 * y1 * e6 * e1 ^ 2 * x3 +
+8 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e5 * x1 * e1 ^ 2 +
+8 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e6 * x1 * e1 ^ 2 +
+8 * y2 ^ 2 * x3 ^ 2 * e3 * e4 * y1 ^ 2 * e1 ^ 2 +
+4 * y2 * x3 ^ 2 * e3 * e4 * y1 * x1 * e1 ^ 3 -
+4 * y2 * x3 * e3 * e4 * y1 * e5 * x1 * e1 ^ 2 -
+4 * y2 * x3 ^ 2 * e3 * e4 * y1 * e5 * e1 ^ 2 -
+4 * y2 * x3 * e3 * e4 * y1 * e6 * x1 * e1 ^ 2 -
+4 * y2 * x3 ^ 2 * e3 * e4 * y1 * e6 * e1 ^ 2 +
+8 * y3 * x2 * e3 * e4 * y2 * e5 * x1 * e1 ^ 2 +
+8 * y3 * x2 ^ 2 * e3 * e4 * y2 * e5 * e1 ^ 2 +
+12 * y3 * x2 * e3 * e4 * y2 * e5 * e1 ^ 2 * x3 +
+8 * y3 * x2 * e3 * e4 * y2 * e6 * x1 * e1 ^ 2 +
+8 * y3 * x2 ^ 2 * e3 * e4 * y2 * e6 * e1 ^ 2 +
+12 * y3 * x2 * e3 * e4 * y2 * e6 * e1 ^ 2 * x3 +
+8 * y3 * x2 * e3 * e4 * y1 * e5 * x1 * e1 ^ 2 +
+8 * y3 * x2 ^ 2 * e3 * e4 * y1 * e5 * e1 ^ 2 +
+12 * y3 * x2 * e3 * e4 * y1 * e5 * e1 ^ 2 * x3 +
+8 * y3 * x2 * e3 * e4 * y1 * e6 * x1 * e1 ^ 2 +
+8 * y3 * x2 ^ 2 * e3 * e4 * y1 * e6 * e1 ^ 2 +
+12 * y3 * x2 * e3 * e4 * y1 * e6 * e1 ^ 2 * x3 -
+8 * y3 * x3 ^ 2 * e3 * e4 * y2 ^ 2 * y1 * e1 ^ 2 -
+4 * y3 * x3 ^ 2 * e3 * e4 * y2 * x1 * e1 ^ 3 +
+4 * y3 * x3 * e3 * e4 * y2 * e5 * x1 * e1 ^ 2 +
+4 * y3 * x3 ^ 2 * e3 * e4 * y2 * e5 * e1 ^ 2 +
+4 * y3 * x3 * e3 * e4 * y2 * e6 * x1 * e1 ^ 2 +
+4 * y3 * x3 ^ 2 * e3 * e4 * y2 * e6 * e1 ^ 2 -
+8 * y3 * x3 ^ 2 * e3 * e4 * y1 ^ 2 * y2 * e1 ^ 2 -
+4 * y3 * x3 ^ 2 * e3 * e4 * y1 * x1 * e1 ^ 3 +
+4 * y3 * x3 * e3 * e4 * y1 * e5 * x1 * e1 ^ 2 +
+4 * y3 * x3 ^ 2 * e3 * e4 * y1 * e5 * e1 ^ 2 +
+4 * y3 * x3 * e3 * e4 * y1 * e6 * x1 * e1 ^ 2 +
+4 * y3 * x3 ^ 2 * e3 * e4 * y1 * e6 * e1 ^ 2 -
+8 * e4 ^ 2 * y2 ^ 2 * y1 ^ 2 * e1 ^ 2 * x3 -
+4 * e4 ^ 2 * y2 * y1 * x1 * e1 ^ 3 * x3 -
+4 * e4 ^ 2 * y2 * y1 * x2 * e1 ^ 3 * x3 +
+4 * e4 ^ 2 * y2 * y1 * e5 * x1 * e1 ^ 2 +
+4 * e4 ^ 2 * y2 * y1 * e5 * x2 * e1 ^ 2 +
+4 * e4 ^ 2 * y2 * y1 * e5 * e1 ^ 2 * x3 +
+4 * e4 ^ 2 * y2 * y1 * e6 * x1 * e1 ^ 2 +
+4 * e4 ^ 2 * y2 * y1 * e6 * x2 * e1 ^ 2 +
+4 * e4 ^ 2 * y2 * y1 * e6 * e1 ^ 2 * x3 + 4 * e1 * e6 ^ 2 * y2 ^ 3 * e5 * y1 -
+4 * e1 * e6 ^ 2 * e7 * y2 ^ 2 * e5 + 8 * e1 * e6 ^ 2 * e7 * y2 ^ 3 * y1 +
+32 * e1 * y2 ^ 4 * y3 * x2 * e3 * e5 * y1 -
+8 * e1 * y2 ^ 3 * y3 * x3 * e3 * e5 * e6 +
+16 * e1 * y2 ^ 4 * y3 * x3 * e3 * e5 * y1 +
+16 * e1 * y2 ^ 4 * y3 * x3 * e3 * e6 * y1 +
+8 * e1 * e6 * e7 * y2 ^ 3 * e5 * y1 - 2 * e1 * e7 ^ 2 * y2 ^ 2 * e5 * e6 +
+4 * e1 * e7 ^ 2 * y2 ^ 3 * e5 * y1 + 4 * e1 * e7 ^ 2 * y2 ^ 3 * e6 * y1 -
+16 * e1 * y2 ^ 3 * y3 ^ 2 * y1 * e6 ^ 2 +
+16 * e1 * y2 ^ 4 * y3 ^ 2 * y1 ^ 2 * e6 - 8 * e1 * y2 ^ 4 * y3 ^ 2 * e5 * e6 +
+16 * e1 * y2 ^ 5 * y3 ^ 2 * e5 * y1 + 16 * e1 * y2 ^ 5 * y3 ^ 2 * e6 * y1 -
+4 * e1 * y2 ^ 2 * y3 ^ 2 * y1 ^ 2 * e6 ^ 2 -
+2 * e1 * e6 * e7 * y2 ^ 2 * e5 ^ 2 - 8 * e1 * e6 * e7 * y1 ^ 2 * y2 ^ 4 -
+4 * e1 * x2 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+16 * e1 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 -
+e1 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+e1 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e6 ^ 2 -
+4 * e1 * x3 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 4 +
+16 * e1 * e6 ^ 3 * y2 ^ 2 * y3 * y1 - 16 * e1 * e6 ^ 2 * y2 ^ 3 * y3 * y1 ^ 2 +
+8 * e1 * e6 ^ 2 * y2 ^ 3 * y3 * e5 - 16 * e1 * y2 ^ 3 * y3 ^ 2 * y1 * e5 * e6 +
+16 * e1 * x2 ^ 2 * e3 ^ 2 * y2 ^ 3 * e5 * y1 -
+2 * e1 * x3 ^ 2 * e3 ^ 2 * y2 ^ 2 * e5 * e6 +
+4 * e1 * x3 ^ 2 * e3 ^ 2 * y2 ^ 3 * e5 * y1 +
+4 * e1 * x3 ^ 2 * e3 ^ 2 * y2 ^ 3 * e6 * y1 -
+8 * e1 * y2 ^ 3 * y3 * x2 * e3 * e5 ^ 2 -
+32 * e1 * y2 ^ 5 * y3 * x2 * e3 * y1 ^ 2 -
+4 * e1 * y2 ^ 3 * y3 * x3 * e3 * e5 ^ 2 -
+4 * e1 * y2 ^ 3 * y3 * x3 * e3 * e6 ^ 2 -
+16 * e1 * y2 ^ 5 * y3 * x3 * e3 * y1 ^ 2 -
+4 * e1 * x2 * e3 ^ 2 * x3 * y2 ^ 2 * e5 ^ 2 +
+16 * e1 * x2 * e3 ^ 2 * x3 * y2 ^ 3 * e5 * y1 +
+16 * e1 * e6 ^ 2 * y2 ^ 2 * y3 * y1 * e5 -
+16 * e1 * e6 * y2 ^ 4 * y3 * e5 * y1 - 16 * e1 * e6 ^ 2 * y2 ^ 4 * y3 * y1 +
+4 * e1 * e6 * y2 ^ 3 * y3 * e5 ^ 2 + 16 * e1 * e6 * y2 ^ 5 * y3 * y1 ^ 2 +
+2 * e1 * e6 ^ 3 * x3 * e3 * y2 ^ 2 + 4 * e1 * e7 * y2 ^ 3 * y3 * e5 ^ 2 +
+4 * e1 * e7 * y2 ^ 3 * y3 * e6 ^ 2 + 16 * e1 * e7 * y2 ^ 5 * y3 * y1 ^ 2 -
+16 * e1 * e6 * x2 * e3 * y2 ^ 3 * e5 * y1 +
+4 * e1 * e6 ^ 2 * x3 * e3 * y2 ^ 2 * e5 -
+8 * e1 * e6 * x3 * e3 * y2 ^ 3 * e5 * y1 -
+8 * e1 * e6 ^ 2 * x3 * e3 * y2 ^ 3 * y1 +
+32 * e1 * e7 * y2 ^ 2 * y3 * y1 * e5 * e6 +
+32 * e1 * e7 * y2 ^ 2 * y3 * y1 * e6 ^ 2 -
+32 * e1 * e7 * y2 ^ 3 * y3 * y1 ^ 2 * e6 +
+8 * e1 * e7 * y2 ^ 3 * y3 * e5 * e6 - 16 * e1 * e7 * y2 ^ 4 * y3 * e5 * y1 -
+16 * e1 * e7 * y2 ^ 4 * y3 * e6 * y1 -
+16 * e1 * e7 * x2 * e3 * y2 ^ 3 * e5 * y1 +
+4 * e1 * e7 * x3 * e3 * y2 ^ 2 * e5 * e6 -
+8 * e1 * e7 * x3 * e3 * y2 ^ 3 * e5 * y1 -
+8 * e1 * e7 * x3 * e3 * y2 ^ 3 * e6 * y1 -
+16 * e1 * x2 * e3 ^ 2 * x3 * y1 ^ 2 * y2 ^ 4 +
+4 * e1 * e6 * x2 * e3 * y2 ^ 2 * e5 ^ 2 +
+16 * e1 * e6 * x2 * e3 * y1 ^ 2 * y2 ^ 4 +
+2 * e1 * e6 * x3 * e3 * y2 ^ 2 * e5 ^ 2 +
+8 * e1 * e6 * x3 * e3 * y1 ^ 2 * y2 ^ 4 +
+4 * e1 * e7 * x2 * e3 * y2 ^ 2 * e5 ^ 2 +
+16 * e1 * e7 * x2 * e3 * y1 ^ 2 * y2 ^ 4 +
+2 * e1 * e7 * x3 * e3 * y2 ^ 2 * e5 ^ 2 +
+2 * e1 * e7 * x3 * e3 * y2 ^ 2 * e6 ^ 2 +
+8 * e1 * e7 * x3 * e3 * y1 ^ 2 * y2 ^ 4 - 8 * e1 * e6 ^ 3 * e7 * y2 * y3 -
+4 * e1 * e5 ^ 2 * e6 ^ 2 * y2 * y3 + 4 * e1 * e5 ^ 2 * e6 * y2 ^ 2 * y3 ^ 2 +
+8 * e1 * e5 * e6 ^ 2 * y2 ^ 2 * y3 ^ 2 - 8 * e1 * e5 * e6 ^ 3 * y2 * y3 -
+16 * e1 * e6 ^ 2 * e7 * y2 * y3 * e5 - 8 * e1 * e5 ^ 2 * e7 * y2 * y3 * e6 -
+2 * e1 * y3 ^ 2 * e7 ^ 2 * e5 * e6 -
+4 * e1 * y3 ^ 2 * e7 ^ 2 * y1 ^ 2 * y2 ^ 2 -
+8 * e1 * y2 ^ 2 * y3 ^ 4 * e5 * e6 - 2 * e1 * e4 ^ 2 * y2 ^ 2 * e5 * e6 -
+2 * e1 * e4 ^ 2 * y1 ^ 2 * e5 * e6 - 16 * e1 * y2 ^ 4 * y3 ^ 4 * y1 ^ 2 -
+e1 * e4 ^ 2 * y2 ^ 2 * e6 ^ 2 - e1 * e4 ^ 2 * y2 ^ 2 * e5 ^ 2 -
+4 * e1 * e4 ^ 2 * y2 ^ 4 * y1 ^ 2 - e1 * e4 ^ 2 * y1 ^ 2 * e6 ^ 2 -
+e1 * e4 ^ 2 * y1 ^ 2 * e5 ^ 2 - 4 * e1 * e4 ^ 2 * y1 ^ 4 * y2 ^ 2 -
+2 * e1 * y2 ^ 2 * e6 ^ 3 * e4 - 2 * e1 * y3 ^ 2 * e6 ^ 3 * e7 +
+4 * e1 * y3 ^ 3 * e6 ^ 3 * y2 - 2 * e1 * y2 ^ 2 * e6 * e4 * e5 ^ 2 -
+4 * e1 * y2 ^ 2 * e6 ^ 2 * e4 * e5 - 8 * e1 * y2 ^ 4 * e6 * e4 * y1 ^ 2 -
+4 * e1 * y2 * e7 ^ 2 * y3 * e6 ^ 2 - 4 * e1 * y2 * e7 ^ 2 * y3 * e5 ^ 2 -
+16 * e1 * y2 ^ 3 * e7 ^ 2 * y3 * y1 ^ 2 +
+4 * e1 * y2 ^ 2 * e7 * y3 ^ 2 * e6 ^ 2 +
+4 * e1 * y2 ^ 2 * e7 * y3 ^ 2 * e5 ^ 2 +
+16 * e1 * y2 ^ 4 * e7 * y3 ^ 2 * y1 ^ 2 - 2 * e1 * y2 ^ 2 * e7 * e4 * e6 ^ 2 -
+2 * e1 * y2 ^ 2 * e7 * e4 * e5 ^ 2 - 8 * e1 * y2 ^ 4 * e7 * e4 * y1 ^ 2 +
+4 * e1 * y2 ^ 3 * y3 * e4 * e6 ^ 2 + 4 * e1 * y2 ^ 3 * y3 * e4 * e5 ^ 2 +
+16 * e1 * y2 ^ 5 * y3 * e4 * y1 ^ 2 - 2 * e1 * y3 ^ 2 * e6 * e7 * e5 ^ 2 -
+4 * e1 * y3 ^ 2 * e6 ^ 2 * e7 * e5 + 4 * e1 * y3 ^ 3 * e6 * y2 * e5 ^ 2 +
+8 * e1 * y3 ^ 3 * e6 ^ 2 * y2 * e5 + 16 * e1 * y3 ^ 3 * e6 * y2 ^ 3 * y1 ^ 2 +
+4 * e1 * y3 ^ 3 * e7 * y2 * e6 ^ 2 + 4 * e1 * y3 ^ 3 * e7 * y2 * e5 ^ 2 +
+16 * e1 * y3 ^ 3 * e7 * y2 ^ 3 * y1 ^ 2 -
+4 * e1 * y2 ^ 2 * y3 ^ 2 * e4 * e6 ^ 2 -
+4 * e1 * y2 ^ 2 * y3 ^ 2 * e4 * e5 ^ 2 -
+16 * e1 * y2 ^ 4 * y3 ^ 2 * e4 * y1 ^ 2 -
+4 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e6 ^ 2 -
+4 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e5 ^ 2 -
+e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e6 ^ 2 -
+e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e5 ^ 2 - 2 * e1 * y2 * e6 ^ 3 * e4 * y1 -
+8 * e1 * y2 ^ 3 * e6 * e4 * y1 ^ 3 - 8 * e1 * y2 ^ 3 * e7 * e4 * y1 ^ 3 +
+4 * e1 * y3 ^ 2 * e6 ^ 3 * y1 * y2 + 16 * e1 * y2 ^ 3 * y3 ^ 4 * e5 * y1 +
+16 * e1 * y2 ^ 3 * y3 ^ 4 * e6 * y1 + 4 * e1 * e4 ^ 2 * y2 ^ 3 * e5 * y1 -
+8 * e1 * y2 * e7 ^ 2 * y3 * e5 * e6 + 8 * e1 * y2 ^ 2 * e7 * y3 ^ 2 * e5 * e6 -
+4 * e1 * y2 ^ 2 * e7 * e4 * e5 * e6 + 8 * e1 * y2 ^ 3 * y3 * e4 * e5 * e6 -
+8 * e1 * y3 ^ 2 * e6 * e7 * y1 ^ 2 * y2 ^ 2 +
+8 * e1 * y3 ^ 3 * e7 * y2 * e5 * e6 - 8 * e1 * y2 ^ 2 * y3 ^ 2 * e4 * e5 * e6 -
+8 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e5 * e6 -
+16 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 -
+2 * e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e5 * e6 -
+4 * e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * y1 ^ 2 * y2 ^ 2 -
+2 * e1 * y2 * e6 * e4 * y1 * e5 ^ 2 - 4 * e1 * y2 * e6 ^ 2 * e4 * y1 * e5 -
+2 * e1 * y2 * e7 * e4 * y1 * e6 ^ 2 - 2 * e1 * y2 * e7 * e4 * y1 * e5 ^ 2 -
+4 * e1 * y2 * e7 * e4 * y1 * e5 * e6 +
+4 * e1 * y3 ^ 2 * e6 ^ 2 * e5 * y1 * y2 +
+4 * e1 * y3 ^ 2 * e7 ^ 2 * e5 * y1 * y2 +
+4 * e1 * y3 ^ 2 * e7 ^ 2 * e6 * y1 * y2 + 4 * e1 * e4 ^ 2 * y2 ^ 3 * e6 * y1 +
+4 * e1 * e4 ^ 2 * y1 ^ 3 * e5 * y2 + 4 * e1 * e4 ^ 2 * y1 ^ 3 * e6 * y2 +
+8 * e1 * y2 ^ 3 * e6 ^ 2 * e4 * y1 - 16 * e1 * y3 ^ 3 * e6 ^ 2 * y2 ^ 2 * y1 +
+8 * e1 * y2 ^ 2 * e6 ^ 2 * e4 * y1 ^ 2 + 16 * e1 * y2 ^ 4 * y3 * e4 * y1 ^ 3 +
+4 * e1 * y3 ^ 2 * e6 ^ 3 * x2 * e3 + 2 * e1 * y3 ^ 2 * e6 ^ 3 * x3 * e3 +
+2 * e1 * y3 * e6 ^ 3 * e4 * y2 + 2 * e1 * y3 * e6 ^ 3 * e4 * y1 -
+2 * e1 * e4 ^ 2 * y2 * y1 * e6 ^ 2 - 2 * e1 * e4 ^ 2 * y2 * y1 * e5 ^ 2 +
+8 * e1 * e4 ^ 2 * y2 ^ 2 * y1 ^ 2 * e5 +
+8 * e1 * e4 ^ 2 * y2 ^ 2 * y1 ^ 2 * e6 + 8 * e1 * y2 ^ 3 * e6 * e4 * e5 * y1 +
+16 * e1 * y2 ^ 2 * e7 ^ 2 * y3 * e5 * y1 +
+16 * e1 * y2 ^ 2 * e7 ^ 2 * y3 * e6 * y1 -
+16 * e1 * y2 ^ 3 * e7 * y3 ^ 2 * e5 * y1 -
+16 * e1 * y2 ^ 3 * e7 * y3 ^ 2 * e6 * y1 +
+8 * e1 * y2 ^ 3 * e7 * e4 * e5 * y1 + 8 * e1 * y2 ^ 3 * e7 * e4 * e6 * y1 -
+16 * e1 * y2 ^ 4 * y3 * e4 * e5 * y1 - 16 * e1 * y2 ^ 4 * y3 * e4 * e6 * y1 +
+8 * e1 * y3 ^ 2 * e6 * e7 * e5 * y1 * y2 +
+8 * e1 * y3 ^ 2 * e6 ^ 2 * e7 * y1 * y2 -
+16 * e1 * y3 ^ 3 * e6 * y2 ^ 2 * e5 * y1 -
+16 * e1 * y3 ^ 3 * e7 * y2 ^ 2 * e5 * y1 -
+16 * e1 * y3 ^ 3 * e7 * y2 ^ 2 * e6 * y1 +
+16 * e1 * y2 ^ 3 * y3 ^ 2 * e4 * e5 * y1 +
+16 * e1 * y2 ^ 3 * y3 ^ 2 * e4 * e6 * y1 +
+16 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e5 * y1 * y2 +
+16 * e1 * y3 ^ 2 * x2 ^ 2 * e3 ^ 2 * e6 * y1 * y2 +
+4 * e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e5 * y1 * y2 +
+4 * e1 * y3 ^ 2 * x3 ^ 2 * e3 ^ 2 * e6 * y1 * y2 +
+8 * e1 * y2 ^ 2 * e6 * e4 * y1 ^ 2 * e5 +
+8 * e1 * y2 ^ 2 * e7 * e4 * y1 ^ 2 * e5 +
+8 * e1 * y2 ^ 2 * e7 * e4 * y1 ^ 2 * e6 -
+4 * e1 * y2 ^ 2 * y3 * e4 * y1 * e6 ^ 2 +
+4 * e1 * y2 ^ 2 * y3 * e4 * y1 * e5 ^ 2 +
+4 * e1 * y2 ^ 2 * x2 * e3 * e4 * e6 ^ 2 +
+4 * e1 * y2 ^ 2 * x2 * e3 * e4 * e5 ^ 2 +
+8 * e1 * y2 ^ 2 * x2 * e3 * e4 * e5 * e6 +
+16 * e1 * y2 ^ 4 * x2 * e3 * e4 * y1 ^ 2 +
+4 * e1 * y2 * x2 * e3 * e4 * y1 * e6 ^ 2 +
+4 * e1 * y2 * x2 * e3 * e4 * y1 * e5 ^ 2 +
+8 * e1 * y2 * x2 * e3 * e4 * y1 * e5 * e6 +
+16 * e1 * y2 ^ 3 * x2 * e3 * e4 * y1 ^ 3 +
+2 * e1 * y2 ^ 2 * x3 * e3 * e4 * e6 ^ 2 +
+2 * e1 * y2 ^ 2 * x3 * e3 * e4 * e5 ^ 2 +
+4 * e1 * y2 ^ 2 * x3 * e3 * e4 * e5 * e6 +
+8 * e1 * y2 ^ 4 * x3 * e3 * e4 * y1 ^ 2 +
+4 * e1 * y3 ^ 2 * e6 * x2 * e3 * e5 ^ 2 +
+8 * e1 * y3 ^ 2 * e6 ^ 2 * x2 * e3 * e5 +
+2 * e1 * y3 ^ 2 * e6 * x3 * e3 * e5 ^ 2 +
+4 * e1 * y3 ^ 2 * e6 ^ 2 * x3 * e3 * e5 +
+8 * e1 * y3 ^ 2 * e6 * x3 * e3 * y1 ^ 2 * y2 ^ 2 +
+2 * e1 * y3 * e6 * e4 * y2 * e5 ^ 2 + 4 * e1 * y3 * e6 ^ 2 * e4 * y2 * e5 -
+8 * e1 * y3 * e6 * e4 * y2 ^ 3 * y1 ^ 2 + 2 * e1 * y3 * e6 * e4 * y1 * e5 ^ 2 +
+4 * e1 * y3 * e6 ^ 2 * e4 * y1 * e5 + 8 * e1 * y3 * e6 * e4 * y1 ^ 3 * y2 ^ 2 +
+4 * e1 * y3 ^ 2 * e7 * x2 * e3 * e6 ^ 2 +
+4 * e1 * y3 ^ 2 * e7 * x2 * e3 * e5 ^ 2 +
+8 * e1 * y3 ^ 2 * e7 * x2 * e3 * e5 * e6 +
+16 * e1 * y3 ^ 2 * e7 * x2 * e3 * y1 ^ 2 * y2 ^ 2 +
+2 * e1 * y3 ^ 2 * e7 * x3 * e3 * e6 ^ 2 +
+2 * e1 * y3 ^ 2 * e7 * x3 * e3 * e5 ^ 2 +
+4 * e1 * y3 ^ 2 * e7 * x3 * e3 * e5 * e6 +
+8 * e1 * y3 ^ 2 * e7 * x3 * e3 * y1 ^ 2 * y2 ^ 2 +
+2 * e1 * y3 * e7 * e4 * y2 * e6 ^ 2 + 2 * e1 * y3 * e7 * e4 * y2 * e5 ^ 2 +
+4 * e1 * y3 * e7 * e4 * y2 * e5 * e6 +
+8 * e1 * y3 * e7 * e4 * y2 ^ 3 * y1 ^ 2 + 2 * e1 * y3 * e7 * e4 * y1 * e6 ^ 2 +
+2 * e1 * y3 * e7 * e4 * y1 * e5 ^ 2 + 4 * e1 * y3 * e7 * e4 * y1 * e5 * e6 +
+8 * e1 * y3 * e7 * e4 * y1 ^ 3 * y2 ^ 2 -
+8 * e1 * y2 * y3 ^ 3 * x2 * e3 * e6 ^ 2 -
+8 * e1 * y2 * y3 ^ 3 * x2 * e3 * e5 ^ 2 -
+16 * e1 * y2 * y3 ^ 3 * x2 * e3 * e5 * e6 -
+32 * e1 * y2 ^ 3 * y3 ^ 3 * x2 * e3 * y1 ^ 2 -
+4 * e1 * y2 * y3 ^ 3 * x3 * e3 * e6 ^ 2 -
+4 * e1 * y2 * y3 ^ 3 * x3 * e3 * e5 ^ 2 -
+8 * e1 * y2 * y3 ^ 3 * x3 * e3 * e5 * e6 -
+16 * e1 * y2 ^ 3 * y3 ^ 3 * x3 * e3 * y1 ^ 2 -
+4 * e1 * y2 * y3 ^ 2 * e4 * y1 * e6 ^ 2 -
+4 * e1 * y2 * y3 ^ 2 * e4 * y1 * e5 ^ 2 -
+8 * e1 * y2 * y3 ^ 2 * e4 * y1 * e5 * e6 -
+4 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e6 ^ 2 -
+4 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e5 ^ 2 -
+8 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e5 * e6 -
+16 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * y1 ^ 2 * y2 ^ 2 +
+2 * e1 * y2 * x3 * e3 * e4 * y1 * e6 ^ 2 +
+2 * e1 * y2 * x3 * e3 * e4 * y1 * e5 ^ 2 +
+4 * e1 * y2 * x3 * e3 * e4 * y1 * e5 * e6 +
+8 * e1 * y2 ^ 3 * x3 * e3 * e4 * y1 ^ 3 -
+4 * e1 * y3 * x2 * e3 * e4 * y2 * e6 ^ 2 -
+4 * e1 * y3 * x2 * e3 * e4 * y2 * e5 ^ 2 -
+8 * e1 * y3 * x2 * e3 * e4 * y2 * e5 * e6 -
+16 * e1 * y3 * x2 * e3 * e4 * y2 ^ 3 * y1 ^ 2 -
+4 * e1 * y3 * x2 * e3 * e4 * y1 * e6 ^ 2 -
+4 * e1 * y3 * x2 * e3 * e4 * y1 * e5 ^ 2 -
+8 * e1 * y3 * x2 * e3 * e4 * y1 * e5 * e6 -
+16 * e1 * y3 * x2 * e3 * e4 * y1 ^ 3 * y2 ^ 2 -
+2 * e1 * y3 * x3 * e3 * e4 * y2 * e6 ^ 2 -
+2 * e1 * y3 * x3 * e3 * e4 * y2 * e5 ^ 2 -
+4 * e1 * y3 * x3 * e3 * e4 * y2 * e5 * e6 -
+8 * e1 * y3 * x3 * e3 * e4 * y2 ^ 3 * y1 ^ 2 -
+2 * e1 * y3 * x3 * e3 * e4 * y1 * e6 ^ 2 -
+2 * e1 * y3 * x3 * e3 * e4 * y1 * e5 ^ 2 -
+4 * e1 * y3 * x3 * e3 * e4 * y1 * e5 * e6 -
+8 * e1 * y3 * x3 * e3 * e4 * y1 ^ 3 * y2 ^ 2 -
+4 * e1 * e4 ^ 2 * y2 * y1 * e5 * e6 -
+16 * e1 * y2 ^ 3 * y3 * e4 * y1 ^ 2 * e5 -
+16 * e1 * y2 ^ 3 * x2 * e3 * e4 * e5 * y1 -
+16 * e1 * y2 ^ 3 * x2 * e3 * e4 * e6 * y1 -
+16 * e1 * y2 ^ 2 * x2 * e3 * e4 * y1 ^ 2 * e5 -
+16 * e1 * y2 ^ 2 * x2 * e3 * e4 * y1 ^ 2 * e6 -
+8 * e1 * y2 ^ 3 * x3 * e3 * e4 * e5 * y1 -
+8 * e1 * y2 ^ 3 * x3 * e3 * e4 * e6 * y1 -
+16 * e1 * y3 ^ 2 * e6 * x2 * e3 * e5 * y1 * y2 -
+16 * e1 * y3 ^ 2 * e6 ^ 2 * x2 * e3 * y1 * y2 -
+8 * e1 * y3 ^ 2 * e6 * x3 * e3 * e5 * y1 * y2 -
+8 * e1 * y3 ^ 2 * e6 ^ 2 * x3 * e3 * y1 * y2 -
+8 * e1 * y3 * e6 * e4 * y1 ^ 2 * e5 * y2 -
+8 * e1 * y3 * e6 ^ 2 * e4 * y1 ^ 2 * y2 -
+16 * e1 * y3 ^ 2 * e7 * x2 * e3 * e5 * y1 * y2 -
+16 * e1 * y3 ^ 2 * e7 * x2 * e3 * e6 * y1 * y2 -
+8 * e1 * y3 ^ 2 * e7 * x3 * e3 * e5 * y1 * y2 -
+8 * e1 * y3 ^ 2 * e7 * x3 * e3 * e6 * y1 * y2 -
+8 * e1 * y3 * e7 * e4 * y2 ^ 2 * e5 * y1 -
+8 * e1 * y3 * e7 * e4 * y2 ^ 2 * e6 * y1 -
+8 * e1 * y3 * e7 * e4 * y1 ^ 2 * e5 * y2 -
+8 * e1 * y3 * e7 * e4 * y1 ^ 2 * e6 * y2 +
+32 * e1 * y2 ^ 2 * y3 ^ 3 * x2 * e3 * e5 * y1 +
+32 * e1 * y2 ^ 2 * y3 ^ 3 * x2 * e3 * e6 * y1 +
+16 * e1 * y2 ^ 2 * y3 ^ 3 * x3 * e3 * e5 * y1 +
+16 * e1 * y2 ^ 2 * y3 ^ 3 * x3 * e3 * e6 * y1 +
+16 * e1 * y2 ^ 2 * y3 ^ 2 * e4 * y1 ^ 2 * e5 +
+16 * e1 * y2 ^ 2 * y3 ^ 2 * e4 * y1 ^ 2 * e6 +
+16 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e5 * y1 * y2 +
+16 * e1 * y3 ^ 2 * x2 * e3 ^ 2 * x3 * e6 * y1 * y2 -
+8 * e1 * y2 ^ 2 * x3 * e3 * e4 * y1 ^ 2 * e5 -
+8 * e1 * y2 ^ 2 * x3 * e3 * e4 * y1 ^ 2 * e6 +
+16 * e1 * y3 * x2 * e3 * e4 * y2 ^ 2 * e5 * y1 +
+16 * e1 * y3 * x2 * e3 * e4 * y2 ^ 2 * e6 * y1 +
+16 * e1 * y3 * x2 * e3 * e4 * y1 ^ 2 * e5 * y2 +
+16 * e1 * y3 * x2 * e3 * e4 * y1 ^ 2 * e6 * y2 +
+8 * e1 * y3 * x3 * e3 * e4 * y2 ^ 2 * e5 * y1 +
+8 * e1 * y3 * x3 * e3 * e4 * y2 ^ 2 * e6 * y1 +
+8 * e1 * y3 * x3 * e3 * e4 * y1 ^ 2 * e5 * y2 +
+8 * e1 * y3 * x3 * e3 * e4 * y1 ^ 2 * e6 * y2 +
+12 * e6 ^ 2 * e7 * y1 * y2 * x1 * e1 ^ 2 + 2 * x1 * e1 ^ 3 * x2 * e6 ^ 3 +
+3 * x1 ^ 2 * e1 ^ 3 * e6 ^ 2 * e7 + 3 * x2 ^ 2 * e1 ^ 3 * e6 ^ 2 * e7 +
+3 * e1 ^ 3 * x3 ^ 2 * e6 ^ 2 * e7 + 2 * x1 * e1 ^ 3 * x3 * e6 ^ 3 +
+2 * x2 * e1 ^ 3 * x3 * e6 ^ 3 + 3 * x1 ^ 2 * e1 ^ 3 * e7 ^ 2 * e6 +
+3 * x2 ^ 2 * e1 ^ 3 * e7 ^ 2 * e6 + 4 * e6 ^ 3 * y1 * y2 * x1 * e1 ^ 2 +
+4 * e6 ^ 3 * y1 * y2 * x2 * e1 ^ 2 + 12 * e6 ^ 2 * e7 * y1 * y2 * x2 * e1 ^ 2 +
+12 * e7 ^ 2 * y1 * e6 * y2 * x1 * e1 ^ 2 +
+12 * e7 ^ 2 * y1 * e6 * y2 * x2 * e1 ^ 2 + e1 * e6 ^ 5 +
+3 * e1 ^ 3 * x3 ^ 2 * e7 ^ 2 * e6 - 2 * e6 ^ 3 * x1 * e1 ^ 2 * e5 -
+2 * e6 ^ 3 * x2 * e1 ^ 2 * e5 - 2 * e6 ^ 3 * e1 ^ 2 * x3 * e5 -
+6 * e6 ^ 3 * e7 * x1 * e1 ^ 2 - 6 * e6 ^ 3 * e7 * x2 * e1 ^ 2 -
+6 * e6 ^ 2 * e7 ^ 2 * x1 * e1 ^ 2 - 6 * e6 ^ 2 * e7 ^ 2 * x2 * e1 ^ 2 -
+6 * e6 ^ 3 * e1 ^ 2 * x3 * e7 - 6 * e6 ^ 2 * e1 ^ 2 * x3 * e7 ^ 2 +
+6 * x1 * e1 ^ 3 * x2 * e6 ^ 2 * e7 + 6 * x1 * e1 ^ 3 * x2 * e7 ^ 2 * e6 +
+6 * x1 * e1 ^ 3 * x3 * e7 ^ 2 * e6 + 6 * x2 * e1 ^ 3 * x3 * e7 ^ 2 * e6 -
+6 * e5 * x1 * e1 ^ 2 * e7 ^ 2 * e6 - 6 * e5 * x2 * e1 ^ 2 * e7 ^ 2 * e6 -
+6 * e5 * e1 ^ 2 * x3 * e7 ^ 2 * e6 - 6 * e5 * e6 ^ 2 * e7 * x1 * e1 ^ 2 -
+6 * e5 * e6 ^ 2 * e7 * x2 * e1 ^ 2 + 4 * e6 ^ 3 * e1 ^ 2 * x3 * y1 * y2 +
+12 * y1 * y2 * e1 ^ 2 * x3 * e6 ^ 2 * e7 + 6 * x1 * e1 ^ 3 * x3 * e6 ^ 2 * e7 +
+6 * x2 * e1 ^ 3 * x3 * e6 ^ 2 * e7 - 6 * e6 ^ 2 * e1 ^ 2 * x3 * e7 * e5 +
+12 * y1 * y2 * e1 ^ 2 * x3 * e7 ^ 2 * e6 + 2 * x1 * e1 ^ 3 * x2 * e7 ^ 3 +
+2 * x1 * e1 ^ 3 * x3 * e7 ^ 3 + 2 * x2 * e1 ^ 3 * x3 * e7 ^ 3 -
+2 * e5 * x1 * e1 ^ 2 * e7 ^ 3 - 2 * e5 * x2 * e1 ^ 2 * e7 ^ 3 -
+2 * e5 * e1 ^ 2 * x3 * e7 ^ 3 - 2 * e6 * e1 ^ 2 * x3 * e7 ^ 3 -
+2 * e6 * x1 * e1 ^ 2 * e7 ^ 3 - 2 * e6 * x2 * e1 ^ 2 * e7 ^ 3 -
+4 * e1 * e6 ^ 4 * y1 * y2 + 4 * e1 * e6 ^ 3 * y1 ^ 2 * y2 ^ 2 +
+6 * e1 * e6 ^ 3 * e7 * e5 + 3 * e1 * e5 ^ 2 * e6 ^ 2 * e7 +
+3 * e1 * e5 ^ 2 * e6 * e7 ^ 2 + 6 * e1 * e5 * e6 ^ 2 * e7 ^ 2 +
+2 * e1 * e5 * e6 * e7 ^ 3 + 4 * e1 * y1 ^ 2 * y2 ^ 2 * e7 ^ 3 +
+4 * y1 * y2 * x1 * e1 ^ 2 * e7 ^ 3 + 4 * y1 * y2 * x2 * e1 ^ 2 * e7 ^ 3 +
+4 * y1 * y2 * e1 ^ 2 * x3 * e7 ^ 3 - 4 * e1 * e6 ^ 3 * y1 * e5 * y2 -
+12 * e1 * e6 ^ 3 * e7 * y1 * y2 + 12 * e1 * e6 ^ 2 * e7 * y1 ^ 2 * y2 ^ 2 -
+12 * e1 * e6 ^ 2 * e7 * y1 * e5 * y2 - 12 * e1 * e7 ^ 2 * y1 * e5 * y2 * e6 -
+12 * e1 * e7 ^ 2 * y1 * e6 ^ 2 * y2 + 12 * e1 * e7 ^ 2 * y1 ^ 2 * e6 * y2 ^ 2 -
+4 * e1 * e5 * y1 * y2 * e7 ^ 3 - 4 * e1 * e6 * y1 * y2 * e7 ^ 3.
+
diff --git a/test-suite/complexity/setoid_rewrite.v b/test-suite/complexity/setoid_rewrite.v
new file mode 100644
index 00000000..3b5a0de7
--- /dev/null
+++ b/test-suite/complexity/setoid_rewrite.v
@@ -0,0 +1,10 @@
+(* Check bug #1176 *)
+(* Expected time < 0.50s *)
+
+Require Import Setoid.
+
+Variable f : nat -> Prop.
+
+Goal forall U:Prop, f 100 <-> U.
+intros U.
+Time setoid_replace U with False.
diff --git a/test-suite/failure/autorewritein.v b/test-suite/failure/autorewritein.v
new file mode 100644
index 00000000..dc17742a
--- /dev/null
+++ b/test-suite/failure/autorewritein.v
@@ -0,0 +1,15 @@
+Variable Ack : nat -> nat -> nat.
+
+Axiom Ack0 : forall m : nat, Ack 0 m = S m.
+Axiom Ack1 : forall n : nat, Ack (S n) 0 = Ack n 1.
+Axiom Ack2 : forall n m : nat, Ack (S n) (S m) = Ack n (Ack (S n) m).
+
+Hint Rewrite Ack0 Ack1 Ack2 : base0.
+
+Lemma ResAck2 : forall H:(Ack 2 2 = 7 -> False), H=H  -> False.
+Proof.
+  intros.
+  autorewrite with base0 in * using try (apply H1;reflexivity).
+
+
+
diff --git a/test-suite/failure/proofirrelevance.v b/test-suite/failure/proofirrelevance.v
new file mode 100644
index 00000000..eedf2612
--- /dev/null
+++ b/test-suite/failure/proofirrelevance.v
@@ -0,0 +1,11 @@
+(* This was working in version 8.1beta (bug in the Sort-polymorphism
+   of inductive types), but this is inconsistent with classical logic 
+   in Prop *)
+
+Inductive bool_in_prop : Type := hide : bool -> bool_in_prop
+with bool : Type := true : bool | false : bool.
+
+Lemma not_proof_irrelevance : ~ forall (P:Prop) (p p':P), p=p'.
+intro H; pose proof (H bool_in_prop (hide true) (hide false)); discriminate.
+Qed.
+
diff --git a/test-suite/failure/rewrite_in_goal.v b/test-suite/failure/rewrite_in_goal.v
new file mode 100644
index 00000000..c11a6237
--- /dev/null
+++ b/test-suite/failure/rewrite_in_goal.v
@@ -0,0 +1,3 @@
+Goal forall T1 T2 (H:T1=T2) (f:T1->Prop) (x:T1) , f x -> Type.
+  intros until x.
+  rewrite H in x.
diff --git a/test-suite/failure/rewrite_in_hyp.v b/test-suite/failure/rewrite_in_hyp.v
new file mode 100644
index 00000000..613d707c
--- /dev/null
+++ b/test-suite/failure/rewrite_in_hyp.v
@@ -0,0 +1,3 @@
+Goal forall (T1 T2 : Type) (f:T1 -> Prop) (x:T1) (H:T1=T2), f x -> 0=1.
+  intros T1 T2 f x H fx.
+  rewrite H in x.
diff --git a/test-suite/failure/universes-buraliforti-redef.v b/test-suite/failure/universes-buraliforti-redef.v
new file mode 100644
index 00000000..049f97f2
--- /dev/null
+++ b/test-suite/failure/universes-buraliforti-redef.v
@@ -0,0 +1,246 @@
+(* A variant of Burali-Forti that used to pass in V8.1beta, because of
+   a bug in the instantiation of sort-polymorphic inductive types *)
+
+(* The following type seems to satisfy the hypothesis of the paradox below *)
+(* It should infer constraints forbidding the paradox to go through, but via *)
+(* a redefinition that did not propagate constraints correctly in V8.1beta *)
+(* it was exploitable to derive an inconsistency *)
+
+(* We keep the file as a non regression test of the bug *)
+
+  Record A1 (B:Type) (g:B->Type) : Type :=  (* Type_i' *)
+    i1 {X0 : B; R0 : g X0 -> g X0 -> Prop}. (* X0: Type_j' *)
+
+  Definition A2 := A1. (* here was the bug *)
+
+  Definition A0 := (A2 Type (fun x => x)).
+  Definition i0 := (i1 Type (fun x => x)).
+
+(* The rest is as in universes-buraliforti.v *)
+
+
+(* Some properties about relations on objects in Type *)
+
+  Inductive ACC (A : Type) (R : A -> A -> Prop) : A -> Prop :=
+      ACC_intro :
+        forall x : A, (forall y : A, R y x -> ACC A R y) -> ACC A R x.
+
+  Lemma ACC_nonreflexive :
+   forall (A : Type) (R : A -> A -> Prop) (x : A),
+   ACC A R x -> R x x -> False.
+simple induction 1; intros.
+exact (H1 x0 H2 H2).
+Qed.
+
+  Definition WF (A : Type) (R : A -> A -> Prop) := forall x : A, ACC A R x.
+
+
+Section Inverse_Image.
+
+  Variables (A B : Type) (R : B -> B -> Prop) (f : A -> B).
+
+  Definition Rof (x y : A) : Prop := R (f x) (f y).
+
+  Remark ACC_lemma :
+   forall y : B, ACC B R y -> forall x : A, y = f x -> ACC A Rof x.
+    simple induction 1; intros.
+    constructor; intros.
+    apply (H1 (f y0)); trivial.
+    elim H2 using eq_ind_r; trivial.
+    Qed.
+
+  Lemma ACC_inverse_image : forall x : A, ACC B R (f x) -> ACC A Rof x.
+    intros; apply (ACC_lemma (f x)); trivial.
+    Qed.
+
+  Lemma WF_inverse_image : WF B R -> WF A Rof.
+    red in |- *; intros; apply ACC_inverse_image; auto.
+    Qed.
+
+End Inverse_Image.
+
+
+(* Remark: the paradox is written in Type, but also works in Prop or Set. *)
+
+Section Burali_Forti_Paradox.
+
+  Definition morphism (A : Type) (R : A -> A -> Prop) 
+    (B : Type) (S : B -> B -> Prop) (f : A -> B) :=
+    forall x y : A, R x y -> S (f x) (f y).
+
+  (* The hypothesis of the paradox:
+     assumes there exists an universal system of notations, i.e:
+      - A type A0
+      - An injection i0 from relations on any type into A0
+      - The proof that i0 is injective modulo morphism 
+   *)
+  Variable A0 : Type.                     (* Type_i *)
+  Variable i0 : forall X : Type, (X -> X -> Prop) -> A0. (* X: Type_j *)
+  Hypothesis
+    inj :
+      forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type)
+        (R2 : X2 -> X2 -> Prop),
+      i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f.
+
+  (* Embedding of x in y: x and y are images of 2 well founded relations
+     R1 and R2, the ordinal of R2 being strictly greater than that of R1.
+   *)
+  Record emb (x y : A0) : Prop := 
+    {X1 : Type;
+     R1 : X1 -> X1 -> Prop;
+     eqx : x = i0 X1 R1;
+     X2 : Type;
+     R2 : X2 -> X2 -> Prop;
+     eqy : y = i0 X2 R2;
+     W2 : WF X2 R2;
+     f : X1 -> X2;
+     fmorph : morphism X1 R1 X2 R2 f;
+     maj : X2;
+     majf : forall z : X1, R2 (f z) maj}.
+
+  Lemma emb_trans : forall x y z : A0, emb x y -> emb y z -> emb x z.
+intros.
+case H; intros X1 R1 eqx X2 R2 eqy; intros.
+case H0; intros X3 R3 eqx0 X4 R4 eqy0; intros.
+generalize eqx0; clear eqx0.
+elim eqy using eq_ind_r; intro.
+case (inj _ _ _ _ eqx0); intros.
+exists X1 R1 X4 R4 (fun x : X1 => f0 (x0 (f x))) maj0; trivial.
+red in |- *; auto.
+Defined.
+
+
+  Lemma ACC_emb :
+   forall (X : Type) (R : X -> X -> Prop) (x : X),
+   ACC X R x ->
+   forall (Y : Type) (S : Y -> Y -> Prop) (f : Y -> X),
+   morphism Y S X R f -> (forall y : Y, R (f y) x) -> ACC A0 emb (i0 Y S).
+simple induction 1; intros.
+constructor; intros.
+case H4; intros.
+elim eqx using eq_ind_r.
+case (inj X2 R2 Y S).
+apply sym_eq; assumption.
+
+intros.
+apply H1 with (y := f (x1 maj)) (f := fun x : X1 => f (x1 (f0 x)));
+ try red in |- *; auto.
+Defined.
+
+  (* The embedding relation is well founded *)
+  Lemma WF_emb : WF A0 emb.
+constructor; intros.
+case H; intros.
+elim eqx using eq_ind_r.
+apply ACC_emb with (X := X2) (R := R2) (x := maj) (f := f); trivial.
+Defined.
+
+
+  (* The following definition enforces Type_j >= Type_i *)
+  Definition Omega : A0 := i0 A0 emb.
+
+
+Section Subsets.
+
+  Variable a : A0.
+
+  (* We define the type of elements of A0 smaller than a w.r.t embedding.
+     The Record is in Type, but it is possible to avoid such structure. *)
+  Record sub : Type :=  {witness : A0; emb_wit : emb witness a}.
+
+  (* F is its image through i0 *)
+  Definition F : A0 := i0 sub (Rof _ _ emb witness).
+
+  (* F is embedded in Omega:
+     - the witness projection is a morphism
+     - a is an upper bound because emb_wit proves that witness is
+       smaller than a.
+   *)
+  Lemma F_emb_Omega : emb F Omega.
+exists sub (Rof _ _ emb witness) A0 emb witness a; trivial.
+exact WF_emb.
+
+red in |- *; trivial.
+
+exact emb_wit.
+Defined.
+
+End Subsets.
+
+
+  Definition fsub (a b : A0) (H : emb a b) (x : sub a) : 
+    sub b := Build_sub _ (witness _ x) (emb_trans _ _ _ (emb_wit _ x) H).
+
+  (* F is a morphism: a < b => F(a) < F(b)
+      - the morphism from F(a) to F(b) is fsub above
+      - the upper bound is a, which is in F(b) since a < b
+   *)
+  Lemma F_morphism : morphism A0 emb A0 emb F.
+red in |- *; intros.
+exists
+ (sub x)
+   (Rof _ _ emb (witness x))
+   (sub y)
+   (Rof _ _ emb (witness y))
+   (fsub x y H)
+   (Build_sub _ x H); trivial.
+apply WF_inverse_image.
+exact WF_emb.
+
+unfold morphism, Rof, fsub in |- *; simpl in |- *; intros.
+trivial.
+
+unfold Rof, fsub in |- *; simpl in |- *; intros.
+apply emb_wit.
+Defined.
+
+
+  (* Omega is embedded in itself:
+     - F is a morphism
+     - Omega is an upper bound of the image of F
+   *)
+  Lemma Omega_refl : emb Omega Omega.
+exists A0 emb A0 emb F Omega; trivial.
+exact WF_emb.
+
+exact F_morphism.
+
+exact F_emb_Omega.
+Defined.
+
+  (* The paradox is that Omega cannot be embedded in itself, since
+     the embedding relation is well founded.
+   *)
+  Theorem Burali_Forti : False.
+apply ACC_nonreflexive with A0 emb Omega.
+apply WF_emb.
+
+exact Omega_refl.
+
+Defined.
+
+End Burali_Forti_Paradox.
+
+
+  (* Note: this proof uses a large elimination of A0. *)
+  Lemma inj :
+   forall (X1 : Type) (R1 : X1 -> X1 -> Prop) (X2 : Type)
+     (R2 : X2 -> X2 -> Prop),
+   i0 X1 R1 = i0 X2 R2 -> exists f : X1 -> X2, morphism X1 R1 X2 R2 f.
+intros.
+change
+  match i0 X1 R1, i0 X2 R2 with
+  | i1 x1 r1, i1 x2 r2 => exists f : _, morphism x1 r1 x2 r2 f
+  end in |- *.
+case H; simpl in |- *.
+exists (fun x : X1 => x).
+red in |- *; trivial.
+Defined.
+
+(* The following command raises 'Error: Universe Inconsistency'.
+   To allow large elimination of A0, i0 must not be a large constructor.
+   Hence, the constraint Type_j' < Type_i' is added, which is incompatible
+   with the constraint j >= i in the paradox.
+*)
+
+  Definition Paradox : False := Burali_Forti A0 i0 inj.
diff --git a/test-suite/interactive/Evar.v b/test-suite/interactive/Evar.v
new file mode 100644
index 00000000..1bc1f71d
--- /dev/null
+++ b/test-suite/interactive/Evar.v
@@ -0,0 +1,6 @@
+(* Check that no toplevel "unresolved evar" flees through Declare
+   Implicit Tactic support (bug #1229) *)
+
+Goal True. 
+(* should raise an error, not an anomaly *)
+set (x := _).
diff --git a/test-suite/modules/ind.v b/test-suite/modules/ind.v
index a4f9d3a2..3af94c3b 100644
--- a/test-suite/modules/ind.v
+++ b/test-suite/modules/ind.v
@@ -14,4 +14,36 @@ End M.
 
 Module N := M.
 
-Check (N.f M.A).
\ No newline at end of file
+Check (N.f M.A).
+
+(* Check use of equivalence on inductive types (bug #1242) *)
+
+  Module Type ASIG.
+  Inductive t : Set := a | b : t.
+  Definition f := fun x => match x with a => true | b => false end.
+  End ASIG.
+
+  Module Type BSIG.
+  Declare Module A : ASIG.
+  Definition f := fun x => match x with A.a => true | A.b => false end.
+  End BSIG.
+
+  Module C (A : ASIG) (B : BSIG with Module A:=A).
+
+  (* Check equivalence is considered in "case_info" *)
+  Lemma test : forall x, A.f x = B.f x.
+  intro x. unfold B.f, A.f.
+  destruct x; reflexivity.
+  Qed.
+
+  (* Check equivalence is considered in pattern-matching *)
+  Definition f (x : A.t) := match x with B.A.a => true | B.A.b => false end.
+
+  End C.
+
+(* Check subtyping of the context of parameters of the inductive types *)
+(* Only the number of expected uniform parameters and the convertibility *)
+(* of the inductive arities and constructors types are checked *)
+
+Module Type S. Inductive I (x:=0) (y:nat): Set := c: x=y -> I y. End S.
+Module P : S.  Inductive I (y':nat) (z:=y'): Set := c : 0=y' -> I y'. End P.
diff --git a/test-suite/modules/nested_mod_types.v b/test-suite/modules/nested_mod_types.v
new file mode 100644
index 00000000..f459f9ec
--- /dev/null
+++ b/test-suite/modules/nested_mod_types.v
@@ -0,0 +1,26 @@
+Module Type T.
+  Module Type U.
+    Module Type V.
+      Variable b : nat.
+    End V.
+    Variable a : nat.
+  End U.
+  Declare Module u : U.
+  Declare Module v : u.V.
+End T.
+
+Module F (t:T).
+End F.
+
+Module M:T.
+  Module Type U.
+    Module Type V.
+      Variable b : nat.
+    End V.
+    Variable a : nat.
+  End U.
+  Declare Module u : U.
+  Declare Module v : u.V.
+End M.
+
+Module FM := F M.
diff --git a/test-suite/output/Notations.out b/test-suite/output/Notations.out
index 3ab3de45..be4cd4fa 100644
--- a/test-suite/output/Notations.out
+++ b/test-suite/output/Notations.out
@@ -14,6 +14,12 @@ forall n : nat, n = 0
      : Prop
 !(0 = 0)
      : Prop
+forall n : nat, #(n = n)
+     : Prop
+forall n n0 : nat, ##(n = n0)
+     : Prop
+forall n n0 : nat, ###(n = n0)
+     : Prop
 3 + 3
      : Z
 3 + 3
@@ -22,3 +28,21 @@ forall n : nat, n = 0
      : list nat
 (1; 2, 4)
      : nat * nat * nat
+Defining 'ifzero' as keyword
+ifzero 3
+     : bool
+Defining 'pred' as keyword
+pred 3
+     : nat
+fun n : nat => pred n
+     : nat -> nat
+fun n : nat => pred n
+     : nat -> nat
+Defining 'ifn' as keyword
+Defining 'is' as keyword
+fun x : nat => ifn x is succ n then n else 0
+     : nat -> nat
+1-
+     : bool
+-4
+     : Z
diff --git a/test-suite/output/Notations.v b/test-suite/output/Notations.v
index 4382975e..3cc0a189 100644
--- a/test-suite/output/Notations.v
+++ b/test-suite/output/Notations.v
@@ -17,12 +17,33 @@ Check (decomp (true,true) as t, u in (t,u)).
 (**********************************************************************)
 (* Behaviour wrt to binding variables (submitted by Roland Zumkeller) *)
 
+Section A.
+
 Notation "! A" := (forall _:nat, A) (at level 60).
 
 Check ! (0=0).
 Check forall n, n=0.
 Check forall n:nat, 0=0.
 
+End A.
+
+(**********************************************************************)
+(* Behaviour wrt to binding variables (cf bug report #1186)           *)
+
+Section B.
+
+Notation "# A" := (forall n:nat, n=n->A) (at level 60).
+Check forall n:nat, # (n=n).
+
+Notation "## A" := (forall n n0:nat, n=n0->A) (at level 60).
+Check forall n n0:nat, ## (n=n0).
+
+Notation "### A" :=
+ (forall n n0:nat, match n with O => True | S n => n=n0 end ->A) (at level 60).
+Check forall n n0:nat, ### (n=n0).
+
+End B.
+
 (**********************************************************************)
 (* Conflict between notation and notation below coercions             *)
 
@@ -66,3 +87,35 @@ Check [1;2;4].
 Reserved Notation "( x ; y , .. , z )" (at level 0).
 Notation "( x ; y , .. , z )" := (pair .. (pair x y) .. z).
 Check (1;2,4).
+
+(* Check basic notations involving "match" *)
+
+Section C.
+
+Notation "'ifzero' n" := (match n with 0 => true | S _ => false end)
+  (at level 0, n at level 0).
+Check (ifzero 3).
+
+Notation "'pred' n" := (match n with 0 => 0 | S n' => n' end)
+  (at level 0, n at level 0).
+Check (pred 3).
+Check (fun n => match n with 0 => 0 | S n => n end).
+Check (fun n => match n with S p as x => p | y => 0 end).
+
+Notation "'ifn' x 'is' 'succ' n 'then' t 'else' u" := 
+  (match x with O => u | S n => t end) (at level 0, u at level 0).
+Check fun x => ifn x is succ n then n else 0.
+
+End C.
+
+(* Check correction of bug #1179 *)
+
+Notation "1 -" := true (at level 0).
+Check 1-.
+
+(* This is another aspect of bug #1179 (raises anomaly in 8.1) *)
+
+Require Import ZArith.
+Open Scope Z_scope.
+Notation "- 4" := (-2 + -2).
+Check -4.
diff --git a/test-suite/success/CanonicalStructure.v b/test-suite/success/CanonicalStructure.v
index 003810cc..44d21b83 100644
--- a/test-suite/success/CanonicalStructure.v
+++ b/test-suite/success/CanonicalStructure.v
@@ -5,3 +5,10 @@ Structure foo : Type := Foo {
 }.
 
 Canonical Structure unopt_nat := @Foo nat (fun _ => O).
+
+(* Granted wish #1187 *)
+
+Record Silly (X : Set) : Set := mkSilly { x : X }.
+Definition anotherMk := mkSilly.
+Definition struct := anotherMk nat 3.
+Canonical Structure struct.
diff --git a/test-suite/success/Case13.v b/test-suite/success/Case13.v
index f19e24b8..f14725a8 100644
--- a/test-suite/success/Case13.v
+++ b/test-suite/success/Case13.v
@@ -67,3 +67,15 @@ Check (fun x => match x with
                 | D _ => 1
                 end).
 
+(* Check coercions against the type of the term to match *)
+(* Used to fail in V8.1beta *)
+
+Inductive C : Set := c : C.
+Inductive E : Set := e :> C -> E.
+Check fun (x : E) => match x with c => e c end.
+
+(* Check coercions with uniform parameters (cf bug #1168) *)
+
+Inductive C' : bool -> Set := c' : C' true.
+Inductive E' (b : bool) : Set := e' :> C' b -> E' b.
+Check fun (x : E' true) => match x with c' => e' true c' end.
diff --git a/test-suite/success/Field.v b/test-suite/success/Field.v
index 9f4ec79a..b4c06c7b 100644
--- a/test-suite/success/Field.v
+++ b/test-suite/success/Field.v
@@ -6,62 +6,75 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Field.v 7693 2005-12-21 23:50:17Z herbelin $ *)
+(* $Id: Field.v 9197 2006-10-02 15:55:52Z barras $ *)
 
 (**** Tests of Field with real numbers ****)
 
-Require Import Reals.
+Require Import Reals RealField.
+Open Scope R_scope.
 
 (* Example 1 *)
 Goal
 forall eps : R,
-(eps * (1 / (2 + 2)) + eps * (1 / (2 + 2)))%R = (eps * (1 / 2))%R.
+eps * (1 / (2 + 2)) + eps * (1 / (2 + 2)) = eps * (1 / 2).
 Proof.
   intros.
    field.
-Abort.
+Qed.
 
 (* Example 2 *)
 Goal
 forall (f g : R -> R) (x0 x1 : R),
-((f x1 - f x0) * (1 / (x1 - x0)) + (g x1 - g x0) * (1 / (x1 - x0)))%R =
-((f x1 + g x1 - (f x0 + g x0)) * (1 / (x1 - x0)))%R.
+(f x1 - f x0) * (1 / (x1 - x0)) + (g x1 - g x0) * (1 / (x1 - x0)) =
+(f x1 + g x1 - (f x0 + g x0)) * (1 / (x1 - x0)).
 Proof.
   intros.
    field.
 Abort.
  
 (* Example 3 *)
-Goal forall a b : R, (1 / (a * b) * (1 / 1 / b))%R = (1 / a)%R.
+Goal forall a b : R, 1 / (a * b) * (1 / (1 / b)) = 1 / a.
 Proof.
   intros.
    field.
 Abort.
+
+Goal forall a b : R, 1 / (a * b) * (1 / 1 / b) = 1 / a.
+Proof.
+  intros.
+   field_simplify_eq.
+Abort.
  
+Goal forall a b : R, 1 / (a * b) * (1 / 1 / b) = 1 / a.
+Proof.
+  intros.
+   field_simplify (1 / (a * b) * (1 / 1 / b)).
+Abort.
+
 (* Example 4 *)
 Goal
-forall a b : R, a <> 0%R -> b <> 0%R -> (1 / (a * b) / 1 / b)%R = (1 / a)%R.
+forall a b : R, a <> 0 -> b <> 0 -> 1 / (a * b) / (1 / b) = 1 / a.
 Proof.
   intros.
-   field.
-Abort.
+   field; auto.
+Qed.
  
 (* Example 5 *)
-Goal forall a : R, 1%R = (1 * (1 / a) * a)%R.
+Goal forall a : R, 1 = 1 * (1 / a) * a.
 Proof.
   intros.
    field.
 Abort.
  
 (* Example 6 *)
-Goal forall a b : R, b = (b * / a * a)%R.
+Goal forall a b : R, b = b * / a * a.
 Proof.
   intros.
    field.
 Abort.
  
 (* Example 7 *)
-Goal forall a b : R, b = (b * (1 / a) * a)%R.
+Goal forall a b : R, b = b * (1 / a) * a.
 Proof.
   intros.
    field.
@@ -70,8 +83,8 @@ Abort.
 (* Example 8 *)
 Goal
 forall x y : R,
-(x * (1 / x + x / (x + y)))%R =
-(- (1 / y) * y * (- (x * (x / (x + y))) - 1))%R.
+x * (1 / x + x / (x + y)) =
+- (1 / y) * y * (- (x * (x / (x + y))) - 1).
 Proof.
   intros.
    field.
diff --git a/test-suite/success/Injection.v b/test-suite/success/Injection.v
index f8f7c996..606e884a 100644
--- a/test-suite/success/Injection.v
+++ b/test-suite/success/Injection.v
@@ -36,3 +36,29 @@ intros.
 exact (fun H => H).
 Qed.
 
+(* Test injection as *)
+
+Lemma l5 : forall x y z t : nat, (x,y) = (z,t) -> x=z.
+intros; injection H as Hyt Hxz.
+exact Hxz.
+Qed.
+
+(* Injection does not projects at positions in Prop... allow it?
+
+Inductive t (A:Prop) : Set := c : A -> t A.
+Goal forall p q : True\/True, c _ p = c _ q -> False.
+intros.
+injection H.
+Abort.
+
+*)
+
+(* Accept does not project on discriminable positions... allow it?
+
+Goal 1=2 -> 1=0.
+intro H.
+injection H.
+intro; assumption.
+Qed.
+
+ *)
diff --git a/test-suite/success/LegacyField.v b/test-suite/success/LegacyField.v
new file mode 100644
index 00000000..d53e4010
--- /dev/null
+++ b/test-suite/success/LegacyField.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        *)
+(************************************************************************)
+
+(* $Id: Field.v 7693 2005-12-21 23:50:17Z herbelin $ *)
+
+(**** Tests of Field with real numbers ****)
+
+Require Import Reals LegacyRfield.
+
+(* Example 1 *)
+Goal
+forall eps : R,
+(eps * (1 / (2 + 2)) + eps * (1 / (2 + 2)))%R = (eps * (1 / 2))%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+
+(* Example 2 *)
+Goal
+forall (f g : R -> R) (x0 x1 : R),
+((f x1 - f x0) * (1 / (x1 - x0)) + (g x1 - g x0) * (1 / (x1 - x0)))%R =
+((f x1 + g x1 - (f x0 + g x0)) * (1 / (x1 - x0)))%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+ 
+(* Example 3 *)
+Goal forall a b : R, (1 / (a * b) * (1 / 1 / b))%R = (1 / a)%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+ 
+(* Example 4 *)
+Goal
+forall a b : R, a <> 0%R -> b <> 0%R -> (1 / (a * b) / 1 / b)%R = (1 / a)%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+ 
+(* Example 5 *)
+Goal forall a : R, 1%R = (1 * (1 / a) * a)%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+ 
+(* Example 6 *)
+Goal forall a b : R, b = (b * / a * a)%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+ 
+(* Example 7 *)
+Goal forall a b : R, b = (b * (1 / a) * a)%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
+
+(* Example 8 *)
+Goal
+forall x y : R,
+(x * (1 / x + x / (x + y)))%R =
+(- (1 / y) * y * (- (x * (x / (x + y))) - 1))%R.
+Proof.
+  intros.
+   legacy field.
+Abort.
diff --git a/test-suite/success/NatRing.v b/test-suite/success/NatRing.v
index 8426c7e4..22d021d5 100644
--- a/test-suite/success/NatRing.v
+++ b/test-suite/success/NatRing.v
@@ -1,10 +1,10 @@
 Require Import ArithRing.
 
 Lemma l1 : 2 = 1 + 1.
-ring_nat.
+ring.
 Qed.
 
 Lemma l2 : forall x : nat, S (S x) = 1 + S x.
 intro.
-ring_nat.
+ring.
 Qed.
diff --git a/test-suite/success/apply.v b/test-suite/success/apply.v
new file mode 100644
index 00000000..4f260696
--- /dev/null
+++ b/test-suite/success/apply.v
@@ -0,0 +1,14 @@
+(* Test apply in *)
+
+Goal (forall x y, x = S y -> y=y) -> 2 = 4 -> 3=3.
+intros H H0.
+apply H in H0.
+assumption.
+Qed.
+
+Require Import ZArith.
+Open Scope Z_scope.
+Goal forall x y z, ~ z <= 0 -> x * z < y * z -> x <= y.
+intros; apply Znot_le_gt, Zgt_lt in H.
+apply Zmult_lt_reg_r, Zlt_le_weak in H0; auto.
+Qed.
diff --git a/test-suite/success/autorewritein.v b/test-suite/success/autorewritein.v
index 8126e9e4..68f2f7ce 100644
--- a/test-suite/success/autorewritein.v
+++ b/test-suite/success/autorewritein.v
@@ -12,9 +12,12 @@ Proof.
   autorewrite with base0 in H using try (apply H; reflexivity).
 Qed.
 
-Lemma ResAck1 : forall H:(Ack 2 2 = 7 -> False), H=H -> False.
+Lemma ResAck1 : forall H:(Ack 2 2 = 7 -> False), True -> False.
 Proof.
   intros.
-  autorewrite with base0 in H using try (apply H1; reflexivity).
+  autorewrite with base0 in *.
+    apply H;reflexivity.
 Qed.
 
+
+
diff --git a/test-suite/success/coercions.v b/test-suite/success/coercions.v
index 8dd48752..d652132e 100644
--- a/test-suite/success/coercions.v
+++ b/test-suite/success/coercions.v
@@ -22,7 +22,7 @@ Coercion i : h >-> nat.
 Parameter C : nat -> nat -> nat.
 Coercion C : nat >-> Funclass.
 
-(* Remark: in the following example, it cannot be decide whether C is
+(* Remark: in the following example, it cannot be decided whether C is
    from nat to Funclass or from A to nat. An explicit Coercion command is
    expected 
 
@@ -30,3 +30,34 @@ Parameter A : nat -> Prop.
 Parameter C:> forall n:nat, A n -> nat.
 *)
 
+(* Check coercion between products based on eta-expansion *)
+(* (there was a de Bruijn bug until rev 9254) *)
+
+Section P.
+
+Variable E : Set.
+Variables C D : E -> Prop.
+Variable G :> forall x, C x -> D x.
+
+Check fun (H : forall y:E, y = y -> C y) => (H : forall y:E, y = y -> D y).
+
+End P.
+
+(* Check that class arguments are computed the same when looking for a
+   coercion and when applying it (class_args_of) (failed until rev 9255) *)
+
+Section Q.
+
+Variable bool : Set.
+Variables C D : bool -> Prop.
+Variable G :> forall x, C x -> D x.
+Variable f : nat -> bool.
+
+Definition For_all (P : nat -> Prop) := forall x, P x.
+
+Check fun (H : For_all (fun x => C (f x))) => H : forall x, D (f x).
+Check fun (H : For_all (fun x => C (f x))) x => H x : D (f x).
+Check fun (H : For_all (fun x => C (f x))) => H : For_all (fun x => D (f x)).
+
+End Q.
+
diff --git a/test-suite/success/evars.v b/test-suite/success/evars.v
index baeec147..ad69ced1 100644
--- a/test-suite/success/evars.v
+++ b/test-suite/success/evars.v
@@ -68,3 +68,9 @@ Proof. trivial. Qed.
 Hint Resolve contradiction.
 Goal False.
 eauto.
+
+(* This used to fail in V8.1beta because first-order unification was
+   used before using type information *)
+
+Check (exist _ O (refl_equal 0) : {n:nat|n=0}).
+Check (exist _ O I : {n:nat|True}).
diff --git a/test-suite/success/implicit.v b/test-suite/success/implicit.v
index 1786424e..47c58f04 100644
--- a/test-suite/success/implicit.v
+++ b/test-suite/success/implicit.v
@@ -29,6 +29,10 @@ Check (fun x => fst (f x)).
 Check (fun x => fst (f x)).
 Notation rhs := snd.
 Check (fun x => snd (f x)).
-(* V8 seulement 
-Check (fun x => @ rhs ? ? (f x)).
-*)
+Check (fun x => @ rhs _ _ (f x)).
+
+(* Implicit arguments in fixpoints and inductive declarations *)
+
+Fixpoint g n := match n with O => true | S n => g n end.
+
+Inductive P n : nat -> Prop := c : P n n.
diff --git a/test-suite/success/ltac.v b/test-suite/success/ltac.v
index 99cfe017..3f25f703 100644
--- a/test-suite/success/ltac.v
+++ b/test-suite/success/ltac.v
@@ -153,3 +153,25 @@ Ltac afi tac := intros; tac.
 Goal 1 = 2.
 afi ltac:auto.
 
+(* Tactic Notation avec listes *)
+
+Tactic Notation "pat" hyp(id) "occs" integer_list(l) := pattern id at l.
+
+Goal forall x, x=0 -> x=x.
+intro x.
+pat x occs 1 3.
+Abort.
+
+Tactic Notation "revert" ne_hyp_list(l) := generalize l; clear l.
+
+Goal forall a b c, a=0 -> b=c+a.
+intros.
+revert a b c H.
+Abort.
+
+(* Used to fail until revision 9280 because of a parasitic App node with
+   empty args *)
+
+Goal True.
+match None with @None => exact I end.
+Abort.
diff --git a/test-suite/success/polymorphism.v b/test-suite/success/polymorphism.v
new file mode 100644
index 00000000..5a008f18
--- /dev/null
+++ b/test-suite/success/polymorphism.v
@@ -0,0 +1,12 @@
+(* Some tests of sort-polymorphisme *)
+Section S.
+Variable A:Type.
+(*
+Definition f (B:Type) := (A * B)%type.
+*)
+Inductive I (B:Type) : Type := prod : A->B->I B.
+End S.
+(*
+Check f nat nat : Set.
+*)
+Check I nat nat : Set.
diff --git a/test-suite/success/replace.v b/test-suite/success/replace.v
new file mode 100644
index 00000000..94b75c7f
--- /dev/null
+++ b/test-suite/success/replace.v
@@ -0,0 +1,24 @@
+Goal forall x, x = 0 -> S x = 7 -> x = 22 .
+Proof.
+replace 0 with 33.
+Undo.
+intros x H H0.
+replace x with 0.
+Undo.
+replace x with 0 in  |- *. 
+Undo.
+replace x with 1 in *.
+Undo.
+replace x with 0 in *|- *.
+Undo.
+replace x with 0 in *|-.
+Undo.
+replace x with 0 in H0 .
+Undo.
+replace x with 0 in H0 |- * .
+Undo.
+
+replace x with 0 in H,H0 |- * .
+Undo.
+Admitted.
+
diff --git a/test-suite/success/setoid_ring_module.v b/test-suite/success/setoid_ring_module.v
new file mode 100644
index 00000000..e947c6d9
--- /dev/null
+++ b/test-suite/success/setoid_ring_module.v
@@ -0,0 +1,40 @@
+Require Import Setoid Ring Ring_theory.
+
+Module abs_ring.
+
+Parameters (Coef:Set)(c0 c1 : Coef)
+(cadd cmul csub: Coef -> Coef -> Coef)
+(copp : Coef -> Coef)
+(ceq : Coef -> Coef -> Prop)
+(ceq_sym : forall x y, ceq x y -> ceq y x)
+(ceq_trans : forall x y z, ceq x y -> ceq y z -> ceq x z)
+(ceq_refl : forall x, ceq x x).
+
+
+Add Relation Coef ceq 
+  reflexivity proved by ceq_refl symmetry proved by ceq_sym
+  transitivity proved by ceq_trans
+  as ceq_relation.
+  
+Add Morphism cadd with signature ceq ==> ceq ==> ceq as cadd_Morphism.
+Admitted.
+
+Add Morphism cmul with signature ceq ==> ceq ==> ceq as cmul_Morphism.
+Admitted.
+
+Add Morphism copp with signature ceq ==> ceq as copp_Morphism.
+Admitted.
+
+Definition cRth : ring_theory c0 c1 cadd cmul csub copp ceq.
+Admitted.
+
+Add Ring CoefRing : cRth.
+
+End abs_ring.
+Import abs_ring.
+
+Theorem check_setoid_ring_modules :
+  forall a b, ceq (cadd a b) (cadd b a).
+intros.
+ring.
+Qed.
diff --git a/test-suite/success/unification.v b/test-suite/success/unification.v
new file mode 100644
index 00000000..68869621
--- /dev/null
+++ b/test-suite/success/unification.v
@@ -0,0 +1,65 @@
+(* Test patterns unification *)
+
+Lemma l1 : (forall P, (exists x:nat, P x) -> False) 
+         -> forall P, (exists x:nat, P x /\ P x) -> False.
+Proof.
+intros; apply (H _ H0).
+Qed.
+
+Lemma l2 :  forall A:Set, forall Q:A->Set,
+           (forall (P: forall x:A, Q x -> Prop), 
+                   (exists x:A, exists y:Q x, P x y) -> False) 
+         -> forall (P: forall x:A, Q x -> Prop), 
+                   (exists x:A, exists y:Q x, P x y /\ P x y) -> False.
+Proof.
+intros; apply (H _ H0).
+Qed.
+
+
+(* Example submitted for Zenon *)
+
+Axiom zenon_noteq : forall T : Type, forall t : T, ((t <> t) -> False).
+Axiom zenon_notall : forall T : Type, forall P : T -> Prop,
+  (forall z : T, (~(P z) -> False)) -> (~(forall x : T, (P x)) -> False).
+
+  (* Must infer "P := fun x => x=x" in zenon_notall *)
+Check (fun _h1 => (zenon_notall nat _ (fun _T_0 =>
+          (fun _h2 => (zenon_noteq _ _T_0 _h2))) _h1)).
+
+
+(* Core of an example submitted by Ralph Matthes (#849)
+
+   It used to fail because of the K-variable x in the type of "sum_rec ..."
+   which was not in the scope of the evar ?B. Solved by a head
+   beta-reduction of the type "(fun _ : unit + unit => L unit) x" of
+   "sum_rec ...". Shall we used more reduction when solving evars (in
+   real_clean)?? Is there a risk of starting too long reductions?
+
+   Note that the example originally came from a non re-typable
+   pretty-printed term (the checked term is actually re-printed the
+   same form it is checked).  
+*)
+
+Set Implicit Arguments.
+Inductive L (A:Set) : Set := c : A -> L A.
+Parameter f: forall (A:Set)(B:Set), (A->B) -> L A -> L B.
+Parameter t: L (unit + unit).
+
+Check (f (fun x : unit + unit =>
+  sum_rec (fun _ : unit + unit => L unit)
+    (fun y => c y) (fun y => c y) x) t).
+
+
+(* Test patterns unification in apply *)
+
+Require Import Arith.
+Parameter x y : nat.
+Parameter G:x=y->x=y->Prop.
+Parameter K:x<>y->x<>y->Prop.
+Lemma l3 : (forall f:x=y->Prop, forall g:x<>y->Prop,
+            match eq_nat_dec x y with left a => f a | right a => g a end)
+   -> match eq_nat_dec x y with left a => G a a | right a => K a a end.
+Proof.
+intros.
+apply H.
+Qed.
diff --git a/theories/Arith/Arith.v b/theories/Arith/Arith.v
index 59d9b2b1..be065f1d 100644
--- a/theories/Arith/Arith.v
+++ b/theories/Arith/Arith.v
@@ -6,15 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Arith.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Arith.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
-Require Export Le.
-Require Export Lt.
-Require Export Plus.
-Require Export Gt.
-Require Export Minus.
-Require Export Mult.
-Require Export Between.
-Require Export Peano_dec.
-Require Export Compare_dec.
-Require Export Factorial.
+Require Export Arith_base.
+Require Export ArithRing.
diff --git a/theories/Arith/Arith_base.v b/theories/Arith/Arith_base.v
new file mode 100644
index 00000000..b076de2a
--- /dev/null
+++ b/theories/Arith/Arith_base.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$ i*)
+
+Require Export Le.
+Require Export Lt.
+Require Export Plus.
+Require Export Gt.
+Require Export Minus.
+Require Export Mult.
+Require Export Between.
+Require Export Peano_dec.
+Require Export Compare_dec.
+Require Export Factorial.
diff --git a/theories/Arith/Between.v b/theories/Arith/Between.v
index 7680997d..2e9472c4 100644
--- a/theories/Arith/Between.v
+++ b/theories/Arith/Between.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Between.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Between.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Le.
 Require Import Lt.
@@ -16,174 +16,174 @@ Open Local Scope nat_scope.
 Implicit Types k l p q r : nat.
 
 Section Between.
-Variables P Q : nat -> Prop.
-
-Inductive between k : nat -> Prop :=
-  | bet_emp : between k k
-  | bet_S : forall l, between k l -> P l -> between k (S l).
-
-Hint Constructors between: arith v62.
-
-Lemma bet_eq : forall k l, l = k -> between k l.
-Proof.
-induction 1; auto with arith.
-Qed.
-
-Hint Resolve bet_eq: arith v62.
-
-Lemma between_le : forall k l, between k l -> k <= l.
-Proof.
-induction 1; auto with arith.
-Qed.
-Hint Immediate between_le: arith v62.
-
-Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l.
-Proof.
-induction 1.
-intros; absurd (S k <= k); auto with arith.
-destruct H; auto with arith.
-Qed.
-Hint Resolve between_Sk_l: arith v62.
-
-Lemma between_restr :
- forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m.
-Proof.
-induction 1; auto with arith.
-Qed.
-
-Inductive exists_between k : nat -> Prop :=
-  | exists_S : forall l, exists_between k l -> exists_between k (S l)
-  | exists_le : forall l, k <= l -> Q l -> exists_between k (S l).
-
-Hint Constructors exists_between: arith v62.
-
-Lemma exists_le_S : forall k l, exists_between k l -> S k <= l.
-Proof.
-induction 1; auto with arith.
-Qed.
-
-Lemma exists_lt : forall k l, exists_between k l -> k < l.
-Proof exists_le_S.
-Hint Immediate exists_le_S exists_lt: arith v62.
-
-Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l.
-Proof.
-intros; apply le_S_n; auto with arith.
-Qed.
-Hint Immediate exists_S_le: arith v62.
-
-Definition in_int p q r := p <= r /\ r < q.
-
-Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r.
-Proof.
-red in |- *; auto with arith.
-Qed.
-Hint Resolve in_int_intro: arith v62.
-
-Lemma in_int_lt : forall p q r, in_int p q r -> p < q.
-Proof.
-induction 1; intros.
-apply le_lt_trans with r; auto with arith.
-Qed.
-
-Lemma in_int_p_Sq :
- forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat.
-Proof.
-induction 1; intros.
-elim (le_lt_or_eq r q); auto with arith.
-Qed.
-
-Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r.
-Proof.
-induction 1; auto with arith.
-Qed.
-Hint Resolve in_int_S: arith v62.
-
-Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r.
-Proof.
-induction 1; auto with arith.
-Qed.
-Hint Immediate in_int_Sp_q: arith v62.
-
-Lemma between_in_int :
- forall k l, between k l -> forall r, in_int k l r -> P r.
-Proof.
-induction 1; intros.
-absurd (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 :
- forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l.
-Proof.
-induction 1; auto with arith.
-Qed.
-
-Lemma exists_in_int :
- forall k l, exists_between k l ->  exists2 m : nat, in_int k l m & Q m.
-Proof.
-induction 1.
-case IHexists_between; intros p inp Qp; exists p; auto with arith.
-exists l; auto with arith.
-Qed.
-
-Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l.
-Proof.
-destruct 1; intros.
-elim H0; auto with arith.
-Qed.
-
-Lemma between_or_exists :
- forall k l,
-   k <= l ->
-   (forall n:nat, in_int k l n -> P n \/ Q n) ->
-   between k l \/ exists_between k l.
-Proof.
-induction 1; intros; auto with arith.
-elim IHle; intro; auto with arith.
-elim (H0 m); auto with arith.
-Qed.
-
-Lemma between_not_exists :
- forall k l,
-   between k l ->
-   (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l.
-Proof.
-induction 1; red in |- *; intros.
-absurd (k < k); auto with arith.
-absurd (Q l); auto with arith.
-elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'.
-replace l with l'; auto with arith.
-elim inl'; intros.
-elim (le_lt_or_eq l' l); auto with arith; intros.
-absurd (exists_between 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 0
-  | nth_S :
+  Variables P Q : nat -> Prop.
+  
+  Inductive between k : nat -> Prop :=
+    | bet_emp : between k k
+    | bet_S : forall l, between k l -> P l -> between k (S l).
+  
+  Hint Constructors between: arith v62.
+
+  Lemma bet_eq : forall k l, l = k -> between k l.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+
+  Hint Resolve bet_eq: arith v62.
+
+  Lemma between_le : forall k l, between k l -> k <= l.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+  Hint Immediate between_le: arith v62.
+
+  Lemma between_Sk_l : forall k l, between k l -> S k <= l -> between (S k) l.
+  Proof.
+    intros k l H; induction H as [|l H].
+    intros; absurd (S k <= k); auto with arith.
+    destruct H; auto with arith.
+  Qed.
+  Hint Resolve between_Sk_l: arith v62.
+
+  Lemma between_restr :
+    forall k l (m:nat), k <= l -> l <= m -> between k m -> between l m.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+
+  Inductive exists_between k : nat -> Prop :=
+    | exists_S : forall l, exists_between k l -> exists_between k (S l)
+    | exists_le : forall l, k <= l -> Q l -> exists_between k (S l).
+
+  Hint Constructors exists_between: arith v62.
+
+  Lemma exists_le_S : forall k l, exists_between k l -> S k <= l.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+
+  Lemma exists_lt : forall k l, exists_between k l -> k < l.
+  Proof exists_le_S.
+  Hint Immediate exists_le_S exists_lt: arith v62.
+
+  Lemma exists_S_le : forall k l, exists_between k (S l) -> k <= l.
+  Proof.
+    intros; apply le_S_n; auto with arith.
+  Qed.
+  Hint Immediate exists_S_le: arith v62.
+
+  Definition in_int p q r := p <= r /\ r < q.
+
+  Lemma in_int_intro : forall p q r, p <= r -> r < q -> in_int p q r.
+  Proof.
+    red in |- *; auto with arith.
+  Qed.
+  Hint Resolve in_int_intro: arith v62.
+
+  Lemma in_int_lt : forall p q r, in_int p q r -> p < q.
+  Proof.
+    induction 1; intros.
+    apply le_lt_trans with r; auto with arith.
+  Qed.
+
+  Lemma in_int_p_Sq :
+    forall p q r, in_int p (S q) r -> in_int p q r \/ r = q :>nat.
+  Proof.
+    induction 1; intros.
+    elim (le_lt_or_eq r q); auto with arith.
+  Qed.
+
+  Lemma in_int_S : forall p q r, in_int p q r -> in_int p (S q) r.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+  Hint Resolve in_int_S: arith v62.
+
+  Lemma in_int_Sp_q : forall p q r, in_int (S p) q r -> in_int p q r.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+  Hint Immediate in_int_Sp_q: arith v62.
+
+  Lemma between_in_int :
+    forall k l, between k l -> forall r, in_int k l r -> P r.
+  Proof.
+    induction 1; intros.
+    absurd (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 :
+    forall k l, k <= l -> (forall r, in_int k l r -> P r) -> between k l.
+  Proof.
+    induction 1; auto with arith.
+  Qed.
+
+  Lemma exists_in_int :
+    forall k l, exists_between k l ->  exists2 m : nat, in_int k l m & Q m.
+  Proof.
+    induction 1.
+    case IHexists_between; intros p inp Qp; exists p; auto with arith.
+    exists l; auto with arith.
+  Qed.
+
+  Lemma in_int_exists : forall k l r, in_int k l r -> Q r -> exists_between k l.
+  Proof.
+    destruct 1; intros.
+    elim H0; auto with arith.
+  Qed.
+
+  Lemma between_or_exists :
+    forall k l,
+      k <= l ->
+      (forall n:nat, in_int k l n -> P n \/ Q n) ->
+      between k l \/ exists_between k l.
+  Proof.
+    induction 1; intros; auto with arith.
+    elim IHle; intro; auto with arith.
+    elim (H0 m); auto with arith.
+  Qed.
+
+  Lemma between_not_exists :
+    forall k l,
+      between k l ->
+      (forall n:nat, in_int k l n -> P n -> ~ Q n) -> ~ exists_between k l.
+  Proof.
+    induction 1; red in |- *; intros.
+    absurd (k < k); auto with arith.
+    absurd (Q l); auto with arith.
+    elim (exists_in_int k (S l)); auto with arith; intros l' inl' Ql'.
+    replace l with l'; auto with arith.
+    elim inl'; intros.
+    elim (le_lt_or_eq l' l); auto with arith; intros.
+    absurd (exists_between 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 0
+    | nth_S :
       forall k l (n:nat),
-        P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n).
+	P_nth init k n -> between (S k) l -> Q l -> P_nth init l (S n).
 
-Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l.
-Proof.
-induction 1; intros; auto with arith.
-apply le_trans with (S k); auto with arith.
-Qed.
+  Lemma nth_le : forall (init:nat) l (n:nat), P_nth init l n -> init <= l.
+  Proof.
+    induction 1; intros; auto with arith.
+    apply le_trans with (S k); auto with arith.
+  Qed.
 
-Definition eventually (n:nat) :=  exists2 k : nat, k <= n & Q k.
+  Definition eventually (n:nat) :=  exists2 k : nat, k <= n & Q k.
 
-Lemma event_O : eventually 0 -> Q 0.
-Proof.
-induction 1; intros.
-replace 0 with x; auto with arith.
-Qed.
+  Lemma event_O : eventually 0 -> Q 0.
+  Proof.
+    induction 1; intros.
+    replace 0 with x; auto with arith.
+  Qed.
 
 End Between.
 
 Hint Resolve nth_O bet_S bet_emp bet_eq between_Sk_l exists_S exists_le
   in_int_S in_int_intro: arith v62. 
-Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62.
\ No newline at end of file
+Hint Immediate in_int_Sp_q exists_le_S exists_S_le: arith v62.
diff --git a/theories/Arith/Compare.v b/theories/Arith/Compare.v
index b11f0517..06898658 100644
--- a/theories/Arith/Compare.v
+++ b/theories/Arith/Compare.v
@@ -6,21 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Compare.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Compare.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Equality is decidable on [nat] *)
+
 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 Types m n p q : nat.
 
-Require Import Arith.
+Require Import Arith_base.
 Require Import Peano_dec.
 Require Import Compare_dec.
 
@@ -41,17 +37,17 @@ Proof le_lt_or_eq.
 
 (* By special request of G. Kahn - Used in Group Theory *)
 Lemma discrete_nat :
- forall n m, n < m -> S n = m \/ (exists r : nat, m = S (S (n + r))).
+  forall n m, n < m -> S n = m \/ (exists r : nat, m = S (S (n + 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.
-induction 1; auto with arith.
-right; exists (n - S (S m)); simpl in |- *.
-rewrite (plus_comm m (n - S (S m))).
-rewrite (plus_n_Sm (n - S (S m)) m).
-rewrite (plus_n_Sm (n - S (S m)) (S m)).
-rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith.
+  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.
+  induction 1; auto with arith.
+  right; exists (n - S (S m)); simpl in |- *.
+  rewrite (plus_comm m (n - S (S m))).
+  rewrite (plus_n_Sm (n - S (S m)) m).
+  rewrite (plus_n_Sm (n - S (S m)) (S m)).
+  rewrite (plus_comm (n - S (S m)) (S (S m))); auto with arith.
 Qed.
 
 Require Export Wf_nat.
diff --git a/theories/Arith/Compare_dec.v b/theories/Arith/Compare_dec.v
index d2eead86..e6dc7c46 100644
--- a/theories/Arith/Compare_dec.v
+++ b/theories/Arith/Compare_dec.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Compare_dec.v 8733 2006-04-25 22:52:18Z letouzey $ i*)
+(*i $Id: Compare_dec.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Le.
 Require Import Lt.
@@ -17,109 +17,113 @@ Open Local Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
-Definition zerop : forall n, {n = 0} + {0 < n}.
-destruct n; auto with arith.
+Definition zerop n : {n = 0} + {0 < n}.
+  destruct n; auto with arith.
 Defined.
 
-Definition lt_eq_lt_dec : forall n m, {n < m} + {n = m} + {m < n}.
-Proof.
-induction n; simple destruct m; auto with arith.
-intros m0; elim (IHn m0); auto with arith.
-induction 1; auto with arith.
+Definition lt_eq_lt_dec n m : {n < m} + {n = m} + {m < n}.
+  induction n; simple destruct m; auto with arith.
+  intros m0; elim (IHn m0); auto with arith.
+  induction 1; auto with arith.
 Defined.
 
-Lemma gt_eq_gt_dec : forall n m, {m > n} + {n = m} + {n > m}.
-Proof lt_eq_lt_dec.
+Definition gt_eq_gt_dec n m : {m > n} + {n = m} + {n > m}.
+  exact lt_eq_lt_dec.
+Defined.
 
-Lemma le_lt_dec : forall n m, {n <= m} + {m < n}.
-Proof.
-induction n.
-auto with arith.
-induction m.
-auto with arith.
-elim (IHn m); auto with arith.
+Definition le_lt_dec n m : {n <= m} + {m < n}.
+  induction n.
+  auto with arith.
+  induction m.
+  auto with arith.
+  elim (IHn m); auto with arith.
 Defined.
 
-Definition le_le_S_dec : forall n m, {n <= m} + {S m <= n}.
-Proof.
-exact le_lt_dec.
+Definition le_le_S_dec n m : {n <= m} + {S m <= n}.
+  exact le_lt_dec.
 Defined.
 
-Definition le_ge_dec : forall n m, {n <= m} + {n >= m}.
-Proof.
-intros; elim (le_lt_dec n m); auto with arith.
+Definition le_ge_dec n m : {n <= m} + {n >= m}.
+  intros; elim (le_lt_dec n m); auto with arith.
 Defined.
 
-Definition le_gt_dec : forall n m, {n <= m} + {n > m}.
-Proof.
-exact le_lt_dec.
+Definition le_gt_dec n m : {n <= m} + {n > m}.
+  exact le_lt_dec.
 Defined.
 
-Definition le_lt_eq_dec : forall n m, n <= m -> {n < m} + {n = m}.
-Proof.
-intros; elim (lt_eq_lt_dec n m); auto with arith.
-intros; absurd (m < n); auto with arith.
+Definition le_lt_eq_dec n m : n <= m -> {n < m} + {n = m}.
+  intros; elim (lt_eq_lt_dec n m); auto with arith.
+  intros; absurd (m < n); auto with arith.
 Defined.
 
 (** Proofs of decidability *)
 
 Theorem dec_le : forall n m, decidable (n <= m).
-intros x y; unfold decidable in |- *; elim (le_gt_dec x y);
- [ auto with arith | intro; right; apply gt_not_le; assumption ].
+Proof.
+  intros x y; unfold decidable in |- *; elim (le_gt_dec x y);
+    [ auto with arith | intro; right; apply gt_not_le; assumption ].
 Qed.
 
 Theorem dec_lt : forall n m, decidable (n < m).
-intros x y; unfold lt in |- *; apply dec_le.
+Proof.
+  intros x y; unfold lt in |- *; apply dec_le.
 Qed.
 
 Theorem dec_gt : forall n m, decidable (n > m).
-intros x y; unfold gt in |- *; apply dec_lt.
+Proof.
+  intros x y; unfold gt in |- *; apply dec_lt.
 Qed.
 
 Theorem dec_ge : forall n m, decidable (n >= m).
-intros x y; unfold ge in |- *; apply dec_le.
+Proof.
+  intros x y; unfold ge in |- *; apply dec_le.
 Qed.
 
 Theorem not_eq : forall n m, n <> m -> n < m \/ m < n.
-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 ].
+Proof.
+  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 : forall n m, ~ n <= m -> n > m.
-intros x y H; elim (le_gt_dec x y);
- [ intros H1; absurd (x <= y); assumption | trivial with arith ].
+Proof.
+  intros x y H; elim (le_gt_dec x y);
+    [ intros H1; absurd (x <= y); assumption | trivial with arith ].
 Qed.
 
 Theorem not_gt : forall n m, ~ n > m -> n <= m.
-intros x y H; elim (le_gt_dec x y);
- [ trivial with arith | intros H1; absurd (x > y); assumption ].
+Proof.
+  intros x y H; elim (le_gt_dec x y);
+    [ trivial with arith | intros H1; absurd (x > y); assumption ].
 Qed.
 
 Theorem not_ge : forall n m, ~ n >= m -> n < m.
-intros x y H; exact (not_le y x H).
+Proof.
+  intros x y H; exact (not_le y x H).
 Qed.
 
 Theorem not_lt : forall n m, ~ n < m -> n >= m.
-intros x y H; exact (not_gt y x H). 
+Proof.
+  intros x y H; exact (not_gt y x H). 
 Qed.
 
 
 (** A ternary comparison function in the spirit of [Zcompare]. *)
 
 Definition nat_compare (n m:nat) :=
- match lt_eq_lt_dec n m with 
-  | inleft (left _) => Lt
-  | inleft (right _) => Eq
-  | inright _ => Gt
- end.
+  match lt_eq_lt_dec n m with 
+    | inleft (left _) => Lt
+    | inleft (right _) => Eq
+    | inright _ => Gt
+  end.
 
 Lemma nat_compare_S : forall n m, nat_compare (S n) (S m) = nat_compare n m.
 Proof.
- unfold nat_compare; intros.
- simpl; destruct (lt_eq_lt_dec n m) as [[H|H]|H]; simpl; auto.
+  unfold nat_compare; intros.
+  simpl; destruct (lt_eq_lt_dec n m) as [[H|H]|H]; simpl; auto.
 Qed.
 
 Lemma nat_compare_eq : forall n m, nat_compare n m = Eq -> n = m.
@@ -188,11 +192,11 @@ Qed.
 
 Fixpoint leb (m:nat) : nat -> bool :=
   match m with
-  | O => fun _:nat => true
-  | S m' =>
+    | O => fun _:nat => true
+    | S m' =>
       fun n:nat => match n with
-                   | O => false
-                   | S n' => leb m' n'
+                     | O => false
+                     | S n' => leb m' n'
                    end
   end.
 
diff --git a/theories/Arith/Div.v b/theories/Arith/Div.v
index 9011cee3..1dec34e2 100644
--- a/theories/Arith/Div.v
+++ b/theories/Arith/Div.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Div.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Div.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Euclidean division *)
 
@@ -20,45 +20,45 @@ 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.
+  [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.
+  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.
+  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/theories/Arith/Div2.v b/theories/Arith/Div2.v
index ca1f39af..c32759b2 100644
--- a/theories/Arith/Div2.v
+++ b/theories/Arith/Div2.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Div2.v 8733 2006-04-25 22:52:18Z letouzey $ i*)
+(*i $Id: Div2.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Lt.
 Require Import Plus.
@@ -30,28 +30,30 @@ Fixpoint div2 n : nat :=
     useful to prove the corresponding induction principle *)
 
 Lemma ind_0_1_SS :
- forall P:nat -> Prop,
-   P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
+  forall P:nat -> Prop,
+    P 0 -> P 1 -> (forall n, P n -> P (S (S n))) -> forall n, P n.
 Proof.
-intros.
-cut (forall n, P n /\ P (S n)).
-intros. elim (H2 n). auto with arith.
-
-induction n0. auto with arith.
-intros. elim IHn0; auto with arith.
+  intros P H0 H1 Hn.
+  cut (forall n, P n /\ P (S n)).
+  intros H'n n. elim (H'n n). auto with arith.
+  
+  induction n. auto with arith.
+  intros. elim IHn; auto with arith.
 Qed.
 
 (** [0 <n  =>  n/2 < n] *)
 
 Lemma lt_div2 : forall n, 0 < n -> div2 n < n.
 Proof.
-intro n. pattern n in |- *. apply ind_0_1_SS.
-intro. inversion H.
-auto with arith.
-intros. simpl in |- *.
-case (zerop n0).
-intro. rewrite e. auto with arith.
-auto with arith.
+  intro n. pattern n in |- *. apply ind_0_1_SS.
+  (* n = 0 *)
+  inversion 1.
+  (* n=1 *)
+  simpl; trivial.
+  (* n=S S n' *)
+  intro n'; case (zerop n').
+    intro n'_eq_0. rewrite n'_eq_0. auto with arith.
+    auto with arith.
 Qed.
 
 Hint Resolve lt_div2: arith.
@@ -59,27 +61,27 @@ Hint Resolve lt_div2: arith.
 (** Properties related to the parity *)
 
 Lemma even_odd_div2 :
- forall n,
-   (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)).
+  forall n,
+    (even n <-> div2 n = div2 (S n)) /\ (odd n <-> S (div2 n) = div2 (S n)).
 Proof.
-intro n. pattern n in |- *. apply ind_0_1_SS.
-(* n  = 0 *)
-split. split; auto with arith. 
-split. intro H. inversion H.
-intro H.  absurd (S (div2 0) = div2 1); auto with arith.
-(* n = 1 *)
-split. split. intro. inversion H. inversion H1.
-intro H.  absurd (div2 1 = div2 2).
-simpl in |- *. 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))) in |- *. auto with arith.
-intro H. inversion H. inversion H1.
-change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith.
+  intro n. pattern n in |- *. apply ind_0_1_SS.
+  (* n  = 0 *)
+  split. split; auto with arith. 
+  split. intro H. inversion H.
+  intro H.  absurd (S (div2 0) = div2 1); auto with arith.
+  (* n = 1 *)
+  split. split. intro. inversion H. inversion H1.
+  intro H.  absurd (div2 1 = div2 2).
+  simpl in |- *. 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))) in |- *. auto with arith.
+  intro H. inversion H. inversion H1.
+  change (S (S (div2 n0)) = S (div2 (S n0))) in |- *. auto with arith.
 Qed.
 
 (** Specializations *)
@@ -106,39 +108,39 @@ Hint Unfold double: arith.
 
 Lemma double_S : forall n, double (S n) = S (S (double n)).
 Proof.
-intro. unfold double in |- *. simpl in |- *. auto with arith.
+  intro. unfold double in |- *. simpl in |- *. auto with arith.
 Qed.
 
 Lemma double_plus : forall n (m:nat), double (n + m) = double n + double m.
 Proof.
-intros m n. unfold double in |- *.
-do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n).
-reflexivity.
+  intros m n. unfold double in |- *.
+  do 2 rewrite plus_assoc_reverse. rewrite (plus_permute n).
+  reflexivity.
 Qed.
 
 Hint Resolve double_S: arith.
 
 Lemma even_odd_double :
- forall n,
-   (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
+  forall n,
+    (even n <-> n = double (div2 n)) /\ (odd n <-> n = S (double (div2 n))).
 Proof.
-intro n. pattern n in |- *. apply ind_0_1_SS.
-(* 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 in |- *. rewrite (double_S (div2 n0)). auto with arith.
-simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
-intro H. inversion H. inversion H1.
-simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
-simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+  intro n. pattern n in |- *. 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 in |- *. rewrite (double_S (div2 n0)). auto with arith.
+  simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
+  intro H. inversion H. inversion H1.
+  simpl in |- *. rewrite (double_S (div2 n0)). auto with arith.
+  simpl in |- *. rewrite (double_S (div2 n0)). intro H. injection H. auto with arith.
 Qed.
 
 
@@ -166,32 +168,32 @@ Hint Resolve even_double double_even odd_double double_odd: arith.
 
 Lemma even_2n : forall n, even n -> {p : nat | n = double p}.
 Proof.
-intros n H. exists (div2 n). auto with arith.
+  intros n H. exists (div2 n). auto with arith.
 Qed.
 
 Lemma odd_S2n : forall n, odd n -> {p : nat | n = S (double p)}.
 Proof.
-intros n H. exists (div2 n). auto with arith.
+  intros n H. exists (div2 n). auto with arith.
 Qed.
 
 (** Doubling before dividing by two brings back to the initial number. *)
 
 Lemma div2_double : forall n:nat, div2 (2*n) = n.
 Proof.
- induction n.
- simpl; auto.
- simpl.
- replace (n+S(n+0)) with (S (2*n)).
- f_equal; auto.
- simpl; auto with arith.
+  induction n.
+  simpl; auto.
+  simpl.
+  replace (n+S(n+0)) with (S (2*n)).
+  f_equal; auto.
+  simpl; auto with arith.
 Qed.
 
 Lemma div2_double_plus_one : forall n:nat, div2 (S (2*n)) = n.
 Proof.
- induction n.
- simpl; auto.
- simpl.
- replace (n+S(n+0)) with (S (2*n)).
- f_equal; auto.
- simpl; auto with arith.
+  induction n.
+  simpl; auto.
+  simpl.
+  replace (n+S(n+0)) with (S (2*n)).
+  f_equal; auto.
+  simpl; auto with arith.
 Qed.
diff --git a/theories/Arith/EqNat.v b/theories/Arith/EqNat.v
index 09df9464..82d05e2c 100644
--- a/theories/Arith/EqNat.v
+++ b/theories/Arith/EqNat.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: EqNat.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: EqNat.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Equality on natural numbers *)
 
@@ -14,52 +14,66 @@ Open Local Scope nat_scope.
 
 Implicit Types m n x y : nat.
 
+(** * Propositional equality  *)
+
 Fixpoint eq_nat n m {struct n} : Prop :=
   match n, m with
-  | O, O => True
-  | O, S _ => False
-  | S _, O => False
-  | S n1, S m1 => eq_nat n1 m1
+    | O, O => True
+    | O, S _ => False
+    | S _, O => False
+    | S n1, S m1 => eq_nat n1 m1
   end.
 
 Theorem eq_nat_refl : forall n, eq_nat n n.
-induction n; simpl in |- *; auto.
+  induction n; simpl in |- *; auto.
 Qed.
 Hint Resolve eq_nat_refl: arith v62.
 
-Theorem eq_eq_nat : forall n m, n = m -> eq_nat n m.
-induction 1; trivial with arith.
+(** [eq] restricted to [nat] and [eq_nat] are equivalent *)
+
+Lemma eq_eq_nat : forall n m, n = m -> eq_nat n m.
+  induction 1; trivial with arith.
 Qed.
 Hint Immediate eq_eq_nat: arith v62.
 
-Theorem eq_nat_eq : forall n m, eq_nat n m -> n = m.
-induction n; induction m; simpl in |- *; contradiction || auto with arith.
+Lemma eq_nat_eq : forall n m, eq_nat n m -> n = m.
+  induction n; induction m; simpl in |- *; contradiction || auto with arith.
 Qed.
 Hint Immediate eq_nat_eq: arith v62.
 
+Theorem eq_nat_is_eq : forall n m, eq_nat n m <-> n = m.
+Proof.
+  split; auto with arith.
+Qed.
+
 Theorem eq_nat_elim :
- forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m.
-intros; replace m with n; auto with arith.
+  forall n (P:nat -> Prop), P n -> forall m, eq_nat n m -> P m.
+Proof.
+  intros; replace m with n; auto with arith.
 Qed.
 
 Theorem eq_nat_decide : forall n m, {eq_nat n m} + {~ eq_nat n m}.
-induction n.
-destruct m as [| n].
-auto with arith.
-intros; right; red in |- *; trivial with arith.
-destruct m as [| n0].
-right; red in |- *; auto with arith.
-intros.
-simpl in |- *.
-apply IHn.
+Proof.
+  induction n.
+  destruct m as [| n].
+  auto with arith.
+  intros; right; red in |- *; trivial with arith.
+  destruct m as [| n0].
+  right; red in |- *; auto with arith.
+  intros.
+  simpl in |- *.
+  apply IHn.
 Defined.
 
+
+(** * Boolean equality on [nat] *)
+
 Fixpoint beq_nat n m {struct n} : bool :=
   match n, m with
-  | O, O => true
-  | O, S _ => false
-  | S _, O => false
-  | S n1, S m1 => beq_nat n1 m1
+    | O, O => true
+    | O, S _ => false
+    | S _, O => false
+    | S n1, S m1 => beq_nat n1 m1
   end.
 
 Lemma beq_nat_refl : forall n, true = beq_nat n n.
@@ -71,7 +85,7 @@ Definition beq_nat_eq : forall x y, true = beq_nat x y -> x = y.
 Proof.
   double induction x y; simpl in |- *.
     reflexivity.
-    intros; discriminate H0.
-    intros; discriminate H0.
-    intros; case (H0 _ H1); reflexivity.
+    intros n H1 H2. discriminate H2.
+    intros n H1 H2. discriminate H2.
+    intros n H1 z H2 H3. case (H2 _ H3). reflexivity.
 Defined.
diff --git a/theories/Arith/Euclid.v b/theories/Arith/Euclid.v
index 23bc7cdb..3d6f1af5 100644
--- a/theories/Arith/Euclid.v
+++ b/theories/Arith/Euclid.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Euclid.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Euclid.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Mult.
 Require Import Compare_dec.
@@ -17,52 +17,55 @@ Open Local Scope nat_scope.
 Implicit Types a b n q r : nat.
 
 Inductive diveucl a b : Set :=
-    divex : forall q r, b > r -> a = q * b + r -> diveucl a b.
+  divex : forall q r, b > r -> a = q * b + r -> diveucl a b.
 
 
 Lemma eucl_dev : forall n, n > 0 -> forall m:nat, diveucl m n.
-intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
-elim (le_gt_dec b n).
-intro lebn.
-elim (H0 (n - b)); auto with arith.
-intros q r g e.
-apply divex with (S q) r; simpl in |- *; auto with arith.
-elim plus_assoc.
-elim e; auto with arith.
-intros gtbn.
-apply divex with 0 n; simpl in |- *; auto with arith.
+Proof.
+  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  elim (le_gt_dec b n).
+  intro lebn.
+  elim (H0 (n - b)); auto with arith.
+  intros q r g e.
+  apply divex with (S q) r; simpl in |- *; auto with arith.
+  elim plus_assoc.
+  elim e; auto with arith.
+  intros gtbn.
+  apply divex with 0 n; simpl in |- *; auto with arith.
 Qed.
 
 Lemma quotient :
- forall n,
-   n > 0 ->
-   forall m:nat, {q : nat |  exists r : nat, m = q * n + r /\ n > r}.
-intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
-elim (le_gt_dec b n).
-intro lebn.
-elim (H0 (n - b)); auto with arith.
-intros q Hq; exists (S q).
-elim Hq; intros r Hr.
-exists r; simpl in |- *; elim Hr; intros.
-elim plus_assoc.
-elim H1; auto with arith.
-intros gtbn.
-exists 0; exists n; simpl in |- *; auto with arith.
+  forall n,
+    n > 0 ->
+    forall m:nat, {q : nat |  exists r : nat, m = q * n + r /\ n > r}.
+Proof.
+  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  elim (le_gt_dec b n).
+  intro lebn.
+  elim (H0 (n - b)); auto with arith.
+  intros q Hq; exists (S q).
+  elim Hq; intros r Hr.
+  exists r; simpl in |- *; elim Hr; intros.
+  elim plus_assoc.
+  elim H1; auto with arith.
+  intros gtbn.
+  exists 0; exists n; simpl in |- *; auto with arith.
 Qed.
 
 Lemma modulo :
- forall n,
-   n > 0 ->
-   forall m:nat, {r : nat |  exists q : nat, m = q * n + r /\ n > r}.
-intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
-elim (le_gt_dec b n).
-intro lebn.
-elim (H0 (n - b)); auto with arith.
-intros r Hr; exists r.
-elim Hr; intros q Hq.
-elim Hq; intros; exists (S q); simpl in |- *.
-elim plus_assoc.
-elim H1; auto with arith.
-intros gtbn.
-exists n; exists 0; simpl in |- *; auto with arith.
-Qed.
\ No newline at end of file
+  forall n,
+    n > 0 ->
+    forall m:nat, {r : nat |  exists q : nat, m = q * n + r /\ n > r}.
+Proof.
+  intros b H a; pattern a in |- *; apply gt_wf_rec; intros n H0.
+  elim (le_gt_dec b n).
+  intro lebn.
+  elim (H0 (n - b)); auto with arith.
+  intros r Hr; exists r.
+  elim Hr; intros q Hq.
+  elim Hq; intros; exists (S q); simpl in |- *.
+  elim plus_assoc.
+  elim H1; auto with arith.
+  intros gtbn.
+  exists n; exists 0; simpl in |- *; auto with arith.
+Qed.
diff --git a/theories/Arith/Even.v b/theories/Arith/Even.v
index cdbc86df..83c0ce17 100644
--- a/theories/Arith/Even.v
+++ b/theories/Arith/Even.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Even.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Even.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Here we define the predicates [even] and [odd] by mutual induction
     and we prove the decidability and the exclusion of those predicates.
@@ -16,6 +16,9 @@ Open Local Scope nat_scope.
 
 Implicit Types m n : nat.
 
+
+(** * Definition of [even] and [odd], and basic facts *) 
+
 Inductive even : nat -> Prop :=
   | even_O : even 0
   | even_S : forall n, odd n -> even (S n)
@@ -27,279 +30,285 @@ Hint Constructors odd: arith.
 
 Lemma even_or_odd : forall n, even n \/ odd n.
 Proof.
-induction n.
-auto with arith.
-elim IHn; auto with arith.
+  induction n.
+    auto with arith.
+    elim IHn; auto with arith.
 Qed.
 
 Lemma even_odd_dec : forall n, {even n} + {odd n}.
 Proof.
-induction n.
-auto with arith.
-elim IHn; auto with arith.
+  induction n.
+    auto with arith.
+    elim IHn; auto with arith.
 Qed.
 
 Lemma not_even_and_odd : forall n, even n -> odd n -> False.
 Proof.
-induction n.
-intros. inversion H0.
-intros. inversion H. inversion H0. auto with arith.
+  induction n.
+    intros even_0 odd_0. inversion odd_0.
+    intros even_Sn odd_Sn. inversion even_Sn. inversion odd_Sn. auto with arith.
 Qed.
 
+
+(** * Facts about [even] & [odd] wrt. [plus] *)
+
 Lemma even_plus_aux :
- forall n m,
-   (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\
-   (even (n + m) <-> even n /\ even m \/ odd n /\ odd m).
+  forall n m,
+    (odd (n + m) <-> odd n /\ even m \/ even n /\ odd m) /\
+    (even (n + m) <-> even n /\ even m \/ odd n /\ odd m).
 Proof.
-intros n; elim n; simpl in |- *; 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.
+  intros n; elim n; simpl in |- *; 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 : forall n m, even n -> even m -> even (n + m).
 Proof.
-intros n m; case (even_plus_aux n m).
-intros H H0; case H0; auto.
+  intros n m; case (even_plus_aux n m).
+  intros H H0; case H0; auto.
 Qed.
  
 Lemma odd_even_plus : forall n m, odd n -> odd m -> even (n + m).
 Proof.
-intros n m; case (even_plus_aux n m).
-intros H H0; case H0; auto.
+  intros n m; case (even_plus_aux n m).
+  intros H H0; case H0; auto.
 Qed.
- 
+
 Lemma even_plus_even_inv_r : forall n m, even (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.
+  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 : forall n m, even (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.
+  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 : forall n m, even (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.
+  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 : forall n m, even (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.
+  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.
 Hint Resolve even_even_plus odd_even_plus: arith.
- 
+
 Lemma odd_plus_l : forall n m, odd n -> even m -> odd (n + m).
 Proof.
-intros n m; case (even_plus_aux n m).
-intros H; case H; auto.
+  intros n m; case (even_plus_aux n m).
+  intros H; case H; auto.
 Qed.
  
 Lemma odd_plus_r : forall n m, even n -> odd m -> odd (n + m).
 Proof.
-intros n m; case (even_plus_aux n m).
-intros H; case H; auto.
+  intros n m; case (even_plus_aux n m).
+  intros H; case H; auto.
 Qed.
  
 Lemma odd_plus_even_inv_l : forall n m, odd (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.
+  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 : forall n m, odd (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.
+  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 : forall n m, odd (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.
+  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 : forall n m, odd (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.
+  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.
 Hint Resolve odd_plus_l odd_plus_r: arith.
- 
+
+
+(** * Facts about [even] and [odd] wrt. [mult] *)
+
 Lemma even_mult_aux :
- forall n m,
-   (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
+  forall n m,
+    (odd (n * m) <-> odd n /\ odd m) /\ (even (n * m) <-> even n \/ even m).
 Proof.
-intros n; elim n; simpl in |- *; auto with arith.
-intros 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 (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 (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 (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 (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.
+  intros n; elim n; simpl in |- *; 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 (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 (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 (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 (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 : forall n m, even n -> even (n * m).
 Proof.
-intros n m; case (even_mult_aux n m); auto.
-intros H H0; case H0; auto.
+  intros n m; case (even_mult_aux n m); auto.
+  intros H H0; case H0; auto.
 Qed.
  
 Lemma even_mult_r : forall n m, even m -> even (n * m).
 Proof.
-intros n m; case (even_mult_aux n m); auto.
-intros H H0; case H0; auto.
+  intros n m; case (even_mult_aux n m); auto.
+  intros H H0; case H0; auto.
 Qed.
 Hint Resolve even_mult_l even_mult_r: arith.
- 
+
 Lemma even_mult_inv_r : forall n m, even (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.
+  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 : forall n m, even (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.
+  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 : forall n m, odd n -> odd m -> odd (n * m).
 Proof.
-intros n m; case (even_mult_aux n m); intros H; case H; auto.
+  intros n m; case (even_mult_aux n m); intros H; case H; auto.
 Qed.
 Hint Resolve even_mult_l even_mult_r odd_mult: arith.
  
 Lemma odd_mult_inv_l : forall n m, odd (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.
+  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 : forall n m, odd (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.
+  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/theories/Arith/Factorial.v b/theories/Arith/Factorial.v
index 2767f9f0..5e2f491a 100644
--- a/theories/Arith/Factorial.v
+++ b/theories/Arith/Factorial.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Factorial.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
+(*i $Id: Factorial.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Plus.
 Require Import Mult.
@@ -17,34 +17,34 @@ Open Local Scope nat_scope.
 
 Boxed Fixpoint fact (n:nat) : nat :=
   match n with
-  | O => 1
-  | S n => S n * fact n
+    | O => 1
+    | S n => S n * fact n
   end.
 
 Arguments Scope fact [nat_scope].
 
 Lemma lt_O_fact : forall n:nat, 0 < fact n.
 Proof.
-simple induction n; unfold lt in |- *; simpl in |- *; auto with arith.
+  simple induction n; unfold lt in |- *; simpl in |- *; auto with arith.
 Qed.
 
 Lemma fact_neq_0 : forall n:nat, fact n <> 0.
 Proof.
-intro.
-apply sym_not_eq.
-apply lt_O_neq.
-apply lt_O_fact.
+  intro.
+  apply sym_not_eq.
+  apply lt_O_neq.
+  apply lt_O_fact.
 Qed.
 
 Lemma fact_le : forall n m:nat, n <= m -> fact n <= fact m.
 Proof.
-induction 1.
-apply le_n.
-assert (1 * fact n <= S m * fact m).
-apply mult_le_compat.
-apply lt_le_S; apply lt_O_Sn.
-assumption.
-simpl (1 * fact n) in H0.
-rewrite <- plus_n_O in H0.
-assumption.
+  induction 1.
+  apply le_n.
+  assert (1 * fact n <= S m * fact m).
+  apply mult_le_compat.
+  apply lt_le_S; apply lt_O_Sn.
+  assumption.
+  simpl (1 * fact n) in H0.
+  rewrite <- plus_n_O in H0.
+  assumption.
 Qed.
diff --git a/theories/Arith/Gt.v b/theories/Arith/Gt.v
index 90f893a3..5b1ee1b2 100644
--- a/theories/Arith/Gt.v
+++ b/theories/Arith/Gt.v
@@ -6,7 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Gt.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Gt.v 9245 2006-10-17 12:53:34Z notin $ i*)
+
+(** Theorems about [gt] in [nat]. [gt] is defined in [Init/Peano.v] as:
+<<
+Definition gt (n m:nat) := m < n.
+>>
+*)
 
 Require Import Le.
 Require Import Lt.
@@ -15,7 +21,7 @@ Open Local Scope nat_scope.
 
 Implicit Types m n p : nat.
 
-(** Order and successor *)
+(** * Order and successor *)
 
 Theorem gt_Sn_O : forall n, S n > 0.
 Proof.
@@ -52,20 +58,20 @@ Proof.
 Qed.
 Hint Immediate gt_pred: arith v62.
 
-(** Irreflexivity *)
+(** * Irreflexivity *)
 
 Lemma gt_irrefl : forall n, ~ n > n.
 Proof lt_irrefl.
 Hint Resolve gt_irrefl: arith v62.
 
-(** Asymmetry *)
+(** * Asymmetry *)
 
 Lemma gt_asym : forall n m, n > m -> ~ m > n.
 Proof fun n m => lt_asym m n.
 
 Hint Resolve gt_asym: arith v62.
 
-(** Relating strict and large orders *)
+(** * Relating strict and large orders *)
 
 Lemma le_not_gt : forall n m, n <= m -> ~ n > m.
 Proof le_not_lt.
@@ -102,7 +108,7 @@ Proof.
 Qed.
 Hint Resolve le_gt_S: arith v62.
 
-(** Transitivity *)
+(** * Transitivity *)
 
 Theorem le_gt_trans : forall n m p, m <= n -> m > p -> n > p.
 Proof.
@@ -127,14 +133,14 @@ Qed.
 
 Hint Resolve gt_trans_S le_gt_trans gt_le_trans: arith v62.
 
-(** Comparison to 0 *)
+(** * Comparison to 0 *)
 
 Theorem gt_O_eq : forall n, n > 0 \/ 0 = n.
 Proof.
   intro n; apply gt_S; auto with arith.
 Qed.
 
-(** Simplification and compatibility *)
+(** * Simplification and compatibility *)
 
 Lemma plus_gt_reg_l : forall n m p, p + n > p + m -> n > m.
 Proof.
diff --git a/theories/Arith/Le.v b/theories/Arith/Le.v
index e95ef408..e8b9e6be 100644
--- a/theories/Arith/Le.v
+++ b/theories/Arith/Le.v
@@ -6,108 +6,124 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Le.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Le.v 9245 2006-10-17 12:53:34Z notin $ i*)
+
+(** Order on natural numbers. [le] is defined in [Init/Peano.v] as:
+<<
+Inductive le (n:nat) : nat -> Prop :=
+  | le_n : n <= n
+  | le_S : forall m:nat, n <= m -> n <= S m
+
+where "n <= m" := (le n m) : nat_scope.
+>>
+ *)
 
-(** Order on natural numbers *)
 Open Local Scope nat_scope.
 
 Implicit Types m n p : nat.
 
-(** Reflexivity *)
+(** * [le] is a pre-order *)
 
+(** Reflexivity *)
 Theorem le_refl : forall n, n <= n.
 Proof.
-exact le_n.
+  exact le_n.
 Qed.
 
 (** Transitivity *)
-
 Theorem le_trans : forall n m p, n <= m -> m <= p -> n <= p.
 Proof.
   induction 2; auto.
 Qed.
 Hint Resolve le_trans: arith v62.
 
-(** Order, successor and predecessor *)
+(** * Properties of [le] w.r.t. successor, predecessor and 0 *)
 
-Theorem le_n_S : forall n m, n <= m -> S n <= S m.
+(** Comparison to 0 *)
+
+Theorem le_O_n : forall n, 0 <= n.
 Proof.
-  induction 1; auto.
+  induction n; auto.
 Qed.
 
-Theorem le_n_Sn : forall n, n <= S n.
+Theorem le_Sn_O : forall n, ~ S n <= 0.
 Proof.
-  auto.
+  red in |- *; intros n H.
+  change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith.
 Qed.
 
-Theorem le_O_n : forall n, 0 <= n.
+Hint Resolve le_O_n le_Sn_O: arith v62.
+
+Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n.
 Proof.
-  induction n; auto.
+  induction n; auto with arith.
+  intro; contradiction le_Sn_O with n.
 Qed.
+Hint Immediate le_n_O_eq: arith v62.
 
-Hint Resolve le_n_S le_n_Sn le_O_n le_n_S: arith v62.
 
-Theorem le_pred_n : forall n, pred n <= n.
+(** [le] and successor *)
+
+Theorem le_n_S : forall n m, n <= m -> S n <= S m.
 Proof.
-induction n; auto with arith.
+  induction 1; auto.
 Qed.
-Hint Resolve le_pred_n: arith v62.
+
+Theorem le_n_Sn : forall n, n <= S n.
+Proof.
+  auto.
+Qed.
+
+Hint Resolve le_n_S le_n_Sn : arith v62.
 
 Theorem le_Sn_le : forall n m, S n <= m -> n <= m.
 Proof.
-intros n m H; apply le_trans with (S n); auto with arith.
+  intros n m H; apply le_trans with (S n); auto with arith.
 Qed.
 Hint Immediate le_Sn_le: arith v62.
 
 Theorem le_S_n : forall n m, S n <= S m -> n <= m.
 Proof.
-intros n m H; change (pred (S n) <= pred (S m)) in |- *.
-destruct H; simpl; auto with arith.
+  intros n m H; change (pred (S n) <= pred (S m)) in |- *.
+  destruct H; simpl; auto with arith.
 Qed.
 Hint Immediate le_S_n: arith v62.
 
-Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
+Theorem le_Sn_n : forall n, ~ S n <= n.
 Proof.
-destruct n; simpl; auto with arith.
-destruct m; simpl; auto with arith.
+  induction n; auto with arith.
 Qed.
+Hint Resolve le_Sn_n: arith v62.
 
-(** Comparison to 0 *)
+(** [le] and predecessor *)
 
-Theorem le_Sn_O : forall n, ~ S n <= 0.
+Theorem le_pred_n : forall n, pred n <= n.
 Proof.
-red in |- *; intros n H.
-change (IsSucc 0) in |- *; elim H; simpl in |- *; auto with arith.
+  induction n; auto with arith.
 Qed.
-Hint Resolve le_Sn_O: arith v62.
+Hint Resolve le_pred_n: arith v62.
 
-Theorem le_n_O_eq : forall n, n <= 0 -> 0 = n.
+Theorem le_pred : forall n m, n <= m -> pred n <= pred m.
 Proof.
-induction n; auto with arith.
-intro; contradiction le_Sn_O with n.
+  destruct n; simpl; auto with arith.
+  destruct m; simpl; auto with arith.
 Qed.
-Hint Immediate le_n_O_eq: arith v62.
 
-(** Negative properties *)
-
-Theorem le_Sn_n : forall n, ~ S n <= n.
-Proof.
-induction n; auto with arith.
-Qed.
-Hint Resolve le_Sn_n: arith v62.
 
+(** * [le] is a order on [nat] *)
 (** Antisymmetry *)
 
 Theorem le_antisym : forall n m, n <= m -> m <= n -> n = m.
 Proof.
-intros n m h; destruct h as [| m0 H]; auto with arith.
-intros H1.
-absurd (S m0 <= m0); auto with arith.
-apply le_trans with n; auto with arith.
+  intros n m H; destruct H as [|m' H]; auto with arith.
+  intros H1.
+  absurd (S m' <= m'); auto with arith.
+  apply le_trans with n; auto with arith.
 Qed.
 Hint Immediate le_antisym: arith v62.
 
-(** A different elimination principle for the order on natural numbers *)
+
+(** * A different elimination principle for the order on natural numbers *)
 
 Lemma le_elim_rel :
  forall P:nat -> nat -> Prop,
@@ -115,7 +131,7 @@ Lemma le_elim_rel :
    (forall p (q:nat), p <= q -> P p q -> P (S p) (S q)) ->
    forall n m, n <= m -> P n m.
 Proof.
-induction n; auto with arith.
-intros m Le.
-elim Le; auto with arith.
-Qed.
\ No newline at end of file
+  induction n; auto with arith.
+  intros m Le.
+  elim Le; auto with arith.
+Qed.
diff --git a/theories/Arith/Lt.v b/theories/Arith/Lt.v
index eeb4e35e..94cf3793 100644
--- a/theories/Arith/Lt.v
+++ b/theories/Arith/Lt.v
@@ -6,86 +6,93 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lt.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Lt.v 9245 2006-10-17 12:53:34Z notin $ i*)
+
+(** Theorems about [lt] in nat. [lt] is defined in library [Init/Peano.v] as:
+<<
+Definition lt (n m:nat) := S n <= m.
+Infix "<" := lt : nat_scope.
+>>
+*)
 
 Require Import Le.
 Open Local Scope nat_scope.
 
 Implicit Types m n p : nat.
 
-(** Irreflexivity *)
+(** * Irreflexivity *)
 
 Theorem lt_irrefl : forall n, ~ n < n.
 Proof le_Sn_n.
 Hint Resolve lt_irrefl: arith v62.
 
-(** Relationship between [le] and [lt] *) 
+(** * Relationship between [le] and [lt] *) 
 
 Theorem lt_le_S : forall n m, n < m -> S n <= m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate lt_le_S: arith v62.
 
 Theorem lt_n_Sm_le : forall n m, n < S m -> n <= m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate lt_n_Sm_le: arith v62.
 
 Theorem le_lt_n_Sm : forall n m, n <= m -> n < S m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate le_lt_n_Sm: arith v62.
 
 Theorem le_not_lt : forall n m, n <= m -> ~ m < n.
 Proof.
-induction 1; auto with arith.
+  induction 1; auto with arith.
 Qed.
 
 Theorem lt_not_le : forall n m, n < m -> ~ m <= n.
 Proof.
-red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt).
+  red in |- *; intros n m Lt Le; exact (le_not_lt m n Le Lt).
 Qed.
 Hint Immediate le_not_lt lt_not_le: arith v62.
 
-(** Asymmetry *)
+(** * Asymmetry *)
 
 Theorem lt_asym : forall n m, n < m -> ~ m < n.
 Proof.
-induction 1; auto with arith.
+  induction 1; auto with arith.
 Qed.
 
-(** Order and successor *)
+(** * Order and successor *)
 
 Theorem lt_n_Sn : forall n, n < S n.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Resolve lt_n_Sn: arith v62.
 
 Theorem lt_S : forall n m, n < m -> n < S m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Resolve lt_S: arith v62.
 
 Theorem lt_n_S : forall n m, n < m -> S n < S m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Resolve lt_n_S: arith v62.
 
 Theorem lt_S_n : forall n m, S n < S m -> n < m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate lt_S_n: arith v62.
 
 Theorem lt_O_Sn : forall n, 0 < S n.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Resolve lt_O_Sn: arith v62.
 
@@ -93,7 +100,7 @@ Theorem lt_n_O : forall n, ~ n < 0.
 Proof le_Sn_O.
 Hint Resolve lt_n_O: arith v62.
 
-(** Predecessor *)
+(** * Predecessor *)
 
 Lemma S_pred : forall n m, m < n -> n = S (pred n).
 Proof.
@@ -111,65 +118,65 @@ destruct 1; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve lt_pred_n_n: arith v62.
 
-(** Transitivity properties *)
+(** * Transitivity properties *)
 
 Theorem lt_trans : forall n m p, n < m -> m < p -> n < p.
 Proof.
-induction 2; auto with arith.
+  induction 2; auto with arith.
 Qed.
 
 Theorem lt_le_trans : forall n m p, n < m -> m <= p -> n < p.
 Proof.
-induction 2; auto with arith.
+  induction 2; auto with arith.
 Qed.
 
 Theorem le_lt_trans : forall n m p, n <= m -> m < p -> n < p.
 Proof.
-induction 2; auto with arith.
+  induction 2; auto with arith.
 Qed.
 
 Hint Resolve lt_trans lt_le_trans le_lt_trans: arith v62.
 
-(** Large = strict or equal *)
+(** * Large = strict or equal *)
 
 Theorem le_lt_or_eq : forall n m, n <= m -> n < m \/ n = m.
 Proof.
-induction 1; auto with arith.
+  induction 1; auto with arith.
 Qed.
 
 Theorem lt_le_weak : forall n m, n < m -> n <= m.
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate lt_le_weak: arith v62.
 
-(** Dichotomy *)
+(** * Dichotomy *)
 
 Theorem le_or_lt : forall n m, n <= m \/ m < n.
 Proof.
-intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith.
-induction 1; auto with arith.
+  intros n m; pattern n, m in |- *; apply nat_double_ind; auto with arith.
+  induction 1; auto with arith.
 Qed.
 
 Theorem nat_total_order : forall n m, n <> m -> n < m \/ m < n.
 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.
+  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 *)
+(** * Comparison to 0 *)
 
 Theorem neq_O_lt : forall n, 0 <> n -> 0 < n.
 Proof.
-induction n; auto with arith.
-intros; absurd (0 = 0); trivial with arith.
+  induction n; auto with arith.
+  intros; absurd (0 = 0); trivial with arith.
 Qed.
 Hint Immediate neq_O_lt: arith v62.
 
 Theorem lt_O_neq : forall n, 0 < n -> 0 <> n.
 Proof.
-induction 1; auto with arith.
+  induction 1; auto with arith.
 Qed.
 Hint Immediate lt_O_neq: arith v62.
\ No newline at end of file
diff --git a/theories/Arith/Max.v b/theories/Arith/Max.v
index 7f5c1148..e0222e41 100644
--- a/theories/Arith/Max.v
+++ b/theories/Arith/Max.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Max.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Max.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Arith.
 
@@ -14,66 +14,66 @@ Open Local Scope nat_scope.
 
 Implicit Types m n : nat.
 
-(** maximum of two natural numbers *)
+(** * maximum of two natural numbers *)
 
 Fixpoint max n m {struct n} : nat :=
   match n, m with
-  | O, _ => m
-  | S n', O => n
-  | S n', S m' => S (max n' m')
+    | O, _ => m
+    | S n', O => n
+    | S n', S m' => S (max n' m')
   end.
 
-(** Simplifications of [max] *)
+(** * Simplifications of [max] *)
 
 Lemma max_SS : forall n m, S (max n m) = max (S n) (S m).
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 
 Lemma max_comm : forall n m, max n m = max m n.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
-(** [max] and [le] *)
+(** * [max] and [le] *)
 
 Lemma max_l : forall n m, m <= n -> max n m = n.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
 Lemma max_r : forall n m, n <= m -> max n m = m.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
 Lemma le_max_l : forall n m, n <= max n m.
 Proof.
-induction n; intros; simpl in |- *; auto with arith.
-elim m; intros; simpl in |- *; auto with arith.
+  induction n; intros; simpl in |- *; auto with arith.
+  elim m; intros; simpl in |- *; auto with arith.
 Qed.
 
 Lemma le_max_r : forall n m, m <= max n m.
 Proof.
-induction n; simpl in |- *; auto with arith.
-induction m; simpl in |- *; auto with arith.
+  induction n; simpl in |- *; auto with arith.
+  induction m; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve max_r max_l le_max_l le_max_r: arith v62.
 
 
-(** [max n m] is equal to [n] or [m] *)
+(** * [max n m] is equal to [n] or [m] *)
 
 Lemma max_dec : forall n m, {max n m = n} + {max n m = m}.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
-elim (IHn m); intro H; elim H; auto.
+  induction n; induction m; simpl in |- *; auto with arith.
+  elim (IHn m); intro H; elim H; auto.
 Qed.
 
 Lemma max_case : forall n m (P:nat -> Type), P n -> P m -> P (max n m).
 Proof.
-induction n; simpl in |- *; auto with arith.
-induction m; intros; simpl in |- *; auto with arith.
-pattern (max n m) in |- *; apply IHn; auto with arith.
+  induction n; simpl in |- *; auto with arith.
+  induction m; intros; simpl in |- *; auto with arith.
+  pattern (max n m) in |- *; apply IHn; auto with arith.
 Qed.
 
 Notation max_case2 := max_case (only parsing).
diff --git a/theories/Arith/Min.v b/theories/Arith/Min.v
index 38351817..db14e74b 100644
--- a/theories/Arith/Min.v
+++ b/theories/Arith/Min.v
@@ -6,73 +6,73 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Min.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Min.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-Require Import Arith.
+Require Import Le.
 
 Open Local Scope nat_scope.
 
 Implicit Types m n : nat.
 
-(** minimum of two natural numbers *)
+(** * minimum of two natural numbers *)
 
 Fixpoint min n m {struct n} : nat :=
   match n, m with
-  | O, _ => 0
-  | S n', O => 0
-  | S n', S m' => S (min n' m')
+    | O, _ => 0
+    | S n', O => 0
+    | S n', S m' => S (min n' m')
   end.
 
-(** Simplifications of [min] *)
+(** * Simplifications of [min] *)
 
 Lemma min_SS : forall n m, S (min n m) = min (S n) (S m).
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 
 Lemma min_comm : forall n m, min n m = min m n.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
-(** [min] and [le] *)
+(** * [min] and [le] *)
 
 Lemma min_l : forall n m, n <= m -> min n m = n.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
 Lemma min_r : forall n m, m <= n -> min n m = m.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
+  induction n; induction m; simpl in |- *; auto with arith.
 Qed.
 
 Lemma le_min_l : forall n m, min n m <= n.
 Proof.
-induction n; intros; simpl in |- *; auto with arith.
-elim m; intros; simpl in |- *; auto with arith.
+  induction n; intros; simpl in |- *; auto with arith.
+  elim m; intros; simpl in |- *; auto with arith.
 Qed.
 
 Lemma le_min_r : forall n m, min n m <= m.
 Proof.
-induction n; simpl in |- *; auto with arith.
-induction m; simpl in |- *; auto with arith.
+  induction n; simpl in |- *; auto with arith.
+  induction m; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve min_l min_r le_min_l le_min_r: arith v62.
 
-(** [min n m] is equal to [n] or [m] *)
+(** * [min n m] is equal to [n] or [m] *)
 
 Lemma min_dec : forall n m, {min n m = n} + {min n m = m}.
 Proof.
-induction n; induction m; simpl in |- *; auto with arith.
-elim (IHn m); intro H; elim H; auto.
+  induction n; induction m; simpl in |- *; auto with arith.
+  elim (IHn m); intro H; elim H; auto.
 Qed.
 
 Lemma min_case : forall n m (P:nat -> Type), P n -> P m -> P (min n m).
 Proof.
-induction n; simpl in |- *; auto with arith.
-induction m; intros; simpl in |- *; auto with arith.
-pattern (min n m) in |- *; apply IHn; auto with arith.
+  induction n; simpl in |- *; auto with arith.
+  induction m; intros; simpl in |- *; auto with arith.
+  pattern (min n m) in |- *; apply IHn; auto with arith.
 Qed.
 
 Notation min_case2 := min_case (only parsing).
diff --git a/theories/Arith/Minus.v b/theories/Arith/Minus.v
index dfecd7cf..2380c2de 100644
--- a/theories/Arith/Minus.v
+++ b/theories/Arith/Minus.v
@@ -6,9 +6,19 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Minus.v 8642 2006-03-17 10:09:02Z notin $ i*)
-
-(** Subtraction (difference between two natural numbers) *)
+(*i $Id: Minus.v 9245 2006-10-17 12:53:34Z notin $ i*)
+
+(** [minus] (difference between two natural numbers) is defined in [Init/Peano.v] as:
+<<
+Fixpoint minus (n m:nat) {struct n} : nat :=
+  match n, m with
+  | O, _ => 0
+  | S k, O => S k
+  | S k, S l => k - l
+  end
+where "n - m" := (minus n m) : nat_scope.
+>>
+*)
 
 Require Import Lt.
 Require Import Le.
@@ -17,36 +27,37 @@ Open Local Scope nat_scope.
 
 Implicit Types m n p : nat.
 
-(** 0 is right neutral *)
+(** * 0 is right neutral *)
 
 Lemma minus_n_O : forall n, n = n - 0.
 Proof.
-induction n; simpl in |- *; auto with arith.
+  induction n; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve minus_n_O: arith v62.
 
-(** Permutation with successor *)
+(** * Permutation with successor *)
 
 Lemma minus_Sn_m : forall n m, m <= n -> S (n - m) = S n - m.
 Proof.
-intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
- auto with arith.
+  intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+    auto with arith.
 Qed.
 Hint Resolve minus_Sn_m: arith v62.
 
 Theorem pred_of_minus : forall n, pred n = n - 1.
-intro x; induction x; simpl in |- *; auto with arith.
+Proof.
+  intro x; induction x; simpl in |- *; auto with arith.
 Qed.
 
-(** Diagonal *)
+(** * Diagonal *)
 
 Lemma minus_n_n : forall n, 0 = n - n.
 Proof.
-induction n; simpl in |- *; auto with arith.
+  induction n; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve minus_n_n: arith v62.
 
-(** Simplification *)
+(** * Simplification *)
 
 Lemma minus_plus_simpl_l_reverse : forall n m p, n - m = p + n - (p + m).
 Proof.
@@ -54,70 +65,71 @@ Proof.
 Qed.
 Hint Resolve minus_plus_simpl_l_reverse: arith v62.
 
-(** Relation with plus *)
+(** * Relation with plus *)
 
 Lemma plus_minus : forall n m p, n = m + p -> p = n - m.
 Proof.
-intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *;
- intros.
-replace (n0 - 0) with n0; auto with arith.
-absurd (0 = S (n0 + p)); auto with arith.
-auto with arith.
+  intros n m p; pattern m, n in |- *; apply nat_double_ind; simpl in |- *;
+    intros.
+  replace (n0 - 0) with n0; auto with arith.
+  absurd (0 = S (n0 + p)); auto with arith.
+  auto with arith.
 Qed.
 Hint Immediate plus_minus: arith v62.
 
 Lemma minus_plus : forall n m, n + m - n = m.
-symmetry  in |- *; auto with arith.
+  symmetry  in |- *; auto with arith.
 Qed.
 Hint Resolve minus_plus: arith v62.
 
 Lemma le_plus_minus : forall n m, n <= m -> m = n + (m - n).
 Proof.
-intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *;
- auto with arith.
+  intros n m Le; pattern n, m in |- *; apply le_elim_rel; simpl in |- *;
+    auto with arith.
 Qed.
 Hint Resolve le_plus_minus: arith v62.
 
 Lemma le_plus_minus_r : forall n m, n <= m -> n + (m - n) = m.
 Proof.
-symmetry  in |- *; auto with arith.
+  symmetry  in |- *; auto with arith.
 Qed.
 Hint Resolve le_plus_minus_r: arith v62.
 
-(** Relation with order *)
+(** * Relation with order *)
 
 Theorem le_minus : forall n m, n - m <= n.
 Proof.
-intros i h; pattern i, h in |- *; apply nat_double_ind;
- [ auto
- | auto
- | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ].
+  intros i h; pattern i, h in |- *; apply nat_double_ind;
+    [ auto
+      | auto
+      | intros m n H; simpl in |- *; apply le_trans with (m := m); auto ].
 Qed.
 
 Lemma lt_minus : forall n m, m <= n -> 0 < m -> n - m < n.
 Proof.
-intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
- auto with arith.
-intros; absurd (0 < 0); auto with arith.
-intros p q lepq Hp gtp.
-elim (le_lt_or_eq 0 p); auto with arith.
-auto with arith.
-induction 1; elim minus_n_O; auto with arith.
+  intros n m Le; pattern m, n in |- *; apply le_elim_rel; simpl in |- *;
+    auto with arith.
+  intros; absurd (0 < 0); auto with arith.
+  intros p q lepq Hp gtp.
+  elim (le_lt_or_eq 0 p); auto with arith.
+  auto with arith.
+  induction 1; elim minus_n_O; auto with arith.
 Qed.
 Hint Resolve lt_minus: arith v62.
 
 Lemma lt_O_minus_lt : forall n m, 0 < n - m -> m < n.
 Proof.
-intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *;
- auto with arith.
-intros; absurd (0 < 0); trivial with arith.
+  intros n m; pattern n, m in |- *; apply nat_double_ind; simpl in |- *;
+    auto with arith.
+  intros; absurd (0 < 0); trivial with arith.
 Qed.
 Hint Immediate lt_O_minus_lt: arith v62.
 
 Theorem not_le_minus_0 : forall n m, ~ m <= n -> n - m = 0.
-intros y x; pattern y, x in |- *; apply nat_double_ind;
- [ simpl in |- *; trivial with arith
- | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ]
- | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3;
-    apply H2; apply le_n_S; assumption ].
-Qed.
\ No newline at end of file
+Proof.
+  intros y x; pattern y, x in |- *; apply nat_double_ind;
+    [ simpl in |- *; trivial with arith
+      | intros n H; absurd (0 <= S n); [ assumption | apply le_O_n ]
+      | simpl in |- *; intros n m H1 H2; apply H1; unfold not in |- *; intros H3;
+	apply H2; apply le_n_S; assumption ].
+Qed.
diff --git a/theories/Arith/Mult.v b/theories/Arith/Mult.v
index 051f8645..2315e12c 100644
--- a/theories/Arith/Mult.v
+++ b/theories/Arith/Mult.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Mult.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Mult.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Plus.
 Require Export Minus.
@@ -17,86 +17,98 @@ Open Local Scope nat_scope.
 
 Implicit Types m n p : nat.
 
-(** Zero property *)
+(** Theorems about multiplication in [nat]. [mult] is defined in module [Init/Peano.v]. *)
+
+(** * [nat] is a semi-ring *)
+
+(** ** Zero property *)
 
 Lemma mult_0_r : forall n, n * 0 = 0.
 Proof.
-intro; symmetry  in |- *; apply mult_n_O.
+  intro; symmetry  in |- *; apply mult_n_O.
 Qed.
 
 Lemma mult_0_l : forall n, 0 * n = 0.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
 
-(** Distributivity *)
+(** ** 1 is neutral *)
 
-Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p.
+Lemma mult_1_l : forall n, 1 * n = n.
 Proof.
-intros; elim n; simpl in |- *; intros; auto with arith.
-elim plus_assoc; elim H; auto with arith.
+  simpl in |- *; auto with arith.
 Qed.
-Hint Resolve mult_plus_distr_r: arith v62.
+Hint Resolve mult_1_l: arith v62.
 
-Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p.
+Lemma mult_1_r : forall n, n * 1 = n.
 Proof.
-  induction n. trivial.
-  intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4.
+  induction n; [ trivial | 
+    simpl; rewrite IHn; reflexivity].
 Qed.
+Hint Resolve mult_1_r: arith v62.
 
-Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p.
+(** ** Commutativity *)
+
+Lemma mult_comm : forall n m, n * m = m * n.
 Proof.
-intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros;
- auto with arith.
-elim minus_plus_simpl_l_reverse; auto with arith.
+intros; elim n; intros; simpl in |- *; auto with arith.
+elim mult_n_Sm.
+elim H; apply plus_comm.
 Qed.
-Hint Resolve mult_minus_distr_r: arith v62.
+Hint Resolve mult_comm: arith v62.
 
-(** Associativity *)
+(** ** Distributivity *)
 
-Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p).
+Lemma mult_plus_distr_r : forall n m p, (n + m) * p = n * p + m * p.
 Proof.
-intros; elim n; intros; simpl in |- *; auto with arith.
-rewrite mult_plus_distr_r.
-elim H; auto with arith.
+  intros; elim n; simpl in |- *; intros; auto with arith.
+  elim plus_assoc; elim H; auto with arith.
 Qed.
-Hint Resolve mult_assoc_reverse: arith v62.
+Hint Resolve mult_plus_distr_r: arith v62.
 
-Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p.
+Lemma mult_plus_distr_l : forall n m p, n * (m + p) = n * m + n * p.
 Proof.
-auto with arith.
+  induction n. trivial.
+  intros. simpl in |- *. rewrite (IHn m p). apply sym_eq. apply plus_permute_2_in_4.
 Qed.
-Hint Resolve mult_assoc: arith v62.
 
-(** Commutativity *)
+Lemma mult_minus_distr_r : forall n m p, (n - m) * p = n * p - m * p.
+Proof.
+  intros; pattern n, m in |- *; apply nat_double_ind; simpl in |- *; intros;
+    auto with arith.
+  elim minus_plus_simpl_l_reverse; auto with arith.
+Qed.
+Hint Resolve mult_minus_distr_r: arith v62.
 
-Lemma mult_comm : forall n m, n * m = m * n.
+Lemma mult_minus_distr_l : forall n m p, n * (m - p) = n * m - n * p.
 Proof.
-intros; elim n; intros; simpl in |- *; auto with arith.
-elim mult_n_Sm.
-elim H; apply plus_comm.
+  intros n m p. rewrite mult_comm. rewrite mult_minus_distr_r. 
+  rewrite (mult_comm m n); rewrite (mult_comm p n); reflexivity.
 Qed.
-Hint Resolve mult_comm: arith v62.
+Hint Resolve mult_minus_distr_l: arith v62.
 
-(** 1 is neutral *)
+(** ** Associativity *)
 
-Lemma mult_1_l : forall n, 1 * n = n.
+Lemma mult_assoc_reverse : forall n m p, n * m * p = n * (m * p).
 Proof.
-simpl in |- *; auto with arith.
+  intros; elim n; intros; simpl in |- *; auto with arith.
+  rewrite mult_plus_distr_r.
+  elim H; auto with arith.
 Qed.
-Hint Resolve mult_1_l: arith v62.
+Hint Resolve mult_assoc_reverse: arith v62.
 
-Lemma mult_1_r : forall n, n * 1 = n.
+Lemma mult_assoc : forall n m p, n * (m * p) = n * m * p.
 Proof.
-intro; elim mult_comm; auto with arith.
+  auto with arith.
 Qed.
-Hint Resolve mult_1_r: arith v62.
+Hint Resolve mult_assoc: arith v62.
 
-(** Compatibility with orders *)
+(** * Compatibility with orders *)
 
 Lemma mult_O_le : forall n m, m = 0 \/ n <= m * n.
 Proof.
-induction m; simpl in |- *; auto with arith.
+  induction m; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve mult_O_le: arith v62.
 
@@ -110,26 +122,27 @@ Hint Resolve mult_le_compat_l: arith.
 
 
 Lemma mult_le_compat_r : forall n m p, n <= m -> n * p <= m * p.
-intros m n p H.
-rewrite mult_comm. rewrite (mult_comm n).
-auto with arith.
+Proof.
+  intros m n p H.
+  rewrite mult_comm. rewrite (mult_comm n).
+  auto with arith.
 Qed.
 
 Lemma mult_le_compat :
- forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q.
-Proof.
-intros m n p q Hmn Hpq; induction Hmn.
-induction 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 (m * m0).
-assumption.
-apply le_plus_l.
-(* m*p<=m0*q -> m*p<=(S m0)*q *)
-simpl in |- *; apply le_trans with (m0 * q).
-assumption.
-apply le_plus_r.
+  forall n m p (q:nat), n <= m -> p <= q -> n * p <= m * q.
+Proof.
+  intros m n p q Hmn Hpq; induction Hmn.
+  induction 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 (m * m0).
+  assumption.
+  apply le_plus_l.
+  (* m*p<=m0*q -> m*p<=(S m0)*q *)
+  simpl in |- *; apply le_trans with (m0 * q).
+  assumption.
+  apply le_plus_r.
 Qed.
 
 Lemma mult_S_lt_compat_l : forall n m p, m < p -> S n * m < S n * p.
@@ -141,11 +154,12 @@ Qed.
 Hint Resolve mult_S_lt_compat_l: arith.
 
 Lemma mult_lt_compat_r : forall n m p, n < m -> 0 < p -> n * p < m * p.
-intros m n p H H0.
-induction p.
-elim (lt_irrefl _ H0).
-rewrite mult_comm.
-replace (n * S p) with (S p * n); auto with arith.
+Proof.
+  intros m n p H H0.
+  induction p.
+  elim (lt_irrefl _ H0).
+  rewrite mult_comm.
+  replace (n * S p) with (S p * n); auto with arith.
 Qed.
 
 Lemma mult_S_le_reg_l : forall n m p, S n * m <= S n * p -> m <= p.
@@ -156,27 +170,28 @@ Proof.
   apply mult_S_lt_compat_l. assumption.
 Qed.
 
-(** n|->2*n and n|->2n+1 have disjoint image *)
+(** * n|->2*n and n|->2n+1 have disjoint image *)
 
 Theorem odd_even_lem : forall p q, 2 * p + 1 <> 2 * q.
-intros p; elim p; auto.
-intros q; case q; simpl in |- *.
-red in |- *; intros; discriminate.
-intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *;
- intros; discriminate.
-intros p' H q; case q.
-simpl in |- *; red in |- *; intros; discriminate.
-intros q'; red in |- *; intros H0; case (H q').
-replace (2 * q') with (2 * S q' - 2).
-rewrite <- H0; simpl in |- *; auto.
-repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto.
-simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *;
- auto.
-case q'; simpl in |- *; auto.
+Proof.
+  intros p; elim p; auto.
+  intros q; case q; simpl in |- *.
+  red in |- *; intros; discriminate.
+  intros q'; rewrite (fun x y => plus_comm x (S y)); simpl in |- *; red in |- *;
+    intros; discriminate.
+  intros p' H q; case q.
+  simpl in |- *; red in |- *; intros; discriminate.
+  intros q'; red in |- *; intros H0; case (H q').
+  replace (2 * q') with (2 * S q' - 2).
+  rewrite <- H0; simpl in |- *; auto.
+  repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *; auto.
+  simpl in |- *; repeat rewrite (fun x y => plus_comm x (S y)); simpl in |- *;
+    auto.
+  case q'; simpl in |- *; auto.
 Qed.
 
 
-(** Tail-recursive mult *)
+(** * Tail-recursive mult *)
 
 (** [tail_mult] is an alternative definition for [mult] which is 
     tail-recursive, whereas [mult] is not. This can be useful 
@@ -184,23 +199,23 @@ Qed.
 
 Fixpoint mult_acc (s:nat) m n {struct n} : nat :=
   match n with
-  | O => s
-  | S p => mult_acc (tail_plus m s) m p
+    | O => s
+    | S p => mult_acc (tail_plus m s) m p
   end.
 
 Lemma mult_acc_aux : forall n m p, m + n * p = mult_acc m p n.
 Proof.
-induction n as [| p IHp]; simpl in |- *; auto.
-intros s m; rewrite <- plus_tail_plus; rewrite <- IHp.
-rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto.
-rewrite plus_comm; auto.
+  induction n as [| p IHp]; simpl in |- *; auto.
+  intros s m; rewrite <- plus_tail_plus; rewrite <- IHp.
+  rewrite <- plus_assoc_reverse; apply (f_equal2 (A1:=nat) (A2:=nat)); auto.
+  rewrite plus_comm; auto.
 Qed.
 
 Definition tail_mult n m := mult_acc 0 m n.
 
 Lemma mult_tail_mult : forall n m, n * m = tail_mult n m.
 Proof.
-intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto.
+  intros; unfold tail_mult in |- *; rewrite <- mult_acc_aux; auto.
 Qed.
 
 (** [TailSimpl] transforms any [tail_plus] and [tail_mult] into [plus] 
@@ -208,4 +223,4 @@ Qed.
 
 Ltac tail_simpl :=
   repeat rewrite <- plus_tail_plus; repeat rewrite <- mult_tail_mult;
-   simpl in |- *. 
\ No newline at end of file
+    simpl in |- *.
\ No newline at end of file
diff --git a/theories/Arith/Peano_dec.v b/theories/Arith/Peano_dec.v
index 4aef7dc0..b17021bc 100644
--- a/theories/Arith/Peano_dec.v
+++ b/theories/Arith/Peano_dec.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Peano_dec.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Peano_dec.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Decidable.
 
@@ -16,19 +16,19 @@ Implicit Types m n x y : nat.
 
 Theorem O_or_S : forall n, {m : nat | S m = n} + {0 = n}.
 Proof.
-induction n.
-auto.
-left; exists n; auto.
+  induction n.
+  auto.
+  left; exists n; auto.
 Defined.
 
 Theorem eq_nat_dec : forall n m, {n = m} + {n <> m}.
 Proof.
-induction n; induction m; auto.
-elim (IHn m); auto.
+  induction n; induction m; auto.
+  elim (IHn m); auto.
 Defined.
 
 Hint Resolve O_or_S eq_nat_dec: arith.
 
 Theorem dec_eq_nat : forall n m, decidable (n = m).
-intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith.
+  intros x y; unfold decidable in |- *; elim (eq_nat_dec x y); auto with arith.
 Defined.
diff --git a/theories/Arith/Plus.v b/theories/Arith/Plus.v
index 56e1c58a..74d0dc93 100644
--- a/theories/Arith/Plus.v
+++ b/theories/Arith/Plus.v
@@ -6,9 +6,18 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Plus.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Plus.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(** Properties of addition *)
+(** Properties of addition. [add] is defined in [Init/Peano.v] as:
+<<
+Fixpoint plus (n m:nat) {struct n} : nat :=
+  match n with
+  | O => m
+  | S p => S (p + m)
+  end
+where "n + m" := (plus n m) : nat_scope.
+>>
+ *)
 
 Require Import Le.
 Require Import Lt.
@@ -17,126 +26,127 @@ Open Local Scope nat_scope.
 
 Implicit Types m n p q : nat.
 
-(** Zero is neutral *)
+(** * Zero is neutral *)
 
 Lemma plus_0_l : forall n, 0 + n = n.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
 
 Lemma plus_0_r : forall n, n + 0 = n.
 Proof.
-intro; symmetry  in |- *; apply plus_n_O.
+  intro; symmetry  in |- *; apply plus_n_O.
 Qed.
 
-(** Commutativity *)
+(** * Commutativity *)
 
 Lemma plus_comm : forall n m, n + m = m + n.
 Proof.
-intros n m; elim n; simpl in |- *; auto with arith.
-intros y H; elim (plus_n_Sm m y); auto with arith.
+  intros n m; elim n; simpl in |- *; auto with arith.
+  intros y H; elim (plus_n_Sm m y); auto with arith.
 Qed.
 Hint Immediate plus_comm: arith v62.
 
-(** Associativity *)
+(** * Associativity *)
 
 Lemma plus_Snm_nSm : forall n m, S n + m = n + S m.
-intros.
-simpl in |- *.
-rewrite (plus_comm n m).
-rewrite (plus_comm n (S m)).
-trivial with arith.
+Proof.
+  intros.
+  simpl in |- *.
+  rewrite (plus_comm n m).
+  rewrite (plus_comm n (S m)).
+  trivial with arith.
 Qed.
 
 Lemma plus_assoc : forall n m p, n + (m + p) = n + m + p.
 Proof.
-intros n m p; elim n; simpl in |- *; auto with arith.
+  intros n m p; elim n; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve plus_assoc: arith v62.
 
 Lemma plus_permute : forall n m p, n + (m + p) = m + (n + p).
 Proof. 
-intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith.
+  intros; rewrite (plus_assoc m n p); rewrite (plus_comm m n); auto with arith.
 Qed.
 
 Lemma plus_assoc_reverse : forall n m p, n + m + p = n + (m + p).
 Proof.
-auto with arith.
+  auto with arith.
 Qed.
 Hint Resolve plus_assoc_reverse: arith v62.
 
-(** Simplification *)
+(** * Simplification *)
 
 Lemma plus_reg_l : forall n m p, p + n = p + m -> n = m.
 Proof.
-intros m p n; induction n; simpl in |- *; auto with arith.
+  intros m p n; induction n; simpl in |- *; auto with arith.
 Qed.
 
 Lemma plus_le_reg_l : forall n m p, p + n <= p + m -> n <= m.
 Proof.
-induction p; simpl in |- *; auto with arith.
+  induction p; simpl in |- *; auto with arith.
 Qed.
 
 Lemma plus_lt_reg_l : forall n m p, p + n < p + m -> n < m.
 Proof.
-induction p; simpl in |- *; auto with arith.
+  induction p; simpl in |- *; auto with arith.
 Qed.
 
-(** Compatibility with order *)
+(** * Compatibility with order *)
 
 Lemma plus_le_compat_l : forall n m p, n <= m -> p + n <= p + m.
 Proof.
-induction p; simpl in |- *; auto with arith.
+  induction p; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve plus_le_compat_l: arith v62.
 
 Lemma plus_le_compat_r : forall n m p, n <= m -> n + p <= m + p.
 Proof.
-induction 1; simpl in |- *; auto with arith.
+  induction 1; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve plus_le_compat_r: arith v62.
 
 Lemma le_plus_l : forall n m, n <= n + m.
 Proof.
-induction n; simpl in |- *; auto with arith.
+  induction n; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve le_plus_l: arith v62.
 
 Lemma le_plus_r : forall n m, m <= n + m.
 Proof.
-intros n m; elim n; simpl in |- *; auto with arith.
+  intros n m; elim n; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve le_plus_r: arith v62.
 
 Theorem le_plus_trans : forall n m p, n <= m -> n <= m + p.
 Proof.
-intros; apply le_trans with (m := m); auto with arith.
+  intros; apply le_trans with (m := m); auto with arith.
 Qed.
 Hint Resolve le_plus_trans: arith v62.
 
 Theorem lt_plus_trans : forall n m p, n < m -> n < m + p.
 Proof.
-intros; apply lt_le_trans with (m := m); auto with arith.
+  intros; apply lt_le_trans with (m := m); auto with arith.
 Qed.
 Hint Immediate lt_plus_trans: arith v62.
 
 Lemma plus_lt_compat_l : forall n m p, n < m -> p + n < p + m.
 Proof.
-induction p; simpl in |- *; auto with arith.
+  induction p; simpl in |- *; auto with arith.
 Qed.
 Hint Resolve plus_lt_compat_l: arith v62.
 
 Lemma plus_lt_compat_r : forall n m p, n < m -> n + p < m + p.
 Proof.
-intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p).
-elim p; auto with arith.
+  intros n m p H; rewrite (plus_comm n p); rewrite (plus_comm m p).
+  elim p; auto with arith.
 Qed.
 Hint Resolve plus_lt_compat_r: arith v62.
 
 Lemma plus_le_compat : forall n m p q, n <= m -> p <= q -> n + p <= m + q.
 Proof.
-intros n m p q H H0.
-elim H; simpl in |- *; auto with arith.
+  intros n m p q H H0.
+  elim H; simpl in |- *; auto with arith.
 Qed.
 
 Lemma plus_le_lt_compat : forall n m p q, n <= m -> p < q -> n + p < m + q.
@@ -156,7 +166,7 @@ Proof.
   apply lt_le_weak. assumption.
 Qed.
 
-(** Inversion lemmas *)
+(** * Inversion lemmas *)
 
 Lemma plus_is_O : forall n m, n + m = 0 -> n = 0 /\ m = 0.
 Proof.
@@ -173,7 +183,7 @@ Proof.
   simpl in H. discriminate H.
 Defined.
 
-(** Derived properties *)
+(** * Derived properties *)
 
 Lemma plus_permute_2_in_4 : forall n m p q, n + m + (p + q) = n + p + (m + q).
 Proof.
@@ -182,7 +192,7 @@ Proof.
   rewrite (plus_comm n p). rewrite <- (plus_assoc p n q). apply plus_assoc.
 Qed.
 
-(** Tail-recursive plus *)
+(** * Tail-recursive plus *)
 
 (** [tail_plus] is an alternative definition for [plus] which is 
     tail-recursive, whereas [plus] is not. This can be useful
@@ -190,8 +200,8 @@ Qed.
 
 Fixpoint plus_acc q n {struct n} : nat :=
   match n with
-  | O => q
-  | S p => plus_acc (S q) p
+    | O => q
+    | S p => plus_acc (S q) p
   end.
 
 Definition tail_plus n m := plus_acc m n.
@@ -201,27 +211,27 @@ unfold tail_plus in |- *; induction n as [| n IHn]; simpl in |- *; auto.
 intro m; rewrite <- IHn; simpl in |- *; auto.
 Qed.
 
-(** Discrimination *)
+(** * Discrimination *)
 
 Lemma succ_plus_discr : forall n m, n <> S (plus m n).
 Proof.
-intros n m; induction n as [|n IHn].
- discriminate.
- intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; 
-   reflexivity.
+  intros n m; induction n as [|n IHn].
+  discriminate.
+  intro H; apply IHn; apply eq_add_S; rewrite H; rewrite <- plus_n_Sm; 
+    reflexivity.
 Qed.
 
 Lemma n_SSn : forall n, n <> S (S n).
 Proof.
-intro n; exact (succ_plus_discr n 1).
+  intro n; exact (succ_plus_discr n 1).
 Qed.
 
 Lemma n_SSSn : forall n, n <> S (S (S n)).
 Proof.
-intro n; exact (succ_plus_discr n 2).
+  intro n; exact (succ_plus_discr n 2).
 Qed.
 
 Lemma n_SSSSn : forall n, n <> S (S (S (S n))).
 Proof.
-intro n; exact (succ_plus_discr n 3).
+  intro n; exact (succ_plus_discr n 3).
 Qed.
diff --git a/theories/Arith/Wf_nat.v b/theories/Arith/Wf_nat.v
index e1bbfad9..11fcd161 100644
--- a/theories/Arith/Wf_nat.v
+++ b/theories/Arith/Wf_nat.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wf_nat.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Wf_nat.v 9341 2006-11-06 13:08:10Z notin $ i*)
 
 (** Well-founded relations and natural numbers *)
 
@@ -18,7 +18,7 @@ Implicit Types m n p : nat.
 
 Section Well_founded_Nat.
 
-Variable A : Set.
+Variable A : Type.
 
 Variable f : A -> nat.
 Definition ltof (a b:A) := f a < f b.
@@ -26,21 +26,21 @@ Definition gtof (a b:A) := f b > f a.
 
 Theorem well_founded_ltof : well_founded ltof.
 Proof.
-red in |- *.
-cut (forall n (a:A), f a < n -> Acc ltof a).
-intros H a; apply (H (S (f a))); auto with arith.
-induction n.
-intros; absurd (f a < 0); auto with arith.
-intros a ltSma.
-apply Acc_intro.
-unfold ltof in |- *; intros b ltfafb.
-apply IHn.
-apply lt_le_trans with (f a); auto with arith.
+  red in |- *.
+  cut (forall n (a:A), f a < n -> Acc ltof a).
+  intros H a; apply (H (S (f a))); auto with arith.
+  induction n.
+  intros; absurd (f a < 0); auto with arith.
+  intros a ltSma.
+  apply Acc_intro.
+  unfold ltof in |- *; intros b ltfafb.
+  apply IHn.
+  apply lt_le_trans with (f a); auto with arith.
 Defined.
 
 Theorem well_founded_gtof : well_founded gtof.
 Proof.
-exact well_founded_ltof.
+  exact well_founded_ltof.
 Defined.
 
 (** It is possible to directly prove the induction principle going
@@ -48,52 +48,55 @@ Defined.
    or to use the previous lemmas to extract a program with a fixpoint
    ([induction_ltof2]) 
 
-the ML-like program for [induction_ltof1] is : [[
+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 : [[
+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 :
- forall P:A -> Set,
-   (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
-Proof.
-intros P F; cut (forall n (a:A), f a < n -> P a).
-intros H a; apply (H (S (f a))); auto with arith.
-induction n.
-intros; absurd (f a < 0); auto with arith.
-intros a ltSma.
-apply F.
-unfold ltof in |- *; intros b ltfafb.
-apply IHn.
-apply lt_le_trans with (f a); auto with arith.
+  forall P:A -> Set,
+    (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
+Proof.
+  intros P F; cut (forall n (a:A), f a < n -> P a).
+  intros H a; apply (H (S (f a))); auto with arith.
+  induction n.
+  intros; absurd (f a < 0); auto with arith.
+  intros a ltSma.
+  apply F.
+  unfold ltof in |- *; intros b ltfafb.
+  apply IHn.
+  apply lt_le_trans with (f a); auto with arith.
 Defined. 
 
 Theorem induction_gtof1 :
- forall P:A -> Set,
-   (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
+  forall P:A -> Set,
+    (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
-exact induction_ltof1.
+  exact induction_ltof1.
 Defined.
 
 Theorem induction_ltof2 :
- forall P:A -> Set,
-   (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
+  forall P:A -> Set,
+    (forall x:A, (forall y:A, ltof y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
-exact (well_founded_induction well_founded_ltof).
+  exact (well_founded_induction well_founded_ltof).
 Defined.
 
 Theorem induction_gtof2 :
- forall P:A -> Set,
-   (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
+  forall P:A -> Set,
+    (forall x:A, (forall y:A, gtof y x -> P y) -> P x) -> forall a:A, P a.
 Proof.
-exact induction_ltof2.
+  exact induction_ltof2.
 Defined.
 
 (** If a relation [R] is compatible with [lt] i.e. if [x R y => f(x) < f(y)]
@@ -105,105 +108,105 @@ Hypothesis H_compat : forall x y:A, R x y -> f x < f y.
 
 Theorem well_founded_lt_compat : well_founded R.
 Proof.
-red in |- *.
-cut (forall n (a:A), f a < n -> Acc R a).
-intros H a; apply (H (S (f a))); auto with arith.
-induction n.
-intros; absurd (f a < 0); auto with arith.
-intros a ltSma.
-apply Acc_intro.
-intros b ltfafb.
-apply IHn.
-apply lt_le_trans with (f a); auto with arith.
+  red in |- *.
+  cut (forall n (a:A), f a < n -> Acc R a).
+  intros H a; apply (H (S (f a))); auto with arith.
+  induction n.
+  intros; absurd (f a < 0); auto with arith.
+  intros a ltSma.
+  apply Acc_intro.
+  intros b ltfafb.
+  apply IHn.
+  apply lt_le_trans with (f a); auto with arith.
 Defined.
 
 End Well_founded_Nat.
 
 Lemma lt_wf : well_founded lt.
 Proof.
-exact (well_founded_ltof nat (fun m => m)).
+  exact (well_founded_ltof nat (fun m => m)).
 Defined.
 
 Lemma lt_wf_rec1 :
- forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
+  forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
 Proof.
-exact (fun p P F => induction_ltof1 nat (fun m => m) P F p).
+  exact (fun p P F => induction_ltof1 nat (fun m => m) P F p).
 Defined.
 
 Lemma lt_wf_rec :
- forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
+  forall n (P:nat -> Set), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
 Proof.
-exact (fun p P F => induction_ltof2 nat (fun m => m) P F p).
+  exact (fun p P F => induction_ltof2 nat (fun m => m) P F p).
 Defined.
 
 Lemma lt_wf_ind :
- forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
+  forall n (P:nat -> Prop), (forall n, (forall m, m < n -> P m) -> P n) -> P n.
 Proof.
-intro p; intros; elim (lt_wf p); auto with arith.
+  intro p; intros; elim (lt_wf p); auto with arith.
 Qed.
 
 Lemma gt_wf_rec :
- forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
+  forall n (P:nat -> Set), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
 Proof.
-exact lt_wf_rec.
+  exact lt_wf_rec.
 Defined.
 
 Lemma gt_wf_ind :
- forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
+  forall n (P:nat -> Prop), (forall n, (forall m, n > m -> P m) -> P n) -> P n.
 Proof lt_wf_ind.
 
 Lemma lt_wf_double_rec :
  forall P:nat -> nat -> Set,
    (forall n m,
-      (forall p q, p < n -> P p q) ->
-      (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
+     (forall p q, p < n -> P p q) ->
+     (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
 Proof.
-intros P Hrec p; pattern p in |- *; apply lt_wf_rec.
-intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith.
+  intros P Hrec p; pattern p in |- *; apply lt_wf_rec.
+  intros n H q; pattern q in |- *; apply lt_wf_rec; auto with arith.
 Defined.
 
 Lemma lt_wf_double_ind :
- forall P:nat -> nat -> Prop,
-   (forall n m,
+  forall P:nat -> nat -> Prop,
+    (forall n m,
       (forall p (q:nat), p < n -> P p q) ->
       (forall p, p < m -> P n p) -> P n m) -> forall n m, P n m.
 Proof.
-intros P Hrec p; pattern p in |- *; apply lt_wf_ind.
-intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith.
+  intros P Hrec p; pattern p in |- *; apply lt_wf_ind.
+  intros n H q; pattern q in |- *; apply lt_wf_ind; auto with arith.
 Qed.
 
 Hint Resolve lt_wf: arith.
 Hint 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 := exists2 n, F x n & (forall m, F y m -> n < m).
-
-Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y.
-Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x.
-Proof.
-intros x [n fxn]; generalize dependent x.
-pattern n in |- *; apply lt_wf_ind; intros.
-constructor; intros.
-destruct (F_compat y x) as (x0,H1,H2); trivial.
-apply (H x0); auto.
-Qed.
-
-Theorem well_founded_inv_lt_rel_compat : well_founded R.
-Proof.
-constructor; intros.
-case (F_compat y a); trivial; intros.
-apply acc_lt_rel; trivial.
-exists x; trivial.
-Qed.
+  Variable A : Set.
+  Variable R : A -> A -> Prop.
+
+  (* Relational form of inversion *)
+  Variable F : A -> nat -> Prop.
+  Definition inv_lt_rel x y := exists2 n, F x n & (forall m, F y m -> n < m).
+
+  Hypothesis F_compat : forall x y:A, R x y -> inv_lt_rel x y.
+  Remark acc_lt_rel : forall x:A, (exists n, F x n) -> Acc R x.
+  Proof.
+    intros x [n fxn]; generalize dependent x.
+    pattern n in |- *; apply lt_wf_ind; intros.
+    constructor; intros.
+    destruct (F_compat y x) as (x0,H1,H2); trivial.
+    apply (H x0); auto.
+  Qed.
+
+  Theorem well_founded_inv_lt_rel_compat : well_founded R.
+  Proof.
+    constructor; intros.
+    case (F_compat y a); trivial; intros.
+    apply acc_lt_rel; trivial.
+    exists x; trivial.
+  Qed.
 
 End LT_WF_REL.
 
 Lemma well_founded_inv_rel_inv_lt_rel :
- forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F).
-intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial.
+  forall (A:Set) (F:A -> nat -> Prop), well_founded (inv_lt_rel A F).
+  intros; apply (well_founded_inv_lt_rel_compat A (inv_lt_rel A F) F); trivial.
 Qed.
diff --git a/theories/Bool/Bool.v b/theories/Bool/Bool.v
index ff87eb96..e126ad35 100644
--- a/theories/Bool/Bool.v
+++ b/theories/Bool/Bool.v
@@ -6,9 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Bool.v 8642 2006-03-17 10:09:02Z notin $ i*)
-
-(** ** Booleans  *)
+(*i $Id: Bool.v 9246 2006-10-17 14:01:18Z herbelin $ i*)
 
 (** The type [bool] is defined in the prelude as
     [Inductive bool : Set := true : bool | false : bool] *)
@@ -16,34 +14,34 @@
 (** Interpretation of booleans as propositions *)
 Definition Is_true (b:bool) :=
   match b with
-  | true => True
-  | false => False
+    | true => True
+    | false => False
   end.
 
-(*****************)
-(** Decidability *)
-(*****************)
+(*******************)
+(** * Decidability *)
+(*******************)
 
 Lemma bool_dec : forall b1 b2 : bool, {b1 = b2} + {b1 <> b2}.
 Proof.
   decide equality.
 Defined.
 
-(*******************)
-(** Discrimination *)
-(*******************)
+(*********************)
+(** * Discrimination *)
+(*********************)
 
 Lemma diff_true_false : true <> false.
 Proof.
-unfold not in |- *; intro contr; change (Is_true false) in |- *.
-elim contr; simpl in |- *; trivial.
+  unfold not in |- *; intro contr; change (Is_true false) in |- *.
+  elim contr; simpl in |- *; trivial.
 Qed.
 Hint Resolve diff_true_false : bool v62.
 
 Lemma diff_false_true : false <> true.
 Proof. 
-red in |- *; intros H; apply diff_true_false.
-symmetry  in |- *.
+  red in |- *; intros H; apply diff_true_false.
+  symmetry  in |- *.
 assumption.
 Qed.
 Hint Resolve diff_false_true : bool v62.
@@ -51,92 +49,92 @@ Hint Extern 1 (false <> true) => exact diff_false_true.
 
 Lemma eq_true_false_abs : forall b:bool, b = true -> b = false -> False.
 Proof.
-intros b H; rewrite H; auto with bool.
+  intros b H; rewrite H; auto with bool.
 Qed.
 
 Lemma not_true_is_false : forall b:bool, b <> true -> b = false.
 Proof.
-destruct b.
-intros.
-red in H; elim H.
-reflexivity.
-intros abs.
-reflexivity.
+  destruct b.
+  intros.
+  red in H; elim H.
+  reflexivity.
+  intros abs.
+  reflexivity.
 Qed.
 
 Lemma not_false_is_true : forall b:bool, b <> false -> b = true.
 Proof.
-destruct b.
-intros.
-reflexivity.
-intro H; red in H; elim H.
-reflexivity.
+  destruct b.
+  intros.
+  reflexivity.
+  intro H; red in H; elim H.
+  reflexivity.
 Qed.
 
 (**********************)
-(** Order on booleans *)
+(** * Order on booleans *)
 (**********************)
 
 Definition leb (b1 b2:bool) :=
   match b1 with
-  | true => b2 = true
-  | false => True
+    | true => b2 = true
+    | false => True
   end.
 Hint Unfold leb: bool v62.
 
 (* Infix "<=" := leb : bool_scope. *)
 
 (*************)
-(** Equality *)
+(** * Equality *)
 (*************)
 
 Definition eqb (b1 b2:bool) : bool :=
   match b1, b2 with
-  | true, true => true
-  | true, false => false
-  | false, true => false
-  | false, false => true
+    | true, true => true
+    | true, false => false
+    | false, true => false
+    | false, false => true
   end.
 
 Lemma eqb_subst :
- forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2.
-Proof.
-unfold eqb in |- *.
-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.
+  forall (P:bool -> Prop) (b1 b2:bool), eqb b1 b2 = true -> P b1 -> P b2.
+Proof.
+  unfold eqb in |- *.
+  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 : forall b:bool, eqb b b = true.
 Proof.
-intro b.
-case b.
-trivial with bool.
-trivial with bool.
+  intro b.
+  case b.
+  trivial with bool.
+  trivial with bool.
 Qed.
 
 Lemma eqb_prop : forall a b:bool, eqb a b = true -> a = b.
 Proof.
-destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity.
+  destruct a; destruct b; simpl in |- *; intro; discriminate H || reflexivity.
 Qed.
 
 
 (************************)
-(** Logical combinators *)
+(** * Logical combinators *)
 (************************)
  
 Definition ifb (b1 b2 b3:bool) : bool :=
   match b1 with
-  | true => b2
-  | false => b3
+    | true => b2
+    | false => b3
   end.
 
 Definition andb (b1 b2:bool) : bool := ifb b1 b2 false.
@@ -147,10 +145,10 @@ Definition implb (b1 b2:bool) : bool := ifb b1 b2 true.
 
 Definition xorb (b1 b2:bool) : bool :=
   match b1, b2 with
-  | true, true => false
-  | true, false => true
-  | false, true => true
-  | false, false => false
+    | true, true => false
+    | true, false => true
+    | false, true => true
+    | false, false => false
   end.
 
 Definition negb (b:bool) := if b then false else true.
@@ -165,7 +163,7 @@ Delimit Scope bool_scope with bool.
 Bind Scope bool_scope with bool.
 
 (****************************)
-(** De Morgan laws          *)
+(** * De Morgan laws          *)
 (****************************)
 
 Lemma negb_orb : forall b1 b2:bool, negb (b1 || b2) = negb b1 && negb b2.
@@ -179,17 +177,17 @@ Proof.
 Qed.
 
 (********************************)
-(** *** Properties of [negb]    *)
+(** * Properties of [negb]    *)
 (********************************)
 
 Lemma negb_involutive : forall b:bool, negb (negb b) = b.
 Proof.
-destruct b; reflexivity.
+  destruct b; reflexivity.
 Qed.
 
 Lemma negb_involutive_reverse : forall b:bool, b = negb (negb b).
 Proof.
-destruct b; reflexivity.
+  destruct b; reflexivity.
 Qed.
 
 Notation negb_elim := negb_involutive (only parsing).
@@ -197,68 +195,68 @@ Notation negb_intro := negb_involutive_reverse (only parsing).
 
 Lemma negb_sym : forall b b':bool, b' = negb b -> b = negb b'.
 Proof.
-destruct b; destruct b'; intros; simpl in |- *; trivial with bool.
+  destruct b; destruct b'; intros; simpl in |- *; trivial with bool.
 Qed.
 
 Lemma no_fixpoint_negb : forall b:bool, negb b <> b.
 Proof.
-destruct b; simpl in |- *; intro; apply diff_true_false;
- auto with bool.
+  destruct b; simpl in |- *; intro; apply diff_true_false;
+    auto with bool.
 Qed.
 
 Lemma eqb_negb1 : forall b:bool, eqb (negb b) b = false.
 Proof.
-destruct b.
-trivial with bool.
-trivial with bool.
+  destruct b.
+  trivial with bool.
+  trivial with bool.
 Qed.
  
 Lemma eqb_negb2 : forall b:bool, eqb b (negb b) = false.
 Proof.
-destruct b.
-trivial with bool.
-trivial with bool.
+  destruct b.
+  trivial with bool.
+  trivial with bool.
 Qed.
 
 
 Lemma if_negb :
- forall (A:Set) (b:bool) (x y:A),
-   (if negb b then x else y) = (if b then y else x).
+  forall (A:Set) (b:bool) (x y:A),
+    (if negb b then x else y) = (if b then y else x).
 Proof.
   destruct b; trivial.
 Qed.
 
 
 (********************************)
-(** *** Properties of [orb]     *)
+(** * Properties of [orb]     *)
 (********************************)
 
 Lemma orb_true_elim :
   forall b1 b2:bool, b1 || b2 = true -> {b1 = true} + {b2 = true}.
 Proof.
-destruct b1; simpl in |- *; auto with bool.
+  destruct b1; simpl in |- *; auto with bool.
 Defined.
 
 Lemma orb_prop : forall a b:bool, a || b = true -> a = true \/ b = true.
 Proof.
-destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
- auto with bool.
+  destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
+    auto with bool.
 Qed.
 
 Lemma orb_true_intro :
- forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true.
+  forall b1 b2:bool, b1 = true \/ b2 = true -> b1 || b2 = true.
 Proof.
-destruct b1; auto with bool.
-destruct 1; intros.
-elim diff_true_false; auto with bool.
-rewrite H; trivial with bool.
+  destruct b1; auto with bool.
+  destruct 1; intros.
+  elim diff_true_false; auto with bool.
+  rewrite H; trivial with bool.
 Qed.
 Hint Resolve orb_true_intro: bool v62.
 
 Lemma orb_false_intro :
- forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
+  forall b1 b2:bool, b1 = false -> b2 = false -> b1 || b2 = false.
 Proof.
-intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool.
+  intros b1 b2 H1 H2; rewrite H1; rewrite H2; trivial with bool.
 Qed.
 Hint Resolve orb_false_intro: bool v62.
 
@@ -266,13 +264,13 @@ Hint Resolve orb_false_intro: bool v62.
 
 Lemma orb_true_r : forall b:bool, b || true = true.
 Proof.
-auto with bool.
+  auto with bool.
 Qed.
 Hint Resolve orb_true_r: bool v62.
 
 Lemma orb_true_l : forall b:bool, true || b = true.
 Proof.
-trivial with bool.
+  trivial with bool.
 Qed.
 
 Notation orb_b_true := orb_true_r (only parsing).
@@ -296,7 +294,7 @@ Notation orb_b_false := orb_false_r (only parsing).
 Notation orb_false_b := orb_false_l (only parsing).
 
 Lemma orb_false_elim :
- forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false.
+  forall b1 b2:bool, b1 || b2 = false -> b1 = false /\ b2 = false.
 Proof.
   destruct b1.
   intros; elim diff_true_false; auto with bool.
@@ -319,7 +317,7 @@ Notation orb_neg_b := orb_negb_r (only parsing).
 
 Lemma orb_comm : forall b1 b2:bool, b1 || b2 = b2 || b1.
 Proof.
-destruct b1; destruct b2; reflexivity.
+  destruct b1; destruct b2; reflexivity.
 Qed.
 
 (** Associativity *)
@@ -330,14 +328,14 @@ Proof.
 Qed.
 Hint Resolve orb_comm orb_assoc: bool v62.
 
-(*********************************)
-(** *** Properties of [andb]     *)
-(*********************************)
+(*******************************)
+(** * Properties of [andb]     *)
+(*******************************)
 
 Lemma andb_prop : forall a b:bool, a && b = true -> a = true /\ b = true.
 Proof.
   destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
-   auto with bool.
+    auto with bool.
 Qed.
 Hint Resolve andb_prop: bool v62.
 
@@ -348,7 +346,7 @@ Proof.
 Defined.
 
 Lemma andb_true_intro :
- forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true.
+  forall b1 b2:bool, b1 = true /\ b2 = true -> b1 && b2 = true.
 Proof.
   destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
 Qed.
@@ -356,24 +354,24 @@ Hint Resolve andb_true_intro: bool v62.
 
 Lemma andb_false_intro1 : forall b1 b2:bool, b1 = false -> b1 && b2 = false.
 Proof.
-destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
+  destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
 Qed.
 
 Lemma andb_false_intro2 : forall b1 b2:bool, b2 = false -> b1 && b2 = false.
 Proof.
-destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
+  destruct b1; destruct b2; simpl in |- *; tauto || auto with bool.
 Qed.
 
 (** [false] is a zero for [andb] *)
 
 Lemma andb_false_r : forall b:bool, b && false = false.
 Proof.
-destruct b; auto with bool.
+  destruct b; auto with bool.
 Qed.
 
 Lemma andb_false_l : forall b:bool, false && b = false.
 Proof.
-trivial with bool.
+  trivial with bool.
 Qed.
 
 Notation andb_b_false := andb_false_r (only parsing).
@@ -383,12 +381,12 @@ Notation andb_false_b := andb_false_l (only parsing).
 
 Lemma andb_true_r : forall b:bool, b && true = b.
 Proof.
-destruct b; auto with bool.
+  destruct b; auto with bool.
 Qed.
 
 Lemma andb_true_l : forall b:bool, true && b = b.
 Proof.
-trivial with bool.
+  trivial with bool.
 Qed.
 
 Notation andb_b_true := andb_true_r (only parsing).
@@ -397,7 +395,7 @@ Notation andb_true_b := andb_true_l (only parsing).
 Lemma andb_false_elim :
   forall b1 b2:bool, b1 && b2 = false -> {b1 = false} + {b2 = false}.
 Proof.
-destruct b1; simpl in |- *; auto with bool.
+  destruct b1; simpl in |- *; auto with bool.
 Defined.
 Hint Resolve andb_false_elim: bool v62.
 
@@ -405,7 +403,7 @@ Hint Resolve andb_false_elim: bool v62.
 
 Lemma andb_negb_r : forall b:bool, b && negb b = false.
 Proof.
-destruct b; reflexivity.
+  destruct b; reflexivity.
 Qed.   
 Hint Resolve andb_negb_r: bool v62.
 
@@ -415,46 +413,46 @@ Notation andb_neg_b := andb_negb_r (only parsing).
 
 Lemma andb_comm : forall b1 b2:bool, b1 && b2 = b2 && b1.
 Proof.
-destruct b1; destruct b2; reflexivity.
+  destruct b1; destruct b2; reflexivity.
 Qed.
 
 (** Associativity *)
 
 Lemma andb_assoc : forall b1 b2 b3:bool, b1 && (b2 && b3) = b1 && b2 && b3.
 Proof.
-destruct b1; destruct b2; destruct b3; reflexivity.
+  destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
 
 Hint Resolve andb_comm andb_assoc: bool v62.
 
 (*******************************************)
-(** *** Properties mixing [andb] and [orb] *)
+(** * Properties mixing [andb] and [orb] *)
 (*******************************************)
 
 (** Distributivity *)
 
 Lemma andb_orb_distrib_r :
- forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3.
+  forall b1 b2 b3:bool, b1 && (b2 || b3) = b1 && b2 || b1 && b3.
 Proof.
-destruct b1; destruct b2; destruct b3; reflexivity.
+  destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
 
 Lemma andb_orb_distrib_l :
  forall b1 b2 b3:bool, (b1 || b2) && b3 = b1 && b3 || b2 && b3.
 Proof.
-destruct b1; destruct b2; destruct b3; reflexivity.
+  destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
 
 Lemma orb_andb_distrib_r :
- forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3).
+  forall b1 b2 b3:bool, b1 || b2 && b3 = (b1 || b2) && (b1 || b3).
 Proof.
-destruct b1; destruct b2; destruct b3; reflexivity.
+  destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
 
 Lemma orb_andb_distrib_l :
- forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3).
+  forall b1 b2 b3:bool, b1 && b2 || b3 = (b1 || b3) && (b2 || b3).
 Proof.
-destruct b1; destruct b2; destruct b3; reflexivity.
+  destruct b1; destruct b2; destruct b3; reflexivity.
 Qed.
 
 (* Compatibility *)
@@ -475,46 +473,64 @@ Proof.
   destruct b1; destruct b2; simpl in |- *; reflexivity.
 Qed.
 
-(***********************************)
-(** *** Properties of [xorb]       *)
-(***********************************)
+(*********************************)
+(** * Properties of [xorb]       *)
+(*********************************)
 
-Lemma xorb_false : forall b:bool, xorb b false = b.
+(** [false] is neutral for [xorb] *)
+
+Lemma xorb_false_r : forall b:bool, xorb b false = b.
 Proof.
   destruct b; trivial.
 Qed.
 
-Lemma false_xorb : forall b:bool, xorb false b = b.
+Lemma xorb_false_l : forall b:bool, xorb false b = b.
 Proof.
   destruct b; trivial.
 Qed.
 
-Lemma xorb_true : forall b:bool, xorb b true = negb b.
+Notation xorb_false := xorb_false_r (only parsing).
+Notation false_xorb := xorb_false_l (only parsing).
+
+(** [true] is "complementing" for [xorb] *)
+
+Lemma xorb_true_r : forall b:bool, xorb b true = negb b.
 Proof.
   trivial.
 Qed.
 
-Lemma true_xorb : forall b:bool, xorb true b = negb b.
+Lemma xorb_true_l : forall b:bool, xorb true b = negb b.
 Proof.
   destruct b; trivial.
 Qed.
 
+Notation xorb_true := xorb_true_r (only parsing).
+Notation true_xorb := xorb_true_l (only parsing).
+
+(** Nilpotency (alternatively: identity is a inverse for [xorb]) *)
+
 Lemma xorb_nilpotent : forall b:bool, xorb b b = false.
 Proof.
   destruct b; trivial.
 Qed.
 
+(** Commutativity *)
+
 Lemma xorb_comm : forall b b':bool, xorb b b' = xorb b' b.
 Proof.
   destruct b; destruct b'; trivial.
 Qed.
 
-Lemma xorb_assoc :
- forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b'').
+(** Associativity *)
+
+Lemma xorb_assoc_reverse :
+  forall b b' b'':bool, xorb (xorb b b') b'' = xorb b (xorb b' b'').
 Proof.
   destruct b; destruct b'; destruct b''; trivial.
 Qed.
 
+Notation xorb_assoc := xorb_assoc_reverse (only parsing). (* Compatibility *)
+
 Lemma xorb_eq : forall b b':bool, xorb b b' = false -> b = b'.
 Proof.
   destruct b; destruct b'; trivial.
@@ -522,26 +538,26 @@ Proof.
 Qed.
 
 Lemma xorb_move_l_r_1 :
- forall b b' b'':bool, xorb b b' = b'' -> b' = xorb b b''.
+  forall 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 :
- forall b b' b'':bool, xorb b b' = b'' -> b = xorb b'' b'.
+  forall 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 :
- forall b b' b'':bool, b = xorb b' b'' -> xorb b' b = b''.
+  forall 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 :
- forall b b' b'':bool, b = xorb b' b'' -> xorb b b'' = b'.
+  forall 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.
@@ -550,24 +566,24 @@ Qed.
 
 Lemma eq_true_iff_eq : forall b1 b2, (b1 = true <-> b2 = true) -> b1 = b2. 
 Proof. 
- intros b1 b2; case b1; case b2; intuition.
+  intros b1 b2; case b1; case b2; intuition.
 Qed.
 
-Notation bool_1 := eq_true_iff_eq. (* Compatibility *)
+Notation bool_1 := eq_true_iff_eq (only parsing). (* Compatibility *)
 
 Lemma eq_true_negb_classical : forall b:bool, negb b <> true -> b = true.
 Proof.
   destruct b; intuition.
 Qed.
 
-Notation bool_3 := eq_true_negb_classical. (* Compatibility *)
+Notation bool_3 := eq_true_negb_classical (only parsing). (* Compatibility *)
 
 Lemma eq_true_not_negb : forall b:bool, b <> true -> negb b = true.  
 Proof.
   destruct b; intuition.
 Qed.
 
-Notation bool_6 := eq_true_not_negb. (* Compatibility *)
+Notation bool_6 := eq_true_not_negb (only parsing). (* Compatibility *)
 
 Hint Resolve eq_true_not_negb : bool.
 
@@ -596,7 +612,7 @@ Qed.
 Hint Resolve trans_eq_bool.
 
 (*****************************************)
-(** *** Reflection of [bool] into [Prop] *)
+(** * Reflection of [bool] into [Prop] *)
 (*****************************************)
 
 (** [Is_true] and equality *)
@@ -605,9 +621,9 @@ Hint Unfold Is_true: bool.
 
 Lemma Is_true_eq_true : forall x:bool, Is_true x -> x = true.
 Proof.
-destruct x; simpl in |- *; tauto.
+  destruct x; simpl in |- *; tauto.
 Qed.
- 
+
 Lemma Is_true_eq_left : forall x:bool, x = true -> Is_true x.
 Proof.
   intros; rewrite H; auto with bool.
@@ -635,7 +651,7 @@ Qed.
 (** [Is_true] and connectives *)
 
 Lemma orb_prop_elim : 
- forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b.
+  forall a b:bool, Is_true (a || b) -> Is_true a \/ Is_true b.
 Proof.
   destruct a; destruct b; simpl; tauto.
 Qed.
@@ -643,13 +659,13 @@ Qed.
 Notation orb_prop2 := orb_prop_elim (only parsing).
 
 Lemma orb_prop_intro : 
- forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b).
+  forall a b:bool, Is_true a \/ Is_true b -> Is_true (a || b).
 Proof.
   destruct a; destruct b; simpl; tauto.
 Qed.
 
 Lemma andb_prop_intro :
- forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (b1 && b2).
+  forall b1 b2:bool, Is_true b1 /\ Is_true b2 -> Is_true (b1 && b2).
 Proof.
   destruct b1; destruct b2; simpl in |- *; tauto.
 Qed.
@@ -660,42 +676,42 @@ Notation andb_true_intro2 :=
   (only parsing).
 
 Lemma andb_prop_elim :
- forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b.
+  forall a b:bool, Is_true (a && b) -> Is_true a /\ Is_true b.
 Proof.
   destruct a; destruct b; simpl in |- *; try (intro H; discriminate H);
-   auto with bool.
+    auto with bool.
 Qed.
 Hint Resolve andb_prop_elim: bool v62.
 
 Notation andb_prop2 := andb_prop_elim (only parsing).
 
 Lemma eq_bool_prop_intro : 
- forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. 
+  forall b1 b2, (Is_true b1 <-> Is_true b2) -> b1 = b2. 
 Proof. 
- destruct b1; destruct b2; simpl in *; intuition.
+  destruct b1; destruct b2; simpl in *; intuition.
 Qed.
 
 Lemma eq_bool_prop_elim : forall b1 b2, b1 = b2 -> (Is_true b1 <-> Is_true b2).
 Proof. 
- intros b1 b2; case b1; case b2; intuition.
+  intros b1 b2; case b1; case b2; intuition.
 Qed. 
 
 Lemma negb_prop_elim : forall b, Is_true (negb b) -> ~ Is_true b.
 Proof.
- destruct b; intuition.
+  destruct b; intuition.
 Qed.
 
 Lemma negb_prop_intro : forall b, ~ Is_true b -> Is_true (negb b).
 Proof.
- destruct b; simpl in *; intuition.
+  destruct b; simpl in *; intuition.
 Qed.
 
 Lemma negb_prop_classical : forall b, ~ Is_true (negb b) -> Is_true b.
 Proof.
- destruct b; intuition.
+  destruct b; intuition.
 Qed.
 
 Lemma negb_prop_involutive : forall b, Is_true b -> ~ Is_true (negb b).
 Proof.
- destruct b; intuition.
+  destruct b; intuition.
 Qed.
diff --git a/theories/Bool/Bvector.v b/theories/Bool/Bvector.v
index 576993c9..659630c5 100644
--- a/theories/Bool/Bvector.v
+++ b/theories/Bool/Bvector.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Bvector.v 8866 2006-05-28 16:21:04Z herbelin $ i*)
+(*i $Id: Bvector.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Bit vectors. Contribution by Jean Duprat (ENS Lyon). *)
 
@@ -16,34 +16,34 @@ Require Import Arith.
 
 Open Local Scope nat_scope.
 
-(*  
+(** 
 On s'inspire de List.v pour fabriquer les vecteurs de bits.
-La dimension du vecteur est un paramètre trop important pour
+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.
+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, car le
-mécanisme d'inférence du type du filtrage n'est pas aussi puissant que
-celui implanté par les tactiques d'élimination.
+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, car le
+mécanisme d'inférence du type du filtrage n'est pas aussi puissant que
+celui implanté par les tactiques d'élimination.
 *)
 
 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.
+(** 
+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 couples de vecteurs 
+de taille n dans les vecteurs de taille n en appliquant f terme à terme.
 *)
 
 Variable A : Type.
@@ -54,129 +54,129 @@ Inductive vector : nat -> Type :=
 
 Definition Vhead : forall n:nat, vector (S n) -> A.
 Proof.
-	intros n v; inversion v; exact a.
+  intros n v; inversion v; exact a.
 Defined.
 
 Definition Vtail : forall n:nat, vector (S n) -> vector n.
 Proof.
-	intros n v; inversion v as [|_ n0 H0 H1]; exact H0.
+  intros n v; inversion v as [|_ n0 H0 H1]; exact H0.
 Defined.
 
 Definition Vlast : forall n:nat, vector (S n) -> A.
 Proof.
-	induction n as [| n f]; intro v.
-	inversion v.
-	exact a.
-
-	inversion v as [| n0 a H0 H1].
-	exact (f H0).
+  induction n as [| n f]; intro v.
+  inversion v.
+  exact a.
+  
+  inversion v as [| n0 a H0 H1].
+  exact (f H0).
 Defined.
 
 Definition Vconst : forall (a:A) (n:nat), vector n.
 Proof.
-	induction n as [| n v].
-	exact Vnil.
+  induction n as [| n v].
+  exact Vnil.
 
-	exact (Vcons a n v).
+  exact (Vcons a n v).
 Defined.
 
 Lemma Vshiftout : forall n:nat, vector (S n) -> vector n.
 Proof.
-	induction n as [| n f]; intro v.
-	exact Vnil.
-
-	inversion v as [| a n0 H0 H1].
-	exact (Vcons a n (f H0)).
+  induction n as [| n f]; intro v.
+  exact Vnil.
+  
+  inversion v as [| a n0 H0 H1].
+  exact (Vcons a n (f H0)).
 Defined.
 
 Lemma Vshiftin : forall n:nat, A -> vector n -> vector (S n).
 Proof.
-	induction n as [| n f]; intros a v.
-	exact (Vcons a 0 v).
-
-	inversion v as [| a0 n0 H0 H1 ].
-	exact (Vcons a (S n) (f a H0)).
+  induction n as [| n f]; intros a v.
+  exact (Vcons a 0 v).
+  
+  inversion v as [| a0 n0 H0 H1 ].
+  exact (Vcons a (S n) (f a H0)).
 Defined.
 
 Lemma Vshiftrepeat : forall n:nat, vector (S n) -> vector (S (S n)).
 Proof.
-	induction n as [| n f]; intro v.
-	inversion v.
-	exact (Vcons a 1 v).
-
-	inversion v as [| a n0 H0 H1 ].
-	exact (Vcons a (S (S n)) (f H0)).
+  induction n as [| n f]; intro v.
+  inversion v.
+  exact (Vcons a 1 v).
+  
+  inversion v as [| a n0 H0 H1 ].
+  exact (Vcons a (S (S n)) (f H0)).
 Defined.
 
 Lemma Vtrunc : forall n p:nat, n > p -> vector n -> vector (n - p).
 Proof.
-	induction p as [| p f]; intros H v.
-	rewrite <- minus_n_O.
-	exact v.
-
-	apply (Vshiftout (n - S p)).
-
-rewrite minus_Sn_m.
-apply f.
-auto with *.
-exact v.
-auto with *.
+  induction p as [| p f]; intros H v.
+  rewrite <- minus_n_O.
+  exact v.
+  
+  apply (Vshiftout (n - S p)).
+  
+  rewrite minus_Sn_m.
+  apply f.
+  auto with *.
+  exact v.
+  auto with *.
 Defined.
 
 Lemma Vextend : forall n p:nat, vector n -> vector p -> vector (n + p).
 Proof.
-	induction n as [| n f]; intros p v v0.
-	simpl in |- *; exact v0.
-
-	inversion v as [| a n0 H0 H1].
-	simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)).
+  induction n as [| n f]; intros p v v0.
+  simpl in |- *; exact v0.
+  
+  inversion v as [| a n0 H0 H1].
+  simpl in |- *; exact (Vcons a (n + p) (f p H0 v0)).
 Defined.
 
 Variable f : A -> A.
 
 Lemma Vunary : forall n:nat, vector n -> vector n.
 Proof.
-	induction n as [| n g]; intro v.
-	exact Vnil.
-
-	inversion v as [| a n0 H0 H1].
-	exact (Vcons (f a) n (g H0)).
+  induction n as [| n g]; intro v.
+  exact Vnil.
+  
+  inversion v as [| a n0 H0 H1].
+  exact (Vcons (f a) n (g H0)).
 Defined.
 
 Variable g : A -> A -> A.
 
 Lemma Vbinary : forall n:nat, vector n -> vector n -> vector n.
 Proof.
-	induction n as [| n h]; intros v v0.
-	exact Vnil.
-
-	inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3].
-	exact (Vcons (g a a0) n (h H0 H2)).
+  induction n as [| n h]; intros v v0.
+  exact Vnil.
+  
+  inversion v as [| a n0 H0 H1]; inversion v0 as [| a0 n1 H2 H3].
+  exact (Vcons (g a a0) n (h H0 H2)).
 Defined.
 
 Definition Vid : forall n:nat, vector n -> vector n.
 Proof.
-destruct n; intro X.
-exact Vnil.
-exact (Vcons (Vhead _ X) _ (Vtail _ X)).
+  destruct n; intro X.
+  exact Vnil.
+  exact (Vcons (Vhead _ X) _ (Vtail _ X)).
 Defined.
 
 Lemma Vid_eq : forall (n:nat) (v:vector n), v=(Vid n v).
 Proof.
-destruct v; auto.
+  destruct v; auto.
 Qed.
 
 Lemma VSn_eq :
   forall (n : nat) (v : vector (S n)), v = Vcons (Vhead _ v) _ (Vtail _ v).
 Proof.
-intros.
-exact (Vid_eq _ v).
+  intros.
+  exact (Vid_eq _ v).
 Qed.
 
 Lemma V0_eq : forall (v : vector 0), v = Vnil.
 Proof.
-intros.
-exact (Vid_eq _ v).
+  intros.
+  exact (Vid_eq _ v).
 Qed.
 
 End VECTORS.
@@ -188,15 +188,15 @@ Implicit Arguments Vcons [A n].
 
 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.
+(**
+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
+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
+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).
 *)
 
@@ -234,24 +234,24 @@ 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) {struct p} :
- Bvector (S n) :=
+  Bvector (S n) :=
   match p with
-  | O => bv
-  | S p' => BshiftL n (BshiftL_iter n bv p') false
+    | O => bv
+    | S p' => BshiftL n (BshiftL_iter n bv p') false
   end.
 
 Fixpoint BshiftRl_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} :
- Bvector (S n) :=
+  Bvector (S n) :=
   match p with
-  | O => bv
-  | S p' => BshiftRl n (BshiftRl_iter n bv p') false
+    | O => bv
+    | S p' => BshiftRl n (BshiftRl_iter n bv p') false
   end.
 
 Fixpoint BshiftRa_iter (n:nat) (bv:Bvector (S n)) (p:nat) {struct p} :
- Bvector (S n) :=
+  Bvector (S n) :=
   match p with
-  | O => bv
-  | S p' => BshiftRa n (BshiftRa_iter n bv p')
+    | O => bv
+    | S p' => BshiftRa n (BshiftRa_iter n bv p')
   end.
 
 End BOOLEAN_VECTORS.
diff --git a/theories/Bool/DecBool.v b/theories/Bool/DecBool.v
index 31ff029c..af9acea1 100644
--- a/theories/Bool/DecBool.v
+++ b/theories/Bool/DecBool.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: DecBool.v 8866 2006-05-28 16:21:04Z herbelin $ i*)
+(*i $Id: DecBool.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Set Implicit Arguments.
 
@@ -15,17 +15,19 @@ Definition ifdec (A B:Prop) (C:Type) (H:{A} + {B}) (x y:C) : C :=
 
 
 Theorem ifdec_left :
- forall (A B:Prop) (C:Set) (H:{A} + {B}),
-   ~ B -> forall x y:C, ifdec H x y = x.
-intros; case H; auto.
-intro; absurd B; trivial.
+  forall (A B:Prop) (C:Set) (H:{A} + {B}),
+    ~ B -> forall x y:C, ifdec H x y = x.
+Proof.
+  intros; case H; auto.
+  intro; absurd B; trivial.
 Qed.
 
 Theorem ifdec_right :
- forall (A B:Prop) (C:Set) (H:{A} + {B}),
-   ~ A -> forall x y:C, ifdec H x y = y.
-intros; case H; auto.
-intro; absurd A; trivial.
+  forall (A B:Prop) (C:Set) (H:{A} + {B}),
+    ~ A -> forall x y:C, ifdec H x y = y.
+Proof.
+  intros; case H; auto.
+  intro; absurd A; trivial.
 Qed.
 
 Unset Implicit Arguments.
diff --git a/theories/Bool/Sumbool.v b/theories/Bool/Sumbool.v
index 2842437d..0da72f56 100644
--- a/theories/Bool/Sumbool.v
+++ b/theories/Bool/Sumbool.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sumbool.v 7235 2005-07-15 17:11:57Z coq $ i*)
+(*i $Id: Sumbool.v 9245 2006-10-17 12:53:34Z notin $ 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
@@ -16,7 +16,6 @@
 (** A boolean is either [true] or [false], and this is decidable *)
 
 Definition sumbool_of_bool : forall b:bool, {b = true} + {b = false}.
-Proof.
   destruct b; auto.
 Defined.
 
@@ -25,41 +24,36 @@ Hint Resolve sumbool_of_bool: bool.
 Definition bool_eq_rec :
   forall (b:bool) (P:bool -> Set),
     (b = true -> P true) -> (b = false -> P false) -> P b.
-destruct b; auto.
+  destruct b; auto.
 Defined.
 
 Definition bool_eq_ind :
   forall (b:bool) (P:bool -> Prop),
     (b = true -> P true) -> (b = false -> P false) -> P b.
-destruct b; auto.
+  destruct 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.
+  Variables A B C D : Prop.
+  
+  Hypothesis H1 : {A} + {B}.
+  Hypothesis H2 : {C} + {D}.
+  
+  Definition sumbool_and : {A /\ C} + {B \/ D}.
+    case H1; case H2; auto.
+  Defined.
+  
+  Definition sumbool_or : {A \/ C} + {B /\ D}.
+    case H1; case H2; auto.
+  Defined.
+  
+  Definition sumbool_not : {B} + {A}.
+    case H1; auto.
+  Defined.
 
 End connectives.
 
@@ -71,8 +65,7 @@ Hint Immediate sumbool_not : core.
 
 Definition bool_of_sumbool :
   forall 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 ].
+  intros A B H.
+  elim H; intro; [exists true | exists false]; assumption.
 Defined.
 Implicit Arguments bool_of_sumbool.
\ No newline at end of file
diff --git a/theories/Bool/Zerob.v b/theories/Bool/Zerob.v
index c9abf94a..fe656777 100644
--- a/theories/Bool/Zerob.v
+++ b/theories/Bool/Zerob.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zerob.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Zerob.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Arith.
 Require Import Bool.
@@ -15,24 +15,28 @@ Open Local Scope nat_scope.
 
 Definition zerob (n:nat) : bool :=
   match n with
-  | O => true
-  | S _ => false
+    | O => true
+    | S _ => false
   end.
 
 Lemma zerob_true_intro : forall n:nat, n = 0 -> zerob n = true.
-destruct n; [ trivial with bool | inversion 1 ].
+Proof.
+  destruct n; [ trivial with bool | inversion 1 ].
 Qed.
 Hint Resolve zerob_true_intro: bool.
 
 Lemma zerob_true_elim : forall n:nat, zerob n = true -> n = 0.
-destruct n; [ trivial with bool | inversion 1 ].
+Proof.
+  destruct n; [ trivial with bool | inversion 1 ].
 Qed.
 
 Lemma zerob_false_intro : forall n:nat, n <> 0 -> zerob n = false.
-destruct n; [ destruct 1; auto with bool | trivial with bool ].
+Proof.
+  destruct n; [ destruct 1; auto with bool | trivial with bool ].
 Qed.
 Hint Resolve zerob_false_intro: bool.
 
 Lemma zerob_false_elim : forall n:nat, zerob n = false -> n <> 0.
-destruct n; [ intro H; inversion H | auto with bool ].
+Proof.
+  destruct n; [ inversion 1 | auto with bool ].
 Qed.
\ No newline at end of file
diff --git a/theories/FSets/FMapPositive.v b/theories/FSets/FMapPositive.v
index dcb7fb49..911de00e 100644
--- a/theories/FSets/FMapPositive.v
+++ b/theories/FSets/FMapPositive.v
@@ -11,8 +11,9 @@
  * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
  *              91405 Orsay, France *)
 
-(* $Id: FMapPositive.v 8773 2006-04-29 14:31:32Z letouzey $ *)
+(* $Id: FMapPositive.v 9178 2006-09-26 11:18:22Z barras $ *)
 
+Require Import Bool.
 Require Import ZArith.
 Require Import OrderedType.
 Require Import FMapInterface.
@@ -734,7 +735,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
   Proof.
   intros.
   generalize (xelements_complete _ _ _ _ H); clear H; intros.
-  revert H; revert v; revert m; revert q; revert p0.
+  revert p0 q m v H.
   induction p; destruct p0; simpl; intros; eauto; try discriminate.
   Qed.
 
@@ -743,7 +744,7 @@ Module PositiveMap <: S with Module E:=PositiveOrderedTypeBits.
   Proof.
   intros.
   generalize (xelements_complete _ _ _ _ H); clear H; intros.
-  revert H; revert v; revert m; revert q; revert p0.
+  revert p0 q m v H.
   induction p; destruct p0; simpl; intros; eauto; try discriminate.
   Qed.
 
diff --git a/theories/FSets/FSetWeak.v b/theories/FSets/FSetWeak.v
index bfe34cd7..c88a7869 100644
--- a/theories/FSets/FSetWeak.v
+++ b/theories/FSets/FSetWeak.v
@@ -6,11 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1       *)
 (***********************************************************************)
 
-(* $Id: FSetWeak.v 8819 2006-05-15 09:52:36Z letouzey $ *)
+(* $Id: FSetWeak.v 9278 2006-10-25 13:43:17Z letouzey $ *)
 
 Require Export DecidableType.
 Require Export DecidableTypeEx.
 Require Export FSetWeakInterface.
-Require Export FSetFacts.
-Require Export FSetProperties.
+Require Export FSetWeakFacts.
+Require Export FSetWeakProperties.
 Require Export FSetWeakList.
diff --git a/theories/FSets/OrderedTypeEx.v b/theories/FSets/OrderedTypeEx.v
index 1c5a4054..6fa6a85c 100644
--- a/theories/FSets/OrderedTypeEx.v
+++ b/theories/FSets/OrderedTypeEx.v
@@ -11,7 +11,7 @@
  * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
  *              91405 Orsay, France *)
 
-(* $Id: OrderedTypeEx.v 8836 2006-05-20 21:34:27Z letouzey $ *)
+(* $Id: OrderedTypeEx.v 9066 2006-08-14 10:11:18Z letouzey $ *)
 
 Require Import OrderedType.
 Require Import ZArith.
@@ -66,7 +66,7 @@ Module Nat_as_OT <: UsualOrderedType.
     constructor 1; auto.
     constructor 2; auto.
     intro; constructor 3; auto.
-  Qed.
+  Defined.
 
 End Nat_as_OT.
 
@@ -182,7 +182,7 @@ Module N_as_OT <: UsualOrderedType.
    destruct (Nle x y); auto.
    destruct (x ?= y)%N; simpl; try discriminate.
    intros (H0,_); elim H0; auto.
-  Qed.
+  Defined.
 
 End N_as_OT.
 
@@ -242,7 +242,7 @@ Module PairOrderedType(O1 O2:OrderedType) <: OrderedType.
  apply EQ; unfold eq; auto.
  apply GT; unfold lt; auto.
  apply GT; unfold lt; auto.
- Qed.
+ Defined.
 
 End PairOrderedType.
 
diff --git a/theories/Init/Datatypes.v b/theories/Init/Datatypes.v
index fdd7ba35..56dc7e95 100644
--- a/theories/Init/Datatypes.v
+++ b/theories/Init/Datatypes.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Datatypes.v 8872 2006-05-29 07:36:28Z herbelin $ i*)
+(*i $Id: Datatypes.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Set Implicit Arguments.
 
@@ -48,7 +48,7 @@ Inductive Empty_set : Set :=.
     sole inhabitant is denoted [refl_identity A a] *)
 
 Inductive identity (A:Type) (a:A) : A -> Type :=
-    refl_identity : identity (A:=A) a a.
+  refl_identity : identity (A:=A) a a.
 Hint Resolve refl_identity: core v62.
 
 Implicit Arguments identity_ind [A].
@@ -65,8 +65,8 @@ Implicit Arguments None [A].
 
 Definition option_map (A B:Type) (f:A->B) o :=
   match o with
-  | Some a => Some (f a)
-  | None => None
+    | Some a => Some (f a)
+    | None => None
   end.
 
 (** [sum A B], written [A + B], is the disjoint sum of [A] and [B] *)
@@ -81,7 +81,7 @@ Notation "x + y" := (sum x y) : type_scope.
     the pair [pair A B a b] of [a] and [b] is abbreviated [(a,b)] *)
 
 Inductive prod (A B:Type) : Type :=
-    pair : A -> B -> prod A B.
+  pair : A -> B -> prod A B.
 Add Printing Let prod.
 
 Notation "x * y" := (prod x y) : type_scope.
@@ -90,27 +90,27 @@ Notation "( x , y , .. , z )" := (pair .. (pair x y) .. z) : core_scope.
 Section projections.
   Variables A B : Type.
   Definition fst (p:A * B) := match p with
-                              | (x, y) => x
+				| (x, y) => x
                               end.
   Definition snd (p:A * B) := match p with
-                              | (x, y) => y
+				| (x, y) => y
                               end.
 End projections. 
 
 Hint Resolve pair inl inr: core v62.
 
 Lemma surjective_pairing :
- forall (A B:Type) (p:A * B), p = pair (fst p) (snd p).
+  forall (A B:Type) (p:A * B), p = pair (fst p) (snd p).
 Proof.
-destruct p; reflexivity.
+  destruct p; reflexivity.
 Qed.
 
 Lemma injective_projections :
- forall (A B:Type) (p1 p2:A * B),
-   fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2.
+  forall (A B:Type) (p1 p2:A * B),
+    fst p1 = fst p2 -> snd p1 = snd p2 -> p1 = p2.
 Proof.
-destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd.
-rewrite Hfst; rewrite Hsnd; reflexivity. 
+  destruct p1; destruct p2; simpl in |- *; intros Hfst Hsnd.
+  rewrite Hfst; rewrite Hsnd; reflexivity. 
 Qed.
 
 Definition prod_uncurry (A B C:Type) (f:prod A B -> C) 
@@ -130,9 +130,9 @@ Inductive comparison : Set :=
 
 Definition CompOpp (r:comparison) :=
   match r with
-  | Eq => Eq
-  | Lt => Gt
-  | Gt => Lt
+    | Eq => Eq
+    | Lt => Gt
+    | Gt => Lt
   end.
 
 (* Compatibility *)
diff --git a/theories/Init/Logic.v b/theories/Init/Logic.v
index 71583718..8b487432 100644
--- a/theories/Init/Logic.v
+++ b/theories/Init/Logic.v
@@ -6,17 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Logic.v 8936 2006-06-09 15:43:33Z herbelin $ i*)
+(*i $Id: Logic.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Set Implicit Arguments.
 
 Require Import Notations.
 
-(** *** Propositional connectives *)
+(** * Propositional connectives *)
 
 (** [True] is the always true proposition *)
 Inductive True : Prop :=
-    I : True. 
+  I : True. 
 
 (** [False] is the always false proposition *)
 Inductive False : Prop :=. 
@@ -36,8 +36,8 @@ Hint Unfold not: core.
       [proj1] and [proj2] are first and second projections of a conjunction *)
 
 Inductive and (A B:Prop) : Prop :=
-    conj : A -> B -> A /\ B 
-
+  conj : A -> B -> A /\ B 
+  
 where "A /\ B" := (and A B) : type_scope.
 
 Section Conjunction.
@@ -46,12 +46,12 @@ Section Conjunction.
 
   Theorem proj1 : A /\ B -> A.
   Proof.
-  destruct 1; trivial.
+    destruct 1; trivial.
   Qed.
 
   Theorem proj2 : A /\ B -> B.
   Proof.
-  destruct 1; trivial.
+    destruct 1; trivial.
   Qed.
 
 End Conjunction.
@@ -97,7 +97,7 @@ Definition IF_then_else (P Q R:Prop) := P /\ Q \/ ~ P /\ R.
 Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
   (at level 200, right associativity) : type_scope.
 
-(** *** First-order quantifiers *)
+(** * First-order quantifiers *)
 
 (** [ex P], or simply [exists x, P x], or also [exists x:A, P x],
     expresses the existence of an [x] of some type [A] in [Set] which
@@ -112,16 +112,16 @@ Notation "'IF' c1 'then' c2 'else' c3" := (IF_then_else c1 c2 c3)
     is provided too.
 *)
 
-(* Remark: [exists x, Q] denotes [ex (fun x => Q)] so that [exists x,
+(** Remark: [exists x, Q] denotes [ex (fun x => Q)] so that [exists x,
    P x] is in fact equivalent to [ex (fun x => P x)] which may be not
    convertible to [ex P] if [P] is not itself an abstraction *)
 
 
 Inductive ex (A:Type) (P:A -> Prop) : Prop :=
-    ex_intro : forall x:A, P x -> ex (A:=A) P.
+  ex_intro : forall x:A, P x -> ex (A:=A) P.
 
 Inductive ex2 (A:Type) (P Q:A -> Prop) : Prop :=
-    ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q.
+  ex_intro2 : forall x:A, P x -> Q x -> ex2 (A:=A) P Q.
 
 Definition all (A:Type) (P:A -> Prop) := forall x:A, P x. 
 
@@ -131,14 +131,14 @@ Notation "'exists' x , p" := (ex (fun x => p))
   (at level 200, x ident, right associativity) : type_scope.
 Notation "'exists' x : t , p" := (ex (fun x:t => p))
   (at level 200, x ident, right associativity, 
-   format "'[' 'exists'  '/  ' x  :  t ,  '/  ' p ']'")
+    format "'[' 'exists'  '/  ' x  :  t ,  '/  ' p ']'")
   : type_scope.
 
 Notation "'exists2' x , p & q" := (ex2 (fun x => p) (fun x => q))
   (at level 200, x ident, p at level 200, right associativity) : type_scope.
 Notation "'exists2' x : t , p & q" := (ex2 (fun x:t => p) (fun x:t => q))
   (at level 200, x ident, t at level 200, p at level 200, right associativity,
-   format "'[' 'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']' ']'")
+    format "'[' 'exists2'  '/  ' x  :  t ,  '/  ' '[' p  &  '/' q ']' ']'")
   : type_scope.
 
 (** Derived rules for universal quantification *)
@@ -150,17 +150,17 @@ Section universal_quantification.
 
   Theorem inst : forall x:A, all (fun x => P x) -> P x.
   Proof.
-  unfold all in |- *; auto.
+    unfold all in |- *; auto.
   Qed.
 
   Theorem gen : forall (B:Prop) (f:forall y:A, B -> P y), B -> all P.
   Proof.
-  red in |- *; auto.
+    red in |- *; auto.
   Qed.
 
 End universal_quantification.
 
-(** *** Equality *)
+(** * Equality *)
 
 (** [eq x y], or simply [x=y] expresses the equality of [x] and
     [y]. Both [x] and [y] must belong to the same type [A].
@@ -202,27 +202,27 @@ Section Logic_lemmas.
 
     Theorem sym_eq : x = y -> y = x.
     Proof.
-     destruct 1; trivial.
+      destruct 1; trivial.
     Defined.
     Opaque sym_eq.
 
     Theorem trans_eq : x = y -> y = z -> x = z.
     Proof.
-     destruct 2; trivial.
+      destruct 2; trivial.
     Defined.
     Opaque trans_eq.
 
     Theorem f_equal : x = y -> f x = f y.
     Proof.
-     destruct 1; trivial.
+      destruct 1; trivial.
     Defined.
     Opaque f_equal.
 
     Theorem sym_not_eq : x <> y -> y <> x.
     Proof.
-     red in |- *; intros h1 h2; apply h1; destruct h2; trivial.
+      red in |- *; intros h1 h2; apply h1; destruct h2; trivial.
     Qed.
-
+    
     Definition sym_equal := sym_eq.
     Definition sym_not_equal := sym_not_eq.
     Definition trans_equal := trans_eq.
@@ -231,14 +231,14 @@ Section Logic_lemmas.
 
   Definition eq_ind_r :
     forall (A:Type) (x:A) (P:A -> Prop), P x -> forall y:A, y = x -> P y.
-   intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
+    intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
   Defined.
-
+  
   Definition eq_rec_r :
     forall (A:Type) (x:A) (P:A -> Set), P x -> forall y:A, y = x -> P y.
     intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
   Defined.
-
+  
   Definition eq_rect_r :
     forall (A:Type) (x:A) (P:A -> Type), P x -> forall y:A, y = x -> P y.
     intros A x P H y H0; elim sym_eq with (1 := H0); assumption.
@@ -246,34 +246,34 @@ Section Logic_lemmas.
 End Logic_lemmas.
 
 Theorem f_equal2 :
- forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) 
-   (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2.
+  forall (A1 A2 B:Type) (f:A1 -> A2 -> B) (x1 y1:A1) 
+    (x2 y2:A2), x1 = y1 -> x2 = y2 -> f x1 x2 = f y1 y2.
 Proof.
   destruct 1; destruct 1; reflexivity.
 Qed.
 
 Theorem f_equal3 :
- forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) 
-   (x2 y2:A2) (x3 y3:A3),
-   x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3.
+  forall (A1 A2 A3 B:Type) (f:A1 -> A2 -> A3 -> B) (x1 y1:A1) 
+    (x2 y2:A2) (x3 y3:A3),
+    x1 = y1 -> x2 = y2 -> x3 = y3 -> f x1 x2 x3 = f y1 y2 y3.
 Proof.
   destruct 1; destruct 1; destruct 1; reflexivity.
 Qed.
 
 Theorem f_equal4 :
- forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) 
-   (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4),
-   x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4.
+  forall (A1 A2 A3 A4 B:Type) (f:A1 -> A2 -> A3 -> A4 -> B) 
+    (x1 y1:A1) (x2 y2:A2) (x3 y3:A3) (x4 y4:A4),
+    x1 = y1 -> x2 = y2 -> x3 = y3 -> x4 = y4 -> f x1 x2 x3 x4 = f y1 y2 y3 y4.
 Proof.
   destruct 1; destruct 1; destruct 1; destruct 1; reflexivity.
 Qed.
 
 Theorem f_equal5 :
- forall (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),
-   x1 = y1 ->
-   x2 = y2 ->
-   x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5.
+  forall (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),
+    x1 = y1 ->
+    x2 = y2 ->
+    x3 = y3 -> x4 = y4 -> x5 = y5 -> f x1 x2 x3 x4 x5 = f y1 y2 y3 y4 y5.
 Proof.
   destruct 1; destruct 1; destruct 1; destruct 1; destruct 1; reflexivity.
 Qed.
@@ -294,22 +294,26 @@ Definition uniqueness (A:Type) (P:A->Prop) := forall x y, P x -> P y -> x = y.
 
 Notation "'exists' ! x , P" := (ex (unique (fun x => P)))
   (at level 200, x ident, right associativity,
-   format "'[' 'exists' !  '/  ' x ,  '/  ' P ']'") : type_scope.
+    format "'[' 'exists' !  '/  ' x ,  '/  ' P ']'") : type_scope.
 Notation "'exists' ! x : A , P" := 
   (ex (unique (fun x:A => P)))
   (at level 200, x ident, right associativity,
-   format "'[' 'exists' !  '/  ' x  :  A ,  '/  ' P ']'") : type_scope.
+    format "'[' 'exists' !  '/  ' x  :  A ,  '/  ' P ']'") : type_scope.
 
 Lemma unique_existence : forall (A:Type) (P:A->Prop),
   ((exists x, P x) /\ uniqueness P) <-> (exists! x, P x).
 Proof.
-intros A P; split.
+  intros A P; split.
   intros ((x,Hx),Huni); exists x; red; auto.
   intros (x,(Hx,Huni)); split. 
-    exists x; assumption.
-    intros x' x'' Hx' Hx''; transitivity x.
-      symmetry; auto.
-      auto.
+  exists x; assumption.
+  intros x' x'' Hx' Hx''; transitivity x.
+  symmetry; auto.
+  auto.
 Qed.
 
+(** Being inhabited *)
+
+Inductive inhabited (A:Type) : Prop := inhabits : A -> inhabited A.
 
+Hint Resolve inhabits: core.
diff --git a/theories/Init/Peano.v b/theories/Init/Peano.v
index c0416b63..3df2b566 100644
--- a/theories/Init/Peano.v
+++ b/theories/Init/Peano.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Peano.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Peano.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** The type [nat] of Peano natural numbers (built from [O] and [S])
     is defined in [Datatypes.v] *)
@@ -47,14 +47,16 @@ Hint Resolve (f_equal pred): v62.
 
 Theorem pred_Sn : forall n:nat, n = pred (S n).
 Proof.
-  auto.
+  simpl; reflexivity.  
 Qed.
 
 (** Injectivity of successor *)
 
 Theorem eq_add_S : forall n m:nat, S n = S m -> n = m.
 Proof.
-  intros n m H; change (pred (S n) = pred (S m)) in |- *; auto.
+  intros n m Sn_eq_Sm.
+  replace (n=m) with (pred (S n) = pred (S m)) by auto using pred_Sn.
+  rewrite Sn_eq_Sm; trivial.
 Qed.
 
 Hint Immediate eq_add_S: core v62.
@@ -65,19 +67,18 @@ Proof.
 Qed.
 Hint Resolve not_eq_S: core v62.
 
-(** Zero is not the successor of a number *)
-
 Definition IsSucc (n:nat) : Prop :=
   match n with
   | O => False
   | S p => True
   end.
 
+(** Zero is not the successor of a number *)
+
 Theorem O_S : forall n:nat, 0 <> S n.
 Proof.
-  red in |- *; intros n H.
-  change (IsSucc 0) in |- *.
-  rewrite <- (sym_eq (x:=0) (y:=(S n))); [ exact I | assumption ].
+  unfold not; intros n H.
+  inversion H.
 Qed.
 Hint Resolve O_S: core v62.
 
diff --git a/theories/Init/Tactics.v b/theories/Init/Tactics.v
index ce37715e..ba210dd6 100644
--- a/theories/Init/Tactics.v
+++ b/theories/Init/Tactics.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Tactics.v 8100 2006-02-27 12:10:03Z letouzey $ i*)
+(*i $Id: Tactics.v 9268 2006-10-24 12:56:16Z herbelin $ i*)
 
 Require Import Notations.
 Require Import Logic.
@@ -15,7 +15,7 @@ Require Import Logic.
 
 (* A shorter name for generalize + clear, can be seen as an anti-intro *)
 
-Ltac revert H := generalize H; clear H.
+Tactic Notation "revert" ne_hyp_list(l) := generalize l; clear l.
 
 (* to contradict an hypothesis without copying its type. *)
 
@@ -49,24 +49,16 @@ Ltac f_equal :=
    | _ => idtac
   end.
 
-(* Rewriting in all hypothesis. *)
-
-Ltac rewrite_all Eq := match type of Eq with
-  ?a = ?b =>
-     generalize Eq; clear Eq;
-     match goal with
-    | H : context [a] |- _ => intro Eq; rewrite Eq in H; rewrite_all Eq
-    | _ => intro Eq; try rewrite Eq
-    end
- end.
-
-Ltac rewrite_all_rev Eq := match type of Eq with
-  ?a = ?b =>
-     generalize Eq; clear Eq;
-     match goal with
-    | H : context [b] |- _ => intro Eq; rewrite <- Eq in H; rewrite_all_rev Eq
-    | _ => intro Eq; try rewrite <- Eq
-    end
- end.
-
-Tactic Notation "rewrite_all" "<-" constr(H) := rewrite_all_rev H.
+(* Rewriting in all hypothesis several times everywhere *)
+
+Tactic Notation "rewrite_all" constr(eq) := repeat rewrite eq in *.
+Tactic Notation "rewrite_all" "<-" constr(eq) := repeat rewrite <- eq in *.
+
+(* Keeping a copy of an expression *)
+
+Ltac remembertac x a :=
+  let x := fresh x in
+  let H := fresh "Heq" x in
+  (set (x:=a) in *; assert (H: x=a) by reflexivity; clearbody x).
+
+Tactic Notation "remember" constr(c) "as" ident(x) := remembertac x c.
diff --git a/theories/Lists/List.v b/theories/Lists/List.v
index df2b17e0..c80d0b15 100644
--- a/theories/Lists/List.v
+++ b/theories/Lists/List.v
@@ -6,7 +6,7 @@
   (*         *       GNU Lesser General Public License Version 2.1        *)
   (************************************************************************)
 
-  (*i $Id: List.v 9035 2006-07-09 15:42:09Z herbelin $ i*)
+  (*i $Id: List.v 9290 2006-10-26 19:20:42Z herbelin $ i*)
 
 Require Import Le Gt Minus Min Bool.
 Require Import Setoid.
@@ -39,6 +39,12 @@ Section Lists.
       | x :: _ => value x
     end.
 
+ Definition hd (default:A) (l:list) :=
+   match l with
+     | nil => default
+     | x :: _ => x
+   end. 
+
   Definition tail (l:list) : list :=
     match l with
       | nil => nil
@@ -670,21 +676,27 @@ Section ListOps.
 
   (**  An alternative tail-recursive definition for reverse *) 
 
-  Fixpoint rev_acc (l l': list A) {struct l} : list A := 
+  Fixpoint rev_append (l l': list A) {struct l} : list A := 
     match l with 
       | nil => l' 
-      | a::l => rev_acc l (a::l')
+      | a::l => rev_append l (a::l')
     end.
 
-  Lemma rev_acc_rev : forall l l', rev_acc l l' = rev l ++ l'.
+  Definition rev' l : list A := rev_append l nil.
+
+  Notation rev_acc := rev_append (only parsing).
+
+  Lemma rev_append_rev : forall l l', rev_acc l l' = rev l ++ l'.
   Proof.
     induction l; simpl; auto; intros.
     rewrite <- ass_app; firstorder.
   Qed.
 
-  Lemma rev_alt : forall l, rev l = rev_acc l nil.
+  Notation rev_acc_rev := rev_append_rev (only parsing).
+
+  Lemma rev_alt : forall l, rev l = rev_append l nil.
   Proof.
-    intros; rewrite rev_acc_rev.
+    intros; rewrite rev_append_rev.
     apply app_nil_end.
   Qed.
 
@@ -1336,14 +1348,14 @@ End Fold_Right_Recursor.
       rewrite IHl; simpl; auto.
     Qed.
 
-    Lemma split_lenght_l : forall (l:list (A*B)),
+    Lemma split_length_l : forall (l:list (A*B)),
       length (fst (split l)) = length l. 
     Proof.
       induction l; simpl; auto.
       destruct a; destruct (split l); simpl; auto.
     Qed.
 
-    Lemma split_lenght_r : forall (l:list (A*B)),
+    Lemma split_length_r : forall (l:list (A*B)),
       length (snd (split l)) = length l. 
     Proof.
       induction l; simpl; auto.
diff --git a/theories/Lists/ListTactics.v b/theories/Lists/ListTactics.v
new file mode 100644
index 00000000..a3b4e647
--- /dev/null
+++ b/theories/Lists/ListTactics.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: ListTactics.v 9290 2006-10-26 19:20:42Z herbelin $ i*)
+
+Require Import BinPos.
+Require Import List.
+
+Ltac list_fold_right fcons fnil l :=
+  match l with
+  | (cons ?x ?tl) => fcons x ltac:(list_fold_right fcons fnil tl)
+  | nil => fnil
+  end.
+
+Ltac list_fold_left fcons fnil l :=
+  match l with
+  | (cons ?x ?tl) => list_fold_left fcons ltac:(fcons x fnil) tl
+  | nil => fnil
+  end.
+
+Ltac list_iter f l :=
+  match l with
+  | (cons ?x ?tl) => f x; list_iter f tl
+  | nil => idtac
+  end.
+
+Ltac list_iter_gen seq f l :=
+  match l with
+  | (cons ?x ?tl) =>
+      let t1 _ := f x in
+      let t2 _ := list_iter_gen seq f tl in
+      seq t1 t2
+  | nil => idtac
+  end.
+
+Ltac AddFvTail a l :=
+ match l with
+ | nil          => constr:(cons a l)
+ | (cons a _)   => l
+ | (cons ?x ?l) => let l' := AddFvTail a l in constr:(cons x l')
+ end.
+
+Ltac Find_at a l :=
+ let rec find n l :=
+   match l with
+   | nil => fail 100 "anomaly: Find_at"
+   | (cons a _) => eval compute in n
+   | (cons _ ?l) => find (Psucc n) l
+   end
+ in find 1%positive l.
+
+Ltac check_is_list t :=
+  match t with
+  | cons _ ?l => check_is_list l
+  | nil => idtac
+  | _ => fail 100 "anomaly: failed to build a canonical list"
+  end.
+
+Ltac check_fv l :=
+  check_is_list l;
+  match type of l with 
+  | list _ => idtac
+  | _ => fail 100 "anomaly: built an ill-typed list"
+  end.
diff --git a/theories/Logic/ChoiceFacts.v b/theories/Logic/ChoiceFacts.v
index d2b7db04..3b066cfc 100644
--- a/theories/Logic/ChoiceFacts.v
+++ b/theories/Logic/ChoiceFacts.v
@@ -7,9 +7,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ChoiceFacts.v 8999 2006-07-04 12:46:04Z notin $ i*)
+(*i $Id: ChoiceFacts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(** ** Some facts and definitions concerning choice and description in
+(** Some facts and definitions concerning choice and description in
        intuitionistic logic.
 
 We investigate the relations between the following choice and
@@ -54,21 +54,21 @@ IPL^2   = 2nd-order functional minimal predicate logic (with ex. quant.)
 
 Table of contents
 
-A. Definitions
+1. Definitions
 
-B. IPL_2^2 |- AC_rel + AC! = AC_fun
+2. IPL_2^2 |- AC_rel + AC! = AC_fun
 
-C. 1. AC_rel + PI -> GAC_rel  and  PL_2 |- AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel
+3. 1. AC_rel + PI -> GAC_rel  and  PL_2 |- AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel
 
-C. 2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker
+4. 2. IPL^2 |- AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker
 
-D. Derivability of choice for decidable relations with well-ordered codomain
+5. Derivability of choice for decidable relations with well-ordered codomain
 
-E. Equivalence of choices on dependent or non dependent functional types
+6. Equivalence of choices on dependent or non dependent functional types
 
-F. Non contradiction of constructive descriptions wrt functional choices
+7. Non contradiction of constructive descriptions wrt functional choices
 
-G. Definite description transports classical logic to the computational world
+8. Definite description transports classical logic to the computational world
 
 References:
 
@@ -87,7 +87,7 @@ Set Implicit Arguments.
 Notation Local "'inhabited' A" := A (at level 10, only parsing).
 
 (**********************************************************************)
-(** *** A. Definitions *)
+(** * Definitions *)
 
 (** Choice, reification and description schemes *)
 
@@ -99,29 +99,29 @@ Variables P:A->Prop.
 
 Variables R:A->B->Prop.
 
-(** **** Constructive choice and description *)
+(** ** Constructive choice and description *)
 
 (** AC_rel *)
 
 Definition RelationalChoice_on :=
   forall R:A->B->Prop,
-  (forall x : A, exists y : B, R x y) ->
-  (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y).
+    (forall x : A, exists y : B, R x y) ->
+    (exists R' : A->B->Prop, subrelation R' R /\ forall x, exists! y, R' x y).
 
 (** AC_fun *)
 
 Definition FunctionalChoice_on :=
   forall R:A->B->Prop,
-  (forall x : A, exists y : B, R x y) ->
-  (exists f : A->B, forall x : A, R x (f x)).
+    (forall x : A, exists y : B, R x y) ->
+    (exists f : A->B, forall x : A, R x (f x)).
 
 (** AC! or Functional Relation Reification (known as Axiom of Unique Choice
     in topos theory; also called principle of definite description *)
 
 Definition FunctionalRelReification_on :=
   forall R:A->B->Prop,
-  (forall x : A, exists! y : B, R x y) ->
-  (exists f : A->B, forall x : A, R x (f x)).
+    (forall x : A, exists! y : B, R x y) ->
+    (exists f : A->B, forall x : A, R x (f x)).
 
 (** ID_epsilon (constructive version of indefinite description;
     combined with proof-irrelevance, it may be connected to
@@ -130,7 +130,7 @@ Definition FunctionalRelReification_on :=
 
 Definition ConstructiveIndefiniteDescription_on :=
   forall P:A->Prop,
-  (exists x, P x) -> { x:A | P x }.
+    (exists x, P x) -> { x:A | P x }.
 
 (** ID_iota (constructive version of definite description; combined
     with proof-irrelevance, it may be connected to Carlstrøm's and
@@ -139,59 +139,59 @@ Definition ConstructiveIndefiniteDescription_on :=
 
 Definition ConstructiveDefiniteDescription_on :=
   forall P:A->Prop,
-  (exists! x, P x) -> { x:A | P x }.
+    (exists! x, P x) -> { x:A | P x }.
 
-(** **** Weakly classical choice and description *)
+(** ** Weakly classical choice and description *)
 
 (** GAC_rel *)
 
 Definition GuardedRelationalChoice_on := 
   forall P : A->Prop, forall R : A->B->Prop,
-  (forall x : A, P x -> exists y : B, R x y) ->
-  (exists R' : A->B->Prop, 
-     subrelation R' R /\ forall x, P x -> exists! y, R' x y).
+    (forall x : A, P x -> exists y : B, R x y) ->
+    (exists R' : A->B->Prop, 
+      subrelation R' R /\ forall x, P x -> exists! y, R' x y).
 
 (** GAC_fun *)
 
 Definition GuardedFunctionalChoice_on := 
   forall P : A->Prop, forall R : A->B->Prop, 
-  inhabited B ->
-  (forall x : A, P x -> exists y : B, R x y) ->
-  (exists f : A->B, forall x, P x -> R x (f x)).
+    inhabited B ->
+    (forall x : A, P x -> exists y : B, R x y) ->
+    (exists f : A->B, forall x, P x -> R x (f x)).
 
 (** GFR_fun *)
 
 Definition GuardedFunctionalRelReification_on :=
   forall P : A->Prop, forall R : A->B->Prop, 
-  inhabited B ->
-  (forall x : A, P x -> exists! y : B, R x y) ->
-  (exists f : A->B, forall x : A, P x -> R x (f x)).
+    inhabited B ->
+    (forall x : A, P x -> exists! y : B, R x y) ->
+    (exists f : A->B, forall x : A, P x -> R x (f x)).
 
 (** OAC_rel *)
 
 Definition OmniscientRelationalChoice_on := 
   forall R : A->B->Prop,
-  exists R' : A->B->Prop, 
-    subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y.
+    exists R' : A->B->Prop, 
+      subrelation R' R /\ forall x : A, (exists y : B, R x y) -> exists! y, R' x y.
 
 (** OAC_fun *)
 
 Definition OmniscientFunctionalChoice_on := 
   forall R : A->B->Prop, 
-  inhabited B ->
-  exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x).
+    inhabited B ->
+    exists f : A->B, forall x : A, (exists y : B, R x y) -> R x (f x).
 
 (** D_epsilon *)
 
 Definition ClassicalIndefiniteDescription := 
   forall P:A->Prop,
-  A -> { x:A | (exists x, P x) -> P x }.
+    A -> { x:A | (exists x, P x) -> P x }.
 
 (** D_iota *)
 
 Definition ClassicalDefiniteDescription := 
   forall P:A->Prop,
-  A -> { x:A | (exists! x, P x) -> P x }.
+    A -> { x:A | (exists! x, P x) -> P x }.
 
 End ChoiceSchemes.
 
@@ -235,10 +235,10 @@ Definition IndependenceOfGeneralPremises :=
 
 Definition SmallDrinker'sParadox :=
   forall (A:Type) (P:A -> Prop), inhabited A ->
-  exists x, (exists x, P x) -> P x.
+    exists x, (exists x, P x) -> P x.
 
 (**********************************************************************)
-(** *** B. AC_rel + PDP = AC_fun
+(** * AC_rel + PDP = AC_fun
 
    We show that the functional formulation of the axiom of Choice
    (usual formulation in type theory) is equivalent to its relational
@@ -251,25 +251,25 @@ Definition SmallDrinker'sParadox :=
 
 Lemma description_rel_choice_imp_funct_choice :
   forall A B : Type,
-  FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B.
+    FunctionalRelReification_on A B -> RelationalChoice_on A B -> FunctionalChoice_on A B.
 Proof.
-intros A B Descr RelCh R H.
-destruct (RelCh R H) as (R',(HR'R,H0)).
-destruct (Descr R') as (f,Hf).
-firstorder.
-exists f; intro x.
-destruct (H0 x) as (y,(HR'xy,Huniq)).
-rewrite <- (Huniq (f x) (Hf x)).
-apply HR'R; assumption.
+  intros A B Descr RelCh R H.
+  destruct (RelCh R H) as (R',(HR'R,H0)).
+  destruct (Descr R') as (f,Hf).
+  firstorder.
+  exists f; intro x.
+  destruct (H0 x) as (y,(HR'xy,Huniq)).
+  rewrite <- (Huniq (f x) (Hf x)).
+  apply HR'R; assumption.
 Qed.
 
 Lemma funct_choice_imp_rel_choice : 
   forall A B, FunctionalChoice_on A B -> RelationalChoice_on A B.
 Proof.
-intros A B FunCh R H.
-destruct (FunCh R H) as (f,H0).
-exists (fun x y => f x = y).
-split.
+  intros A B FunCh R H.
+  destruct (FunCh R H) as (f,H0).
+  exists (fun x y => f x = y).
+  split.
   intros x y Heq; rewrite <- Heq; trivial.
   intro x; exists (f x); split.
     reflexivity.
@@ -279,77 +279,77 @@ Qed.
 Lemma funct_choice_imp_description : 
   forall A B, FunctionalChoice_on A B -> FunctionalRelReification_on A B.
 Proof.
-intros A B FunCh R H.
-destruct (FunCh R) as [f H0].
-(* 1 *)
-intro x.
-destruct (H x) as (y,(HRxy,_)).
-exists y; exact HRxy.
-(* 2 *)
-exists f; exact H0.
+  intros A B FunCh R H.
+  destruct (FunCh R) as [f H0].
+  (* 1 *)
+  intro x.
+  destruct (H x) as (y,(HRxy,_)).
+  exists y; exact HRxy.
+  (* 2 *)
+  exists f; exact H0.
 Qed.
 
 Theorem FunChoice_Equiv_RelChoice_and_ParamDefinDescr :
   forall A B, FunctionalChoice_on A B <-> 
     RelationalChoice_on A B /\ FunctionalRelReification_on A B.
 Proof.
-intros A B; 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).
+  intros A B; 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.
 
 (**********************************************************************)
-(** *** C. Connection between the guarded, non guarded and descriptive choices and *)
+(** * Connection between the guarded, non guarded and descriptive choices and *)
 
 (** 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 *)
 
 (**********************************************************************)
-(** **** C. 1. AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *)
+(** ** AC_rel + PI -> GAC_rel and AC_rel + IGP -> GAC_rel and GAC_rel = OAC_rel *)
 
 Lemma rel_choice_and_proof_irrel_imp_guarded_rel_choice :
   RelationalChoice -> ProofIrrelevance -> GuardedRelationalChoice.
 Proof.
-intros rel_choice proof_irrel.
-red in |- *; intros A B P R H.
-destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)).
-intros (x,HPx).
-destruct (H x HPx) as (y,HRxy).
-exists y; exact HRxy.
-set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y).
-exists R''; split.
+  intros rel_choice proof_irrel.
+  red in |- *; intros A B P R H.
+  destruct (rel_choice _ _ (fun (x:sigT P) (y:B) => R (projT1 x) y)) as (R',(HR'R,H0)).
+  intros (x,HPx).
+  destruct (H x HPx) as (y,HRxy).
+  exists y; exact HRxy.
+  set (R'' := fun (x:A) (y:B) => exists H : P x, R' (existT P x H) y).
+  exists R''; split.
   intros x y (HPx,HR'xy).
     change x with (projT1 (existT P x HPx)); apply HR'R; exact HR'xy.
   intros x HPx.
   destruct (H0 (existT P x HPx)) as (y,(HR'xy,Huniq)).
-    exists y; split. exists HPx; exact HR'xy.
-    intros y' (H'Px,HR'xy').
-      apply Huniq.
-      rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'.
+  exists y; split. exists HPx; exact HR'xy.
+  intros y' (H'Px,HR'xy').
+    apply Huniq.
+    rewrite proof_irrel with (a1 := HPx) (a2 := H'Px); exact HR'xy'.
 Qed.
 
 Lemma rel_choice_indep_of_general_premises_imp_guarded_rel_choice :
- forall A B, inhabited B -> RelationalChoice_on A B -> 
-  IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B.
+  forall A B, inhabited B -> RelationalChoice_on A B -> 
+    IndependenceOfGeneralPremises -> GuardedRelationalChoice_on A B.
 Proof.
-intros A B Inh AC_rel IndPrem P R H.
-destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)).
+  intros A B Inh AC_rel IndPrem P R H.
+  destruct (AC_rel (fun x y => P x -> R x y)) as (R',(HR'R,H0)).
   intro x. apply IndPrem. exact Inh. intro Hx. 
-    apply H; assumption.
+  apply H; assumption.
   exists (fun x y => P x /\ R' x y).
   firstorder.
 Qed.
 
 Lemma guarded_rel_choice_imp_rel_choice :
- forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B.
+  forall A B, GuardedRelationalChoice_on A B -> RelationalChoice_on A B.
 Proof.
-intros A B GAC_rel R H.
-destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)).
+  intros A B GAC_rel R H.
+  destruct (GAC_rel (fun _ => True) R) as (R',(HR'R,H0)).
   firstorder.
-exists R'; firstorder.
+  exists R'; firstorder.
 Qed.
 
 (** OAC_rel = GAC_rel *)
@@ -357,43 +357,43 @@ Qed.
 Lemma guarded_iff_omniscient_rel_choice :
   GuardedRelationalChoice <-> OmniscientRelationalChoice.
 Proof.
-split.
+  split.
   intros GAC_rel A B R.
-    apply (GAC_rel A B (fun x => exists y, R x y) R); auto.
+  apply (GAC_rel A B (fun x => exists y, R x y) R); auto.
   intros OAC_rel A B P R H.
-    destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder.
+  destruct (OAC_rel A B R) as (f,Hf); exists f; firstorder.
 Qed.
 
 (**********************************************************************)
-(** **** C. 2. AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *)
+(** ** AC_fun + IGP = GAC_fun = OAC_fun = AC_fun + Drinker *)
 
 (** AC_fun + IGP = GAC_fun *)
  
 Lemma guarded_fun_choice_imp_indep_of_general_premises :
- GuardedFunctionalChoice -> IndependenceOfGeneralPremises.
+  GuardedFunctionalChoice -> IndependenceOfGeneralPremises.
 Proof.
-intros GAC_fun A P Q Inh H.
-destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf).
-tauto.
-exists (f tt); auto.
+  intros GAC_fun A P Q Inh H.
+  destruct (GAC_fun unit A (fun _ => Q) (fun _ => P) Inh) as (f,Hf).
+  tauto.
+  exists (f tt); auto.
 Qed.
 
 Lemma guarded_fun_choice_imp_fun_choice :
- GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet.
+  GuardedFunctionalChoice -> FunctionalChoiceOnInhabitedSet.
 Proof.
-intros GAC_fun A B Inh R H.
-destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf).
-firstorder.
-exists f; auto.
+  intros GAC_fun A B Inh R H.
+  destruct (GAC_fun A B (fun _ => True) R Inh) as (f,Hf).
+  firstorder.
+  exists f; auto.
 Qed.
 
 Lemma fun_choice_and_indep_general_prem_imp_guarded_fun_choice :
   FunctionalChoiceOnInhabitedSet -> IndependenceOfGeneralPremises
   -> GuardedFunctionalChoice.
 Proof.
-intros AC_fun IndPrem A B P R Inh H.
-apply (AC_fun A B Inh (fun x y => P x -> R x y)).
-intro x; apply IndPrem; eauto.
+  intros AC_fun IndPrem A B P R Inh H.
+  apply (AC_fun A B Inh (fun x y => P x -> R x y)).
+  intro x; apply IndPrem; eauto.
 Qed.
 
 (** AC_fun + Drinker = OAC_fun *)
@@ -403,26 +403,26 @@ Qed.
 Lemma omniscient_fun_choice_imp_small_drinker :
   OmniscientFunctionalChoice -> SmallDrinker'sParadox.
 Proof.
-intros OAC_fun A P Inh.
-destruct (OAC_fun unit A (fun _ => P)) as (f,Hf).
-auto.
-exists (f tt); firstorder.
+  intros OAC_fun A P Inh.
+  destruct (OAC_fun unit A (fun _ => P)) as (f,Hf).
+  auto.
+  exists (f tt); firstorder.
 Qed.
 
 Lemma omniscient_fun_choice_imp_fun_choice :
   OmniscientFunctionalChoice -> FunctionalChoiceOnInhabitedSet.
 Proof.
-intros OAC_fun A B Inh R H.
-destruct (OAC_fun A B R Inh) as (f,Hf).
-exists f; firstorder.
+  intros OAC_fun A B Inh R H.
+  destruct (OAC_fun A B R Inh) as (f,Hf).
+  exists f; firstorder.
 Qed.
 
 Lemma fun_choice_and_small_drinker_imp_omniscient_fun_choice :
   FunctionalChoiceOnInhabitedSet -> SmallDrinker'sParadox 
   -> OmniscientFunctionalChoice.
 Proof.
-intros AC_fun Drinker A B R Inh.
-destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf).
+  intros AC_fun Drinker A B R Inh.
+  destruct (AC_fun A B Inh (fun x y => (exists y, R x y) -> R x y)) as (f,Hf).
   intro x; apply (Drinker B (R x) Inh).
   exists f; assumption.
 Qed.
@@ -435,16 +435,16 @@ but we give a direct proof *)
 Lemma guarded_iff_omniscient_fun_choice :
   GuardedFunctionalChoice <-> OmniscientFunctionalChoice.
 Proof.
-split.
+  split.
   intros GAC_fun A B R Inh.
-    apply (GAC_fun A B (fun x => exists y, R x y) R); auto.
+  apply (GAC_fun A B (fun x => exists y, R x y) R); auto.
   intros OAC_fun A B P R Inh H.
-    destruct (OAC_fun A B R Inh) as (f,Hf).
- exists f; firstorder.
+  destruct (OAC_fun A B R Inh) as (f,Hf).
+  exists f; firstorder.
 Qed.
 
 (**********************************************************************)
-(** *** D. Derivability of choice for decidable relations with well-ordered codomain *)
+(** * Derivability of choice for decidable relations with well-ordered codomain *)
 
 (** Countable codomains, such as [nat], can be equipped with a
     well-order, which implies the existence of a least element on
@@ -468,10 +468,10 @@ Lemma dec_inh_nat_subset_has_unique_least_element :
   forall P:nat->Prop, (forall n, P n \/ ~ P n) ->
     (exists n, P n) -> has_unique_least_element le P.
 Proof.
-intros P Pdec (n0,HPn0).
-assert
-   (forall n, (exists n', n'<n /\ P n' /\ forall n'', P n'' -> n'<=n'')
-              \/(forall n', P n' -> n<=n')).
+  intros P Pdec (n0,HPn0).
+  assert
+    (forall n, (exists n', n'<n /\ P n' /\ forall n'', P n'' -> n'<=n'')
+      \/(forall n', P n' -> n<=n')).
   induction n.
   right.
   intros n' Hn'.
@@ -493,43 +493,43 @@ assert
   destruct H0.
   rewrite Heqn; assumption.
   destruct (H n0) as [(n,(Hltn,(Hmin,Huniqn)))|]; [exists n | exists n0];
-  repeat split;
-  assumption || intros n' (HPn',Hminn'); apply le_antisym; auto.
+    repeat split;
+      assumption || intros n' (HPn',Hminn'); apply le_antisym; auto.
 Qed.
 
 Definition FunctionalChoice_on_rel (A B:Type) (R:A->B->Prop) :=
   (forall x:A, exists y : B, R x y) ->
-   exists f : A -> B, (forall x:A, R x (f x)).
+  exists f : A -> B, (forall x:A, R x (f x)).
 
 Lemma classical_denumerable_description_imp_fun_choice : 
   forall A:Type, 
-  FunctionalRelReification_on A nat -> 
-  forall R:A->nat->Prop, 
-    (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R.
+    FunctionalRelReification_on A nat -> 
+    forall R:A->nat->Prop, 
+      (forall x y, decidable (R x y)) -> FunctionalChoice_on_rel R.
 Proof.
-intros A Descr.
-red in |- *; intros R Rdec H.
-set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y').
-destruct (Descr R') as (f,Hf).
+  intros A Descr.
+  red in |- *; intros R Rdec H.
+  set (R':= fun x y => R x y /\ forall y', R x y' -> y <= y').
+  destruct (Descr R') as (f,Hf).
   intro x.
   apply (dec_inh_nat_subset_has_unique_least_element (R x)). 
     apply Rdec.
     apply (H x).
-exists f.
-intros x.
-destruct (Hf x) as (Hfx,_).
-assumption.
+    exists f.
+    intros x.
+    destruct (Hf x) as (Hfx,_).
+    assumption.
 Qed.
 
 (**********************************************************************)
-(** *** E. Choice on dependent and non dependent function types are equivalent *)
+(** * Choice on dependent and non dependent function types are equivalent *)
 
-(** **** E. 1. Choice on dependent and non dependent function types are equivalent *)
+(** ** Choice on dependent and non dependent function types are equivalent *)
 
 Definition DependentFunctionalChoice_on (A:Type) (B:A -> Type) :=
   forall R:forall x:A, B x -> Prop,
-  (forall x:A, exists y : B x, R x y) ->
-  (exists f : (forall x:A, B x), forall x:A, R x (f x)).
+    (forall x:A, exists y : B x, R x y) ->
+    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
 
 Notation DependentFunctionalChoice := 
   (forall A (B:A->Type), DependentFunctionalChoice_on B).
@@ -539,7 +539,7 @@ Notation DependentFunctionalChoice :=
 Theorem dep_non_dep_functional_choice : 
   DependentFunctionalChoice -> FunctionalChoice.
 Proof.
-intros AC_depfun A B R H.
+  intros AC_depfun A B R H.
   destruct (AC_depfun A (fun _ => B) R H) as (f,Hf).
   exists f; trivial.
 Qed.
@@ -558,24 +558,24 @@ Definition proj1_inf (A B:Prop) (p : A/\B) :=
 Theorem non_dep_dep_functional_choice : 
   FunctionalChoice -> DependentFunctionalChoice.
 Proof.
-intros AC_fun A B R H.
-pose (B' := { x:A & B x }). 
-pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). 
-destruct (AC_fun A B' R') as (f,Hf).
-intros x. destruct (H x) as (y,Hy).
-exists (existT (fun x => B x) x y). split; trivial.
-exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))).
-intro x; destruct (Hf x) as (Heq,HR) using and_indd.
-destruct (f x); simpl in *.
-destruct Heq using eq_indd; trivial.
+  intros AC_fun A B R H.
+  pose (B' := { x:A & B x }). 
+  pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). 
+  destruct (AC_fun A B' R') as (f,Hf).
+  intros x. destruct (H x) as (y,Hy).
+  exists (existT (fun x => B x) x y). split; trivial.
+  exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))).
+  intro x; destruct (Hf x) as (Heq,HR) using and_indd.
+  destruct (f x); simpl in *.
+  destruct Heq using eq_indd; trivial.
 Qed.
 
-(** **** E. 2. Reification of dependent and non dependent functional relation  are equivalent *)
+(** ** Reification of dependent and non dependent functional relation  are equivalent *)
 
 Definition DependentFunctionalRelReification_on (A:Type) (B:A -> Type) :=
   forall (R:forall x:A, B x -> Prop),
-  (forall x:A, exists! y : B x, R x y) ->
-  (exists f : (forall x:A, B x), forall x:A, R x (f x)).
+    (forall x:A, exists! y : B x, R x y) ->
+    (exists f : (forall x:A, B x), forall x:A, R x (f x)).
 
 Notation DependentFunctionalRelReification :=
   (forall A (B:A->Type), DependentFunctionalRelReification_on B).
@@ -585,7 +585,7 @@ Notation DependentFunctionalRelReification :=
 Theorem dep_non_dep_functional_rel_reification : 
   DependentFunctionalRelReification -> FunctionalRelReification.
 Proof.
-intros DepFunReify A B R H.
+  intros DepFunReify A B R H.
   destruct (DepFunReify A (fun _ => B) R H) as (f,Hf).
   exists f; trivial.
 Qed.
@@ -598,91 +598,91 @@ Qed.
 Theorem non_dep_dep_functional_rel_reification : 
   FunctionalRelReification -> DependentFunctionalRelReification.
 Proof.
-intros AC_fun A B R H.
-pose (B' := { x:A & B x }). 
-pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). 
-destruct (AC_fun A B' R') as (f,Hf).
-intros x. destruct (H x) as (y,(Hy,Huni)).
+  intros AC_fun A B R H.
+  pose (B' := { x:A & B x }). 
+  pose (R' := fun (x:A) (y:B') => projT1 y = x /\ R (projT1 y) (projT2 y)). 
+  destruct (AC_fun A B' R') as (f,Hf).
+  intros x. destruct (H x) as (y,(Hy,Huni)).
   exists (existT (fun x => B x) x y). repeat split; trivial.
   intros (x',y') (Heqx',Hy').
   simpl in *.
   destruct Heqx'.
   rewrite (Huni y'); trivial.
-exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))).
-intro x; destruct (Hf x) as (Heq,HR) using and_indd.
-destruct (f x); simpl in *.
-destruct Heq using eq_indd; trivial.
+  exists (fun x => eq_rect _ _ (projT2 (f x)) _ (proj1_inf (Hf x))).
+  intro x; destruct (Hf x) as (Heq,HR) using and_indd.
+  destruct (f x); simpl in *.
+  destruct Heq using eq_indd; trivial.
 Qed.
 
 (**********************************************************************)
-(** *** F. Non contradiction of constructive descriptions wrt functional axioms of choice *)
+(** * Non contradiction of constructive descriptions wrt functional axioms of choice *)
 
-(** **** F. 1. Non contradiction of indefinite description *)
+(** ** Non contradiction of indefinite description *)
 
 Lemma relative_non_contradiction_of_indefinite_desc :
-      (ConstructiveIndefiniteDescription -> False)
-   -> (FunctionalChoice -> False).
+  (ConstructiveIndefiniteDescription -> False)
+  -> (FunctionalChoice -> False).
 Proof.
-intros H AC_fun.
-assert (AC_depfun := non_dep_dep_functional_choice AC_fun).
-pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}).
-pose (B0 := fun x:A0 => projT1 x).
-pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y).
-pose (H0 := fun x:A0 => projT2 (projT2 x)).
-destruct (AC_depfun A0 B0 R0 H0) as (f, Hf).
-apply H.
-intros A P H'.
-exists (f (existT (fun _ => sigT _) A
-            (existT (fun P => exists x, P x) P H'))).
-pose (Hf' := 
-          Hf (existT (fun _ => sigT _) A
-            (existT (fun P => exists x, P x) P H'))).
-assumption.
+  intros H AC_fun.
+  assert (AC_depfun := non_dep_dep_functional_choice AC_fun).
+  pose (A0 := { A:Type & { P:A->Prop & exists x, P x }}).
+  pose (B0 := fun x:A0 => projT1 x).
+  pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y).
+  pose (H0 := fun x:A0 => projT2 (projT2 x)).
+  destruct (AC_depfun A0 B0 R0 H0) as (f, Hf).
+  apply H.
+  intros A P H'.
+  exists (f (existT (fun _ => sigT _) A
+    (existT (fun P => exists x, P x) P H'))).
+  pose (Hf' := 
+    Hf (existT (fun _ => sigT _) A
+      (existT (fun P => exists x, P x) P H'))).
+  assumption.
 Qed.
 
 Lemma constructive_indefinite_descr_fun_choice :
-   ConstructiveIndefiniteDescription -> FunctionalChoice.
+  ConstructiveIndefiniteDescription -> FunctionalChoice.
 Proof.
-intros IndefDescr A B R H.
-exists (fun x => proj1_sig (IndefDescr B (R x) (H x))).
-intro x.
-apply (proj2_sig (IndefDescr B (R x) (H x))).
+  intros IndefDescr A B R H.
+  exists (fun x => proj1_sig (IndefDescr B (R x) (H x))).
+  intro x.
+  apply (proj2_sig (IndefDescr B (R x) (H x))).
 Qed.
 
-(** **** F. 2. Non contradiction of definite description *)
+(** ** Non contradiction of definite description *)
 
 Lemma relative_non_contradiction_of_definite_descr :
-      (ConstructiveDefiniteDescription -> False)
-   -> (FunctionalRelReification -> False).
+  (ConstructiveDefiniteDescription -> False)
+  -> (FunctionalRelReification -> False).
 Proof.
-intros H FunReify.
-assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify).
-pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}).
-pose (B0 := fun x:A0 => projT1 x).
-pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y).
-pose (H0 := fun x:A0 => projT2 (projT2 x)).
-destruct (DepFunReify A0 B0 R0 H0) as (f, Hf).
-apply H.
-intros A P H'.
-exists (f (existT (fun _ => sigT _) A
-            (existT (fun P => exists! x, P x) P H'))).
-pose (Hf' := 
-          Hf (existT (fun _ => sigT _) A
-            (existT (fun P => exists! x, P x) P H'))).
-assumption.
+  intros H FunReify.
+  assert (DepFunReify := non_dep_dep_functional_rel_reification FunReify).
+  pose (A0 := { A:Type & { P:A->Prop & exists! x, P x }}).
+  pose (B0 := fun x:A0 => projT1 x).
+  pose (R0 := fun x:A0 => fun y:B0 x => projT1 (projT2 x) y).
+  pose (H0 := fun x:A0 => projT2 (projT2 x)).
+  destruct (DepFunReify A0 B0 R0 H0) as (f, Hf).
+  apply H.
+  intros A P H'.
+  exists (f (existT (fun _ => sigT _) A
+    (existT (fun P => exists! x, P x) P H'))).
+  pose (Hf' := 
+    Hf (existT (fun _ => sigT _) A
+      (existT (fun P => exists! x, P x) P H'))).
+  assumption.
 Qed.
 
 Lemma constructive_definite_descr_fun_reification :
-   ConstructiveDefiniteDescription -> FunctionalRelReification.
+  ConstructiveDefiniteDescription -> FunctionalRelReification.
 Proof.
-intros DefDescr A B R H.
-exists (fun x => proj1_sig (DefDescr B (R x) (H x))).
-intro x.
-apply (proj2_sig (DefDescr B (R x) (H x))).
+  intros DefDescr A B R H.
+  exists (fun x => proj1_sig (DefDescr B (R x) (H x))).
+  intro x.
+  apply (proj2_sig (DefDescr B (R x) (H x))).
 Qed.
 
 (**********************************************************************)
-(** *** G. Excluded-middle + definite description => computational excluded-middle *)
+(** * Excluded-middle + definite description => computational excluded-middle *)
 
 (** The idea for the following proof comes from [ChicliPottierSimpson02] *)
 
@@ -705,15 +705,15 @@ Theorem constructive_definite_descr_excluded_middle :
   ConstructiveDefiniteDescription ->
   (forall P:Prop, P \/ ~ P) -> (forall P:Prop, {P} + {~ P}).
 Proof.
-intros Descr EM P.
-pose (select := fun b:bool => if b then P else ~P).
-assert { b:bool | select b } as ([|],HP).
+  intros Descr EM P.
+  pose (select := fun b:bool => if b then P else ~P).
+  assert { b:bool | select b } as ([|],HP).
   apply Descr.
   rewrite <- unique_existence; split.
   destruct (EM P).
-      exists true; trivial.
-      exists false; trivial.
-    intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction.
-left; trivial.
-right; trivial.
+  exists true; trivial.
+  exists false; trivial.
+  intros [|] [|] H1 H2; simpl in *; reflexivity || contradiction.
+  left; trivial.
+  right; trivial.
 Qed.  
diff --git a/theories/Logic/ClassicalEpsilon.v b/theories/Logic/ClassicalEpsilon.v
index b7293bec..6d0a9c77 100644
--- a/theories/Logic/ClassicalEpsilon.v
+++ b/theories/Logic/ClassicalEpsilon.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalEpsilon.v 8933 2006-06-09 14:08:38Z herbelin $ i*)
+(*i $Id: ClassicalEpsilon.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(** *** This file provides classical logic and indefinite description
+(** This file provides classical logic and indefinite description
     (Hilbert's epsilon operator) *)
 
 (** Classical epsilon's operator (i.e. indefinite description) implies
@@ -21,37 +21,39 @@ Require Import ChoiceFacts.
 
 Set Implicit Arguments.
 
-Notation Local "'inhabited' A" := A (at level 200, only parsing).
-
 Axiom constructive_indefinite_description :
   forall (A : Type) (P : A->Prop), 
-  (ex P) -> { x : A | P x }.
+    (exists x, P x) -> { x : A | P x }.
 
 Lemma constructive_definite_description :
   forall (A : Type) (P : A->Prop), 
-  (exists! x : A, P x) -> { x : A | P x }.
+    (exists! x, P x) -> { x : A | P x }.
 Proof.
-intros; apply constructive_indefinite_description; firstorder.
+  intros; apply constructive_indefinite_description; firstorder.
 Qed.
 
 Theorem excluded_middle_informative : forall P:Prop, {P} + {~ P}.
 Proof.
-apply 
-  (constructive_definite_descr_excluded_middle 
-   constructive_definite_description classic).
+  apply 
+    (constructive_definite_descr_excluded_middle 
+      constructive_definite_description classic).
 Qed.
 
 Theorem classical_indefinite_description : 
   forall (A : Type) (P : A->Prop), inhabited A ->
-  { x : A | ex P -> P x }.
+    { x : A | (exists x, P x) -> P x }.
 Proof.
-intros A P i.
-destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP].
-  apply constructive_indefinite_description with (P:= fun x => ex P -> P x).
+  intros A P i.
+  destruct (excluded_middle_informative (exists x, P x)) as [Hex|HnonP].
+  apply constructive_indefinite_description 
+    with (P:= fun x => (exists x, P x) -> P x).
   destruct Hex as (x,Hx).
     exists x; intros _; exact Hx.
-    firstorder.
-Qed.
+  assert {x : A | True} as (a,_).
+    apply constructive_indefinite_description with (P := fun _ : A => True).
+    destruct i as (a); firstorder.
+  firstorder.
+Defined.
 
 (** Hilbert's epsilon operator *)
 
@@ -59,11 +61,9 @@ Definition epsilon (A : Type) (i:inhabited A) (P : A->Prop) : A
   := proj1_sig (classical_indefinite_description P i).
 
 Definition epsilon_spec (A : Type) (i:inhabited A) (P : A->Prop) : 
-  (ex P) -> P (epsilon i P)
+  (exists x, P x) -> P (epsilon i P)
   := proj2_sig (classical_indefinite_description P i).
 
-Opaque epsilon.
-
 (** Open question: is classical_indefinite_description constructively
     provable from [relational_choice] and
     [constructive_definite_description] (at least, using the fact that
@@ -72,19 +72,31 @@ Opaque epsilon.
     [classical_indefinite_description] is provable (see
     [relative_non_contradiction_of_indefinite_desc]). *)
 
-(** Remark: we use [ex P] rather than [exists x, P x] (which is [ex
-    (fun x => P x)] to ease unification *)
+(** A proof that if [P] is inhabited, [epsilon a P] does not depend on
+    the actual proof that the domain of [P] is inhabited
+    (proof idea kindly provided by Pierre Castéran) *)
+
+Lemma epsilon_inh_irrelevance : 
+   forall (A:Type) (i j : inhabited A) (P:A->Prop),
+   (exists x, P x) -> epsilon i P = epsilon j P.
+Proof.
+ intros.
+ unfold epsilon, classical_indefinite_description.
+ destruct (excluded_middle_informative (exists x : A, P x)) as [|[]]; trivial.
+Qed.
+
+Opaque epsilon.
 
 (** *** Weaker lemmas (compatibility lemmas) *)
 
 Theorem choice :
- forall (A B : Type) (R : A->B->Prop),
-   (forall x : A, exists y : B, R x y) ->
-   (exists f : A->B, forall x : A, R x (f x)).
+  forall (A B : Type) (R : A->B->Prop),
+    (forall x : A, exists y : B, R x y) ->
+    (exists f : A->B, forall x : A, R x (f x)).
 Proof.
-intros A B R H.
-exists (fun x => proj1_sig (constructive_indefinite_description (H x))).
-intro x.
-apply (proj2_sig (constructive_indefinite_description  (H x))).
+  intros A B R H.
+  exists (fun x => proj1_sig (constructive_indefinite_description _ (H x))).
+  intro x.
+  apply (proj2_sig (constructive_indefinite_description _ (H x))).
 Qed.
 
diff --git a/theories/Logic/ClassicalFacts.v b/theories/Logic/ClassicalFacts.v
index 70da74d3..dd911db6 100644
--- a/theories/Logic/ClassicalFacts.v
+++ b/theories/Logic/ClassicalFacts.v
@@ -7,39 +7,39 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ClassicalFacts.v 8892 2006-06-04 17:59:53Z herbelin $ i*)
+(*i $Id: ClassicalFacts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(** ** Some facts and definitions about classical logic
+(** Some facts and definitions about classical logic
 
 Table of contents:
 
-A. Propositional degeneracy = excluded-middle + propositional extensionality
+1. Propositional degeneracy = excluded-middle + propositional extensionality
 
-B. Classical logic and proof-irrelevance
+2. Classical logic and proof-irrelevance
 
-B. 1. CC |- prop. ext. + A inhabited -> (A = A->A) -> A has fixpoint
+2.1. CC |- prop. ext. + A inhabited -> (A = A->A) -> A has fixpoint
 
-B. 2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance
+2.2. CC |- prop. ext. + dep elim on bool -> proof-irrelevance
 
-B. 3. CIC |- prop. ext. -> proof-irrelevance
+2.3. CIC |- prop. ext. -> proof-irrelevance
 
-B. 4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance
+2.4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance
 
-B. 5. CIC |- excluded-middle -> proof-irrelevance
+2.5. CIC |- excluded-middle -> proof-irrelevance
 
-C. Weak classical axioms
+3. Weak classical axioms
 
-C. 1. Weak excluded middle
+3.1. Weak excluded middle
 
-C. 2. Gödel-Dummet axiom and right distributivity of implication over
+3.2. Gödel-Dummet axiom and right distributivity of implication over
       disjunction
 
-C. 3. Independence of general premises and drinker's paradox
+3 3. Independence of general premises and drinker's paradox
 
 *)
 
 (************************************************************************)
-(** *** A. Prop degeneracy = excluded-middle + prop extensionality      *)
+(** * Prop degeneracy = excluded-middle + prop extensionality      *)
 (**
  i.e.        [(forall A, A=True \/ A=False)
                          <->
@@ -61,41 +61,41 @@ Definition excluded_middle := forall A:Prop, A \/ ~ A.
 
 Lemma prop_degen_ext : prop_degeneracy -> prop_extensionality.
 Proof.
-intros H A B [Hab Hba].
-destruct (H A); destruct (H B).
-  rewrite H1; exact H0.
-  absurd B.
-    rewrite H1; exact (fun H => H).
-    apply Hab; rewrite H0; exact I.
-  absurd A.
-    rewrite H0; exact (fun H => H).
-    apply Hba; rewrite H1; exact I.
-  rewrite H1; exact H0.
+  intros H A B [Hab Hba].
+  destruct (H A); destruct (H B).
+    rewrite H1; exact H0.
+    absurd B.
+      rewrite H1; exact (fun H => H).
+      apply Hab; rewrite H0; exact I.
+    absurd A.
+      rewrite H0; exact (fun 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.
-destruct (H A).
-  left; rewrite H0; exact I.
-  right; rewrite H0; exact (fun x => x).
+  intros H A.
+  destruct (H A).
+    left; rewrite H0; exact I.
+    right; rewrite H0; exact (fun x => x).
 Qed.
 
 Lemma prop_ext_em_degen :
- prop_extensionality -> excluded_middle -> prop_degeneracy.
+  prop_extensionality -> excluded_middle -> prop_degeneracy.
 Proof.
-intros Ext EM A.
-destruct (EM A).
-  left; apply (Ext A True); split;
-   [ exact (fun _ => I) | exact (fun _ => H) ].
-  right; apply (Ext A False); split; [ exact H | apply False_ind ].
+  intros Ext EM A.
+  destruct (EM A).
+    left; apply (Ext A True); split;
+     [ exact (fun _ => I) | exact (fun _ => H) ].
+    right; apply (Ext A False); split; [ exact H | apply False_ind ].
 Qed.
 
 (************************************************************************)
-(** *** B. Classical logic and proof-irrelevance *)
+(** * Classical logic and proof-irrelevance *)
 
 (************************************************************************)
-(** **** B. 1. CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *)
+(** ** CC |- prop ext + A inhabited -> (A = A->A) -> A has fixpoint *)
 
 (** We successively show that:
 
@@ -110,41 +110,41 @@ Qed.
 Definition inhabited (A:Prop) := A.
 
 Lemma prop_ext_A_eq_A_imp_A :
- prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A.
+  prop_extensionality -> forall A:Prop, inhabited A -> (A -> A) = A.
 Proof.
-intros Ext A a.
-apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ].
+  intros Ext A a.
+  apply (Ext (A -> A) A); split; [ exact (fun _ => a) | exact (fun _ _ => a) ].
 Qed.
 
 Record retract (A B:Prop) : Prop := 
   {f1 : A -> B; f2 : B -> A; f1_o_f2 : forall x:B, f1 (f2 x) = x}.
 
 Lemma prop_ext_retract_A_A_imp_A :
- prop_extensionality -> forall A:Prop, inhabited A -> retract A (A -> A).
+  prop_extensionality -> forall 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 (fun x:A => x) (fun x:A => x).
-reflexivity.
+  intros Ext A a.
+  rewrite (prop_ext_A_eq_A_imp_A Ext A a).
+  exists (fun x:A => x) (fun x:A => x).
+  reflexivity.
 Qed.
 
 Record has_fixpoint (A:Prop) : Prop := 
   {F : (A -> A) -> A; Fix : forall f:A -> A, F f = f (F f)}.
 
 Lemma ext_prop_fixpoint :
- prop_extensionality -> forall A:Prop, inhabited A -> has_fixpoint A.
+  prop_extensionality -> forall 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 (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))).
-intro f.
-pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *.
-rewrite (g1_o_g2 (fun x:A => f (g1 x x))).
-reflexivity.
+  intros Ext A a.
+  case (prop_ext_retract_A_A_imp_A Ext A a); intros g1 g2 g1_o_g2.
+  exists (fun f => (fun x:A => f (g1 x x)) (g2 (fun x => f (g1 x x)))).
+  intro f.
+  pattern (g1 (g2 (fun x:A => f (g1 x x)))) at 1 in |- *.
+  rewrite (g1_o_g2 (fun x:A => f (g1 x x))).
+  reflexivity.
 Qed.
 
 (************************************************************************)
-(** **** B. 2. CC |- prop_ext /\ dep elim on bool -> proof-irrelevance  *)
+(** ** CC |- prop_ext /\ dep elim on bool -> proof-irrelevance  *)
 
 (** [proof_irrelevance] asserts equality of all proofs of a given formula *)
 Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
@@ -161,44 +161,44 @@ Definition proof_irrelevance := forall (A:Prop) (a1 a2:A), a1 = a2.
 
 Section Proof_irrelevance_gen.
 
-Variable bool : Prop.
-Variable true : bool.
-Variable false : bool.
-Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C.
-Hypothesis
-  bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true.
-Hypothesis
-  bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false.
-Let bool_dep_induction :=
+  Variable bool : Prop.
+  Variable true : bool.
+  Variable false : bool.
+  Hypothesis bool_elim : forall C:Prop, C -> C -> bool -> C.
+  Hypothesis
+    bool_elim_redl : forall (C:Prop) (c1 c2:C), c1 = bool_elim C c1 c2 true.
+  Hypothesis
+    bool_elim_redr : forall (C:Prop) (c1 c2:C), c2 = bool_elim C c1 c2 false.
+  Let bool_dep_induction :=
   forall P:bool -> Prop, P true -> P false -> forall 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.
-set (neg := fun b:bool => bool_elim bool false true b).
-generalize (refl_equal (G neg)).
-pattern (G neg) at 1 in |- *.
-apply Ind with (b := G neg); intro Heq.
-rewrite (bool_elim_redl bool false true).
-change (true = neg true) in |- *; rewrite Heq; apply Gfix.
-rewrite (bool_elim_redr bool false true).
-change (neg false = false) in |- *; rewrite Heq; symmetry  in |- *;
- apply Gfix.
-Qed.
-
-Lemma ext_prop_dep_proof_irrel_gen :
- prop_extensionality -> bool_dep_induction -> proof_irrelevance.
-Proof.
-intros Ext Ind A a1 a2.
-set (f := fun b:bool => bool_elim A a1 a2 b).
-rewrite (bool_elim_redl A a1 a2).
-change (f true = a2) in |- *.
-rewrite (bool_elim_redr A a1 a2).
-change (f true = f false) in |- *.
-rewrite (aux Ext Ind).
-reflexivity.
-Qed.
+  Lemma aux : prop_extensionality -> bool_dep_induction -> true = false.
+  Proof.
+    intros Ext Ind.
+    case (ext_prop_fixpoint Ext bool true); intros G Gfix.
+    set (neg := fun b:bool => bool_elim bool false true b).
+    generalize (refl_equal (G neg)).
+    pattern (G neg) at 1 in |- *.
+    apply Ind with (b := G neg); intro Heq.
+    rewrite (bool_elim_redl bool false true).
+    change (true = neg true) in |- *; rewrite Heq; apply Gfix.
+    rewrite (bool_elim_redr bool false true).
+    change (neg false = false) in |- *; rewrite Heq; symmetry  in |- *;
+      apply Gfix.
+  Qed.
+
+  Lemma ext_prop_dep_proof_irrel_gen :
+    prop_extensionality -> bool_dep_induction -> proof_irrelevance.
+  Proof.
+    intros Ext Ind A a1 a2.
+    set (f := fun b:bool => bool_elim A a1 a2 b).
+    rewrite (bool_elim_redl A a1 a2).
+    change (f true = a2) in |- *.
+    rewrite (bool_elim_redr A a1 a2).
+    change (f true = f false) in |- *.
+    rewrite (aux Ext Ind).
+    reflexivity.
+  Qed.
 
 End Proof_irrelevance_gen.
 
@@ -208,29 +208,30 @@ End Proof_irrelevance_gen.
 *)
 
 Section Proof_irrelevance_Prop_Ext_CC.
-
-Definition BoolP := forall C:Prop, C -> C -> C.
-Definition TrueP : BoolP := fun C c1 c2 => c1.
-Definition FalseP : BoolP := fun C c1 c2 => c2.
-Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2.
-Definition BoolP_elim_redl (C:Prop) (c1 c2:C) :
-  c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1.
-Definition BoolP_elim_redr (C:Prop) (c1 c2:C) :
-  c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2.
-
-Definition BoolP_dep_induction :=
-  forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall 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.
+  
+  Definition BoolP := forall C:Prop, C -> C -> C.
+  Definition TrueP : BoolP := fun C c1 c2 => c1.
+  Definition FalseP : BoolP := fun C c1 c2 => c2.
+  Definition BoolP_elim C c1 c2 (b:BoolP) := b C c1 c2.
+  Definition BoolP_elim_redl (C:Prop) (c1 c2:C) :
+    c1 = BoolP_elim C c1 c2 TrueP := refl_equal c1.
+  Definition BoolP_elim_redr (C:Prop) (c1 c2:C) :
+    c2 = BoolP_elim C c1 c2 FalseP := refl_equal c2.
+  
+  Definition BoolP_dep_induction :=
+    forall P:BoolP -> Prop, P TrueP -> P FalseP -> forall b:BoolP, P b.
+  
+  Lemma ext_prop_dep_proof_irrel_cc :
+    prop_extensionality -> BoolP_dep_induction -> proof_irrelevance.
+  Proof.
+    exact (ext_prop_dep_proof_irrel_gen BoolP TrueP FalseP BoolP_elim BoolP_elim_redl
+      BoolP_elim_redr).
+  Qed.
 
 End Proof_irrelevance_Prop_Ext_CC.
 
 (************************************************************************)
-(** **** B. 3. CIC |- prop. ext. -> proof-irrelevance                   *)
+(** ** CIC |- prop. ext. -> proof-irrelevance                   *)
 
 (** In the Calculus of Inductive Constructions, inductively defined booleans
     enjoy dependent case analysis, hence directly proof-irrelevance from
@@ -238,21 +239,22 @@ End Proof_irrelevance_Prop_Ext_CC.
 *)
 
 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 := refl_equal c1.
-Definition boolP_elim_redr (C:Prop) (c1 c2:C) :
-  c2 = boolP_ind C c1 c2 falseP := refl_equal c2.
-Scheme boolP_indd := Induction for boolP Sort Prop.
-
-Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
-Proof
-  fun pe =>
-    ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl
-      boolP_elim_redr pe boolP_indd.
+  
+  Inductive boolP : Prop :=
+    | trueP : boolP
+    | falseP : boolP.
+  Definition boolP_elim_redl (C:Prop) (c1 c2:C) :
+    c1 = boolP_ind C c1 c2 trueP := refl_equal c1.
+  Definition boolP_elim_redr (C:Prop) (c1 c2:C) :
+    c2 = boolP_ind C c1 c2 falseP := refl_equal c2.
+  Scheme boolP_indd := Induction for boolP Sort Prop.
+  
+  Lemma ext_prop_dep_proof_irrel_cic : prop_extensionality -> proof_irrelevance.
+  Proof.
+    exact (fun pe =>
+      ext_prop_dep_proof_irrel_gen boolP trueP falseP boolP_ind boolP_elim_redl
+      boolP_elim_redr pe boolP_indd).
+  Qed.
 
 End Proof_irrelevance_CIC.
 
@@ -267,12 +269,12 @@ End Proof_irrelevance_CIC.
   cannot be refined.
 
   [[Berardi90]] Stefano Berardi, "Type dependence and constructive
-  mathematics", Ph. D. thesis, Dipartimento Matematica, Università di
+  mathematics", Ph. D. thesis, Dipartimento Matematica, Università di
   Torino, 1990.
 *)
 
 (************************************************************************)
-(** **** B. 4. CC |- excluded-middle + dep elim on bool -> proof-irrelevance *)
+(** ** CC |- excluded-middle + dep elim on bool -> proof-irrelevance *)
 
 (** This is a proof in the pure Calculus of Construction that
     classical logic in [Prop] + dependent elimination of disjunction entails
@@ -293,60 +295,61 @@ End Proof_irrelevance_CIC.
 Require Import Hurkens.
 
 Section Proof_irrelevance_EM_CC.
-
-Variable or : Prop -> Prop -> Prop.
-Variable or_introl : forall A B:Prop, A -> or A B.
-Variable or_intror : forall A B:Prop, B -> or A B.
-Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C.
-Hypothesis
-  or_elim_redl :
+  
+  Variable or : Prop -> Prop -> Prop.
+  Variable or_introl : forall A B:Prop, A -> or A B.
+  Variable or_intror : forall A B:Prop, B -> or A B.
+  Hypothesis or_elim : forall A B C:Prop, (A -> C) -> (B -> C) -> or A B -> C.
+  Hypothesis
+    or_elim_redl :
     forall (A B 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 :
+  Hypothesis
+    or_elim_redr :
     forall (A B 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 :
+  Hypothesis
+    or_dep_elim :
     forall (A B:Prop) (P:or A B -> Prop),
       (forall a:A, P (or_introl A B a)) ->
       (forall b:B, P (or_intror A B b)) -> forall b:or A B, P b.
-
-Hypothesis em : forall A:Prop, or A (~ A).
-Variable B : Prop.
-Variables b1 b2 : B.
-
-(** [p2b] and [b2p] form a retract if [~b1=b2] *)
-
-Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A).
-Definition b2p b := b1 = b.
-
-Lemma p2p1 : forall A:Prop, A -> b2p (p2b A).
-Proof.
-  unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
-   unfold b2p in |- *; intros.
-  apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)).
-  destruct (b H).
-Qed.
-Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A.
-Proof.
-  intro not_eq_b1_b2.
-  unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
-   unfold b2p in |- *; intros.
-  assumption.
-  destruct not_eq_b1_b2.
-  rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => 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.
+  
+  Hypothesis em : forall A:Prop, or A (~ A).
+  Variable B : Prop.
+  Variables b1 b2 : B.
+  
+  (** [p2b] and [b2p] form a retract if [~b1=b2] *)
+
+  Definition p2b A := or_elim A (~ A) B (fun _ => b1) (fun _ => b2) (em A).
+  Definition b2p b := b1 = b.
+
+  Lemma p2p1 : forall A:Prop, A -> b2p (p2b A).
+  Proof.
+    unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
+      unfold b2p in |- *; intros.
+    apply (or_elim_redl A (~ A) B (fun _ => b1) (fun _ => b2)).
+    destruct (b H).
+  Qed.
+
+  Lemma p2p2 : b1 <> b2 -> forall A:Prop, b2p (p2b A) -> A.
+  Proof.
+    intro not_eq_b1_b2.
+    unfold p2b in |- *; intro A; apply or_dep_elim with (b := em A);
+      unfold b2p in |- *; intros.
+    assumption.
+    destruct not_eq_b1_b2.
+    rewrite <- (or_elim_redr A (~ A) B (fun _ => b1) (fun _ => 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.
+    apply (paradox B p2b b2p (p2p2 H) p2p1).
+  Qed.
 
 End Proof_irrelevance_EM_CC.
 
@@ -357,7 +360,7 @@ End Proof_irrelevance_EM_CC.
 *)
 
 (************************************************************************)
-(** **** B. 5. CIC |- excluded-middle -> proof-irrelevance               *)
+(** ** CIC |- excluded-middle -> proof-irrelevance               *)
 
 (**
     Since, dependent elimination is derivable in the Calculus of
@@ -367,18 +370,19 @@ End Proof_irrelevance_EM_CC.
 
 Section Proof_irrelevance_CCI.
 
-Hypothesis em : forall A:Prop, A \/ ~ A.
-
-Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) 
-  (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a).
-Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) 
-  (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b).
-Scheme or_indd := Induction for or Sort Prop.
-
-Theorem proof_irrelevance_cci : forall (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.
+  Hypothesis em : forall A:Prop, A \/ ~ A.
+  
+  Definition or_elim_redl (A B C:Prop) (f:A -> C) (g:B -> C) 
+    (a:A) : f a = or_ind f g (or_introl B a) := refl_equal (f a).
+  Definition or_elim_redr (A B C:Prop) (f:A -> C) (g:B -> C) 
+    (b:B) : g b = or_ind f g (or_intror A b) := refl_equal (g b).
+  Scheme or_indd := Induction for or Sort Prop.
+  
+  Theorem proof_irrelevance_cci : forall (B:Prop) (b1 b2:B), b1 = b2.
+  Proof.
+    exact (proof_irrelevance_cc or or_introl or_intror or_ind or_elim_redl
+      or_elim_redr or_indd em).
+  Qed.
 
 End Proof_irrelevance_CCI.
 
@@ -388,16 +392,16 @@ End Proof_irrelevance_CCI.
     [em : forall A:Prop, {A}+{~A}] in the Set-impredicative CCI.
 *)
 
-(** *** C. Weak classical axioms *)
+(** * Weak classical axioms *)
 
 (** We show the following increasing in the strength of axioms:
  - weak excluded-middle
- - right distributivity of implication over disjunction and Gödel-Dummet axiom
+ - right distributivity of implication over disjunction and Gödel-Dummet axiom
  - independence of general premises and drinker's paradox
  - excluded-middle
 *)
 
-(** **** C. 1. Weak excluded-middle *)
+(** ** Weak excluded-middle *)
 
 (** The weak classical logic based on [~~A \/ ~A] is referred to with
     name KC in {[ChagrovZakharyaschev97]]
@@ -411,20 +415,20 @@ Definition weak_excluded_middle :=
 
 (** The interest in the equivalent variant
     [weak_generalized_excluded_middle] is that it holds even in logic
-    without a primitive [False] connective (like Gödel-Dummett axiom) *)
+    without a primitive [False] connective (like Gödel-Dummett axiom) *)
 
 Definition weak_generalized_excluded_middle := 
   forall A B:Prop, ((A -> B) -> B) \/ (A -> B).
 
-(** **** C. 2. Gödel-Dummett axiom *)
+(** ** Gödel-Dummett axiom *)
 
-(** [(A->B) \/ (B->A)] is studied in [[Dummett59]] and is based on [[Gödel33]].
+(** [(A->B) \/ (B->A)] is studied in [[Dummett59]] and is based on [[Gödel33]].
 
     [[Dummett59]] Michael A. E. Dummett. "A Propositional Calculus
     with a Denumerable Matrix", In the Journal of Symbolic Logic, Vol
     24 No. 2(1959), pp 97-103.
 
-    [[Gödel33]] Kurt Gödel. "Zum intuitionistischen Aussagenkalkül",
+    [[Gödel33]] Kurt Gödel. "Zum intuitionistischen Aussagenkalkül",
     Ergeb. Math. Koll. 4 (1933), pp. 34-38.
  *)
 
@@ -432,7 +436,7 @@ Definition GodelDummett := forall A B:Prop, (A -> B) \/ (B -> A).
 
 Lemma excluded_middle_Godel_Dummett : excluded_middle -> GodelDummett.
 Proof.
-intros EM A B. destruct (EM B) as [HB|HnotB].
+  intros EM A B. destruct (EM B) as [HB|HnotB].
   left; intros _; exact HB.
   right; intros HB; destruct (HnotB HB).
 Qed.
@@ -446,15 +450,15 @@ Definition RightDistributivityImplicationOverDisjunction :=
 Lemma Godel_Dummett_iff_right_distr_implication_over_disjunction :
   GodelDummett <-> RightDistributivityImplicationOverDisjunction.
 Proof.
-split.
-  intros GD A B C HCAB.
-  destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; 
-    destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption.
-  intros Distr A B.
-  destruct (Distr A B (A\/B)) as [HABA|HABB].
-    intro HAB; exact HAB.
-    right; intro HB; apply HABA; right; assumption.
-    left; intro HA; apply HABB; left; assumption.
+  split.
+    intros GD A B C HCAB.
+    destruct (GD B A) as [HBA|HAB]; [left|right]; intro HC; 
+      destruct (HCAB HC) as [HA|HB]; [ | apply HBA | apply HAB | ]; assumption.
+    intros Distr A B.
+    destruct (Distr A B (A\/B)) as [HABA|HABB].
+      intro HAB; exact HAB.
+      right; intro HB; apply HABA; right; assumption.
+      left; intro HA; apply HABB; left; assumption.
 Qed.
 
 (** [(A->B) \/ (B->A)] is stronger than the weak excluded middle *)
@@ -462,12 +466,12 @@ Qed.
 Lemma Godel_Dummett_weak_excluded_middle : 
   GodelDummett -> weak_excluded_middle.
 Proof.
-intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA].
-  left; intro HnotA; apply (HnotA (HnotAA HnotA)).
-  right; intro HA; apply (HAnotA HA HA).
+  intros GD A. destruct (GD (~A) A) as [HnotAA|HAnotA].
+    left; intro HnotA; apply (HnotA (HnotAA HnotA)).
+    right; intro HA; apply (HAnotA HA HA).
 Qed.
 
-(** **** C. 3. Independence of general premises and drinker's paradox *)
+(** ** Independence of general premises and drinker's paradox *)
 
 (** Independence of general premises is the unconstrained, non
     constructive, version of the Independence of Premises as
@@ -475,13 +479,13 @@ Qed.
 
     It is a generalization to predicate logic of the right
     distributivity of implication over disjunction (hence of
-    Gödel-Dummett axiom) whose own constructive form (obtained by a
+    Gödel-Dummett axiom) whose own constructive form (obtained by a
     restricting the third formula to be negative) is called
     Kreisel-Putnam principle [[KreiselPutnam57]].
 
     [[KreiselPutnam57]], Georg Kreisel and Hilary Putnam. "Eine
-    Unableitsbarkeitsbeweismethode für den intuitionistischen
-    Aussagenkalkül". Archiv für Mathematische Logik und
+    Unableitsbarkeitsbeweismethode für den intuitionistischen
+    Aussagenkalkül". Archiv für Mathematische Logik und
     Graundlagenforschung, 3:74- 78, 1957.
 
     [[Troelstra73]], Anne Troelstra, editor. Metamathematical
@@ -499,33 +503,33 @@ Lemma
   independence_general_premises_right_distr_implication_over_disjunction :
   IndependenceOfGeneralPremises -> RightDistributivityImplicationOverDisjunction.
 Proof.
-intros IP A B C HCAB.
-destruct (IP bool (fun b => if b then A else B) C true) as ([|],H).
-  intro HC; destruct (HCAB HC); [exists true|exists false]; assumption.
-  left; assumption.
-  right; assumption.
+  intros IP A B C HCAB.
+  destruct (IP bool (fun b => if b then A else B) C true) as ([|],H).
+    intro HC; destruct (HCAB HC); [exists true|exists false]; assumption.
+    left; assumption.
+    right; assumption.
 Qed.
 
 Lemma independence_general_premises_Godel_Dummett :
   IndependenceOfGeneralPremises -> GodelDummett.
 Proof.
-destruct Godel_Dummett_iff_right_distr_implication_over_disjunction.
-auto using independence_general_premises_right_distr_implication_over_disjunction.
+  destruct Godel_Dummett_iff_right_distr_implication_over_disjunction.
+  auto using independence_general_premises_right_distr_implication_over_disjunction.
 Qed.
 
 (** Independence of general premises is equivalent to the drinker's paradox *)
 
 Definition DrinkerParadox :=
   forall (A:Type) (P:A -> Prop), 
-  inhabited A -> exists x, (exists x, P x) -> P x.
+    inhabited A -> exists x, (exists x, P x) -> P x.
 
 Lemma independence_general_premises_drinker : 
   IndependenceOfGeneralPremises <-> DrinkerParadox.
 Proof.
-split.
-  intros IP A P InhA; apply (IP A P (exists x, P x) InhA); intro Hx; exact Hx.
-  intros Drinker A P Q InhA H; destruct (Drinker A P InhA) as (x,Hx).
-    exists x; intro HQ; apply (Hx (H HQ)).
+  split.
+    intros IP A P InhA; apply (IP A P (exists x, P x) InhA); intro Hx; exact Hx.
+    intros Drinker A P Q InhA H; destruct (Drinker A P InhA) as (x,Hx).
+      exists x; intro HQ; apply (Hx (H HQ)).
 Qed.
 
 (** Independence of general premises is weaker than (generalized) 
@@ -537,9 +541,9 @@ Definition generalized_excluded_middle :=
 Lemma excluded_middle_independence_general_premises :
   generalized_excluded_middle -> DrinkerParadox.
 Proof.
-intros GEM A P x0.
-destruct (GEM (exists x, P x) (P x0)) as [(x,Hx)|Hnot].
-  exists x; intro; exact Hx.
-  exists x0; exact Hnot.
+  intros GEM A P x0.
+  destruct (GEM (exists x, P x) (P x0)) as [(x,Hx)|Hnot].
+    exists x; intro; exact Hx.
+    exists x0; exact Hnot.
 Qed.
  
diff --git a/theories/Logic/Diaconescu.v b/theories/Logic/Diaconescu.v
index 19d5d7ec..5f139f35 100644
--- a/theories/Logic/Diaconescu.v
+++ b/theories/Logic/Diaconescu.v
@@ -7,7 +7,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Diaconescu.v 8892 2006-06-04 17:59:53Z herbelin $ i*)
+(*i $Id: Diaconescu.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Diaconescu showed that the Axiom of Choice entails Excluded-Middle
    in topoi [Diaconescu75]. Lacas and Werner adapted the proof to show
@@ -44,7 +44,7 @@
 *)
 
 (**********************************************************************)
-(** *** A. Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle       *)
+(** * Pred. Ext. + Rel. Axiom of Choice -> Excluded-Middle       *)
 
 Section PredExt_RelChoice_imp_EM.
 
@@ -156,7 +156,7 @@ Qed.
 End PredExt_RelChoice_imp_EM.
 
 (**********************************************************************)
-(** *** B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
+(** * B. Proof-Irrel. + Rel. Axiom of Choice -> Excl.-Middle for Equality *)
 
 (** This is an adaptation of Diaconescu's paradox exploiting that
     proof-irrelevance is some form of extensionality *)
@@ -263,7 +263,7 @@ Qed.
 End ProofIrrel_RelChoice_imp_EqEM.
 
 (**********************************************************************)
-(** *** B. Extensional Hilbert's epsilon description operator -> Excluded-Middle *)
+(** * Extensional Hilbert's epsilon description operator -> Excluded-Middle *)
 
 (** Proof sketch from Bell [Bell93] (with thanks to P. Castéran) *)
 
@@ -285,20 +285,20 @@ Notation Local eps := (epsilon bool true) (only parsing).
 
 Theorem extensional_epsilon_imp_EM : forall P:Prop, P \/ ~ P.
 Proof.
-intro P.
-pose (B := fun y => y=false \/ P).
-pose (C := fun y => y=true  \/ P).
-assert (B (eps B)) as [Hfalse|HP] 
-  by (apply epsilon_spec; exists false; left; reflexivity).
-assert (C (eps C)) as [Htrue|HP] 
-  by (apply epsilon_spec; exists true; left; reflexivity).
-  right; intro HP.
-  assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption).
-  rewrite epsilon_extensionality with (1:=H) in Hfalse.
-  rewrite Htrue in Hfalse.
-  discriminate.
-auto.
-auto.
+  intro P.
+  pose (B := fun y => y=false \/ P).
+  pose (C := fun y => y=true  \/ P).
+  assert (B (eps B)) as [Hfalse|HP] 
+    by (apply epsilon_spec; exists false; left; reflexivity).
+  assert (C (eps C)) as [Htrue|HP] 
+    by (apply epsilon_spec; exists true; left; reflexivity).
+    right; intro HP.
+    assert (forall y, B y <-> C y) by (intro y; split; intro; right; assumption).
+    rewrite epsilon_extensionality with (1:=H) in Hfalse.
+    rewrite Htrue in Hfalse.
+    discriminate.
+  auto.
+  auto.
 Qed.
 
 End ExtensionalEpsilon_imp_EM.
diff --git a/theories/Logic/EqdepFacts.v b/theories/Logic/EqdepFacts.v
index 7963555a..a257ef55 100644
--- a/theories/Logic/EqdepFacts.v
+++ b/theories/Logic/EqdepFacts.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: EqdepFacts.v 8674 2006-03-30 06:56:50Z herbelin $ i*)
+(*i $Id: EqdepFacts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** This file defines dependent equality and shows its equivalence with
     equality on dependent pairs (inhabiting sigma-types). It derives
@@ -32,70 +32,70 @@
 
 Table of contents:
 
-A. Definition of dependent equality and equivalence with equality
+1. Definition of dependent equality and equivalence with equality
 
-B. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K
+2. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K
 
-C. Definition of the functor that builds properties of dependent
+3. Definition of the functor that builds properties of dependent
    equalities assuming axiom eq_rect_eq
 
 *)
 
 (************************************************************************)
-(** *** A. Definition of dependent equality and equivalence with equality of dependent pairs *)
+(** * Definition of dependent equality and equivalence with equality of dependent pairs *)
 
 Section Dependent_Equality.
+  
+  Variable U : Type.
+  Variable P : U -> Type.
 
-Variable U : Type.
-Variable P : U -> Type.
+  (** Dependent equality *)
 
-(** Dependent equality *)
-
-Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop :=
+  Inductive eq_dep (p:U) (x:P p) : forall q:U, P q -> Prop :=
     eq_dep_intro : eq_dep p x p x.
-Hint Constructors eq_dep: core v62.
+  Hint Constructors eq_dep: core v62.
 
-Lemma eq_dep_refl : forall (p:U) (x:P p), eq_dep p x p x.
-Proof eq_dep_intro.
+  Lemma eq_dep_refl : forall (p:U) (x:P p), eq_dep p x p x.
+  Proof eq_dep_intro.
 
-Lemma eq_dep_sym :
- forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x.
-Proof.
-  destruct 1; auto.
-Qed.
-Hint Immediate eq_dep_sym: core v62.
+  Lemma eq_dep_sym :
+    forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep q y p x.
+  Proof.
+    destruct 1; auto.
+  Qed.
+  Hint Immediate eq_dep_sym: core v62.
 
-Lemma eq_dep_trans :
- forall (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.
-  destruct 1; auto.
-Qed.
+  Lemma eq_dep_trans :
+    forall (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.
+    destruct 1; auto.
+  Qed.
 
-Scheme eq_indd := Induction for eq Sort Prop.
+  Scheme eq_indd := Induction for eq Sort Prop.
 
-(** Equivalent definition of dependent equality expressed as a non
-    dependent inductive type *)
+  (** Equivalent definition of dependent equality expressed as a non
+      dependent inductive type *)
 
-Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop :=
+  Inductive eq_dep1 (p:U) (x:P p) (q:U) (y:P q) : Prop :=
     eq_dep1_intro : forall h:q = p, x = eq_rect q P y p h -> eq_dep1 p x q y.
 
-Lemma eq_dep1_dep :
- forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y.
-Proof.
-  destruct 1 as (eq_qp, H).
-  destruct eq_qp using eq_indd.
-  rewrite H.
-  apply eq_dep_intro.
-Qed.
-
-Lemma eq_dep_dep1 :
- forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y.
-Proof.
-  destruct 1.
-  apply eq_dep1_intro with (refl_equal p).
-  simpl in |- *; trivial.
-Qed.
+  Lemma eq_dep1_dep :
+    forall (p:U) (x:P p) (q:U) (y:P q), eq_dep1 p x q y -> eq_dep p x q y.
+  Proof.
+    destruct 1 as (eq_qp, H).
+    destruct eq_qp using eq_indd.
+    rewrite H.
+    apply eq_dep_intro.
+  Qed.
+
+  Lemma eq_dep_dep1 :
+    forall (p q:U) (x:P p) (y:P q), eq_dep p x q y -> eq_dep1 p x q y.
+  Proof.
+    destruct 1.
+    apply eq_dep1_intro with (refl_equal p).
+    simpl in |- *; trivial.
+  Qed.
 
 End Dependent_Equality.
 
@@ -105,8 +105,8 @@ Implicit Arguments eq_dep1 [U P].
 (** Dependent equality is equivalent to equality on dependent pairs *)
 
 Lemma eq_sigS_eq_dep :
- forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q),
-   existS P p x = existS P q y -> eq_dep p x q y.
+  forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q),
+    existS P p x = existS P q y -> eq_dep p x q y.
 Proof.
   intros.
   dependent rewrite H.
@@ -114,10 +114,10 @@ Proof.
 Qed.
 
 Lemma equiv_eqex_eqdep :
- forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q),
+  forall (U:Set) (P:U -> Set) (p q:U) (x:P p) (y:P q),
    existS P p x = existS P q y <-> eq_dep p x q y.
 Proof.
-split. 
+  split. 
   (* -> *)
   apply eq_sigS_eq_dep.
   (* <- *)
@@ -125,8 +125,8 @@ split.
 Qed.
 
 Lemma eq_sigT_eq_dep :
- forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
-   existT P p x = existT P q y -> eq_dep p x q y.
+  forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
+    existT P p x = existT P q y -> eq_dep p x q y.
 Proof.
   intros.
   dependent rewrite H.
@@ -134,8 +134,8 @@ Proof.
 Qed.
 
 Lemma eq_dep_eq_sigT :
- forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
-   eq_dep p x q y -> existT P p x = existT P q y.
+  forall (U:Type) (P:U -> Type) (p q:U) (x:P p) (y:P q),
+    eq_dep p x q y -> existT P p x = existT P q y.
 Proof.
   destruct 1; reflexivity.
 Qed.
@@ -146,90 +146,90 @@ Hint Resolve eq_dep_intro: core v62.
 Hint Immediate eq_dep_sym: core v62.
 
 (************************************************************************)
-(** *** B. Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K          *)
+(** * Eq_rect_eq <-> Eq_dep_eq <-> UIP <-> UIP_refl <-> K          *)
 
 Section Equivalences.
-
-Variable U:Type.
-
-(** Invariance by Substitution of Reflexive Equality Proofs *)
-
-Definition Eq_rect_eq := 
-  forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
-
-(** Injectivity of Dependent Equality *)
-
-Definition Eq_dep_eq := 
-  forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y.
-
-(** Uniqueness of Identity Proofs (UIP) *)
-
-Definition UIP_ := 
-  forall (x y:U) (p1 p2:x = y), p1 = p2.
-
-(** Uniqueness of Reflexive Identity Proofs *)
-
-Definition UIP_refl_ := 
-  forall (x:U) (p:x = x), p = refl_equal x.
-
-(** Streicher's axiom K *)
-
-Definition Streicher_K_ :=
-  forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
-
-(** Injectivity of Dependent Equality is a consequence of *)
-(** Invariance by Substitution of Reflexive Equality Proof *)
-
-Lemma eq_rect_eq__eq_dep1_eq :
-  Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
-Proof.
-  intro eq_rect_eq.
-  simple destruct 1; intro.
-  rewrite <- eq_rect_eq; auto.
-Qed.
-
-Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq.
-Proof.
-  intros eq_rect_eq; red; intros.
-  apply (eq_rect_eq__eq_dep1_eq eq_rect_eq); apply eq_dep_dep1; trivial.
-Qed.
-
-(** Uniqueness of Identity Proofs (UIP) is a consequence of *)
-(** Injectivity of Dependent Equality *)
-
-Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_.
-Proof.
-  intro eq_dep_eq; red.
-  intros; apply eq_dep_eq with (P := fun 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__UIP_refl : UIP_ -> UIP_refl_.
-Proof.
-  intro UIP; red; intros; apply UIP.
-Qed.
-
-(** Streicher's axiom K is a direct consequence of Uniqueness of
-    Reflexive Identity Proofs *)
-
-Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_.
-Proof.
-  intro UIP_refl; red; intros; rewrite UIP_refl; assumption.
-Qed.
-
-(** We finally recover from K the Invariance by Substitution of
-    Reflexive Equality Proofs *)
-
-Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq.
-Proof.
-  intro Streicher_K; red; intros.
-  apply Streicher_K with (p := h).
-  reflexivity.
-Qed.
+  
+  Variable U:Type.
+  
+  (** Invariance by Substitution of Reflexive Equality Proofs *)
+  
+  Definition Eq_rect_eq := 
+    forall (p:U) (Q:U -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+  
+  (** Injectivity of Dependent Equality *)
+  
+  Definition Eq_dep_eq := 
+    forall (P:U->Type) (p:U) (x y:P p), eq_dep p x p y -> x = y.
+  
+  (** Uniqueness of Identity Proofs (UIP) *)
+  
+  Definition UIP_ := 
+    forall (x y:U) (p1 p2:x = y), p1 = p2.
+  
+  (** Uniqueness of Reflexive Identity Proofs *)
+
+  Definition UIP_refl_ := 
+    forall (x:U) (p:x = x), p = refl_equal x.
+
+  (** Streicher's axiom K *)
+
+  Definition Streicher_K_ :=
+    forall (x:U) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+
+  (** Injectivity of Dependent Equality is a consequence of *)
+  (** Invariance by Substitution of Reflexive Equality Proof *)
+
+  Lemma eq_rect_eq__eq_dep1_eq :
+    Eq_rect_eq -> forall (P:U->Type) (p:U) (x y:P p), eq_dep1 p x p y -> x = y.
+  Proof.
+    intro eq_rect_eq.
+    simple destruct 1; intro.
+    rewrite <- eq_rect_eq; auto.
+  Qed.
+
+  Lemma eq_rect_eq__eq_dep_eq : Eq_rect_eq -> Eq_dep_eq.
+  Proof.
+    intros eq_rect_eq; red; intros.
+    apply (eq_rect_eq__eq_dep1_eq eq_rect_eq); apply eq_dep_dep1; trivial.
+  Qed.
+
+  (** Uniqueness of Identity Proofs (UIP) is a consequence of *)
+  (** Injectivity of Dependent Equality *)
+
+  Lemma eq_dep_eq__UIP : Eq_dep_eq -> UIP_.
+  Proof.
+    intro eq_dep_eq; red.
+    intros; apply eq_dep_eq with (P := fun 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__UIP_refl : UIP_ -> UIP_refl_.
+  Proof.
+    intro UIP; red; intros; apply UIP.
+  Qed.
+
+  (** Streicher's axiom K is a direct consequence of Uniqueness of
+      Reflexive Identity Proofs *)
+
+  Lemma UIP_refl__Streicher_K : UIP_refl_ -> Streicher_K_.
+  Proof.
+    intro UIP_refl; red; intros; rewrite UIP_refl; assumption.
+  Qed.
+
+  (** We finally recover from K the Invariance by Substitution of
+      Reflexive Equality Proofs *)
+  
+  Lemma Streicher_K__eq_rect_eq : Streicher_K_ -> Eq_rect_eq.
+  Proof.
+    intro Streicher_K; red; intros.
+    apply Streicher_K with (p := h).
+    reflexivity.
+  Qed.
 
 (** Remark: It is reasonable to think that [eq_rect_eq] is strictly
     stronger than [eq_rec_eq] (which is [eq_rect_eq] restricted on [Set]):
@@ -246,37 +246,37 @@ Qed.
 End Equivalences.
 
 Section Corollaries.
-
-Variable U:Type.
-Variable V:Set.
-
-(** UIP implies the injectivity of equality on dependent pairs in Type *)
-
-Definition Inj_dep_pairT :=
-  forall (P:U -> Type) (p:U) (x y:P p),
-    existT P p x = existT P p y -> x = y.
-
-Lemma eq_dep_eq__inj_pairT2 : Eq_dep_eq U -> Inj_dep_pairT.
+  
+  Variable U:Type.
+  Variable V:Set.
+  
+  (** UIP implies the injectivity of equality on dependent pairs in Type *)
+
+  Definition Inj_dep_pairT :=
+    forall (P:U -> Type) (p:U) (x y:P p),
+      existT P p x = existT P p y -> x = y.
+  
+  Lemma eq_dep_eq__inj_pairT2 : Eq_dep_eq U -> Inj_dep_pairT.
+  Proof.
+    intro eq_dep_eq; red; intros.
+    apply eq_dep_eq.
+    apply eq_sigT_eq_dep.
+    assumption.
+ Qed.
+ 
+  (** UIP implies the injectivity of equality on dependent pairs in Set *)
+ 
+ Definition Inj_dep_pairS :=
+   forall (P:V -> Set) (p:V) (x y:P p), existS P p x = existS P p y -> x = y.
+ 
+ Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq V -> Inj_dep_pairS.
  Proof.
    intro eq_dep_eq; red; intros.
    apply eq_dep_eq.
-   apply eq_sigT_eq_dep.
+   apply eq_sigS_eq_dep.
    assumption.
  Qed.
 
-(** UIP implies the injectivity of equality on dependent pairs in Set *)
-
-Definition Inj_dep_pairS :=
-  forall (P:V -> Set) (p:V) (x y:P p), existS P p x = existS P p y -> x = y.
-
-Lemma eq_dep_eq__inj_pair2 : Eq_dep_eq V -> Inj_dep_pairS.
-Proof.
-  intro eq_dep_eq; red; intros.
-  apply eq_dep_eq.
-  apply eq_sigS_eq_dep.
-  assumption.
-Qed.
-
 End Corollaries.
 
 (************************************************************************)
@@ -286,16 +286,16 @@ Module Type EqdepElimination.
 
   Axiom eq_rect_eq :
     forall (U:Type) (p:U) (Q:U -> Type) (x:Q p) (h:p = p),
-    x = eq_rect p Q x p h.
+      x = eq_rect p Q x p h.
 
 End EqdepElimination.
 
 Module EqdepTheory (M:EqdepElimination).
-
-Section Axioms.
-
-Variable U:Type.
-
+  
+  Section Axioms.
+    
+    Variable U:Type.
+    
 (** Invariance by Substitution of Reflexive Equality Proofs *)
 
 Lemma eq_rect_eq :
diff --git a/theories/Logic/Eqdep_dec.v b/theories/Logic/Eqdep_dec.v
index 7d71a1a6..740fcfcf 100644
--- a/theories/Logic/Eqdep_dec.v
+++ b/theories/Logic/Eqdep_dec.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Eqdep_dec.v 8136 2006-03-05 21:57:47Z herbelin $ i*)
+(*i $Id: Eqdep_dec.v 9245 2006-10-17 12:53:34Z notin $ 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.
@@ -20,149 +20,153 @@
 
 Table of contents:
 
-A. Streicher's K and injectivity of dependent pair hold on decidable types
+1. Streicher's K and injectivity of dependent pair hold on decidable types
 
-B.1. Definition of the functor that builds properties of dependent equalities
+1.1. Definition of the functor that builds properties of dependent equalities
      from a proof of decidability of equality for a set in Type
 
-B.2. Definition of the functor that builds properties of dependent equalities
+1.2. Definition of the functor that builds properties of dependent equalities
      from a proof of decidability of equality for a set in Set
 
 *)
 
 (************************************************************************)
-(** *** A. Streicher's K and injectivity of dependent pair hold on decidable types *)
+(** * Streicher's K and injectivity of dependent pair hold on decidable types *)
 
 Set Implicit Arguments.
 
 Section EqdepDec.
 
   Variable A : Type.
-
+  
   Let comp (x y y':A) (eq1:x = y) (eq2:x = y') : y = y' :=
     eq_ind _ (fun a => a = y') eq2 _ eq1.
 
   Remark trans_sym_eq : forall (x y:A) (u:x = y), comp u u = refl_equal y.
-intros.
-case u; trivial.
-Qed.
-
-
+  Proof.
+    intros.
+    case u; trivial.
+  Qed.
 
   Variable eq_dec : forall x y:A, x = y \/ x <> y.
-
+  
   Variable x : A.
 
-
   Let nu (y:A) (u:x = y) : x = y :=
     match eq_dec x y with
-    | or_introl eqxy => eqxy
-    | or_intror neqxy => False_ind _ (neqxy u)
+      | or_introl eqxy => eqxy
+      | or_intror neqxy => False_ind _ (neqxy u)
     end.
 
   Let nu_constant : forall (y:A) (u v:x = y), nu u = nu v.
-intros.
-unfold nu in |- *.
-case (eq_dec x y); intros.
-reflexivity.
-
-case n; trivial.
-Qed.
+    intros.
+    unfold nu in |- *.
+    case (eq_dec x y); intros.
+    reflexivity.
+  
+    case n; trivial.
+  Qed.
 
 
   Let nu_inv (y:A) (v:x = y) : x = y := comp (nu (refl_equal x)) v.
-
+  
 
   Remark nu_left_inv : forall (y:A) (u:x = y), nu_inv (nu u) = u.
-intros.
-case u; unfold nu_inv in |- *.
-apply trans_sym_eq.
-Qed.
+  Proof.
+    intros.
+    case u; unfold nu_inv in |- *.
+    apply trans_sym_eq.
+  Qed.
 
 
   Theorem eq_proofs_unicity : forall (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.
+  Proof.
+    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 :
-   forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p.
-intros.
-elim eq_proofs_unicity with x (refl_equal x) p.
-trivial.
-Qed.
+  Theorem K_dec : 
+    forall P:x = x -> Prop, P (refl_equal x) -> forall p:x = x, P p.
+  Proof.
+    intros.
+    elim eq_proofs_unicity with x (refl_equal x) p.
+    trivial.
+  Qed.
 
   (** The corollary *)
 
   Let proj (P:A -> Prop) (exP:ex P) (def:P x) : P x :=
     match exP with
-    | ex_intro x' prf =>
+      | ex_intro x' prf =>
         match eq_dec x' x with
-        | or_introl eqprf => eq_ind x' P prf x eqprf
-        | _ => def
+          | or_introl eqprf => eq_ind x' P prf x eqprf
+          | _ => def
         end
     end.
 
 
   Theorem inj_right_pair :
-   forall (P:A -> Prop) (y y':P x),
-     ex_intro P x y = ex_intro P x y' -> y = y'.
-intros.
-cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y).
-simpl in |- *.
-case (eq_dec x x).
-intro e.
-elim e using K_dec; trivial.
-
-intros.
-case n; trivial.
-
-case H.
-reflexivity.
-Qed.
+    forall (P:A -> Prop) (y y':P x),
+      ex_intro P x y = ex_intro P x y' -> y = y'.
+  Proof.
+    intros.
+    cut (proj (ex_intro P x y) y = proj (ex_intro P x y') y).
+    simpl in |- *.
+    case (eq_dec x x).
+    intro e.
+    elim e using K_dec; trivial.
+    
+    intros.
+    case n; trivial.
+    
+    case H.
+    reflexivity.
+  Qed.
 
 End EqdepDec.
 
 Require Import EqdepFacts.
 
-  (** We deduce axiom [K] for (decidable) types *)
-  Theorem K_dec_type :
-   forall A:Type,
-     (forall x y:A, {x = y} + {x <> y}) ->
-     forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
-intros A eq_dec x P H p.
-elim p using K_dec; intros.
-case (eq_dec x0 y); [left|right]; assumption.
-trivial.
+(** We deduce axiom [K] for (decidable) types *)
+Theorem K_dec_type :
+  forall A:Type,
+    (forall x y:A, {x = y} + {x <> y}) ->
+    forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+Proof.
+  intros A eq_dec x P H p.
+  elim p using K_dec; intros.
+  case (eq_dec x0 y); [left|right]; assumption.
+  trivial.
 Qed.
 
-  Theorem K_dec_set :
-   forall A:Set,
-     (forall x y:A, {x = y} + {x <> y}) ->
-     forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
-  Proof fun A => K_dec_type (A:=A).
-
-  (** We deduce the [eq_rect_eq] axiom for (decidable) types *)
-  Theorem eq_rect_eq_dec :
-    forall A:Type,
-     (forall x y:A, {x = y} + {x <> y}) ->
-     forall (p:A) (Q:A -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
-intros A eq_dec.
-apply (Streicher_K__eq_rect_eq A (K_dec_type eq_dec)).
+Theorem K_dec_set :
+  forall A:Set,
+    (forall x y:A, {x = y} + {x <> y}) ->
+    forall (x:A) (P:x = x -> Prop), P (refl_equal x) -> forall p:x = x, P p.
+Proof fun A => K_dec_type (A:=A).
+
+(** We deduce the [eq_rect_eq] axiom for (decidable) types *)
+Theorem eq_rect_eq_dec :
+  forall A:Type,
+    (forall x y:A, {x = y} + {x <> y}) ->
+    forall (p:A) (Q:A -> Type) (x:Q p) (h:p = p), x = eq_rect p Q x p h.
+Proof.
+  intros A eq_dec.
+  apply (Streicher_K__eq_rect_eq A (K_dec_type eq_dec)).
 Qed.
 
 Unset Implicit Arguments.
 
 (************************************************************************)
-(** *** B.1. Definition of the functor that builds properties of dependent equalities on decidable sets in Type *)
+(** ** Definition of the functor that builds properties of dependent equalities on decidable sets in Type *)
 
 (** The signature of decidable sets in [Type] *)
 
 Module Type DecidableType.
-
+  
   Parameter U:Type.
   Axiom eq_dec : forall x y:U, {x = y} + {x <> y}.
 
@@ -215,16 +219,17 @@ Module DecidableEqDep (M:DecidableType).
   Lemma inj_pairP2 :
     forall (P:U -> Prop) (x:U) (p q:P x),
       ex_intro P x p = ex_intro P x q -> p = q.
-  intros.
-  apply inj_right_pair with (A:=U).
-  intros x0 y0; case (eq_dec x0 y0); [left|right]; assumption.
-  assumption.
+  Proof.
+    intros.
+    apply inj_right_pair with (A:=U).
+    intros x0 y0; case (eq_dec x0 y0); [left|right]; assumption.
+    assumption.
   Qed.
 
 End DecidableEqDep.
 
 (************************************************************************)
-(** *** B.2 Definition of the functor that builds properties of dependent equalities on decidable sets in Set *)
+(** ** B Definition of the functor that builds properties of dependent equalities on decidable sets in Set *)
 
 (** The signature of decidable sets in [Set] *)
 
diff --git a/theories/Logic/JMeq.v b/theories/Logic/JMeq.v
index 4d365e32..6a723e43 100644
--- a/theories/Logic/JMeq.v
+++ b/theories/Logic/JMeq.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: JMeq.v 6009 2004-08-03 17:42:55Z herbelin $ i*)
+(*i $Id: JMeq.v 9077 2006-08-24 08:44:32Z herbelin $ i*)
 
 (** John Major's Equality as proposed by Conor McBride
 
@@ -19,56 +19,65 @@
 
 Set Implicit Arguments.
 
-Inductive JMeq (A:Set) (x:A) : forall B:Set, B -> Prop :=
+Inductive JMeq (A:Type) (x:A) : forall B:Type, B -> Prop :=
     JMeq_refl : JMeq x x.
-Reset JMeq_ind.
+Reset JMeq_rect.
 
 Hint Resolve JMeq_refl.
 
-Lemma sym_JMeq : forall (A B:Set) (x:A) (y:B), JMeq x y -> JMeq y x.
+Lemma sym_JMeq : forall (A B:Type) (x:A) (y:B), JMeq x y -> JMeq y x.
 destruct 1; trivial.
 Qed.
 
 Hint Immediate sym_JMeq.
 
 Lemma trans_JMeq :
- forall (A B C:Set) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z.
+ forall (A B C:Type) (x:A) (y:B) (z:C), JMeq x y -> JMeq y z -> JMeq x z.
 destruct 1; trivial.
 Qed.
 
-Axiom JMeq_eq : forall (A:Set) (x y:A), JMeq x y -> x = y.
+Axiom JMeq_eq : forall (A:Type) (x y:A), JMeq x y -> x = y.
 
-Lemma JMeq_ind : forall (A:Set) (x y:A) (P:A -> Prop), P x -> JMeq x y -> P y.
+Lemma JMeq_ind : forall (A:Type) (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 : forall (A:Set) (x y:A) (P:A -> Set), P x -> JMeq x y -> P y.
+Lemma JMeq_rec : forall (A:Type) (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_rect : forall (A:Type) (x y:A) (P:A->Type), 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 :
- forall (A:Set) (x y:A) (P:A -> Prop), P y -> JMeq x y -> P x.
+ forall (A:Type) (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 :
- forall (A:Set) (x y:A) (P:A -> Set), P y -> JMeq x y -> P x.
+ forall (A:Type) (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.
+
+Lemma JMeq_rect_r :
+ forall (A:Type) (x y:A) (P:A -> Type), 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)] *)
+(** [JMeq] is equivalent to [(eq_dep Type [X]X)] *)
 
 Require Import Eqdep.
 
 Lemma JMeq_eq_dep :
- forall (A B:Set) (x:A) (y:B), JMeq x y -> eq_dep Set (fun X => X) A x B y.
+ forall (A B:Type) (x:A) (y:B), JMeq x y -> eq_dep Type (fun X => X) A x B y.
 Proof.
 destruct 1.
 apply eq_dep_intro.
 Qed.
 
 Lemma eq_dep_JMeq :
- forall (A B:Set) (x:A) (y:B), eq_dep Set (fun X => X) A x B y -> JMeq x y.
+ forall (A B:Type) (x:A) (y:B), eq_dep Type (fun X => X) A x B y -> JMeq x y.
 Proof.
 destruct 1.
 apply JMeq_refl. 
diff --git a/theories/NArith/NArith.v b/theories/NArith/NArith.v
index 2f066efa..019ef5f7 100644
--- a/theories/NArith/NArith.v
+++ b/theories/NArith/NArith.v
@@ -6,9 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: NArith.v 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: NArith.v 9210 2006-10-05 10:12:15Z barras $ *)
 
 (** Library for binary natural numbers *)
 
 Require Export BinPos.
-Require Export BinNat.
\ No newline at end of file
+Require Export BinNat.
+
+Require Export NArithRing.
diff --git a/theories/QArith/QArith_base.v b/theories/QArith/QArith_base.v
index 335466a6..66d16cfe 100644
--- a/theories/QArith/QArith_base.v
+++ b/theories/QArith/QArith_base.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: QArith_base.v 8989 2006-06-25 22:17:49Z letouzey $ i*)
+(*i $Id: QArith_base.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export ZArith.
 Require Export ZArithRing.
@@ -87,7 +87,7 @@ Qed.
 Hint Unfold Qeq Qlt Qle: qarith.
 Hint Extern 5 (?X1 <> ?X2) => intro; discriminate: qarith.
 
-(** Properties of equality. *)
+(** * Properties of equality. *)
 
 Theorem Qeq_refl : forall x, x == x.
 Proof.
@@ -104,8 +104,10 @@ Proof.
 unfold Qeq in |- *; intros.
 apply Zmult_reg_l with (QDen y). 
 auto with qarith.
-ring; rewrite H; ring.
-rewrite Zmult_assoc; rewrite H0; ring.
+transitivity (Qnum x * QDen y * QDen z)%Z; try ring.
+rewrite H.
+transitivity (Qnum y * QDen z * QDen x)%Z; try ring.
+rewrite H0; ring.
 Qed.
 
 (** Furthermore, this equality is decidable: *)
@@ -128,6 +130,9 @@ Hint Resolve (Seq_refl Q Qeq Q_Setoid): qarith.
 Hint Resolve (Seq_sym Q Qeq Q_Setoid): qarith.
 Hint Resolve (Seq_trans Q Qeq Q_Setoid): qarith.
 
+
+(** * Addition, multiplication and opposite *)
+
 (** The addition, multiplication and opposite are defined 
    in the straightforward way: *)
 
@@ -160,133 +165,138 @@ Infix "/" := Qdiv : Q_scope.
 
 Notation " ' x " := (Zpos x) (at level 20, no associativity) : Z_scope.
 
-(** Setoid compatibility results *)
+
+(** * Setoid compatibility results *)
 
 Add Morphism Qplus : Qplus_comp. 
 Proof.
-unfold Qeq, Qplus; simpl.
-Open Scope Z_scope.
-intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
-simpl_mult; ring.
-replace (p1 * ('s2 * 'q2)) with (p1 * 'q2 * 's2) by ring.
-rewrite H.
-replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring.
-rewrite H0.
-ring.
-Open Scope Q_scope.
+  unfold Qeq, Qplus; simpl.
+  Open Scope Z_scope.
+  intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
+  simpl_mult; ring_simplify.
+  replace (p1 * 'r2 * 'q2) with (p1 * 'q2 * 'r2) by ring.
+  rewrite H.
+  replace (r1 * 'p2 * 'q2 * 's2) with (r1 * 's2 * 'p2 * 'q2) by ring.
+  rewrite H0.
+  ring.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qopp : Qopp_comp.
 Proof.
-unfold Qeq, Qopp; simpl.
-intros; ring; rewrite H; ring.
+  unfold Qeq, Qopp; simpl.
+  Open Scope Z_scope.
+  intros.
+  replace (- Qnum x1 * ' Qden x2) with (- (Qnum x1 * ' Qden x2)) by ring.
+  rewrite H in |- *;  ring.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qminus : Qminus_comp.
 Proof.
-intros.
-unfold Qminus. 
-rewrite H; rewrite H0; auto with qarith.
+  intros.
+  unfold Qminus. 
+  rewrite H; rewrite H0; auto with qarith.
 Qed.
 
 Add Morphism Qmult : Qmult_comp.
 Proof.
-unfold Qeq; simpl.
-Open Scope Z_scope.
-intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
-intros; simpl_mult; ring.
-replace ('p2 * (q1 * s1)) with (q1 * 'p2 * s1) by ring.
-rewrite <- H.
-replace ('s2 * ('q2 * r1)) with (r1 * 's2 * 'q2) by ring.
-rewrite H0.
-ring.
-Open Scope Q_scope.
+  unfold Qeq; simpl.
+  Open Scope Z_scope.
+  intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0; simpl in *.
+  intros; simpl_mult; ring_simplify.
+  replace (q1 * s1 * 'p2) with (q1 * 'p2 * s1) by ring.
+  rewrite <- H.
+  replace (p1 * r1 * 'q2 * 's2) with (r1 * 's2 * p1 * 'q2) by ring.
+  rewrite H0.
+  ring.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qinv : Qinv_comp.
 Proof.
-unfold Qeq, Qinv; simpl.
-Open Scope Z_scope.
-intros (p1, p2) (q1, q2); simpl.
-case p1; simpl.
-intros. 
-assert (q1 = 0).
- elim (Zmult_integral q1 ('p2)); auto with zarith.
- intros; discriminate.
-subst; auto. 
-case q1; simpl; intros; try discriminate.
-rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
-case q1; simpl; intros; try discriminate.
-rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
-Open Scope Q_scope.
+  unfold Qeq, Qinv; simpl.
+  Open Scope Z_scope.
+  intros (p1, p2) (q1, q2); simpl.
+  case p1; simpl.
+  intros. 
+  assert (q1 = 0).
+  elim (Zmult_integral q1 ('p2)); auto with zarith.
+  intros; discriminate.
+  subst; auto. 
+  case q1; simpl; intros; try discriminate.
+  rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
+  case q1; simpl; intros; try discriminate.
+  rewrite (Pmult_comm p2 p); rewrite (Pmult_comm q2 p0); auto.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qdiv : Qdiv_comp.
 Proof.
-intros; unfold Qdiv.
-rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qdiv.
+  rewrite H; rewrite H0; auto with qarith.
 Qed.
 
 Add Morphism Qle with signature Qeq ==> Qeq ==> iff as Qle_comp.
 Proof.
-cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4).
-split; apply H; assumption || (apply Qeq_sym ; assumption).
-
-unfold Qeq, Qle; simpl.
-Open Scope Z_scope.
-intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *.
-apply Zmult_le_reg_r with ('p2).
-unfold Zgt; auto.
-replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring.
-rewrite <- H.
-apply Zmult_le_reg_r with ('r2).
-unfold Zgt; auto.
-replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring.
-rewrite <- H0.
-replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring.
-replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring.
-auto with zarith.
-Open Scope Q_scope.
+  cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<=x3 -> x2<=x4).
+  split; apply H; assumption || (apply Qeq_sym ; assumption).
+  
+  unfold Qeq, Qle; simpl.
+  Open Scope Z_scope.
+  intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *.
+  apply Zmult_le_reg_r with ('p2).
+  unfold Zgt; auto.
+  replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring.
+  rewrite <- H.
+  apply Zmult_le_reg_r with ('r2).
+  unfold Zgt; auto.
+  replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring.
+  rewrite <- H0.
+  replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring.
+  replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring.
+  auto with zarith.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qlt with signature Qeq ==> Qeq ==> iff as  Qlt_comp.
 Proof.
-cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<x3 -> x2<x4).
-split; apply H; assumption || (apply Qeq_sym ; assumption).
-
-unfold Qeq, Qlt; simpl.
-Open Scope Z_scope.
-intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *.
-apply Zgt_lt.
-generalize (Zlt_gt _ _ H1); clear H1; intro H1.
-apply Zmult_gt_reg_r with ('p2); auto with zarith.
-replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring.
-rewrite <- H.
-apply Zmult_gt_reg_r with ('r2); auto with zarith.
-replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring.
-rewrite <- H0.
-replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring.
-replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. 
-apply Zlt_gt.
-apply Zmult_gt_0_lt_compat_l; auto with zarith.
-Open Scope Q_scope.
+  cut (forall x1 x2, x1==x2 -> forall x3 x4, x3==x4 -> x1<x3 -> x2<x4).
+  split; apply H; assumption || (apply Qeq_sym ; assumption).
+
+  unfold Qeq, Qlt; simpl.
+  Open Scope Z_scope.
+  intros (p1, p2) (q1, q2) H (r1, r2) (s1, s2) H0 H1; simpl in *.
+  apply Zgt_lt.
+  generalize (Zlt_gt _ _ H1); clear H1; intro H1.
+  apply Zmult_gt_reg_r with ('p2); auto with zarith.
+  replace (q1 * 's2 * 'p2) with (q1 * 'p2 * 's2) by ring.
+  rewrite <- H.
+  apply Zmult_gt_reg_r with ('r2); auto with zarith.
+  replace (s1 * 'q2 * 'p2 * 'r2) with (s1 * 'r2 * 'q2 * 'p2) by ring.
+  rewrite <- H0.
+  replace (p1 * 'q2 * 's2 * 'r2) with ('q2 * 's2 * (p1 * 'r2)) by ring.
+  replace (r1 * 's2 * 'q2 * 'p2) with ('q2 * 's2 * (r1 * 'p2)) by ring. 
+  apply Zlt_gt.
+  apply Zmult_gt_0_lt_compat_l; auto with zarith.
+  Close Scope Z_scope.
 Qed.
 
 
 Lemma Qcompare_egal_dec: forall n m p q : Q, 
- (n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)).
+  (n<m -> p<q) -> (n==m -> p==q) -> (n>m -> p>q) -> ((n?=m) = (p?=q)).
 Proof.
-intros.
-do 2 rewrite Qeq_alt in H0.
-unfold Qeq, Qlt, Qcompare in *.
-apply Zcompare_egal_dec; auto.
-omega.
+  intros.
+  do 2 rewrite Qeq_alt in H0.
+  unfold Qeq, Qlt, Qcompare in *.
+  apply Zcompare_egal_dec; auto.
+  omega.
 Qed.
 
 
 Add Morphism Qcompare : Qcompare_comp.
 Proof.
-intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto.
+  intros; apply Qcompare_egal_dec; rewrite H; rewrite H0; auto.
 Qed.
 
 
@@ -294,382 +304,387 @@ Qed.
 
 Lemma Q_apart_0_1 : ~ 1 == 0.
 Proof.
- unfold Qeq; auto with qarith.
+  unfold Qeq; auto with qarith.
 Qed.
 
+(** * Properties of [Qadd] *)
+
 (** Addition is associative: *)
 
 Theorem Qplus_assoc : forall x y z, x+(y+z)==(x+y)+z.
 Proof.
- intros (x1, x2) (y1, y2) (z1, z2).
- unfold Qeq, Qplus; simpl; simpl_mult; ring.
+  intros (x1, x2) (y1, y2) (z1, z2).
+  unfold Qeq, Qplus; simpl; simpl_mult; ring.
 Qed.
 
 (** [0] is a neutral element for addition: *)
 
 Lemma Qplus_0_l : forall x, 0+x == x.
 Proof.
- intros (x1, x2); unfold Qeq, Qplus; simpl; ring.
+  intros (x1, x2); unfold Qeq, Qplus; simpl; ring.
 Qed.
 
 Lemma Qplus_0_r : forall x, x+0 == x.
 Proof.
- intros (x1, x2); unfold Qeq, Qplus; simpl.
- rewrite Pmult_comm; simpl; ring.
+  intros (x1, x2); unfold Qeq, Qplus; simpl.
+  rewrite Pmult_comm; simpl; ring.
 Qed. 
 
 (** Commutativity of addition: *)
 
 Theorem Qplus_comm : forall x y, x+y == y+x.
 Proof.
- intros (x1, x2); unfold Qeq, Qplus; simpl.
- intros; rewrite Pmult_comm; ring.
+  intros (x1, x2); unfold Qeq, Qplus; simpl.
+  intros; rewrite Pmult_comm; ring.
 Qed.
 
-(** Properties of [Qopp] *)
+
+(** * Properties of [Qopp] *)
 
 Lemma Qopp_involutive : forall q, - -q == q.
 Proof.
- red; simpl; intros; ring.
+  red; simpl; intros; ring.
 Qed.
 
 Theorem Qplus_opp_r : forall q, q+(-q) == 0.
 Proof.
- red; simpl; intro; ring.
+  red; simpl; intro; ring.
 Qed.
 
+
+(** * Properties of [Qmult] *)
+
 (** Multiplication is associative: *)
 
 Theorem Qmult_assoc : forall n m p, n*(m*p)==(n*m)*p.
 Proof.
- intros; red; simpl; rewrite Pmult_assoc; ring.
+  intros; red; simpl; rewrite Pmult_assoc; ring.
 Qed.
 
 (** [1] is a neutral element for multiplication: *)
 
 Lemma Qmult_1_l : forall n, 1*n == n.
 Proof.
- intro; red; simpl; destruct (Qnum n); auto.
+  intro; red; simpl; destruct (Qnum n); auto.
 Qed.
 
 Theorem Qmult_1_r : forall n, n*1==n.
 Proof.
- intro; red; simpl.
- rewrite Zmult_1_r with (n := Qnum n).
- rewrite Pmult_comm; simpl; trivial. 
+  intro; red; simpl.
+  rewrite Zmult_1_r with (n := Qnum n).
+  rewrite Pmult_comm; simpl; trivial. 
 Qed.
 
 (** Commutativity of multiplication *)
 
 Theorem Qmult_comm : forall x y, x*y==y*x.
 Proof.
- intros; red; simpl; rewrite Pmult_comm; ring.
+  intros; red; simpl; rewrite Pmult_comm; ring.
 Qed.
 
-(** Distributivity *)
+(** Distributivity over [Qadd] *)
 
 Theorem Qmult_plus_distr_r : forall x y z, x*(y+z)==(x*y)+(x*z).
 Proof.
-intros (x1, x2) (y1, y2) (z1, z2).
-unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring.
+  intros (x1, x2) (y1, y2) (z1, z2).
+  unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring.
 Qed.
 
 Theorem Qmult_plus_distr_l : forall x y z, (x+y)*z==(x*z)+(y*z).
 Proof.
-intros (x1, x2) (y1, y2) (z1, z2).
-unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring.
+  intros (x1, x2) (y1, y2) (z1, z2).
+  unfold Qeq, Qmult, Qplus; simpl; simpl_mult; ring.
 Qed.
 
 (** Integrality *)
 
 Theorem Qmult_integral : forall x y, x*y==0 -> x==0 \/ y==0.
 Proof.
- intros (x1,x2) (y1,y2).
- unfold Qeq, Qmult; simpl; intros.
- destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto.
- rewrite <- H; ring.
+  intros (x1,x2) (y1,y2).
+  unfold Qeq, Qmult; simpl; intros.
+  destruct (Zmult_integral (x1*1)%Z (y1*1)%Z); auto.
+  rewrite <- H; ring.
 Qed.
 
 Theorem Qmult_integral_l : forall x y, ~ x == 0 -> x*y == 0 -> y == 0.
 Proof.
- intros (x1, x2) (y1, y2).
- unfold Qeq, Qmult; simpl; intros.
- apply Zmult_integral_l with x1; auto with zarith.
- rewrite <- H0; ring.
+  intros (x1, x2) (y1, y2).
+  unfold Qeq, Qmult; simpl; intros.
+  apply Zmult_integral_l with x1; auto with zarith.
+  rewrite <- H0; ring.
 Qed.
 
-(** Inverse and division. *) 
+(** * Inverse and division. *) 
 
 Theorem Qmult_inv_r : forall x, ~ x == 0 -> x*(/x) == 1.
 Proof.
- intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl;
-  intros; simpl_mult; try ring.
- elim H; auto. 
+  intros (x1, x2); unfold Qeq, Qdiv, Qmult; case x1; simpl;
+    intros; simpl_mult; try ring.
+  elim H; auto. 
 Qed.
 
 Lemma Qinv_mult_distr : forall p q, / (p * q) == /p * /q.
 Proof.
-intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl.
-destruct x1; simpl; auto; 
- destruct y1; simpl; auto.
+  intros (x1,x2) (y1,y2); unfold Qeq, Qinv, Qmult; simpl.
+  destruct x1; simpl; auto; 
+    destruct y1; simpl; auto.
 Qed.
 
 Theorem Qdiv_mult_l : forall x y, ~ y == 0 -> (x*y)/y == x.
 Proof.
- intros; unfold Qdiv.
- rewrite <- (Qmult_assoc x y (Qinv y)).
- rewrite (Qmult_inv_r y H).
- apply Qmult_1_r.
+  intros; unfold Qdiv.
+  rewrite <- (Qmult_assoc x y (Qinv y)).
+  rewrite (Qmult_inv_r y H).
+  apply Qmult_1_r.
 Qed.
 
 Theorem Qmult_div_r : forall x y, ~ y == 0 -> y*(x/y) == x.
 Proof.
- intros; unfold Qdiv.
- rewrite (Qmult_assoc y x (Qinv y)).
- rewrite (Qmult_comm y x).
- fold (Qdiv (Qmult x y) y).
- apply Qdiv_mult_l; auto.
+  intros; unfold Qdiv.
+  rewrite (Qmult_assoc y x (Qinv y)).
+  rewrite (Qmult_comm y x).
+  fold (Qdiv (Qmult x y) y).
+  apply Qdiv_mult_l; auto.
 Qed.
 
-(** Properties of order upon Q. *)
+(** * Properties of order upon Q. *)
 
 Lemma Qle_refl : forall x, x<=x.
 Proof.
-unfold Qle; auto with zarith.
+  unfold Qle; auto with zarith.
 Qed.
 
 Lemma Qle_antisym : forall x y, x<=y -> y<=x -> x==y.
 Proof.
-unfold Qle, Qeq; auto with zarith.
+  unfold Qle, Qeq; auto with zarith.
 Qed.
 
 Lemma Qle_trans : forall x y z, x<=y -> y<=z -> x<=z.
 Proof.
-unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
-Open Scope Z_scope.
-apply Zmult_le_reg_r with ('y2).
-red; trivial.
-apply Zle_trans with (y1 * 'x2 * 'z2).
-replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-apply Zmult_le_compat_r; auto with zarith. 
-replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-apply Zmult_le_compat_r; auto with zarith. 
-Open Scope Q_scope.
+  unfold Qle; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
+  Open Scope Z_scope.
+  apply Zmult_le_reg_r with ('y2).
+  red; trivial.
+  apply Zle_trans with (y1 * 'x2 * 'z2).
+  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
+  apply Zmult_le_compat_r; auto with zarith. 
+  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
+  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
+  apply Zmult_le_compat_r; auto with zarith. 
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qlt_not_eq : forall x y, x<y -> ~ x==y.
 Proof.
-unfold Qlt, Qeq; auto with zarith.
+  unfold Qlt, Qeq; auto with zarith.
 Qed.
 
 (** Large = strict or equal *)
 
 Lemma Qlt_le_weak : forall x y, x<y -> x<=y.
 Proof.
-unfold Qle, Qlt; auto with zarith.
+  unfold Qle, Qlt; auto with zarith.
 Qed.
 
 Lemma Qle_lt_trans : forall x y z, x<=y -> y<z -> x<z.
 Proof.
-unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
-Open Scope Z_scope.
-apply Zgt_lt.
-apply Zmult_gt_reg_r with ('y2).
-red; trivial.
-apply Zgt_le_trans with (y1 * 'x2 * 'z2).
-replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-apply Zmult_gt_compat_r; auto with zarith. 
-replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-apply Zmult_le_compat_r; auto with zarith. 
-Open Scope Q_scope.
+  unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
+  Open Scope Z_scope.
+  apply Zgt_lt.
+  apply Zmult_gt_reg_r with ('y2).
+  red; trivial.
+  apply Zgt_le_trans with (y1 * 'x2 * 'z2).
+  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
+  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
+  apply Zmult_gt_compat_r; auto with zarith. 
+  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
+  apply Zmult_le_compat_r; auto with zarith. 
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qlt_le_trans : forall x y z, x<y -> y<=z -> x<z.
 Proof.
-unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
-Open Scope Z_scope.
-apply Zgt_lt.
-apply Zmult_gt_reg_r with ('y2).
-red; trivial.
-apply Zle_gt_trans with (y1 * 'x2 * 'z2).
-replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
-replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
-apply Zmult_le_compat_r; auto with zarith. 
-replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
-apply Zmult_gt_compat_r; auto with zarith. 
-Open Scope Q_scope.
+  unfold Qle, Qlt; intros (x1, x2) (y1, y2) (z1, z2); simpl; intros.
+  Open Scope Z_scope.
+  apply Zgt_lt.
+  apply Zmult_gt_reg_r with ('y2).
+  red; trivial.
+  apply Zle_gt_trans with (y1 * 'x2 * 'z2).
+  replace (y1 * 'x2 * 'z2) with (y1 * 'z2 * 'x2) by ring.
+  replace (z1 * 'x2 * 'y2) with (z1 * 'y2 * 'x2) by ring.
+  apply Zmult_le_compat_r; auto with zarith. 
+  replace (x1 * 'z2 * 'y2) with (x1 * 'y2 * 'z2) by ring.
+  apply Zmult_gt_compat_r; auto with zarith. 
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qlt_trans : forall x y z, x<y -> y<z -> x<z.
 Proof.
-intros.
-apply Qle_lt_trans with y; auto.
-apply Qlt_le_weak; auto.
+  intros.
+  apply Qle_lt_trans with y; auto.
+  apply Qlt_le_weak; auto.
 Qed.
 
 (** [x<y] iff [~(y<=x)] *)
 
 Lemma Qnot_lt_le : forall x y, ~ x<y -> y<=x.
 Proof.
-unfold Qle, Qlt; auto with zarith.
+  unfold Qle, Qlt; auto with zarith.
 Qed.
 
 Lemma Qnot_le_lt : forall x y, ~ x<=y -> y<x.
 Proof.
-unfold Qle, Qlt; auto with zarith.
+  unfold Qle, Qlt; auto with zarith.
 Qed.
 
 Lemma Qlt_not_le : forall x y, x<y -> ~ y<=x.
 Proof.
-unfold Qle, Qlt; auto with zarith.
+  unfold Qle, Qlt; auto with zarith.
 Qed.
 
 Lemma Qle_not_lt : forall x y, x<=y -> ~ y<x.
 Proof.
-unfold Qle, Qlt; auto with zarith.
+  unfold Qle, Qlt; auto with zarith.
 Qed.
 
 Lemma Qle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y.
 Proof.
-unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto.
+  unfold Qle, Qlt, Qeq; intros; apply Zle_lt_or_eq; auto.
 Qed.
 
 (** Some decidability results about orders. *)
 
 Lemma Q_dec : forall x y, {x<y} + {y<x} + {x==y}.
 Proof.
-unfold Qlt, Qle, Qeq; intros.
-exact (Z_dec' (Qnum x * QDen y) (Qnum y * QDen x)).
+  unfold Qlt, Qle, Qeq; intros.
+  exact (Z_dec' (Qnum x * QDen y) (Qnum y * QDen x)).
 Defined.
 
 Lemma Qlt_le_dec : forall x y, {x<y} + {y<=x}.
 Proof.
-unfold Qlt, Qle; intros.
-exact (Z_lt_le_dec (Qnum x * QDen y) (Qnum y * QDen x)).
+  unfold Qlt, Qle; intros.
+  exact (Z_lt_le_dec (Qnum x * QDen y) (Qnum y * QDen x)).
 Defined.
 
 (** Compatibility of operations with respect to order. *)
 
 Lemma Qopp_le_compat : forall p q, p<=q -> -q <= -p.
 Proof.
-intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl.
-do 2 rewrite <- Zopp_mult_distr_l; omega.
+  intros (a1,a2) (b1,b2); unfold Qle, Qlt; simpl.
+  do 2 rewrite <- Zopp_mult_distr_l; omega.
 Qed.
 
 Lemma Qle_minus_iff : forall p q, p <= q <-> 0 <= q+-p.
 Proof.
-intros (x1,x2) (y1,y2); unfold Qle; simpl.
-rewrite <- Zopp_mult_distr_l.
-split; omega.
+  intros (x1,x2) (y1,y2); unfold Qle; simpl.
+  rewrite <- Zopp_mult_distr_l.
+  split; omega.
 Qed.
 
 Lemma Qlt_minus_iff : forall p q, p < q <-> 0 < q+-p.
 Proof.
-intros (x1,x2) (y1,y2); unfold Qlt; simpl.
-rewrite <- Zopp_mult_distr_l.
-split; omega.
+  intros (x1,x2) (y1,y2); unfold Qlt; simpl.
+  rewrite <- Zopp_mult_distr_l.
+  split; omega.
 Qed.
 
 Lemma Qplus_le_compat :
- forall x y z t, x<=y -> z<=t -> x+z <= y+t.
-Proof.
-unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2);
- simpl; simpl_mult.
-Open Scope Z_scope.
-intros.
-match goal with |- ?a <= ?b => ring a; ring b end.
-apply Zplus_le_compat.
-replace ('t2 * ('y2 * (z1 * 'x2))) with (z1 * 't2 * ('y2 * 'x2)) by ring.
-replace ('z2 * ('x2 * (t1 * 'y2))) with (t1 * 'z2 * ('y2 * 'x2)) by ring.
-apply Zmult_le_compat_r; auto with zarith.
-replace ('t2 * ('y2 * ('z2 * x1))) with (x1 * 'y2 * ('z2 * 't2)) by ring.
-replace ('z2 * ('x2 * ('t2 * y1))) with (y1 * 'x2 * ('z2 * 't2)) by ring.
-apply Zmult_le_compat_r; auto with zarith.
-Open Scope Q_scope.
+  forall x y z t, x<=y -> z<=t -> x+z <= y+t.
+Proof.
+  unfold Qplus, Qle; intros (x1, x2) (y1, y2) (z1, z2) (t1, t2);
+    simpl; simpl_mult.
+  Open Scope Z_scope.
+  intros.
+  match goal with |- ?a <= ?b => ring_simplify a b end.
+  rewrite Zplus_comm.
+  apply Zplus_le_compat.
+  match goal with |- ?a <= ?b => ring_simplify z1 t1 ('z2) ('t2) a b end.
+  auto with zarith.
+  match goal with |- ?a <= ?b => ring_simplify x1 y1 ('x2) ('y2) a b end.
+  auto with zarith.
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z.
 Proof.
-intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
-Open Scope Z_scope.
-intros; simpl_mult.
-replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-apply Zmult_le_compat_r; auto with zarith.
-Open Scope Q_scope.
+  intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
+  Open Scope Z_scope.
+  intros; simpl_mult.
+  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
+  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
+  apply Zmult_le_compat_r; auto with zarith.
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qmult_lt_0_le_reg_r : forall x y z, 0 <  z  -> x*z <= y*z -> x <= y.
 Proof.
-intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
-Open Scope Z_scope.
-simpl_mult.
-replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith.
-Open Scope Q_scope.
+  intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
+  Open Scope Z_scope.
+  simpl_mult.
+  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
+  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
+  intros; apply Zmult_le_reg_r with (c1*'c2); auto with zarith.
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qmult_lt_compat_r : forall x y z, 0 < z  -> x < y -> x*z < y*z.
 Proof.
-intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
-Open Scope Z_scope.
-intros; simpl_mult.
-replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
-replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
-apply Zmult_lt_compat_r; auto with zarith.
-apply Zmult_lt_0_compat.
-omega.
-compute; auto.
-Open Scope Q_scope.
+  intros (a1,a2) (b1,b2) (c1,c2); unfold Qle, Qlt; simpl.
+  Open Scope Z_scope.
+  intros; simpl_mult.
+  replace (a1*c1*('b2*'c2)) with ((a1*'b2)*(c1*'c2)) by ring.
+  replace (b1*c1*('a2*'c2)) with ((b1*'a2)*(c1*'c2)) by ring.
+  apply Zmult_lt_compat_r; auto with zarith.
+  apply Zmult_lt_0_compat.
+  omega.
+  compute; auto.
+  Close Scope Z_scope.
 Qed.
 
-(** Rational to the n-th power *)
+(** * Rational to the n-th power *)
 
 Fixpoint Qpower (q:Q)(n:nat) { struct n } : Q := 
- match n with 
-  | O => 1
-  | S n => q * (Qpower q n)
- end. 
+  match n with 
+    | O => 1
+    | S n => q * (Qpower q n)
+  end. 
 
 Notation " q ^ n " := (Qpower q n) : Q_scope.
 
 Lemma Qpower_1 : forall n, 1^n == 1.
 Proof.
-induction n; simpl; auto with qarith.
-rewrite IHn; auto with qarith.
+  induction n; simpl; auto with qarith.
+  rewrite IHn; auto with qarith.
 Qed.
 
 Lemma Qpower_0 : forall n, n<>O -> 0^n == 0.
 Proof.
-destruct n; simpl.
-destruct 1; auto.
-intros. 
-compute; auto.
+  destruct n; simpl.
+  destruct 1; auto.
+  intros. 
+  compute; auto.
 Qed.
 
 Lemma Qpower_pos : forall p n, 0 <= p -> 0 <= p^n.
 Proof.
-induction n; simpl; auto with qarith.
-intros; compute; intro; discriminate.
-intros.
-apply Qle_trans with (0*(p^n)).
-compute; intro; discriminate.
-apply Qmult_le_compat_r; auto.
+  induction n; simpl; auto with qarith.
+  intros; compute; intro; discriminate.
+  intros.
+  apply Qle_trans with (0*(p^n)).
+  compute; intro; discriminate.
+  apply Qmult_le_compat_r; auto.
 Qed.
 
 Lemma Qinv_power_n : forall n p, (1#p)^n == /(inject_Z ('p))^n.
 Proof.
-induction n.
-compute; auto.
-simpl.
-intros; rewrite IHn; clear IHn.
-unfold Qdiv; rewrite Qinv_mult_distr.
-setoid_replace (1#p) with (/ inject_Z ('p)).
-apply Qeq_refl.
-compute; auto.
+  induction n.
+  compute; auto.
+  simpl.
+  intros; rewrite IHn; clear IHn.
+  unfold Qdiv; rewrite Qinv_mult_distr.
+  setoid_replace (1#p) with (/ inject_Z ('p)).
+  apply Qeq_refl.
+  compute; auto.
 Qed.
 
 
diff --git a/theories/QArith/Qcanon.v b/theories/QArith/Qcanon.v
index 9cbd400d..98c5ff9e 100644
--- a/theories/QArith/Qcanon.v
+++ b/theories/QArith/Qcanon.v
@@ -6,9 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qcanon.v 8989 2006-06-25 22:17:49Z letouzey $ i*)
+(*i $Id: Qcanon.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
+Require Import Field.
 Require Import QArith.
+Require Import Znumtheory.
 Require Import Eqdep_dec.
 
 (** [Qc] : A canonical representation of rational numbers. 
@@ -22,50 +24,50 @@ Arguments Scope Qcmake [Q_scope].
 Open Scope Qc_scope.
 
 Lemma Qred_identity : 
- forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q.
+  forall q:Q, Zgcd (Qnum q) (QDen q) = 1%Z -> Qred q = q.
 Proof.
-unfold Qred; intros (a,b); simpl.
-generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)).
-intros.
-rewrite H1 in H; clear H1.
-destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
-destruct H0.
-rewrite Zmult_1_l in H, H0.
-subst; simpl; auto.
+  unfold Qred; intros (a,b); simpl.
+  generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)).
+  intros.
+  rewrite H1 in H; clear H1.
+  destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
+  destruct H0.
+  rewrite Zmult_1_l in H, H0.
+  subst; simpl; auto.
 Qed.
 
 Lemma Qred_identity2 : 
- forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z.
-Proof.
-unfold Qred; intros (a,b); simpl.
-generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)) (Zgcd_is_pos a ('b)).
-intros.
-rewrite <- H; rewrite <- H in H1; clear H.
-destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
-injection H2; intros; clear H2.
-destruct H0.
-clear H0 H3.
-destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate.
-f_equal.
-apply Pmult_reg_r with bb.
-injection H2; intros. 
-rewrite <- H0.
-rewrite H; simpl; auto.
-elim H1; auto.
+  forall q:Q, Qred q = q -> Zgcd (Qnum q) (QDen q) = 1%Z.
+Proof.
+  unfold Qred; intros (a,b); simpl.
+  generalize (Zggcd_gcd a ('b)) (Zggcd_correct_divisors a ('b)) (Zgcd_is_pos a ('b)).
+  intros.
+  rewrite <- H; rewrite <- H in H1; clear H.
+  destruct (Zggcd a ('b)) as (g,(aa,bb)); simpl in *; subst.
+  injection H2; intros; clear H2.
+  destruct H0.
+  clear H0 H3.
+  destruct g as [|g|g]; destruct bb as [|bb|bb]; simpl in *; try discriminate.
+  f_equal.
+  apply Pmult_reg_r with bb.
+  injection H2; intros. 
+  rewrite <- H0.
+  rewrite H; simpl; auto.
+  elim H1; auto.
 Qed.
 
 Lemma Qred_iff : forall q:Q, Qred q = q <-> Zgcd (Qnum q) (QDen q) = 1%Z.
 Proof.
-split; intros.
-apply Qred_identity2; auto.
-apply Qred_identity; auto.
+  split; intros.
+  apply Qred_identity2; auto.
+  apply Qred_identity; auto.
 Qed.
 
 
 Lemma Qred_involutive : forall q:Q, Qred (Qred q) = Qred q.
 Proof.
-intros; apply Qred_complete.
-apply Qred_correct.
+  intros; apply Qred_complete.
+  apply Qred_correct.
 Qed.
 
 Definition Q2Qc (q:Q) : Qc := Qcmake (Qred q) (Qred_involutive q). 
@@ -74,16 +76,16 @@ Notation " !! " := Q2Qc : Qc_scope.
 
 Lemma Qc_is_canon : forall q q' : Qc, q == q' -> q = q'.
 Proof.
-intros (q,proof_q) (q',proof_q').
-simpl.
-intros H.
-assert (H0:=Qred_complete _ _ H).
-assert (q = q') by congruence.
-subst q'.
-assert (proof_q = proof_q'). 
- apply eq_proofs_unicity; auto; intros.
- repeat decide equality.
-congruence.
+  intros (q,proof_q) (q',proof_q').
+  simpl.
+  intros H.
+  assert (H0:=Qred_complete _ _ H).
+  assert (q = q') by congruence.
+  subst q'.
+  assert (proof_q = proof_q'). 
+  apply eq_proofs_unicity; auto; intros.
+  repeat decide equality.
+  congruence.
 Qed.
 Hint Resolve Qc_is_canon.
 
@@ -105,39 +107,39 @@ Notation "p ?= q" := (Qccompare p q) : Qc_scope.
 
 Lemma Qceq_alt : forall p q, (p = q) <-> (p ?= q) = Eq.
 Proof.
-unfold Qccompare.
-intros; rewrite <- Qeq_alt.
-split; auto.
-intro H; rewrite H; auto with qarith.
+  unfold Qccompare.
+  intros; rewrite <- Qeq_alt.
+  split; auto.
+  intro H; rewrite H; auto with qarith.
 Qed.
 
 Lemma Qclt_alt : forall p q, (p<q) <-> (p?=q = Lt).
 Proof.
-intros; exact (Qlt_alt p q).
+  intros; exact (Qlt_alt p q).
 Qed.
 
 Lemma Qcgt_alt : forall p q, (p>q) <-> (p?=q = Gt).
 Proof.
-intros; exact (Qgt_alt p q).
+  intros; exact (Qgt_alt p q).
 Qed.
 
 Lemma Qle_alt : forall p q, (p<=q) <-> (p?=q <> Gt).
 Proof.
-intros; exact (Qle_alt p q).
+  intros; exact (Qle_alt p q).
 Qed.
 
 Lemma Qge_alt : forall p q, (p>=q) <-> (p?=q <> Lt).
 Proof.
-intros; exact (Qge_alt p q).
+  intros; exact (Qge_alt p q).
 Qed.
 
 (** equality on [Qc] is decidable: *)
 
 Theorem Qc_eq_dec : forall x y:Qc, {x=y} + {x<>y}.
 Proof.
- intros.
- destruct (Qeq_dec x y) as [H|H]; auto.
- right; swap H; subst; auto with qarith.
+  intros.
+  destruct (Qeq_dec x y) as [H|H]; auto.
+  right; swap H; subst; auto with qarith.
 Defined. 
 
 (** The addition, multiplication and opposite are defined 
@@ -160,8 +162,8 @@ Infix "/" := Qcdiv : Qc_scope.
 
 Lemma Q_apart_0_1 : 1 <> 0.
 Proof.
- unfold Q2Qc.
- intros H; discriminate H.
+  unfold Q2Qc.
+  intros H; discriminate H.
 Qed.
 
 Ltac qc := match goal with 
@@ -175,309 +177,309 @@ Opaque Qred.
 
 Theorem Qcplus_assoc : forall x y z, x+(y+z)=(x+y)+z.
 Proof.
- intros; qc; apply Qplus_assoc.
+  intros; qc; apply Qplus_assoc.
 Qed.
 
 (** [0] is a neutral element for addition: *)
 
 Lemma Qcplus_0_l : forall x, 0+x = x.
 Proof.
- intros; qc; apply Qplus_0_l.
+  intros; qc; apply Qplus_0_l.
 Qed.
 
 Lemma Qcplus_0_r : forall x, x+0 = x.
 Proof.
- intros; qc; apply Qplus_0_r.
+  intros; qc; apply Qplus_0_r.
 Qed. 
 
 (** Commutativity of addition: *)
 
 Theorem Qcplus_comm : forall x y, x+y = y+x.
 Proof.
- intros; qc; apply Qplus_comm.
+  intros; qc; apply Qplus_comm.
 Qed.
 
 (** Properties of [Qopp] *)
 
 Lemma Qcopp_involutive : forall q, - -q = q.
 Proof.
- intros; qc; apply Qopp_involutive.
+  intros; qc; apply Qopp_involutive.
 Qed.
 
 Theorem Qcplus_opp_r : forall q, q+(-q) = 0.
 Proof.
- intros; qc; apply Qplus_opp_r.
+  intros; qc; apply Qplus_opp_r.
 Qed.
 
 (** Multiplication is associative: *)
 
 Theorem Qcmult_assoc : forall n m p, n*(m*p)=(n*m)*p.
 Proof.
- intros; qc; apply Qmult_assoc.
+  intros; qc; apply Qmult_assoc.
 Qed.
 
 (** [1] is a neutral element for multiplication: *)
 
 Lemma Qcmult_1_l : forall n, 1*n = n.
 Proof.
- intros; qc; apply Qmult_1_l.
+  intros; qc; apply Qmult_1_l.
 Qed.
 
 Theorem Qcmult_1_r : forall n, n*1=n.
 Proof.
- intros; qc; apply Qmult_1_r.
+  intros; qc; apply Qmult_1_r.
 Qed.
 
 (** Commutativity of multiplication *)
 
 Theorem Qcmult_comm : forall x y, x*y=y*x.
 Proof.
- intros; qc; apply Qmult_comm.
+  intros; qc; apply Qmult_comm.
 Qed.
 
 (** Distributivity *)
 
 Theorem Qcmult_plus_distr_r : forall x y z, x*(y+z)=(x*y)+(x*z).
 Proof.
- intros; qc; apply Qmult_plus_distr_r.
+  intros; qc; apply Qmult_plus_distr_r.
 Qed.
 
 Theorem Qcmult_plus_distr_l : forall x y z, (x+y)*z=(x*z)+(y*z).
 Proof.
- intros; qc; apply Qmult_plus_distr_l.
+  intros; qc; apply Qmult_plus_distr_l.
 Qed.
 
 (** Integrality *)
 
 Theorem Qcmult_integral : forall x y, x*y=0 -> x=0 \/ y=0.
 Proof.
- intros.
- destruct (Qmult_integral x y); try qc; auto.
- injection H; clear H; intros.
- rewrite <- (Qred_correct (x*y)).
- rewrite <- (Qred_correct 0).
- rewrite H; auto with qarith.
+  intros.
+  destruct (Qmult_integral x y); try qc; auto.
+  injection H; clear H; intros.
+  rewrite <- (Qred_correct (x*y)).
+  rewrite <- (Qred_correct 0).
+  rewrite H; auto with qarith.
 Qed.
 
 Theorem Qcmult_integral_l : forall x y, ~ x = 0 -> x*y = 0 -> y = 0.
 Proof.
- intros; destruct (Qcmult_integral _ _ H0); tauto.
+  intros; destruct (Qcmult_integral _ _ H0); tauto.
 Qed. 
 
 (** Inverse and division. *) 
 
 Theorem Qcmult_inv_r : forall x, x<>0 -> x*(/x) = 1.
 Proof.
- intros; qc; apply Qmult_inv_r; auto. 
+  intros; qc; apply Qmult_inv_r; auto. 
 Qed.
 
 Theorem Qcmult_inv_l : forall x, x<>0 -> (/x)*x = 1.
 Proof.
- intros.
- rewrite Qcmult_comm.
- apply Qcmult_inv_r; auto.
+  intros.
+  rewrite Qcmult_comm.
+  apply Qcmult_inv_r; auto.
 Qed.
 
 Lemma Qcinv_mult_distr : forall p q, / (p * q) = /p * /q.
 Proof.
- intros; qc; apply Qinv_mult_distr.
+  intros; qc; apply Qinv_mult_distr.
 Qed.
 
 Theorem Qcdiv_mult_l : forall x y, y<>0 -> (x*y)/y = x.
 Proof.
- unfold Qcdiv.
- intros.
- rewrite <- Qcmult_assoc.
- rewrite Qcmult_inv_r; auto.
- apply Qcmult_1_r.
+  unfold Qcdiv.
+  intros.
+  rewrite <- Qcmult_assoc.
+  rewrite Qcmult_inv_r; auto.
+  apply Qcmult_1_r.
 Qed.
 
 Theorem Qcmult_div_r : forall x y, ~ y = 0 -> y*(x/y) = x.
 Proof.
- unfold Qcdiv.
- intros.
- rewrite Qcmult_assoc.
- rewrite Qcmult_comm.
- rewrite Qcmult_assoc.
- rewrite Qcmult_inv_l; auto.
- apply Qcmult_1_l.
+  unfold Qcdiv.
+  intros.
+  rewrite Qcmult_assoc.
+  rewrite Qcmult_comm.
+  rewrite Qcmult_assoc.
+  rewrite Qcmult_inv_l; auto.
+  apply Qcmult_1_l.
 Qed.
 
 (** Properties of order upon Q. *)
 
 Lemma Qcle_refl : forall x, x<=x.
 Proof.
-unfold Qcle; intros; simpl; apply Qle_refl.
+  unfold Qcle; intros; simpl; apply Qle_refl.
 Qed.
 
 Lemma Qcle_antisym : forall x y, x<=y -> y<=x -> x=y.
 Proof.
-unfold Qcle; intros; simpl in *.
-apply Qc_is_canon; apply Qle_antisym; auto.
+  unfold Qcle; intros; simpl in *.
+  apply Qc_is_canon; apply Qle_antisym; auto.
 Qed.
 
 Lemma Qcle_trans : forall x y z, x<=y -> y<=z -> x<=z.
 Proof.
-unfold Qcle; intros; eapply Qle_trans; eauto.
+  unfold Qcle; intros; eapply Qle_trans; eauto.
 Qed.
 
 Lemma Qclt_not_eq : forall x y, x<y -> x<>y.
 Proof.
-unfold Qclt; intros; simpl in *.
-intro; destruct (Qlt_not_eq _ _ H).
-subst; auto with qarith.
+  unfold Qclt; intros; simpl in *.
+  intro; destruct (Qlt_not_eq _ _ H).
+  subst; auto with qarith.
 Qed.
 
 (** Large = strict or equal *)
 
 Lemma Qclt_le_weak : forall x y, x<y -> x<=y.
 Proof.
-unfold Qcle, Qclt; intros; apply Qlt_le_weak; auto.
+  unfold Qcle, Qclt; intros; apply Qlt_le_weak; auto.
 Qed.
 
 Lemma Qcle_lt_trans : forall x y z, x<=y -> y<z -> x<z.
 Proof.
-unfold Qcle, Qclt; intros; eapply Qle_lt_trans; eauto.
+  unfold Qcle, Qclt; intros; eapply Qle_lt_trans; eauto.
 Qed.
 
 Lemma Qclt_le_trans : forall x y z, x<y -> y<=z -> x<z.
 Proof.
-unfold Qcle, Qclt; intros; eapply Qlt_le_trans; eauto.
+  unfold Qcle, Qclt; intros; eapply Qlt_le_trans; eauto.
 Qed.
 
 Lemma Qlt_trans : forall x y z, x<y -> y<z -> x<z.
 Proof.
-unfold Qclt; intros; eapply Qlt_trans; eauto.
+  unfold Qclt; intros; eapply Qlt_trans; eauto.
 Qed.
 
 (** [x<y] iff [~(y<=x)] *)
 
 Lemma Qcnot_lt_le : forall x y, ~ x<y -> y<=x.
 Proof.
-unfold Qcle, Qclt; intros; apply Qnot_lt_le; auto.
+  unfold Qcle, Qclt; intros; apply Qnot_lt_le; auto.
 Qed.
 
 Lemma Qcnot_le_lt : forall x y, ~ x<=y -> y<x.
 Proof.
-unfold Qcle, Qclt; intros; apply Qnot_le_lt; auto.
+  unfold Qcle, Qclt; intros; apply Qnot_le_lt; auto.
 Qed.
 
 Lemma Qclt_not_le : forall x y, x<y -> ~ y<=x.
 Proof.
-unfold Qcle, Qclt; intros; apply Qlt_not_le; auto.
+  unfold Qcle, Qclt; intros; apply Qlt_not_le; auto.
 Qed.
 
 Lemma Qcle_not_lt : forall x y, x<=y -> ~ y<x.
 Proof.
-unfold Qcle, Qclt; intros; apply Qle_not_lt; auto.
+  unfold Qcle, Qclt; intros; apply Qle_not_lt; auto.
 Qed.
 
 Lemma Qcle_lt_or_eq : forall x y, x<=y -> x<y \/ x==y.
 Proof.
-unfold Qcle, Qclt; intros; apply Qle_lt_or_eq; auto.
+  unfold Qcle, Qclt; intros; apply Qle_lt_or_eq; auto.
 Qed.
 
 (** Some decidability results about orders. *)
 
 Lemma Qc_dec : forall x y, {x<y} + {y<x} + {x=y}.
 Proof.
-unfold Qclt, Qcle; intros.
-destruct (Q_dec x y) as [H|H].
-left; auto.
-right; apply Qc_is_canon; auto.
+  unfold Qclt, Qcle; intros.
+  destruct (Q_dec x y) as [H|H].
+  left; auto.
+  right; apply Qc_is_canon; auto.
 Defined.
 
 Lemma Qclt_le_dec : forall x y, {x<y} + {y<=x}.
 Proof.
-unfold Qclt, Qcle; intros; apply Qlt_le_dec; auto.
+  unfold Qclt, Qcle; intros; apply Qlt_le_dec; auto.
 Defined.
 
 (** Compatibility of operations with respect to order. *)
 
 Lemma Qcopp_le_compat : forall p q, p<=q -> -q <= -p.
 Proof.
-unfold Qcle, Qcopp; intros; simpl in *.
-repeat rewrite Qred_correct.
-apply Qopp_le_compat; auto.
+  unfold Qcle, Qcopp; intros; simpl in *.
+  repeat rewrite Qred_correct.
+  apply Qopp_le_compat; auto.
 Qed.
 
 Lemma Qcle_minus_iff : forall p q, p <= q <-> 0 <= q+-p.
 Proof.
-unfold Qcle, Qcminus; intros; simpl in *.
-repeat rewrite Qred_correct.
-apply Qle_minus_iff; auto.
+  unfold Qcle, Qcminus; intros; simpl in *.
+  repeat rewrite Qred_correct.
+  apply Qle_minus_iff; auto.
 Qed.
 
 Lemma Qclt_minus_iff : forall p q, p < q <-> 0 < q+-p.
 Proof.
-unfold Qclt, Qcplus, Qcopp; intros; simpl in *.
-repeat rewrite Qred_correct.
-apply Qlt_minus_iff; auto.
+  unfold Qclt, Qcplus, Qcopp; intros; simpl in *.
+  repeat rewrite Qred_correct.
+  apply Qlt_minus_iff; auto.
 Qed.
 
 Lemma Qcplus_le_compat :
- forall x y z t, x<=y -> z<=t -> x+z <= y+t.
+  forall x y z t, x<=y -> z<=t -> x+z <= y+t.
 Proof.
-unfold Qcplus, Qcle; intros; simpl in *.
-repeat rewrite Qred_correct.
-apply Qplus_le_compat; auto.
+  unfold Qcplus, Qcle; intros; simpl in *.
+  repeat rewrite Qred_correct.
+  apply Qplus_le_compat; auto.
 Qed.
 
 Lemma Qcmult_le_compat_r : forall x y z, x <= y -> 0 <= z -> x*z <= y*z.
 Proof.
-unfold Qcmult, Qcle; intros; simpl in *.
-repeat rewrite Qred_correct.
-apply Qmult_le_compat_r; auto.
+  unfold Qcmult, Qcle; intros; simpl in *.
+  repeat rewrite Qred_correct.
+  apply Qmult_le_compat_r; auto.
 Qed.
 
 Lemma Qcmult_lt_0_le_reg_r : forall x y z, 0 <  z  -> x*z <= y*z -> x <= y.
 Proof.
-unfold Qcmult, Qcle, Qclt; intros; simpl in *.
-repeat progress rewrite Qred_correct in * |-. 
-eapply Qmult_lt_0_le_reg_r; eauto.
+  unfold Qcmult, Qcle, Qclt; intros; simpl in *.
+  repeat progress rewrite Qred_correct in * |-. 
+  eapply Qmult_lt_0_le_reg_r; eauto.
 Qed.
 
 Lemma Qcmult_lt_compat_r : forall x y z, 0 < z  -> x < y -> x*z < y*z.
 Proof.
-unfold Qcmult, Qclt; intros; simpl in *.
-repeat progress rewrite Qred_correct in *. 
-eapply Qmult_lt_compat_r; eauto.
+  unfold Qcmult, Qclt; intros; simpl in *.
+  repeat progress rewrite Qred_correct in *. 
+  eapply Qmult_lt_compat_r; eauto.
 Qed.
 
 (** Rational to the n-th power *)
 
 Fixpoint Qcpower (q:Qc)(n:nat) { struct n } : Qc := 
- match n with 
-  | O => 1
-  | S n => q * (Qcpower q n)
- end. 
+  match n with 
+    | O => 1
+    | S n => q * (Qcpower q n)
+  end. 
 
 Notation " q ^ n " := (Qcpower q n) : Qc_scope.
 
 Lemma Qcpower_1 : forall n, 1^n = 1.
 Proof.
-induction n; simpl; auto with qarith.
-rewrite IHn; auto with qarith.
+  induction n; simpl; auto with qarith.
+  rewrite IHn; auto with qarith.
 Qed.
 
 Lemma Qcpower_0 : forall n, n<>O -> 0^n = 0.
 Proof.
-destruct n; simpl.
-destruct 1; auto.
-intros. 
-apply Qc_is_canon.
-simpl.
-compute; auto.
+  destruct n; simpl.
+  destruct 1; auto.
+  intros. 
+  apply Qc_is_canon.
+  simpl.
+  compute; auto.
 Qed.
 
 Lemma Qpower_pos : forall p n, 0 <= p -> 0 <= p^n.
 Proof.
-induction n; simpl; auto with qarith.
-intros; compute; intro; discriminate.
-intros.
-apply Qcle_trans with (0*(p^n)).
-compute; intro; discriminate.
-apply Qcmult_le_compat_r; auto.
+  induction n; simpl; auto with qarith.
+  intros; compute; intro; discriminate.
+  intros.
+  apply Qcle_trans with (0*(p^n)).
+  compute; intro; discriminate.
+  apply Qcmult_le_compat_r; auto.
 Qed.
 
 (** And now everything is easier concerning tactics: *)
@@ -488,10 +490,12 @@ Definition Qc_eq_bool (x y : Qc) :=
   if Qc_eq_dec x y then true else false.
 
 Lemma Qc_eq_bool_correct : forall x y : Qc, Qc_eq_bool x y = true -> x=y.
-intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto.
-intros _ H; inversion H.
+Proof.
+  intros x y; unfold Qc_eq_bool in |- *; case (Qc_eq_dec x y); simpl in |- *; auto.
+  intros _ H; inversion H.
 Qed.
 
+(*
 Definition Qcrt : Ring_Theory Qcplus Qcmult 1 0 Qcopp Qc_eq_bool.
 Proof.
 constructor.
@@ -506,17 +510,37 @@ exact Qcmult_plus_distr_l.
 unfold Is_true; intros x y; generalize (Qc_eq_bool_correct x y);
  case (Qc_eq_bool x y); auto.
 Qed.
-
 Add Ring Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcrt [ Qcmake ].
+*)
+Definition Qcrt : ring_theory 0 1 Qcplus Qcmult Qcminus Qcopp (eq(A:=Qc)).
+Proof.
+  constructor.
+  exact Qcplus_0_l.
+  exact Qcplus_comm.
+  exact Qcplus_assoc.
+  exact Qcmult_1_l.
+  exact Qcmult_comm.
+  exact Qcmult_assoc.
+  exact Qcmult_plus_distr_l.
+  reflexivity.
+  exact Qcplus_opp_r.
+Qed.
 
-(** A field tactic for rational numbers *)
+Definition Qcft :
+  field_theory 0%Qc 1%Qc Qcplus Qcmult Qcminus Qcopp Qcdiv Qcinv (eq(A:=Qc)).
+Proof.
+  constructor.
+  exact Qcrt.
+  exact Q_apart_0_1.
+  reflexivity.
+  exact Qcmult_inv_l.
+Qed.
 
-Require Import Field.
+Add Field Qcfield : Qcft.
 
-Add Field Qc Qcplus Qcmult 1 0 Qcopp Qc_eq_bool Qcinv Qcrt Qcmult_inv_l
- with div:=Qcdiv.
+(** A field tactic for rational numbers *)
 
-Example test_field : forall x y : Qc, y<>0 -> (x/y)*y = x.
+Example test_field : (forall x y : Qc, y<>0 -> (x/y)*y = x)%Qc.
 intros.
 field.
 auto.
diff --git a/theories/QArith/Qreals.v b/theories/QArith/Qreals.v
index 5b7480c1..6bd161f3 100644
--- a/theories/QArith/Qreals.v
+++ b/theories/QArith/Qreals.v
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qreals.v 8883 2006-05-31 21:56:37Z letouzey $ i*)
+(*i $Id: Qreals.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Rbase.
 Require Export QArith_base.
 
-(** * A field tactic for rational numbers. *)
+(** A field tactic for rational numbers. *)
 
 (** Since field cannot operate on setoid datatypes (yet?), 
   we translate Q goals into reals before applying field. *)
@@ -52,8 +52,9 @@ assert ((X1 * Y2)%R = (Y1 * X2)%R).
  unfold X1, X2, Y1, Y2 in |- *; do 2 rewrite <- mult_IZR.
  apply IZR_eq; auto.
 clear H.
-field; auto.
-rewrite <- H0; field; auto.
+field_simplify_eq; auto.
+ring_simplify X1 Y2 (Y2 * X1)%R.
+rewrite H0 in |- *;  ring.
 Qed.
 
 Lemma Rle_Qle : forall x y : Q, (Q2R x <= Q2R y)%R -> x<=y.
@@ -176,16 +177,11 @@ unfold Qinv, Q2R, Qeq in |- *; intros (x1, x2); unfold Qden, Qnum in |- *.
 case x1.
 simpl in |- *; intros; elim H; trivial.
 intros; field; auto.
-apply Rmult_integral_contrapositive; split; auto.
-apply Rmult_integral_contrapositive; split; auto.
-apply Rinv_neq_0_compat; auto.
-intros; field; auto.
-do 2 rewrite <- mult_IZR.
-simpl in |- *; rewrite Pmult_comm; auto.
-apply Rmult_integral_contrapositive; split; auto.
-apply Rmult_integral_contrapositive; split; auto.
-apply not_O_IZR; auto with qarith.
-apply Rinv_neq_0_compat; auto.
+intros; 
+  change (IZR (Zneg x2)) with (- IZR (' x2))%R in |- *;
+  change (IZR (Zneg p)) with (- IZR (' p))%R in |- *;
+  field; (*auto 8 with real.*)
+  repeat split; auto; auto with real.
 Qed.
 
 Lemma Q2R_div :
@@ -210,4 +206,4 @@ Goal forall x y : Q, ~ y==0#1 -> (x/y)*y == x.
 intros; QField.
 intro; apply H; apply eqR_Qeq.
 rewrite H0; unfold Q2R in |- *; simpl in |- *; field; auto with real.
-Abort.
\ No newline at end of file
+Abort.
diff --git a/theories/QArith/Qreduction.v b/theories/QArith/Qreduction.v
index c503daad..340cac83 100644
--- a/theories/QArith/Qreduction.v
+++ b/theories/QArith/Qreduction.v
@@ -6,12 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qreduction.v 8989 2006-06-25 22:17:49Z letouzey $ i*)
+(*i $Id: Qreduction.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(** * Normalisation functions for rational numbers. *)
+(** Normalisation functions for rational numbers. *)
 
 Require Export QArith_base.
-Require Export Znumtheory.
+Require Import Znumtheory.
 
 (** First, a function that (tries to) build a positive back from a Z. *)
 
@@ -42,104 +42,105 @@ Definition Qred (q:Q) :=
 
 Lemma Qred_correct : forall q, (Qred q) == q.
 Proof.
-unfold Qred, Qeq; intros (n,d); simpl.
-generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) 
-  (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)).
-destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl.
-Open Scope Z_scope.
-intuition.
-rewrite <- H in H0,H1; clear H.
-rewrite H3; rewrite H4.
-assert (0 <> g).
+  unfold Qred, Qeq; intros (n,d); simpl.
+  generalize (Zggcd_gcd n ('d)) (Zgcd_is_pos n ('d)) 
+    (Zgcd_is_gcd n ('d)) (Zggcd_correct_divisors n ('d)).
+  destruct (Zggcd n (Zpos d)) as (g,(nn,dd)); simpl.
+  Open Scope Z_scope.
+  intuition.
+  rewrite <- H in H0,H1; clear H.
+  rewrite H3; rewrite H4.
+  assert (0 <> g).
   intro; subst g; discriminate.
-
-assert (0 < dd).
+  
+  assert (0 < dd).
   apply Zmult_gt_0_lt_0_reg_r with g.
   omega.
   rewrite Zmult_comm.
   rewrite <- H4; compute; auto.
-rewrite Z2P_correct; auto.
-ring.
+  rewrite Z2P_correct; auto.
+  ring.
+  Close Scope Z_scope.
 Qed.
 
 Lemma Qred_complete : forall p q,  p==q -> Qred p = Qred q.
 Proof.
-intros (a,b) (c,d).
-unfold Qred, Qeq in *; simpl in *.
-Open Scope Z_scope.
-generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) 
- (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)).
-destruct (Zggcd a (Zpos b)) as (g,(aa,bb)).
-generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) 
- (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)).
-destruct (Zggcd c (Zpos d)) as (g',(cc,dd)).
-simpl.
-intro H; rewrite <- H; clear H.
-intros Hg'1 Hg'2 (Hg'3,Hg'4).
-intro H; rewrite <- H; clear H.
-intros Hg1 Hg2 (Hg3,Hg4).
-intros.
-assert (g <> 0).
+  intros (a,b) (c,d).
+  unfold Qred, Qeq in *; simpl in *.
+  Open Scope Z_scope.
+  generalize (Zggcd_gcd a ('b)) (Zgcd_is_gcd a ('b)) 
+    (Zgcd_is_pos a ('b)) (Zggcd_correct_divisors a ('b)).
+  destruct (Zggcd a (Zpos b)) as (g,(aa,bb)).
+  generalize (Zggcd_gcd c ('d)) (Zgcd_is_gcd c ('d)) 
+    (Zgcd_is_pos c ('d)) (Zggcd_correct_divisors c ('d)).
+  destruct (Zggcd c (Zpos d)) as (g',(cc,dd)).
+  simpl.
+  intro H; rewrite <- H; clear H.
+  intros Hg'1 Hg'2 (Hg'3,Hg'4).
+  intro H; rewrite <- H; clear H.
+  intros Hg1 Hg2 (Hg3,Hg4).
+  intros.
+  assert (g <> 0).
   intro; subst g; discriminate.
-assert (g' <> 0).
+  assert (g' <> 0).
   intro; subst g'; discriminate.
-elim (rel_prime_cross_prod aa bb cc dd).
-congruence.
-unfold rel_prime in |- *.
-(*rel_prime*)
-constructor.
-exists aa; auto with zarith.
-exists bb; auto with zarith.
-intros.
-inversion Hg1.
-destruct (H6 (g*x)).
-rewrite Hg3.
-destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring.
-rewrite Hg4.
-destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring.
-exists q.
-apply Zmult_reg_l with g; auto.
-pattern g at 1; rewrite H7; ring.
-(* /rel_prime *)
-unfold rel_prime in |- *.
-(* rel_prime *)
-constructor.
-exists cc; auto with zarith.
-exists dd; auto with zarith.
-intros.
-inversion Hg'1.
-destruct (H6 (g'*x)).
-rewrite Hg'3.
-destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring.
-rewrite Hg'4.
-destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring.
-exists q.
-apply Zmult_reg_l with g'; auto.
-pattern g' at 1; rewrite H7; ring.
-(* /rel_prime *)
-assert (0<bb); [|auto with zarith].
+  elim (rel_prime_cross_prod aa bb cc dd).
+  congruence.
+  unfold rel_prime in |- *.
+  (*rel_prime*)
+  constructor.
+  exists aa; auto with zarith.
+  exists bb; auto with zarith.
+  intros.
+  inversion Hg1.
+  destruct (H6 (g*x)).
+  rewrite Hg3.
+  destruct H2 as (xa,Hxa); exists xa; rewrite Hxa; ring.
+  rewrite Hg4.
+  destruct H3 as (xb,Hxb); exists xb; rewrite Hxb; ring.
+  exists q.
+  apply Zmult_reg_l with g; auto.
+  pattern g at 1; rewrite H7; ring.
+  (* /rel_prime *)
+  unfold rel_prime in |- *.
+  (* rel_prime *)
+  constructor.
+  exists cc; auto with zarith.
+  exists dd; auto with zarith.
+  intros.
+  inversion Hg'1.
+  destruct (H6 (g'*x)).
+  rewrite Hg'3.
+  destruct H2 as (xc,Hxc); exists xc; rewrite Hxc; ring.
+  rewrite Hg'4.
+  destruct H3 as (xd,Hxd); exists xd; rewrite Hxd; ring.
+  exists q.
+  apply Zmult_reg_l with g'; auto.
+  pattern g' at 1; rewrite H7; ring.
+    (* /rel_prime *)
+  assert (0<bb); [|auto with zarith].
   apply Zmult_gt_0_lt_0_reg_r with g.
   omega.
   rewrite Zmult_comm.
   rewrite <- Hg4; compute; auto.
-assert (0<dd); [|auto with zarith].
+  assert (0<dd); [|auto with zarith].
   apply Zmult_gt_0_lt_0_reg_r with g'.
   omega.
   rewrite Zmult_comm.
   rewrite <- Hg'4; compute; auto.
-apply Zmult_reg_l with (g'*g).
-intro H2; elim (Zmult_integral _ _ H2); auto.
-replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring].
-replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring].
-rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto.
-Open Scope Q_scope.
+  apply Zmult_reg_l with (g'*g).
+  intro H2; elim (Zmult_integral _ _ H2); auto.
+  replace (g'*g*(aa*dd)) with ((g*aa)*(g'*dd)); [|ring].
+  replace (g'*g*(bb*cc)) with ((g'*cc)*(g*bb)); [|ring].
+  rewrite <- Hg3; rewrite <- Hg4; rewrite <- Hg'3; rewrite <- Hg'4; auto.
+  Close Scope Z_scope.
 Qed.
 
 Add Morphism Qred : Qred_comp. 
 Proof.
-intros q q' H.
-rewrite (Qred_correct q); auto.
-rewrite (Qred_correct q'); auto.
+  intros q q' H.
+  rewrite (Qred_correct q); auto.
+  rewrite (Qred_correct q'); auto.
 Qed.
 
 Definition Qplus' (p q : Q) := Qred (Qplus p q).
@@ -147,22 +148,22 @@ Definition Qmult' (p q : Q) := Qred (Qmult p q).
 
 Lemma Qplus'_correct : forall p q : Q, (Qplus' p q)==(Qplus p q).
 Proof.
-intros; unfold Qplus' in |- *; apply Qred_correct; auto.
+  intros; unfold Qplus' in |- *; apply Qred_correct; auto.
 Qed.
 
 Lemma Qmult'_correct : forall p q : Q, (Qmult' p q)==(Qmult p q).
 Proof.
-intros; unfold Qmult' in |- *; apply Qred_correct; auto.
+  intros; unfold Qmult' in |- *; apply Qred_correct; auto.
 Qed.
 
 Add Morphism Qplus' : Qplus'_comp.
 Proof.
-intros; unfold Qplus' in |- *.
-rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qplus' in |- *.
+  rewrite H; rewrite H0; auto with qarith.
 Qed.
 
 Add Morphism Qmult' : Qmult'_comp.
-intros; unfold Qmult' in |- *.
-rewrite H; rewrite H0; auto with qarith.
+  intros; unfold Qmult' in |- *.
+  rewrite H; rewrite H0; auto with qarith.
 Qed.
 
diff --git a/theories/QArith/Qring.v b/theories/QArith/Qring.v
index 774b20f4..9d294805 100644
--- a/theories/QArith/Qring.v
+++ b/theories/QArith/Qring.v
@@ -6,10 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Qring.v 8883 2006-05-31 21:56:37Z letouzey $ i*)
+(*i $Id: Qring.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-Require Import Ring.
-Require Export Setoid_ring.
+Require Export Ring.
 Require Export QArith_base.
 
 (** * A ring tactic for rational numbers *)
@@ -18,74 +17,88 @@ Definition Qeq_bool (x y : Q) :=
   if Qeq_dec x y then true else false.
 
 Lemma Qeq_bool_correct : forall x y : Q, Qeq_bool x y = true -> x==y.
-intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto.
-intros _ H; inversion H.
+Proof.
+  intros x y; unfold Qeq_bool in |- *; case (Qeq_dec x y); simpl in |- *; auto.
+  intros _ H; inversion H.
 Qed.
 
-Definition Qsrt : Setoid_Ring_Theory Qeq Qplus Qmult 1 0 Qopp Qeq_bool.
+Definition Qsrt : ring_theory 0 1 Qplus Qmult Qminus Qopp Qeq.
 Proof.
-constructor.
-exact Qplus_comm.
-exact Qplus_assoc.
-exact Qmult_comm.
-exact Qmult_assoc.
-exact Qplus_0_l.
-exact Qmult_1_l.
-exact Qplus_opp_r.
-exact Qmult_plus_distr_l.
-unfold Is_true; intros x y; generalize (Qeq_bool_correct x y);
- case (Qeq_bool x y); auto.
+  constructor.
+  exact Qplus_0_l.
+  exact Qplus_comm.
+  exact Qplus_assoc.
+  exact Qmult_1_l.
+  exact Qmult_comm.
+  exact Qmult_assoc.
+  exact Qmult_plus_distr_l.
+  reflexivity.
+  exact Qplus_opp_r.
 Qed.
 
-Add Setoid Ring Q Qeq Q_Setoid Qplus Qmult 1 0 Qopp Qeq_bool
- Qplus_comp Qmult_comp Qopp_comp Qsrt
- [ Qmake (*inject_Z*)  Zpos 0%Z Zneg xI xO 1%positive ].
-
+Ltac isQcst t :=
+  let t := eval hnf in t in
+    match t with
+      Qmake ?n ?d =>
+      match isZcst n with
+        true => isZcst d
+	| _ => false
+      end
+      | _ => false
+    end.
+
+Ltac Qcst t :=
+  match isQcst t with
+    true => t
+    | _ => NotConstant
+  end.
+
+Add Ring Qring : Qsrt (decidable Qeq_bool_correct, constants [Qcst]).
 (** Exemple of use: *)
 
 Section Examples. 
 
 Let ex1 : forall x y z : Q, (x+y)*z ==  (x*z)+(y*z).
-intros.
-ring.
+  intros.
+  ring.
 Qed.
 
 Let ex2 : forall x y : Q, x+y == y+x.
-intros. 
-ring.
+  intros. 
+  ring.
 Qed.
 
 Let ex3 : forall x y z : Q, (x+y)+z == x+(y+z).
-intros.
-ring.
+  intros.
+  ring.
 Qed.
 
 Let ex4 : (inject_Z 1)+(inject_Z 1)==(inject_Z 2).
-ring.
+  ring.
 Qed.
 
 Let ex5 : 1+1 == 2#1.
-ring.
+  ring.
 Qed.
 
 Let ex6 : (1#1)+(1#1) == 2#1.
-ring.
+  ring.
 Qed.
 
 Let ex7 : forall x : Q, x-x== 0#1.
-intro.
-ring.
+  intro.
+  ring.
 Qed.
 
 End Examples.
 
 Lemma Qopp_plus : forall a b,  -(a+b) == -a + -b.
 Proof.
-intros; ring.
+  intros; ring.
 Qed.
 
 Lemma Qopp_opp : forall q, - -q==q.
 Proof.
-intros; ring.
+  intros; ring.
 Qed.
 
diff --git a/theories/Reals/Alembert.v b/theories/Reals/Alembert.v
index e6bc69b6..802bfa71 100644
--- a/theories/Reals/Alembert.v
+++ b/theories/Reals/Alembert.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Alembert.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+(*i $Id: Alembert.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -22,705 +22,712 @@ Open Local Scope R_scope.
 (***************************************************)
 
 Lemma Alembert_C1 :
- forall An:nat -> R,
-   (forall n:nat, 0 < An n) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros An H H0.
-cut
- (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
-  sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
-intro X; apply X.
-apply completeness.
-unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2);
- [ intro | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H0 (/ 2) H1); intros.
-exists (sum_f_R0 An x + 2 * An (S x)).
-unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros.
-rewrite H4; assert (H5 := lt_eq_lt_dec x1 x).
-elim H5; intros.
-elim a; intro.
-replace (sum_f_R0 An x) with
- (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)).
-pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r;
- rewrite Rplus_assoc; apply Rplus_le_compat_l.
-left; apply Rplus_lt_0_compat.
-apply tech1; intros; apply H.
-apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
-symmetry  in |- *; apply tech2; assumption.
-rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l.
-left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
-replace (sum_f_R0 An x1) with
- (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)).
-apply Rplus_le_compat_l.
-cut
- (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <=
-  An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
-intro;
- apply Rle_trans with
-  (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
-assumption.
-rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l.
-left; apply H.
-rewrite tech3.
-replace (1 - / 2) with (/ 2).
-unfold Rdiv in |- *; rewrite Rinv_involutive.
-pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
- apply Rmult_le_compat_l.
-left; prove_sup0.
-left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)).
-replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1;
- [ idtac | ring ].
-rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_lt_compat_l.
-apply pow_lt; apply Rinv_0_lt_compat; prove_sup0.
-discrR.
-apply Rmult_eq_reg_l with 2.
-rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym.
-ring.
-discrR.
-discrR.
-pattern 1 at 3 in |- *; replace 1 with (/ 1);
- [ apply tech7; discrR | apply Rinv_1 ].
-replace (An (S x)) with (An (S x + 0)%nat).
-apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
-left; apply Rinv_0_lt_compat; prove_sup0.
-intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n).
-intro; replace (S x + S i)%nat with (S (S x + i)).
-apply H6; unfold ge in |- *; apply tech8.
-apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
-intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n).
-apply Rinv_0_lt_compat; apply H.
-do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r;
- replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)).
-apply H2; assumption.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
- rewrite Rabs_Rabsolu; rewrite Rabs_right.
-unfold Rdiv in |- *; reflexivity.
-left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
- apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ].
-red in |- *; intro; assert (H8 := H n); rewrite H7 in H8;
- elim (Rlt_irrefl _ H8).
-replace (S x + 0)%nat with (S x); [ reflexivity | ring ].
-symmetry  in |- *; apply tech2; assumption.
-exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
-intro X; elim X; intros.
-apply existT with x; apply tech10;
- [ unfold Un_growing in |- *; intro; rewrite tech5;
-    pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
-    apply Rplus_le_compat_l; left; apply H
- | apply p ].
+  forall An:nat -> R,
+    (forall n:nat, 0 < An n) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros An H H0.
+  cut
+    (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
+      sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
+  intro X; apply X.
+  apply completeness.
+  unfold Un_cv in H0; unfold bound in |- *; cut (0 < / 2);
+    [ intro | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H0 (/ 2) H1); intros.
+  exists (sum_f_R0 An x + 2 * An (S x)).
+  unfold is_upper_bound in |- *; intros; unfold EUn in H3; elim H3; intros.
+  rewrite H4; assert (H5 := lt_eq_lt_dec x1 x).
+  elim H5; intros.
+  elim a; intro.
+  replace (sum_f_R0 An x) with
+    (sum_f_R0 An x1 + sum_f_R0 (fun i:nat => An (S x1 + i)%nat) (x - S x1)).
+  pattern (sum_f_R0 An x1) at 1 in |- *; rewrite <- Rplus_0_r;
+    rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  left; apply Rplus_lt_0_compat.
+  apply tech1; intros; apply H.
+  apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
+  symmetry  in |- *; apply tech2; assumption.
+  rewrite b; pattern (sum_f_R0 An x) at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_le_compat_l.
+  left; apply Rmult_lt_0_compat; [ prove_sup0 | apply H ].
+  replace (sum_f_R0 An x1) with
+    (sum_f_R0 An x + sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x)).
+  apply Rplus_le_compat_l.
+  cut
+    (sum_f_R0 (fun i:nat => An (S x + i)%nat) (x1 - S x) <=
+      An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
+  intro;
+    apply Rle_trans with
+      (An (S x) * sum_f_R0 (fun i:nat => (/ 2) ^ i) (x1 - S x)).
+  assumption.
+  rewrite <- (Rmult_comm (An (S x))); apply Rmult_le_compat_l.
+  left; apply H.
+  rewrite tech3.
+  replace (1 - / 2) with (/ 2).
+  unfold Rdiv in |- *; rewrite Rinv_involutive.
+  pattern 2 at 3 in |- *; rewrite <- Rmult_1_r; rewrite <- (Rmult_comm 2);
+    apply Rmult_le_compat_l.
+  left; prove_sup0.
+  left; apply Rplus_lt_reg_r with ((/ 2) ^ S (x1 - S x)).
+  replace ((/ 2) ^ S (x1 - S x) + (1 - (/ 2) ^ S (x1 - S x))) with 1;
+    [ idtac | ring ].
+  rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_lt_compat_l.
+  apply pow_lt; apply Rinv_0_lt_compat; prove_sup0.
+  discrR.
+  apply Rmult_eq_reg_l with 2.
+  rewrite Rmult_minus_distr_l; rewrite <- Rinv_r_sym.
+  ring.
+  discrR.
+  discrR.
+  pattern 1 at 3 in |- *; replace 1 with (/ 1);
+    [ apply tech7; discrR | apply Rinv_1 ].
+  replace (An (S x)) with (An (S x + 0)%nat).
+  apply (tech6 (fun i:nat => An (S x + i)%nat) (/ 2)).
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  intro; cut (forall n:nat, (n >= x)%nat -> An (S n) < / 2 * An n).
+  intro; replace (S x + S i)%nat with (S (S x + i)).
+  apply H6; unfold ge in |- *; apply tech8.
+  apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR; ring.
+  intros; unfold R_dist in H2; apply Rmult_lt_reg_l with (/ An n).
+  apply Rinv_0_lt_compat; apply H.
+  do 2 rewrite (Rmult_comm (/ An n)); rewrite Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r;
+    replace (An (S n) * / An n) with (Rabs (Rabs (An (S n) / An n) - 0)).
+  apply H2; assumption.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+    rewrite Rabs_Rabsolu; rewrite Rabs_right.
+  unfold Rdiv in |- *; reflexivity.
+  left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+    apply Rmult_lt_0_compat; [ apply H | apply Rinv_0_lt_compat; apply H ].
+  red in |- *; intro; assert (H8 := H n); rewrite H7 in H8;
+    elim (Rlt_irrefl _ H8).
+  replace (S x + 0)%nat with (S x); [ reflexivity | ring ].
+  symmetry  in |- *; apply tech2; assumption.
+  exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+  intro X; elim X; intros.
+  apply existT with x; apply tech10;
+    [ unfold Un_growing in |- *; intro; rewrite tech5;
+      pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+	apply Rplus_le_compat_l; left; apply H
+      | apply p ].
 Qed.
 
 Lemma Alembert_C2 :
- forall An:nat -> R,
-   (forall n:nat, An n <> 0) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros.
-set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2).
-set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2).
-cut (forall n:nat, 0 < Vn n).
-intro; cut (forall n:nat, 0 < Wn n).
-intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0).
-intro; cut (Un_cv (fun n:nat => Rabs (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 existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p;
- unfold Un_cv in p0; intros; cut (0 < eps / 2).
-intro; elim (p (eps / 2) H8); clear p; intros.
-elim (p0 (eps / 2) H8); clear p0; intros.
-set (N := max x1 x2).
-exists N; intros;
- replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n).
-unfold R_dist in |- *;
- replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with
-  (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ];
- apply Rle_lt_trans with
-  (Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))).
-apply Rabs_triang.
-rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2).
-apply Rplus_lt_compat.
-unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N;
- [ unfold N in |- *; apply le_max_l | assumption ].
-unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N;
- [ unfold N in |- *; apply le_max_r | assumption ].
-right; symmetry  in |- *; apply double_var.
-symmetry  in |- *; apply tech11; intro; unfold Vn, Wn in |- *;
- unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
- apply Rmult_eq_reg_l with 2.
-rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-ring.
-discrR.
-discrR.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)).
-intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)).
-intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)).
-intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3).
-intro; elim (H0 (eps / 3) H8); intros.
-exists x; intros.
-assert (H11 := H9 n H10).
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11;
- unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11;
- rewrite Rabs_Rabsolu in H11; rewrite Rabs_right.
-apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
-apply H6.
-apply Rmult_lt_reg_l with (/ 3).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
- rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11;
- exact H11.
-left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat.
-apply H2.
-apply Rinv_0_lt_compat; apply H2.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
- replace 3 with (2 * (3 * / 2));
- [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
- apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)).
-rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply H2.
-apply H5.
-rewrite Rabs_Rinv.
-replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n));
- [ idtac | ring ];
- replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
-  (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); 
- [ idtac | ring ]; apply Rmult_le_compat_l.
-left; apply Rmult_lt_0_compat.
-prove_sup0.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
-elim (H4 (S n)); intros; assumption.
-apply H.
-intro; apply Rmult_le_reg_l with (Wn n).
-apply H2.
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (Rabs (An n)).
-apply Rabs_pos_lt; apply H.
-rewrite Rmult_1_r;
- replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with
-  (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; elim (H4 n); intros; assumption.
-discrR.
-apply Rabs_no_R0; apply H.
-red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6;
- elim (Rlt_irrefl _ H6).
-intro; split.
-unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
- apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; prove_sup0.
-pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
- unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l.
-apply Rplus_le_reg_l with (An n).
-rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
- rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs.
-unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
- repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; prove_sup0.
-unfold Rminus in |- *; rewrite double;
- replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
- [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
-rewrite <- Rabs_Ropp; apply RRle_abs.
-cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)).
-intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)).
-intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)).
-intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3).
-intro; elim (H0 (eps / 3) H7); intros.
-exists x; intros.
-assert (H10 := H8 n H9).
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10;
- unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10;
- rewrite Rabs_Rabsolu in H10; rewrite Rabs_right.
-apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
-apply H5.
-apply Rmult_lt_reg_l with (/ 3).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
- rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10;
- exact H10.
-left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat.
-apply H1.
-apply Rinv_0_lt_compat; apply H1.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
- replace 3 with (2 * (3 * / 2));
- [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
- apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)).
-rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply H1.
-apply H4.
-rewrite Rabs_Rinv.
-replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n));
- [ idtac | ring ];
- replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
-  (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); 
- [ idtac | ring ]; apply Rmult_le_compat_l.
-left; apply Rmult_lt_0_compat.
-prove_sup0.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
-elim (H3 (S n)); intros; assumption.
-apply H.
-intro; apply Rmult_le_reg_l with (Vn n).
-apply H1.
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (Rabs (An n)).
-apply Rabs_pos_lt; apply H.
-rewrite Rmult_1_r;
- replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with
-  (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; elim (H3 n); intros; assumption.
-discrR.
-apply Rabs_no_R0; apply H.
-red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5;
- elim (Rlt_irrefl _ H5).
-intro; split.
-unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
- apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; prove_sup0.
-pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
- rewrite Rplus_assoc; apply Rplus_le_compat_l.
-apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r;
- rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; 
- rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; 
- apply RRle_abs.
-unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
- repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; prove_sup0.
-unfold Rminus in |- *; rewrite double;
- replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
- [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l;
- apply RRle_abs.
-intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
- rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
-apply Rinv_0_lt_compat; prove_sup0.
-apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *;
- rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; 
- rewrite Rplus_opp_l; rewrite Rplus_0_r;
- apply Rle_lt_trans with (Rabs (An n)).
-apply RRle_abs.
-rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
-intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
- rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
-apply Rinv_0_lt_compat; prove_sup0.
-apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *;
- rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; 
- rewrite Rplus_opp_r; rewrite Rplus_0_r;
- apply Rle_lt_trans with (Rabs (An n)).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
+  forall An:nat -> R,
+    (forall n:nat, An n <> 0) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros.
+  set (Vn := fun i:nat => (2 * Rabs (An i) + An i) / 2).
+  set (Wn := fun i:nat => (2 * Rabs (An i) - An i) / 2).
+  cut (forall n:nat, 0 < Vn n).
+  intro; cut (forall n:nat, 0 < Wn n).
+  intro; cut (Un_cv (fun n:nat => Rabs (Vn (S n) / Vn n)) 0).
+  intro; cut (Un_cv (fun n:nat => Rabs (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 existT with (x - x0); unfold Un_cv in |- *; unfold Un_cv in p;
+    unfold Un_cv in p0; intros; cut (0 < eps / 2).
+  intro; elim (p (eps / 2) H8); clear p; intros.
+  elim (p0 (eps / 2) H8); clear p0; intros.
+  set (N := max x1 x2).
+  exists N; intros;
+    replace (sum_f_R0 An n) with (sum_f_R0 Vn n - sum_f_R0 Wn n).
+  unfold R_dist in |- *;
+    replace (sum_f_R0 Vn n - sum_f_R0 Wn n - (x - x0)) with
+      (sum_f_R0 Vn n - x + - (sum_f_R0 Wn n - x0)); [ idtac | ring ];
+      apply Rle_lt_trans with
+	(Rabs (sum_f_R0 Vn n - x) + Rabs (- (sum_f_R0 Wn n - x0))).
+  apply Rabs_triang.
+  rewrite Rabs_Ropp; apply Rlt_le_trans with (eps / 2 + eps / 2).
+  apply Rplus_lt_compat.
+  unfold R_dist in H9; apply H9; unfold ge in |- *; apply le_trans with N;
+    [ unfold N in |- *; apply le_max_l | assumption ].
+  unfold R_dist in H10; apply H10; unfold ge in |- *; apply le_trans with N;
+    [ unfold N in |- *; apply le_max_r | assumption ].
+  right; symmetry  in |- *; apply double_var.
+  symmetry  in |- *; apply tech11; intro; unfold Vn, Wn in |- *;
+    unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+      apply Rmult_eq_reg_l with 2.
+  rewrite Rmult_minus_distr_l; repeat rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  ring.
+  discrR.
+  discrR.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  cut (forall n:nat, / 2 * Rabs (An n) <= Wn n <= 3 * / 2 * Rabs (An n)).
+  intro; cut (forall n:nat, / Wn n <= 2 * / Rabs (An n)).
+  intro; cut (forall n:nat, Wn (S n) / Wn n <= 3 * Rabs (An (S n) / An n)).
+  intro; unfold Un_cv in |- *; intros; unfold Un_cv in H0; cut (0 < eps / 3).
+  intro; elim (H0 (eps / 3) H8); intros.
+  exists x; intros.
+  assert (H11 := H9 n H10).
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H11;
+      unfold Rminus in H11; rewrite Ropp_0 in H11; rewrite Rplus_0_r in H11;
+	rewrite Rabs_Rabsolu in H11; rewrite Rabs_right.
+  apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
+  apply H6.
+  apply Rmult_lt_reg_l with (/ 3).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
+    rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H11;
+      exact H11.
+  left; change (0 < Wn (S n) / Wn n) in |- *; unfold Rdiv in |- *;
+    apply Rmult_lt_0_compat.
+  apply H2.
+  apply Rinv_0_lt_compat; apply H2.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+    replace 3 with (2 * (3 * / 2));
+      [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
+      apply Rle_trans with (Wn (S n) * 2 * / Rabs (An n)).
+  rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply H2.
+  apply H5.
+  rewrite Rabs_Rinv.
+  replace (Wn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Wn (S n));
+    [ idtac | ring ];
+    replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
+      (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); 
+      [ idtac | ring ]; apply Rmult_le_compat_l.
+  left; apply Rmult_lt_0_compat.
+  prove_sup0.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
+  elim (H4 (S n)); intros; assumption.
+  apply H.
+  intro; apply Rmult_le_reg_l with (Wn n).
+  apply H2.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (Rabs (An n)).
+  apply Rabs_pos_lt; apply H.
+  rewrite Rmult_1_r;
+    replace (Rabs (An n) * (Wn n * (2 * / Rabs (An n)))) with
+      (2 * Wn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
+      rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; elim (H4 n); intros; assumption.
+  discrR.
+  apply Rabs_no_R0; apply H.
+  red in |- *; intro; assert (H6 := H2 n); rewrite H5 in H6;
+    elim (Rlt_irrefl _ H6).
+  intro; split.
+  unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+    apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
+    unfold Rminus in |- *; rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  apply Rplus_le_reg_l with (An n).
+  rewrite Rplus_0_r; rewrite (Rplus_comm (An n)); rewrite Rplus_assoc;
+    rewrite Rplus_opp_l; rewrite Rplus_0_r; apply RRle_abs.
+  unfold Wn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+    repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  unfold Rminus in |- *; rewrite double;
+    replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
+      [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  cut (forall n:nat, / 2 * Rabs (An n) <= Vn n <= 3 * / 2 * Rabs (An n)).
+  intro; cut (forall n:nat, / Vn n <= 2 * / Rabs (An n)).
+  intro; cut (forall n:nat, Vn (S n) / Vn n <= 3 * Rabs (An (S n) / An n)).
+  intro; unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / 3).
+  intro; elim (H0 (eps / 3) H7); intros.
+  exists x; intros.
+  assert (H10 := H8 n H9).
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold R_dist in H10;
+      unfold Rminus in H10; rewrite Ropp_0 in H10; rewrite Rplus_0_r in H10;
+	rewrite Rabs_Rabsolu in H10; rewrite Rabs_right.
+  apply Rle_lt_trans with (3 * Rabs (An (S n) / An n)).
+  apply H5.
+  apply Rmult_lt_reg_l with (/ 3).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ];
+    rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H10;
+      exact H10.
+  left; change (0 < Vn (S n) / Vn n) in |- *; unfold Rdiv in |- *;
+    apply Rmult_lt_0_compat.
+  apply H1.
+  apply Rinv_0_lt_compat; apply H1.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  intro; unfold Rdiv in |- *; rewrite Rabs_mult; rewrite <- Rmult_assoc;
+    replace 3 with (2 * (3 * / 2));
+      [ idtac | rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR ];
+      apply Rle_trans with (Vn (S n) * 2 * / Rabs (An n)).
+  rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply H1.
+  apply H4.
+  rewrite Rabs_Rinv.
+  replace (Vn (S n) * 2 * / Rabs (An n)) with (2 * / Rabs (An n) * Vn (S n));
+    [ idtac | ring ];
+    replace (2 * (3 * / 2) * Rabs (An (S n)) * / Rabs (An n)) with
+      (2 * / Rabs (An n) * (3 * / 2 * Rabs (An (S n)))); 
+      [ idtac | ring ]; apply Rmult_le_compat_l.
+  left; apply Rmult_lt_0_compat.
+  prove_sup0.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply H.
+  elim (H3 (S n)); intros; assumption.
+  apply H.
+  intro; apply Rmult_le_reg_l with (Vn n).
+  apply H1.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (Rabs (An n)).
+  apply Rabs_pos_lt; apply H.
+  rewrite Rmult_1_r;
+    replace (Rabs (An n) * (Vn n * (2 * / Rabs (An n)))) with
+      (2 * Vn n * (Rabs (An n) * / Rabs (An n))); [ idtac | ring ];
+      rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; apply Rmult_le_reg_l with (/ 2).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; elim (H3 n); intros; assumption.
+  discrR.
+  apply Rabs_no_R0; apply H.
+  red in |- *; intro; assert (H5 := H1 n); rewrite H4 in H5;
+    elim (Rlt_irrefl _ H5).
+  intro; split.
+  unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+    apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r; rewrite double;
+    rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  apply Rplus_le_reg_l with (- An n); rewrite Rplus_0_r;
+    rewrite <- (Rplus_comm (An n)); rewrite <- Rplus_assoc; 
+      rewrite Rplus_opp_l; rewrite Rplus_0_l; rewrite <- Rabs_Ropp; 
+	apply RRle_abs.
+  unfold Vn in |- *; unfold Rdiv in |- *; repeat rewrite <- (Rmult_comm (/ 2));
+    repeat rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  unfold Rminus in |- *; rewrite double;
+    replace (3 * Rabs (An n)) with (Rabs (An n) + Rabs (An n) + Rabs (An n));
+      [ idtac | ring ]; repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l;
+	apply RRle_abs.
+  intro; unfold Wn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+    rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+  apply Rinv_0_lt_compat; prove_sup0.
+  apply Rplus_lt_reg_r with (An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+    rewrite (Rplus_comm (An n)); rewrite Rplus_assoc; 
+      rewrite Rplus_opp_l; rewrite Rplus_0_r;
+	apply Rle_lt_trans with (Rabs (An n)).
+  apply RRle_abs.
+  rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
+  intro; unfold Vn in |- *; unfold Rdiv in |- *; rewrite <- (Rmult_0_r (/ 2));
+    rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+  apply Rinv_0_lt_compat; prove_sup0.
+  apply Rplus_lt_reg_r with (- An n); rewrite Rplus_0_r; unfold Rminus in |- *;
+    rewrite (Rplus_comm (- An n)); rewrite Rplus_assoc; 
+      rewrite Rplus_opp_r; rewrite Rplus_0_r;
+	apply Rle_lt_trans with (Rabs (An n)).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  rewrite double; pattern (Rabs (An n)) at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_lt_compat_l; apply Rabs_pos_lt; apply H.
 Qed.
 
 Lemma AlembertC3_step1 :
- forall (An:nat -> R) (x:R),
-   x <> 0 ->
-   (forall n:nat, An n <> 0) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
-   sigT (fun l:R => Pser An x l).
-intros; set (Bn := fun i:nat => An i * x ^ i).
-cut (forall n:nat, Bn n <> 0).
-intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0).
-intro; assert (H4 := Alembert_C2 Bn H2 H3).
-elim H4; intros.
-apply existT with x0; unfold Bn in p; apply tech12; assumption.
-unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
-intro; elim (H1 (eps / Rabs x) H4); intros.
-exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *;
- rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
- unfold Bn in |- *;
- replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
-rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5;
- replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0).
-apply H5; assumption.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; 
- reflexivity.
-apply Rabs_no_R0; assumption.
-replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add;
- unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with
- (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); 
- [ idtac | ring ]; rewrite <- Rinv_r_sym.
-simpl in |- *; ring.
-apply pow_nonzero; assumption.
-apply H0.
-apply pow_nonzero; assumption.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
-intro; unfold Bn in |- *; apply prod_neq_R0;
- [ apply H0 | apply pow_nonzero; assumption ].
+  forall (An:nat -> R) (x:R),
+    x <> 0 ->
+    (forall n:nat, An n <> 0) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+    sigT (fun l:R => Pser An x l).
+Proof.
+  intros; set (Bn := fun i:nat => An i * x ^ i).
+  cut (forall n:nat, Bn n <> 0).
+  intro; cut (Un_cv (fun n:nat => Rabs (Bn (S n) / Bn n)) 0).
+  intro; assert (H4 := Alembert_C2 Bn H2 H3).
+  elim H4; intros.
+  apply existT with x0; unfold Bn in p; apply tech12; assumption.
+  unfold Un_cv in |- *; intros; unfold Un_cv in H1; cut (0 < eps / Rabs x).
+  intro; elim (H1 (eps / Rabs x) H4); intros.
+  exists x0; intros; unfold R_dist in |- *; unfold Rminus in |- *;
+    rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
+      unfold Bn in |- *;
+	replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+  rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs x).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  rewrite <- (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); unfold Rdiv in H5;
+    replace (Rabs (An (S n) / An n)) with (R_dist (Rabs (An (S n) * / An n)) 0).
+  apply H5; assumption.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; unfold Rdiv in |- *; 
+      reflexivity.
+  apply Rabs_no_R0; assumption.
+  replace (S n) with (n + 1)%nat; [ idtac | ring ]; rewrite pow_add;
+    unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  replace (An (n + 1)%nat * (x ^ n * x ^ 1) * (/ An n * / x ^ n)) with
+    (An (n + 1)%nat * x ^ 1 * / An n * (x ^ n * / x ^ n)); 
+    [ idtac | ring ]; rewrite <- Rinv_r_sym.
+  simpl in |- *; ring.
+  apply pow_nonzero; assumption.
+  apply H0.
+  apply pow_nonzero; assumption.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
+  intro; unfold Bn in |- *; apply prod_neq_R0;
+    [ apply H0 | apply pow_nonzero; assumption ].
 Qed.
 
 Lemma AlembertC3_step2 :
- forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l).
-intros; apply existT with (An 0%nat).
-unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros;
- replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat).
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; assumption.
-induction  n as [| n Hrecn].
-simpl in |- *; ring.
-rewrite tech5; rewrite Hrecn;
- [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ].
+  forall (An:nat -> R) (x:R), x = 0 -> sigT (fun l:R => Pser An x l).
+Proof.
+  intros; apply existT with (An 0%nat).
+  unfold Pser in |- *; unfold infinit_sum in |- *; intros; exists 0%nat; intros;
+    replace (sum_f_R0 (fun n0:nat => An n0 * x ^ n0) n) with (An 0%nat).
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; assumption.
+  induction  n as [| n Hrecn].
+  simpl in |- *; ring.
+  rewrite tech5; rewrite Hrecn;
+    [ rewrite H; simpl in |- *; ring | unfold ge in |- *; apply le_O_n ].
 Qed.
 
-(* An useful criterion of convergence for power series *)
+(** An useful criterion of convergence for power series *)
 Theorem Alembert_C3 :
- forall (An:nat -> R) (x:R),
-   (forall n:nat, An n <> 0) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
-   sigT (fun l:R => Pser An x l).
-intros; case (total_order_T x 0); intro.
-elim s; intro.
-cut (x <> 0).
-intro; apply AlembertC3_step1; assumption.
-red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
-apply AlembertC3_step2; assumption.
-cut (x <> 0).
-intro; apply AlembertC3_step1; assumption.
-red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
+  forall (An:nat -> R) (x:R),
+    (forall n:nat, An n <> 0) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) 0 ->
+    sigT (fun l:R => Pser An x l).
+Proof.
+  intros; case (total_order_T x 0); intro.
+  elim s; intro.
+  cut (x <> 0).
+  intro; apply AlembertC3_step1; assumption.
+  red in |- *; intro; rewrite H1 in a; elim (Rlt_irrefl _ a).
+  apply AlembertC3_step2; assumption.
+  cut (x <> 0).
+  intro; apply AlembertC3_step1; assumption.
+  red in |- *; intro; rewrite H1 in r; elim (Rlt_irrefl _ r).
 Qed.
 
 Lemma Alembert_C4 :
- forall (An:nat -> R) (k:R),
-   0 <= k < 1 ->
-   (forall n:nat, 0 < An n) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros An k Hyp H H0.
-cut
- (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
-  sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
-intro X; apply X.
-apply completeness.
-assert (H1 := tech13 _ _ Hyp H0).
-elim H1; intros.
-elim H2; intros.
-elim H4; intros.
-unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)).
-unfold is_upper_bound in |- *; intros; unfold EUn in H6.
-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
- (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)).
-pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r.
-rewrite Rplus_assoc; apply Rplus_le_compat_l.
-left; apply Rplus_lt_0_compat.
-apply tech1.
-intros; apply H.
-apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
- replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
-apply H.
-symmetry  in |- *; apply tech2; assumption.
-rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l.
-left; apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
- replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
-apply H.
-replace (sum_f_R0 An x2) with
- (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)).
-apply Rplus_le_compat_l.
-cut
- (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <=
-  An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
-intro;
- apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
-assumption.
-rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l.
-left; apply H.
-rewrite tech3.
-unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x).
-apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
-replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
-do 2 rewrite (Rmult_comm (1 - x)).
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)).
-replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1;
- [ idtac | ring ].
-rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l.
-left; apply pow_lt.
-apply Rle_lt_trans with k.
-elim Hyp; intros; assumption.
-elim H3; intros; assumption.
-apply Rminus_eq_contra.
-red in |- *; intro.
-elim H3; intros.
-rewrite H10 in H12; elim (Rlt_irrefl _ H12).
-red in |- *; intro.
-elim H3; intros.
-rewrite H10 in H12; elim (Rlt_irrefl _ H12).
-replace (An (S x0)) with (An (S x0 + 0)%nat).
-apply (tech6 (fun i:nat => An (S x0 + i)%nat) x).
-left; apply Rle_lt_trans with k.
-elim Hyp; intros; assumption.
-elim H3; intros; assumption.
-intro.
-cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n).
-intro.
-replace (S x0 + S i)%nat with (S (S x0 + i)).
-apply H9.
-unfold ge in |- *.
-apply tech8.
+  forall (An:nat -> R) (k:R),
+    0 <= k < 1 ->
+    (forall n:nat, 0 < An n) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros An k Hyp H H0.
+  cut
+    (sigT (fun l:R => is_lub (EUn (fun N:nat => sum_f_R0 An N)) l) ->
+      sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l)).
+  intro X; apply X.
+  apply completeness.
+  assert (H1 := tech13 _ _ Hyp H0).
+  elim H1; intros.
+  elim H2; intros.
+  elim H4; intros.
+  unfold bound in |- *; exists (sum_f_R0 An x0 + / (1 - x) * An (S x0)).
+  unfold is_upper_bound in |- *; intros; unfold EUn in H6.
+  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
+    (sum_f_R0 An x2 + sum_f_R0 (fun i:nat => An (S x2 + i)%nat) (x0 - S x2)).
+  pattern (sum_f_R0 An x2) at 1 in |- *; rewrite <- Rplus_0_r.
+  rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  left; apply Rplus_lt_0_compat.
+  apply tech1.
+  intros; apply H.
+  apply Rmult_lt_0_compat.
+  apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+    replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+  apply H.
+  symmetry  in |- *; apply tech2; assumption.
+  rewrite b; pattern (sum_f_R0 An x0) at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_le_compat_l.
+  left; apply Rmult_lt_0_compat.
+  apply Rinv_0_lt_compat; apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+    replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+  apply H.
+  replace (sum_f_R0 An x2) with
+    (sum_f_R0 An x0 + sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0)).
+  apply Rplus_le_compat_l.
+  cut
+    (sum_f_R0 (fun i:nat => An (S x0 + i)%nat) (x2 - S x0) <=
+      An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
+  intro;
+    apply Rle_trans with (An (S x0) * sum_f_R0 (fun i:nat => x ^ i) (x2 - S x0)).
+  assumption.
+  rewrite <- (Rmult_comm (An (S x0))); apply Rmult_le_compat_l.
+  left; apply H.
+  rewrite tech3.
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with (1 - x).
+  apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+  replace (x + (1 - x)) with 1; [ elim H3; intros; assumption | ring ].
+  do 2 rewrite (Rmult_comm (1 - x)).
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; apply Rplus_le_reg_l with (x ^ S (x2 - S x0)).
+  replace (x ^ S (x2 - S x0) + (1 - x ^ S (x2 - S x0))) with 1;
+    [ idtac | ring ].
+  rewrite <- (Rplus_comm 1); pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_le_compat_l.
+  left; apply pow_lt.
+  apply Rle_lt_trans with k.
+  elim Hyp; intros; assumption.
+  elim H3; intros; assumption.
+  apply Rminus_eq_contra.
+  red in |- *; intro.
+  elim H3; intros.
+  rewrite H10 in H12; elim (Rlt_irrefl _ H12).
+  red in |- *; intro.
+  elim H3; intros.
+  rewrite H10 in H12; elim (Rlt_irrefl _ H12).
+  replace (An (S x0)) with (An (S x0 + 0)%nat).
+  apply (tech6 (fun i:nat => An (S x0 + i)%nat) x).
+  left; apply Rle_lt_trans with k.
+  elim Hyp; intros; assumption.
+  elim H3; intros; assumption.
+  intro.
+  cut (forall n:nat, (n >= x0)%nat -> An (S n) < x * An n).
+  intro.
+  replace (S x0 + S i)%nat with (S (S x0 + i)).
+  apply H9.
+  unfold ge in |- *.
+  apply tech8.
   apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; do 2 rewrite S_INR;
-   ring.
-intros.
-apply Rmult_lt_reg_l with (/ An n).
-apply Rinv_0_lt_compat; apply H.
-do 2 rewrite (Rmult_comm (/ An n)).
-rewrite Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r.
-replace (An (S n) * / An n) with (Rabs (An (S n) / An n)).
-apply H5; assumption.
-rewrite Rabs_right.
-unfold Rdiv in |- *; reflexivity.
-left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
- apply Rmult_lt_0_compat.
-apply H.
-apply Rinv_0_lt_compat; apply H.
-red in |- *; intro.
-assert (H11 := H n).
-rewrite H10 in H11; elim (Rlt_irrefl _ H11).
-replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ].
-symmetry  in |- *; apply tech2; assumption.
-exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
-intro X; elim X; intros.
-apply existT with x; apply tech10;
- [ unfold Un_growing in |- *; intro; rewrite tech5;
-    pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
-    apply Rplus_le_compat_l; left; apply H
- | apply p ].
+    ring.
+  intros.
+  apply Rmult_lt_reg_l with (/ An n).
+  apply Rinv_0_lt_compat; apply H.
+  do 2 rewrite (Rmult_comm (/ An n)).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r.
+  replace (An (S n) * / An n) with (Rabs (An (S n) / An n)).
+  apply H5; assumption.
+  rewrite Rabs_right.
+  unfold Rdiv in |- *; reflexivity.
+  left; unfold Rdiv in |- *; change (0 < An (S n) * / An n) in |- *;
+    apply Rmult_lt_0_compat.
+  apply H.
+  apply Rinv_0_lt_compat; apply H.
+  red in |- *; intro.
+  assert (H11 := H n).
+  rewrite H10 in H11; elim (Rlt_irrefl _ H11).
+  replace (S x0 + 0)%nat with (S x0); [ reflexivity | ring ].
+  symmetry  in |- *; apply tech2; assumption.
+  exists (sum_f_R0 An 0); unfold EUn in |- *; exists 0%nat; reflexivity.
+  intro X; elim X; intros.
+  apply existT with x; apply tech10;
+    [ unfold Un_growing in |- *; intro; rewrite tech5;
+      pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+	apply Rplus_le_compat_l; left; apply H
+      | apply p ].
 Qed.
 
 Lemma Alembert_C5 :
- forall (An:nat -> R) (k:R),
-   0 <= k < 1 ->
-   (forall n:nat, An n <> 0) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros.
-cut
- (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
-  sigT (fun l:R => Un_cv (fun 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
-    (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) ->
-  sigT
-    (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)).
-intro Hyp; apply Hyp.
-apply (Alembert_C4 (fun i:nat => Rabs (An i)) k).
-assumption.
-intro; apply Rabs_pos_lt; apply H0.
-unfold Un_cv in |- *.
-unfold Un_cv in H1.
-unfold Rdiv in |- *.
-intros.
-elim (H1 eps H2); intros.
-exists x; intros.
-rewrite <- Rabs_Rinv.
-rewrite <- Rabs_mult.
-rewrite Rabs_Rabsolu.
-unfold Rdiv in H3; apply H3; assumption.
-apply H0.
-intro X.
-elim X; intros.
-apply existT with x.
-assumption.
-intro X.
-elim X; intros.
-apply existT with x.
-assumption.
+  forall (An:nat -> R) (k:R),
+    0 <= k < 1 ->
+    (forall n:nat, An n <> 0) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros.
+  cut
+    (sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
+      sigT (fun l:R => Un_cv (fun 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
+      (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l) ->
+      sigT
+      (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => Rabs (An i)) N) l)).
+  intro Hyp; apply Hyp.
+  apply (Alembert_C4 (fun i:nat => Rabs (An i)) k).
+  assumption.
+  intro; apply Rabs_pos_lt; apply H0.
+  unfold Un_cv in |- *.
+  unfold Un_cv in H1.
+  unfold Rdiv in |- *.
+  intros.
+  elim (H1 eps H2); intros.
+  exists x; intros.
+  rewrite <- Rabs_Rinv.
+  rewrite <- Rabs_mult.
+  rewrite Rabs_Rabsolu.
+  unfold Rdiv in H3; apply H3; assumption.
+  apply H0.
+  intro X.
+  elim X; intros.
+  apply existT with x.
+  assumption.
+  intro X.
+  elim X; intros.
+  apply existT with x.
+  assumption.
 Qed.
 
-(* Convergence of power series in D(O,1/k) *)
-(*     k=0 is described in Alembert_C3     *)
+(** Convergence of power series in D(O,1/k)
+    k=0 is described in Alembert_C3     *)
 Lemma Alembert_C6 :
- forall (An:nat -> R) (x k:R),
-   0 < k ->
-   (forall n:nat, An n <> 0) ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
-   Rabs x < / k -> sigT (fun l:R => Pser An x l).
-intros.
-cut
- (sigT
-    (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)).
-intro X.
-elim X; intros.
-apply existT with x0.
-apply tech12; assumption.
-case (total_order_T x 0); intro.
-elim s; intro.
-eapply Alembert_C5 with (k * Rabs x).
-split.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-left; assumption.
-left; apply Rabs_pos_lt.
-red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
-apply Rmult_lt_reg_l with (/ k).
-apply Rinv_0_lt_compat; assumption.
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-rewrite Rmult_1_r; assumption.
-red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
-intro; apply prod_neq_R0.
-apply H0.
-apply pow_nonzero.
-red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
-unfold Un_cv in |- *; unfold Un_cv in H1.
-intros.
-cut (0 < eps / Rabs x).
-intro.
-elim (H1 (eps / Rabs x) H4); intros.
-exists x0.
-intros.
-replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
-unfold R_dist in |- *.
-rewrite Rabs_mult.
-replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
- (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
-rewrite Rabs_mult.
-rewrite Rabs_Rabsolu.
-apply Rmult_lt_reg_l with (/ Rabs x).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-rewrite <- (Rmult_comm eps).
-unfold R_dist in H5.
-unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
-apply Rabs_no_R0.
-red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite pow_add.
-simpl in |- *.
-rewrite Rmult_1_r.
-rewrite Rinv_mult_distr.
-replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
- (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); 
- [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; reflexivity.
-apply pow_nonzero.
-red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-apply H0.
-apply pow_nonzero.
-red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
-apply existT with (An 0%nat).
-unfold Un_cv in |- *.
-intros.
-exists 0%nat.
-intros.
-unfold R_dist in |- *.
-replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat).
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-induction  n as [| n Hrecn].
-simpl in |- *; ring.
-rewrite tech5.
-rewrite <- Hrecn.
-rewrite b; simpl in |- *; ring.
-unfold ge in |- *; apply le_O_n.
-eapply Alembert_C5 with (k * Rabs x).
-split.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-left; assumption.
-left; apply Rabs_pos_lt.
-red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
-apply Rmult_lt_reg_l with (/ k).
-apply Rinv_0_lt_compat; assumption.
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-rewrite Rmult_1_r; assumption.
-red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
-intro; apply prod_neq_R0.
-apply H0.
-apply pow_nonzero.
-red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
-unfold Un_cv in |- *; unfold Un_cv in H1.
-intros.
-cut (0 < eps / Rabs x).
-intro.
-elim (H1 (eps / Rabs x) H4); intros.
-exists x0.
-intros.
-replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
-unfold R_dist in |- *.
-rewrite Rabs_mult.
-replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
- (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
-rewrite Rabs_mult.
-rewrite Rabs_Rabsolu.
-apply Rmult_lt_reg_l with (/ Rabs x).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-rewrite <- (Rmult_comm eps).
-unfold R_dist in H5.
-unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
-apply Rabs_no_R0.
-red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite pow_add.
-simpl in |- *.
-rewrite Rmult_1_r.
-rewrite Rinv_mult_distr.
-replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
- (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); 
- [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; reflexivity.
-apply pow_nonzero.
-red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-apply H0.
-apply pow_nonzero.
-red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  forall (An:nat -> R) (x k:R),
+    0 < k ->
+    (forall n:nat, An n <> 0) ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+    Rabs x < / k -> sigT (fun l:R => Pser An x l).
+  intros.
+  cut
+    (sigT
+      (fun l:R => Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l)).
+  intro X.
+  elim X; intros.
+  apply existT with x0.
+  apply tech12; assumption.
+  case (total_order_T x 0); intro.
+  elim s; intro.
+  eapply Alembert_C5 with (k * Rabs x).
+  split.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  left; assumption.
+  left; apply Rabs_pos_lt.
+  red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+  apply Rmult_lt_reg_l with (/ k).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  rewrite Rmult_1_r; assumption.
+  red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  intro; apply prod_neq_R0.
+  apply H0.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H3 in a; elim (Rlt_irrefl _ a).
+  unfold Un_cv in |- *; unfold Un_cv in H1.
+  intros.
+  cut (0 < eps / Rabs x).
+  intro.
+  elim (H1 (eps / Rabs x) H4); intros.
+  exists x0.
+  intros.
+  replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+  unfold R_dist in |- *.
+  rewrite Rabs_mult.
+  replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
+    (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
+  rewrite Rabs_mult.
+  rewrite Rabs_Rabsolu.
+  apply Rmult_lt_reg_l with (/ Rabs x).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  rewrite <- (Rmult_comm eps).
+  unfold R_dist in H5.
+  unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+  apply Rabs_no_R0.
+  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add.
+  simpl in |- *.
+  rewrite Rmult_1_r.
+  rewrite Rinv_mult_distr.
+  replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
+    (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); 
+    [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; reflexivity.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  apply H0.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+  red in |- *; intro H7; rewrite H7 in a; elim (Rlt_irrefl _ a).
+  apply existT with (An 0%nat).
+  unfold Un_cv in |- *.
+  intros.
+  exists 0%nat.
+  intros.
+  unfold R_dist in |- *.
+  replace (sum_f_R0 (fun i:nat => An i * x ^ i) n) with (An 0%nat).
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  induction  n as [| n Hrecn].
+  simpl in |- *; ring.
+  rewrite tech5.
+  rewrite <- Hrecn.
+  rewrite b; simpl in |- *; ring.
+  unfold ge in |- *; apply le_O_n.
+  eapply Alembert_C5 with (k * Rabs x).
+  split.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  left; assumption.
+  left; apply Rabs_pos_lt.
+  red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+  apply Rmult_lt_reg_l with (/ k).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  rewrite Rmult_1_r; assumption.
+  red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  intro; apply prod_neq_R0.
+  apply H0.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H3 in r; elim (Rlt_irrefl _ r).
+  unfold Un_cv in |- *; unfold Un_cv in H1.
+  intros.
+  cut (0 < eps / Rabs x).
+  intro.
+  elim (H1 (eps / Rabs x) H4); intros.
+  exists x0.
+  intros.
+  replace (An (S n) * x ^ S n / (An n * x ^ n)) with (An (S n) / An n * x).
+  unfold R_dist in |- *.
+  rewrite Rabs_mult.
+  replace (Rabs (An (S n) / An n) * Rabs x - k * Rabs x) with
+    (Rabs x * (Rabs (An (S n) / An n) - k)); [ idtac | ring ].
+  rewrite Rabs_mult.
+  rewrite Rabs_Rabsolu.
+  apply Rmult_lt_reg_l with (/ Rabs x).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  rewrite <- (Rmult_comm eps).
+  unfold R_dist in H5.
+  unfold Rdiv in |- *; unfold Rdiv in H5; apply H5; assumption.
+  apply Rabs_no_R0.
+  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  unfold Rdiv in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add.
+  simpl in |- *.
+  rewrite Rmult_1_r.
+  rewrite Rinv_mult_distr.
+  replace (An (n + 1)%nat * (x ^ n * x) * (/ An n * / x ^ n)) with
+    (An (n + 1)%nat * / An n * x * (x ^ n * / x ^ n)); 
+    [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; reflexivity.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  apply H0.
+  apply pow_nonzero.
+  red in |- *; intro; rewrite H7 in r; elim (Rlt_irrefl _ r).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+  red in |- *; intro H7; rewrite H7 in r; elim (Rlt_irrefl _ r).
 Qed.
diff --git a/theories/Reals/AltSeries.v b/theories/Reals/AltSeries.v
index 1ec8c664..fa44b6ff 100644
--- a/theories/Reals/AltSeries.v
+++ b/theories/Reals/AltSeries.v
@@ -1,12 +1,12 @@
-(************************************************************************)
-(*  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 5920 2004-07-16 20:01:26Z herbelin $ i*)
+  (************************************************************************)
+  (*  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 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -17,432 +17,442 @@ Require Import Max.
 Open Local Scope R_scope.
 
 (**********)
+(** * Formalization of alternated series *)
 Definition tg_alt (Un:nat -> R) (i:nat) : R := (-1) ^ i * Un i.
 Definition positivity_seq (Un:nat -> R) : Prop := forall n:nat, 0 <= Un n.
 
 Lemma CV_ALT_step0 :
- forall Un:nat -> R,
-   Un_decreasing Un ->
-   Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
-intros; unfold Un_growing in |- *; intro.
-cut ((2 * S n)%nat = S (S (2 * n))).
-intro; rewrite H0.
-do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l.
-pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r.
-apply Rplus_le_compat_l.
-unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
- rewrite Rmult_1_l.
-apply Rplus_le_reg_l with (Un (S (2 * S n))).
-rewrite Rplus_0_r;
- replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with
-  (Un (2 * S n)%nat); [ idtac | ring ].
-apply H.
-cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
-rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
+  forall Un:nat -> R,
+    Un_decreasing Un ->
+    Un_growing (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
+Proof.
+  intros; unfold Un_growing in |- *; intro.
+  cut ((2 * S n)%nat = S (S (2 * n))).
+  intro; rewrite H0.
+  do 4 rewrite tech5; repeat rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  pattern (tg_alt Un (S (2 * n))) at 1 in |- *; rewrite <- Rplus_0_r.
+  apply Rplus_le_compat_l.
+  unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+    rewrite Rmult_1_l.
+  apply Rplus_le_reg_l with (Un (S (2 * S n))).
+  rewrite Rplus_0_r;
+    replace (Un (S (2 * S n)) + (Un (2 * S n)%nat + -1 * Un (S (2 * S n)))) with
+      (Un (2 * S n)%nat); [ idtac | ring ].
+  apply H.
+  cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
+  rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
 Qed.
 
 Lemma CV_ALT_step1 :
- forall Un:nat -> R,
-   Un_decreasing Un ->
-   Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)).
-intros; unfold Un_decreasing in |- *; intro.
-cut ((2 * S n)%nat = S (S (2 * n))).
-intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc.
-pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r.
-apply Rplus_le_compat_l.
-unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
- rewrite Rmult_1_l.
-apply Rplus_le_reg_l with (Un (S (2 * n))).
-rewrite Rplus_0_r;
- replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with
-  (Un (2 * S n)%nat); [ idtac | ring ].
-rewrite H0; apply H.
-cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
-rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
+  forall Un:nat -> R,
+    Un_decreasing Un ->
+    Un_decreasing (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)).
+Proof.
+  intros; unfold Un_decreasing in |- *; intro.
+  cut ((2 * S n)%nat = S (S (2 * n))).
+  intro; rewrite H0; do 2 rewrite tech5; repeat rewrite Rplus_assoc.
+  pattern (sum_f_R0 (tg_alt Un) (2 * n)) at 2 in |- *; rewrite <- Rplus_0_r.
+  apply Rplus_le_compat_l.
+  unfold tg_alt in |- *; rewrite <- H0; rewrite pow_1_odd; rewrite pow_1_even;
+    rewrite Rmult_1_l.
+  apply Rplus_le_reg_l with (Un (S (2 * n))).
+  rewrite Rplus_0_r;
+    replace (Un (S (2 * n)) + (-1 * Un (S (2 * n)) + Un (2 * S n)%nat)) with
+      (Un (2 * S n)%nat); [ idtac | ring ].
+  rewrite H0; apply H.
+  cut (forall n:nat, S n = (n + 1)%nat); [ intro | intro; ring ].
+  rewrite (H0 n); rewrite (H0 (S (2 * n))); rewrite (H0 (2 * n)%nat); ring.
 Qed.
 
 (**********)
 Lemma CV_ALT_step2 :
- forall (Un:nat -> R) (N:nat),
-   Un_decreasing Un ->
-   positivity_seq Un ->
-   sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. 
-intros; induction  N as [| N HrecN].
-simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
-replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ].
-apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r.
-replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat);
- [ apply H | ring ].
-cut (S (2 * S N) = S (S (S (2 * N)))).
-intro; rewrite H1; do 2 rewrite tech5.
-apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))).
-pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *;
- rewrite <- Rplus_0_r.
-rewrite Rplus_assoc; apply Rplus_le_compat_l.
-unfold tg_alt in |- *; rewrite <- H1.
-rewrite pow_1_odd.
-cut (S (S (2 * S N)) = (2 * S (S N))%nat).
-intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2.
-apply Rplus_le_reg_l with (Un (S (2 * S N))).
-rewrite Rplus_0_r;
- replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N)))))
-  with (Un (S (S (2 * 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.
+  forall (Un:nat -> R) (N:nat),
+    Un_decreasing Un ->
+    positivity_seq Un ->
+    sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N)) <= 0. 
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+  replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ].
+  apply Rplus_le_reg_l with (Un 1%nat); rewrite Rplus_0_r.
+  replace (Un 1%nat + (-1 * Un 1%nat + Un 2%nat)) with (Un 2%nat);
+    [ apply H | ring ].
+  cut (S (2 * S N) = S (S (S (2 * N)))).
+  intro; rewrite H1; do 2 rewrite tech5.
+  apply Rle_trans with (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))).
+  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * N))) at 2 in |- *;
+    rewrite <- Rplus_0_r.
+  rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  unfold tg_alt in |- *; rewrite <- H1.
+  rewrite pow_1_odd.
+  cut (S (S (2 * S N)) = (2 * S (S N))%nat).
+  intro; rewrite H2; rewrite pow_1_even; rewrite Rmult_1_l; rewrite <- H2.
+  apply Rplus_le_reg_l with (Un (S (2 * S N))).
+  rewrite Rplus_0_r;
+    replace (Un (S (2 * S N)) + (-1 * Un (S (2 * S N)) + Un (S (S (2 * S N)))))
+      with (Un (S (S (2 * S N)))); [ idtac | ring ].
+  apply H.
+  ring_nat.
+  apply HrecN.
+  ring_nat.
 Qed.
 
-(* A more general inequality *)
+(** A more general inequality *)
 Lemma CV_ALT_step3 :
- forall (Un:nat -> R) (N:nat),
-   Un_decreasing Un ->
-   positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. 
-intros; induction  N as [| N HrecN].
-simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
-apply Rplus_le_reg_l with (Un 1%nat).
-rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0;
- [ apply H0 | ring ].
-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 (fun i:nat => tg_alt Un (S i)) (S (2 * x))).
-pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *;
- rewrite <- Rplus_0_r.
-apply Rplus_le_compat_l.
-unfold tg_alt in |- *; simpl in |- *.
-replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ].
-rewrite pow_1_even.
-replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with
- (- Un (S (S (S (2 * x))))); [ idtac | ring ].
-apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))).
-rewrite Rplus_0_r; rewrite Rplus_opp_r.
-apply H0.
-apply CV_ALT_step2; assumption.
+  forall (Un:nat -> R) (N:nat),
+    Un_decreasing Un ->
+    positivity_seq Un -> sum_f_R0 (fun i:nat => tg_alt Un (S i)) N <= 0. 
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_r.
+  apply Rplus_le_reg_l with (Un 1%nat).
+  rewrite Rplus_0_r; replace (Un 1%nat + -1 * Un 1%nat) with 0;
+    [ apply H0 | ring ].
+  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 (fun i:nat => tg_alt Un (S i)) (S (2 * x))).
+  pattern (sum_f_R0 (fun i:nat => tg_alt Un (S i)) (S (2 * x))) at 2 in |- *;
+    rewrite <- Rplus_0_r.
+  apply Rplus_le_compat_l.
+  unfold tg_alt in |- *; simpl in |- *.
+  replace (x + (x + 0))%nat with (2 * x)%nat; [ idtac | ring ].
+  rewrite pow_1_even.
+  replace (-1 * (-1 * (-1 * 1)) * Un (S (S (S (2 * x))))) with
+    (- Un (S (S (S (2 * x))))); [ idtac | ring ].
+  apply Rplus_le_reg_l with (Un (S (S (S (2 * x))))).
+  rewrite Rplus_0_r; rewrite Rplus_opp_r.
+  apply H0.
+  apply CV_ALT_step2; assumption.
 Qed.
 
-(**********)
+  (**********)
 Lemma CV_ALT_step4 :
- forall Un:nat -> R,
-   Un_decreasing Un ->
-   positivity_seq Un ->
-   has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
-intros; unfold has_ub in |- *; unfold bound in |- *.
-exists (Un 0%nat).
-unfold is_upper_bound in |- *; intros; elim H1; intros.
-rewrite H2; rewrite decomp_sum.
-replace (tg_alt Un 0) with (Un 0%nat).
-pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r.
-apply Rplus_le_compat_l.
-apply CV_ALT_step3; assumption.
-unfold tg_alt in |- *; simpl in |- *; ring.
-apply lt_O_Sn.
+  forall Un:nat -> R,
+    Un_decreasing Un ->
+    positivity_seq Un ->
+    has_ub (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))).
+Proof.
+  intros; unfold has_ub in |- *; unfold bound in |- *.
+  exists (Un 0%nat).
+  unfold is_upper_bound in |- *; intros; elim H1; intros.
+  rewrite H2; rewrite decomp_sum.
+  replace (tg_alt Un 0) with (Un 0%nat).
+  pattern (Un 0%nat) at 2 in |- *; rewrite <- Rplus_0_r.
+  apply Rplus_le_compat_l.
+  apply CV_ALT_step3; assumption.
+  unfold tg_alt in |- *; simpl in |- *; ring.
+  apply lt_O_Sn.
 Qed.
 
-(* This lemma gives an interesting result about alternated series *)
+(** This lemma gives an interesting result about alternated series *)
 Lemma CV_ALT :
- forall Un:nat -> R,
-   Un_decreasing Un ->
-   positivity_seq Un ->
-   Un_cv Un 0 ->
-   sigT (fun l:R => Un_cv (fun 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 existT with x.
-unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
- unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p.
-intros; cut (0 < eps / 2);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H1 (eps / 2) H5); intros N2 H6.
-elim (p (eps / 2) H5); intros N1 H7.
-set (N := max (S (2 * N1)) N2).
-exists N; intros.
-assert (H9 := even_odd_cor n).
-elim H9; intros P H10.
-cut (N1 <= P)%nat.
-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
- (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))).
-apply Rabs_triang.
-rewrite (double_var eps); apply Rplus_lt_compat.
-rewrite H12; apply H7; assumption.
-rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult;
- rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6;
- rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); 
- apply H6.
-unfold ge in |- *; apply le_trans with n.
-apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ].
-apply le_n_Sn.
-rewrite tech5; ring.
-rewrite H12; apply Rlt_trans with (eps / 2).
-apply H7; assumption.
-unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
- [ rewrite Rmult_1_r | discrR ].
-rewrite double.
-pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l;
- assumption.
-elim H10; intro; apply le_double.
-rewrite <- H11; apply le_trans with N.
-unfold N in |- *; apply le_trans with (S (2 * N1));
- [ apply le_n_Sn | apply le_max_l ].
-assumption.
-apply lt_n_Sm_le.
-rewrite <- H11.
-apply lt_le_trans with N.
-unfold N in |- *; apply lt_le_trans with (S (2 * N1)).
-apply lt_n_Sn.
-apply le_max_l.
-assumption.
+  forall Un:nat -> R,
+    Un_decreasing Un ->
+    positivity_seq Un ->
+    Un_cv Un 0 ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l).
+Proof.
+  intros.
+  assert (H2 := CV_ALT_step0 _ H).
+  assert (H3 := CV_ALT_step4 _ H H0).
+  assert (X := growing_cv _ H2 H3).
+  elim X; intros.
+  apply existT with x.
+  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+    unfold R_dist in H1; unfold Un_cv in p; unfold R_dist in p.
+  intros; cut (0 < eps / 2);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+	[ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H1 (eps / 2) H5); intros N2 H6.
+  elim (p (eps / 2) H5); intros N1 H7.
+  set (N := max (S (2 * N1)) N2).
+  exists N; intros.
+  assert (H9 := even_odd_cor n).
+  elim H9; intros P H10.
+  cut (N1 <= P)%nat.
+  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
+    (Rabs (sum_f_R0 (tg_alt Un) (S n) - x) + Rabs (- tg_alt Un (S n))).
+  apply Rabs_triang.
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  rewrite H12; apply H7; assumption.
+  rewrite Rabs_Ropp; unfold tg_alt in |- *; rewrite Rabs_mult;
+    rewrite pow_1_abs; rewrite Rmult_1_l; unfold Rminus in H6;
+      rewrite Ropp_0 in H6; rewrite <- (Rplus_0_r (Un (S n))); 
+	apply H6.
+  unfold ge in |- *; apply le_trans with n.
+  apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ].
+  apply le_n_Sn.
+  rewrite tech5; ring.
+  rewrite H12; apply Rlt_trans with (eps / 2).
+  apply H7; assumption.
+  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+    [ rewrite Rmult_1_r | discrR ].
+  rewrite double.
+  pattern eps at 1 in |- *; rewrite <- (Rplus_0_r eps); apply Rplus_lt_compat_l;
+    assumption.
+  elim H10; intro; apply le_double.
+  rewrite <- H11; apply le_trans with N.
+  unfold N in |- *; apply le_trans with (S (2 * N1));
+    [ apply le_n_Sn | apply le_max_l ].
+  assumption.
+  apply lt_n_Sm_le.
+  rewrite <- H11.
+  apply lt_le_trans with N.
+  unfold N in |- *; apply lt_le_trans with (S (2 * N1)).
+  apply lt_n_Sn.
+  apply le_max_l.
+  assumption.
 Qed.
 
-(************************************************)
-(*        Convergence of alternated series      *)
-(*                                              *)
-(*         Applications: PI, cos, sin           *)
-(************************************************)
+
+(*************************************************)
+(** *       Convergence of alternated series     *)
 Theorem alternated_series :
- forall Un:nat -> R,
-   Un_decreasing Un ->
-   Un_cv Un 0 ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l).
-intros; apply CV_ALT.
-assumption.
-unfold positivity_seq in |- *; apply decreasing_ineq; assumption.
-assumption.
+  forall Un:nat -> R,
+    Un_decreasing Un ->
+    Un_cv Un 0 ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l).
+Proof.
+  intros; apply CV_ALT.
+  assumption.
+  unfold positivity_seq in |- *; apply decreasing_ineq; assumption.
+  assumption.
 Qed.
 
 Theorem alternated_series_ineq :
- forall (Un:nat -> R) (l:R) (N:nat),
-   Un_decreasing Un ->
-   Un_cv Un 0 ->
-   Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l ->
-   sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N).
-intros.
-cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l).
-cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l).
-intros; split.
-apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))).
-apply CV_ALT_step0; assumption.
-assumption.
-apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))).
-apply CV_ALT_step1; assumption.
-assumption.
-unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
- unfold R_dist in H1; intros. 
-elim (H1 eps H2); intros.
-exists x; intros.
-apply H3.
-unfold ge in |- *; apply le_trans with (2 * n)%nat.
-apply le_trans with n.
-assumption.
-assert (H5 := mult_O_le n 2).
-elim H5; intro. 
-cut (0%nat <> 2%nat);
- [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
-assumption.
-apply le_n_Sn.
-unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
- unfold R_dist in H1; intros. 
-elim (H1 eps H2); intros.
-exists x; intros.
-apply H3.
-unfold ge in |- *; apply le_trans with n.
-assumption.
-assert (H5 := mult_O_le n 2).
-elim H5; intro. 
-cut (0%nat <> 2%nat);
- [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
-assumption.
+  forall (Un:nat -> R) (l:R) (N:nat),
+    Un_decreasing Un ->
+    Un_cv Un 0 ->
+    Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) N) l ->
+    sum_f_R0 (tg_alt Un) (S (2 * N)) <= l <= sum_f_R0 (tg_alt Un) (2 * N).
+Proof.
+  intros.
+  cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N)) l).
+  cut (Un_cv (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N))) l).
+  intros; split.
+  apply (growing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (S (2 * N)))).
+  apply CV_ALT_step0; assumption.
+  assumption.
+  apply (decreasing_ineq (fun N:nat => sum_f_R0 (tg_alt Un) (2 * N))).
+  apply CV_ALT_step1; assumption.
+  assumption.
+  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+    unfold R_dist in H1; intros. 
+  elim (H1 eps H2); intros.
+  exists x; intros.
+  apply H3.
+  unfold ge in |- *; apply le_trans with (2 * n)%nat.
+  apply le_trans with n.
+  assumption.
+  assert (H5 := mult_O_le n 2).
+  elim H5; intro. 
+  cut (0%nat <> 2%nat);
+    [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
+  assumption.
+  apply le_n_Sn.
+  unfold Un_cv in |- *; unfold R_dist in |- *; unfold Un_cv in H1;
+    unfold R_dist in H1; intros. 
+  elim (H1 eps H2); intros.
+  exists x; intros.
+  apply H3.
+  unfold ge in |- *; apply le_trans with n.
+  assumption.
+  assert (H5 := mult_O_le n 2).
+  elim H5; intro. 
+  cut (0%nat <> 2%nat);
+    [ intro; elim H7; symmetry  in |- *; assumption | discriminate ].
+  assumption.
 Qed.
 
-(************************************)
-(* Application : construction of PI *)
-(************************************)
+(***************************************)
+(** * Application : construction of PI *)
+(***************************************)
 
 Definition PI_tg (n:nat) := / INR (2 * n + 1).
 
 Lemma PI_tg_pos : forall n:nat, 0 <= PI_tg n.
-intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0;
- replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+Proof.
+  intro; unfold PI_tg in |- *; left; apply Rinv_0_lt_compat; apply lt_INR_0;
+    replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
 Qed.
 
 Lemma PI_tg_decreasing : Un_decreasing PI_tg.
-unfold PI_tg, Un_decreasing in |- *; intro.
-apply Rmult_le_reg_l with (INR (2 * n + 1)).
-apply lt_INR_0.
-replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (INR (2 * S n + 1)).
-apply lt_INR_0.
-replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ].
-rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-do 2 rewrite Rmult_1_r; apply le_INR.
-replace (2 * S n + 1)%nat with (S (S (2 * n + 1))).
-apply le_trans with (S (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 (2 * n + 1)%nat with (S (2 * n));
- [ discriminate | ring ].
+Proof.
+  unfold PI_tg, Un_decreasing in |- *; intro.
+  apply Rmult_le_reg_l with (INR (2 * n + 1)).
+  apply lt_INR_0.
+  replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (INR (2 * S n + 1)).
+  apply lt_INR_0.
+  replace (2 * S n + 1)%nat with (S (2 * S n)); [ apply lt_O_Sn | ring ].
+  rewrite (Rmult_comm (INR (2 * S n + 1))); rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  do 2 rewrite Rmult_1_r; apply le_INR.
+  replace (2 * S n + 1)%nat with (S (S (2 * n + 1))).
+  apply le_trans with (S (2 * n + 1)); apply le_n_Sn.
+  ring_nat.
+  apply not_O_INR; discriminate.
+  apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n));
+    [ discriminate | ring ].
 Qed.
 
 Lemma PI_tg_cv : Un_cv PI_tg 0.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-cut (0 < 2 * eps);
- [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ].
-assert (H1 := archimed (/ (2 * eps))).
-cut (0 <= up (/ (2 * eps)))%Z.
-intro; assert (H3 := IZN (up (/ (2 * eps))) H2).
-elim H3; intros N H4.
-cut (0 < N)%nat.
-intro; exists N; intros.
-cut (0 < n)%nat.
-intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
- rewrite Rabs_right.
-unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)).
-apply Rmult_lt_reg_l with (INR (2 * n)).
-apply lt_INR_0.
-replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ].
-apply lt_le_trans with n.
-assumption.
-apply le_plus_l.
-rewrite <- Rinv_r_sym.
-apply Rmult_lt_reg_l with (INR (2 * n + 1)).
-apply lt_INR_0.
-replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
-rewrite (Rmult_comm (INR (2 * n + 1))).
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-do 2 rewrite Rmult_1_r; apply lt_INR.
-replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ].
-apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n));
- [ discriminate | ring ].
-replace n with (S (pred n)).
-apply not_O_INR; discriminate.
-symmetry  in |- *; apply S_pred with 0%nat.
-assumption.
-apply Rle_lt_trans with (/ INR (2 * N)).
-apply Rmult_le_reg_l with (INR (2 * N)).
-rewrite mult_INR; apply Rmult_lt_0_compat;
- [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (INR (2 * n)).
-rewrite mult_INR; apply Rmult_lt_0_compat;
- [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
-rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-do 2 rewrite Rmult_1_r; apply le_INR.
-apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
-replace n with (S (pred n)).
-apply not_O_INR; discriminate.
-symmetry  in |- *; apply S_pred with 0%nat.
-assumption.
-replace N with (S (pred N)).
-apply not_O_INR; discriminate.
-symmetry  in |- *; apply S_pred with 0%nat.
-assumption.
-rewrite mult_INR.
-rewrite Rinv_mult_distr.
-replace (INR 2) with 2; [ idtac | reflexivity ].
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ].
-rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N).
-apply lt_INR_0; assumption.
-rewrite <- Rinv_r_sym.
-apply Rmult_lt_reg_l with (/ (2 * eps)).
-apply Rinv_0_lt_compat; assumption.
-rewrite Rmult_1_r;
- replace (/ (2 * eps) * (INR N * (2 * eps))) with
-  (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)).
-rewrite <- H4.
-elim H1; intros; assumption.
-symmetry  in |- *; apply INR_IZR_INZ.
-apply prod_neq_R0;
- [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
-apply not_O_INR.
-red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
-replace (INR 2) with 2; [ discrR | reflexivity ].
-apply not_O_INR.
-red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
-apply Rle_ge; apply PI_tg_pos.
-apply lt_le_trans with N; assumption.
-elim H1; intros H5 _.
-assert (H6 := lt_eq_lt_dec 0 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 Rinv_0_lt_compat; assumption ].
-elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)).
-elim (lt_n_O _ b).
-apply le_IZR.
-simpl in |- *.
-left; apply Rlt_trans with (/ (2 * eps)).
-apply Rinv_0_lt_compat; assumption.
-elim H1; intros; assumption.
+Proof.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  cut (0 < 2 * eps);
+    [ intro | apply Rmult_lt_0_compat; [ prove_sup0 | assumption ] ].
+  assert (H1 := archimed (/ (2 * eps))).
+  cut (0 <= up (/ (2 * eps)))%Z.
+  intro; assert (H3 := IZN (up (/ (2 * eps))) H2).
+  elim H3; intros N H4.
+  cut (0 < N)%nat.
+  intro; exists N; intros.
+  cut (0 < n)%nat.
+  intro; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+    rewrite Rabs_right.
+  unfold PI_tg in |- *; apply Rlt_trans with (/ INR (2 * n)).
+  apply Rmult_lt_reg_l with (INR (2 * n)).
+  apply lt_INR_0.
+  replace (2 * n)%nat with (n + n)%nat; [ idtac | ring ].
+  apply lt_le_trans with n.
+  assumption.
+  apply le_plus_l.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (INR (2 * n + 1)).
+  apply lt_INR_0.
+  replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+  rewrite (Rmult_comm (INR (2 * n + 1))).
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  do 2 rewrite Rmult_1_r; apply lt_INR.
+  replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_n_Sn | ring ].
+  apply not_O_INR; replace (2 * n + 1)%nat with (S (2 * n));
+    [ discriminate | ring ].
+  replace n with (S (pred n)).
+  apply not_O_INR; discriminate.
+  symmetry  in |- *; apply S_pred with 0%nat.
+  assumption.
+  apply Rle_lt_trans with (/ INR (2 * N)).
+  apply Rmult_le_reg_l with (INR (2 * N)).
+  rewrite mult_INR; apply Rmult_lt_0_compat;
+    [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (INR (2 * n)).
+  rewrite mult_INR; apply Rmult_lt_0_compat;
+    [ simpl in |- *; prove_sup0 | apply lt_INR_0; assumption ].
+  rewrite (Rmult_comm (INR (2 * n))); rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  do 2 rewrite Rmult_1_r; apply le_INR.
+  apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
+  replace n with (S (pred n)).
+  apply not_O_INR; discriminate.
+  symmetry  in |- *; apply S_pred with 0%nat.
+  assumption.
+  replace N with (S (pred N)).
+  apply not_O_INR; discriminate.
+  symmetry  in |- *; apply S_pred with 0%nat.
+  assumption.
+  rewrite mult_INR.
+  rewrite Rinv_mult_distr.
+  replace (INR 2) with 2; [ idtac | reflexivity ].
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym; [ idtac | discrR ].
+  rewrite Rmult_1_l; apply Rmult_lt_reg_l with (INR N).
+  apply lt_INR_0; assumption.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (/ (2 * eps)).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite Rmult_1_r;
+    replace (/ (2 * eps) * (INR N * (2 * eps))) with
+      (INR N * (2 * eps * / (2 * eps))); [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; replace (INR N) with (IZR (Z_of_nat N)).
+  rewrite <- H4.
+  elim H1; intros; assumption.
+  symmetry  in |- *; apply INR_IZR_INZ.
+  apply prod_neq_R0;
+    [ discrR | red in |- *; intro; rewrite H8 in H; elim (Rlt_irrefl _ H) ].
+  apply not_O_INR.
+  red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+  replace (INR 2) with 2; [ discrR | reflexivity ].
+  apply not_O_INR.
+  red in |- *; intro; rewrite H8 in H5; elim (lt_irrefl _ H5).
+  apply Rle_ge; apply PI_tg_pos.
+  apply lt_le_trans with N; assumption.
+  elim H1; intros H5 _.
+  assert (H6 := lt_eq_lt_dec 0 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 Rinv_0_lt_compat; assumption ].
+  elim (Rlt_irrefl _ (Rlt_trans _ _ _ H7 H5)).
+  elim (lt_n_O _ b).
+  apply le_IZR.
+  simpl in |- *.
+  left; apply Rlt_trans with (/ (2 * eps)).
+  apply Rinv_0_lt_compat; assumption.
+  elim H1; intros; assumption.
 Qed.
 
 Lemma exist_PI :
- sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l).
-apply alternated_series.
-apply PI_tg_decreasing.
-apply PI_tg_cv.
+  sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 (tg_alt PI_tg) N) l).
+Proof.
+  apply alternated_series.
+  apply PI_tg_decreasing.
+  apply PI_tg_cv.
 Qed.
 
-(* Now, PI is defined *)
+(** Now, PI is defined *)
 Definition PI : R := 4 * match exist_PI with
-                         | existT a b => a
+                           | existT a b => a
                          end.
 
-(* We can get an approximation of PI with the following inequality *)
+(** We can get an approximation of PI with the following inequality *)
 Lemma PI_ineq :
- forall N:nat,
-   sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <=
-   sum_f_R0 (tg_alt PI_tg) (2 * N).
-intro; apply alternated_series_ineq.
-apply PI_tg_decreasing.
-apply PI_tg_cv.
-unfold PI in |- *; case exist_PI; intro.
-replace (4 * x / 4) with x.
-trivial.
-unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc;
- rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ].
+  forall N:nat,
+    sum_f_R0 (tg_alt PI_tg) (S (2 * N)) <= PI / 4 <=
+    sum_f_R0 (tg_alt PI_tg) (2 * N).
+Proof.
+  intro; apply alternated_series_ineq.
+  apply PI_tg_decreasing.
+  apply PI_tg_cv.
+  unfold PI in |- *; case exist_PI; intro.
+  replace (4 * x / 4) with x.
+  trivial.
+  unfold Rdiv in |- *; rewrite (Rmult_comm 4); rewrite Rmult_assoc;
+    rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r; reflexivity | discrR ].
 Qed.
 
 Lemma PI_RGT_0 : 0 < PI.
-assert (H := PI_ineq 0).
-apply Rmult_lt_reg_l with (/ 4).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite Rmult_0_r; rewrite Rmult_comm.
-elim H; clear H; intros H _.
-unfold Rdiv in H;
- apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))).
-simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l;
- rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1).
-rewrite Rplus_0_r;
- replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0);
- [ unfold PI_tg in |- * | ring ].
-simpl in |- *; apply Rinv_lt_contravar.
-rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ].
-rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_lt_compat_l; prove_sup0.
-assumption.
-Qed.
\ No newline at end of file
+Proof.
+  assert (H := PI_ineq 0).
+  apply Rmult_lt_reg_l with (/ 4).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite Rmult_0_r; rewrite Rmult_comm.
+  elim H; clear H; intros H _.
+  unfold Rdiv in H;
+    apply Rlt_le_trans with (sum_f_R0 (tg_alt PI_tg) (S (2 * 0))).
+  simpl in |- *; unfold tg_alt in |- *; simpl in |- *; rewrite Rmult_1_l;
+    rewrite Rmult_1_r; apply Rplus_lt_reg_r with (PI_tg 1).
+  rewrite Rplus_0_r;
+    replace (PI_tg 1 + (PI_tg 0 + -1 * PI_tg 1)) with (PI_tg 0);
+      [ unfold PI_tg in |- * | ring ].
+  simpl in |- *; apply Rinv_lt_contravar.
+  rewrite Rmult_1_l; replace (2 + 1) with 3; [ prove_sup0 | ring ].
+  rewrite Rplus_comm; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_lt_compat_l; prove_sup0.
+  assumption.
+Qed.
diff --git a/theories/Reals/ArithProp.v b/theories/Reals/ArithProp.v
index 24d64c07..48876be2 100644
--- a/theories/Reals/ArithProp.v
+++ b/theories/Reals/ArithProp.v
@@ -1,178 +1,187 @@
-(************************************************************************)
-(*  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 5920 2004-07-16 20:01:26Z herbelin $ i*)
+  (************************************************************************)
+  (*  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 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rbasic_fun.
 Require Import Even.
 Require Import Div2.
+Require Import ArithRing.
+
 Open Local Scope Z_scope.
 Open Local Scope R_scope.
 
 Lemma minus_neq_O : forall n i:nat, (i < n)%nat -> (n - i)%nat <> 0%nat.
-intros; red in |- *; intro.
-cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
-intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H;
- elim (lt_irrefl _ H).
-set (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
-cut
- ((forall n m:nat, R n m) ->
-  forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m).
-intro; apply H1.
-apply nat_double_ind.
-unfold R in |- *; intros; inversion H2; reflexivity.
-unfold R in |- *; intros; simpl in H3; assumption.
-unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3);
- assert (H6 := H2 H5 H4); rewrite H6; reflexivity.
-unfold R in |- *; intros; apply H1; assumption.
+Proof.
+  intros; red in |- *; intro.
+  cut (forall n m:nat, (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
+  intro; assert (H2 := H1 _ _ (lt_le_weak _ _ H) H0); rewrite H2 in H;
+    elim (lt_irrefl _ H).
+  set (R := fun n m:nat => (m <= n)%nat -> (n - m)%nat = 0%nat -> n = m).
+  cut
+    ((forall n m:nat, R n m) ->
+      forall n0 m:nat, (m <= n0)%nat -> (n0 - m)%nat = 0%nat -> n0 = m).
+  intro; apply H1.
+  apply nat_double_ind.
+  unfold R in |- *; intros; inversion H2; reflexivity.
+  unfold R in |- *; intros; simpl in H3; assumption.
+  unfold R in |- *; intros; simpl in H4; assert (H5 := le_S_n _ _ H3);
+    assert (H6 := H2 H5 H4); rewrite H6; reflexivity.
+  unfold R in |- *; intros; apply H1; assumption.
 Qed.
 
 Lemma le_minusni_n : forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat.
-set (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat).
-cut
- ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat).
-intro; apply H.
-apply nat_double_ind.
-unfold R in |- *; intros; simpl in |- *; apply le_n.
-unfold R in |- *; intros; simpl in |- *; apply le_n.
-unfold R in |- *; intros; simpl in |- *; apply le_trans with n.
-apply H0; apply le_S_n; assumption.
-apply le_n_Sn.
-unfold R in |- *; intros; apply H; assumption.
+Proof.
+  set (R := fun m n:nat => (n <= m)%nat -> (m - n <= m)%nat).
+  cut
+    ((forall m n:nat, R m n) -> forall n i:nat, (i <= n)%nat -> (n - i <= n)%nat).
+  intro; apply H.
+  apply nat_double_ind.
+  unfold R in |- *; intros; simpl in |- *; apply le_n.
+  unfold R in |- *; intros; simpl in |- *; apply le_n.
+  unfold R in |- *; intros; simpl in |- *; apply le_trans with n.
+  apply H0; apply le_S_n; assumption.
+  apply le_n_Sn.
+  unfold R in |- *; intros; apply H; assumption.
 Qed.
 
 Lemma lt_minus_O_lt : forall m n:nat, (m < n)%nat -> (0 < n - m)%nat.
-intros n m; pattern n, m in |- *; apply nat_double_ind;
- [ intros; rewrite <- minus_n_O; assumption
- | intros; elim (lt_n_O _ H)
- | intros; simpl in |- *; apply H; apply lt_S_n; assumption ].
+Proof.
+  intros n m; pattern n, m in |- *; apply nat_double_ind;
+    [ intros; rewrite <- minus_n_O; assumption
+      | intros; elim (lt_n_O _ H)
+      | intros; simpl in |- *; apply H; apply lt_S_n; assumption ].
 Qed.
 
 Lemma even_odd_cor :
- forall n:nat,  exists p : nat, n = (2 * p)%nat \/ n = S (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 (2 * div2 n)%nat with (double (div2 n)).
-elim H; intro.
-left.
-apply H3; assumption.
-right.
-apply H4; assumption.
-unfold double in |- *; ring.
+  forall n:nat,  exists p : nat, n = (2 * p)%nat \/ n = S (2 * p).
+Proof.
+  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 (2 * div2 n)%nat with (double (div2 n)).
+  elim H; intro.
+  left.
+  apply H3; assumption.
+  right.
+  apply H4; assumption.
+  unfold double in |- *; ring.
 Qed.
 
-(* 2m <= 2n => m<=n *)
+  (* 2m <= 2n => m<=n *)
 Lemma le_double : forall m n:nat, (2 * m <= 2 * n)%nat -> (m <= n)%nat.
-intros; apply INR_le.
-assert (H1 := le_INR _ _ H).
-do 2 rewrite mult_INR in H1.
-apply Rmult_le_reg_l with (INR 2).
-replace (INR 2) with 2; [ prove_sup0 | reflexivity ].
-assumption.
+Proof.
+  intros; apply INR_le.
+  assert (H1 := le_INR _ _ H).
+  do 2 rewrite mult_INR in H1.
+  apply Rmult_le_reg_l with (INR 2).
+  replace (INR 2) with 2; [ prove_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 *)
+(** 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 :
- forall x y:R,
-   y <> 0 ->
+  forall x y:R,
+    y <> 0 ->
     exists k : Z, (exists r : R, x = IZR k * y + r /\ 0 <= r < Rabs y).
-intros.
-set
- (k0 :=
-  match Rcase_abs y with
-  | left _ => (1 - up (x / - y))%Z
-  | right _ => (up (x / y) - 1)%Z
-  end).
-exists k0.
-exists (x - IZR k0 * y).
-split.
-ring.
-unfold k0 in |- *; case (Rcase_abs y); intro.
-assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *;
- unfold Rminus in |- *.
-replace (- ((1 + - IZR (up (x / - y))) * y)) with
- ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ].
-split.
-apply Rmult_le_reg_l with (/ - y).
-apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
-rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
- rewrite <- Ropp_inv_permute; [ idtac | assumption ].
-rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
- rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ].
-apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y).
-rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *;
- rewrite <- Ropp_inv_permute; [ idtac | assumption ].
-replace
- (IZR (up (x * / - y)) - x * - / y +
-  (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; 
- [ idtac | ring ].
-elim H0; intros _ H1; unfold Rdiv in H1; exact H1.
-rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y).
-apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
-rewrite <- Rinv_l_sym.
-rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
- rewrite <- Ropp_inv_permute; [ idtac | assumption ].
-rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
- rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ];
- apply Rplus_lt_reg_r 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_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0;
- unfold Rdiv in |- *; intros H1 _; exact H1.
-apply Ropp_neq_0_compat; assumption.
-assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *;
- cut (0 < y).
-intro; unfold Rminus in |- *;
- replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y);
- [ idtac | ring ].
-split.
-apply Rmult_le_reg_l with (/ y).
-apply Rinv_0_lt_compat; assumption.
-rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r;
- rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
- [ rewrite Rmult_1_r | assumption ];
- apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); 
- rewrite Rplus_0_r; unfold Rdiv in |- *;
- replace
-  (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with
-  1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; 
- exact H2.
-rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y).
-apply Rinv_0_lt_compat; assumption.
-rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y));
- rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
- [ rewrite Rmult_1_r | assumption ];
- apply Rplus_lt_reg_r 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 in |- *; 
- intros H2 _; exact H2.
-case (total_order_T 0 y); intro.
-elim s; intro.
-assumption.
-elim H; symmetry  in |- *; exact b.
-assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)).
+Proof.
+  intros.
+  set
+    (k0 :=
+      match Rcase_abs y with
+	| left _ => (1 - up (x / - y))%Z
+	| right _ => (up (x / y) - 1)%Z
+      end).
+  exists k0.
+  exists (x - IZR k0 * y).
+  split.
+  ring.
+  unfold k0 in |- *; case (Rcase_abs y); intro.
+  assert (H0 := archimed (x / - y)); rewrite <- Z_R_minus; simpl in |- *;
+    unfold Rminus in |- *.
+  replace (- ((1 + - IZR (up (x / - y))) * y)) with
+    ((IZR (up (x / - y)) - 1) * y); [ idtac | ring ].
+  split.
+  apply Rmult_le_reg_l with (/ - y).
+  apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+  rewrite Rmult_0_r; rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
+    rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+  rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
+    rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ].
+  apply Rplus_le_reg_l with (IZR (up (x / - y)) - x / - y).
+  rewrite Rplus_0_r; unfold Rdiv in |- *; pattern (/ - y) at 4 in |- *;
+    rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+  replace
+    (IZR (up (x * / - y)) - x * - / y +
+      (- (x * / y) + - (IZR (up (x * / - y)) - 1))) with 1; 
+    [ idtac | ring ].
+  elim H0; intros _ H1; unfold Rdiv in H1; exact H1.
+  rewrite (Rabs_left _ r); apply Rmult_lt_reg_l with (/ - y).
+  apply Rinv_0_lt_compat; apply Ropp_0_gt_lt_contravar; exact r.
+  rewrite <- Rinv_l_sym.
+  rewrite (Rmult_comm (/ - y)); rewrite Rmult_plus_distr_r;
+    rewrite <- Ropp_inv_permute; [ idtac | assumption ].
+  rewrite Rmult_assoc; repeat rewrite Ropp_mult_distr_r_reverse;
+    rewrite <- Rinv_r_sym; [ rewrite Rmult_1_r | assumption ];
+      apply Rplus_lt_reg_r 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_mult_distr_r_reverse; rewrite (Ropp_inv_permute _ H); elim H0;
+    unfold Rdiv in |- *; intros H1 _; exact H1.
+  apply Ropp_neq_0_compat; assumption.
+  assert (H0 := archimed (x / y)); rewrite <- Z_R_minus; simpl in |- *;
+    cut (0 < y).
+  intro; unfold Rminus in |- *;
+    replace (- ((IZR (up (x / y)) + -1) * y)) with ((1 - IZR (up (x / y))) * y);
+      [ idtac | ring ].
+  split.
+  apply Rmult_le_reg_l with (/ y).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite Rmult_0_r; rewrite (Rmult_comm (/ y)); rewrite Rmult_plus_distr_r;
+    rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
+      [ rewrite Rmult_1_r | assumption ];
+      apply Rplus_le_reg_l with (IZR (up (x / y)) - x / y); 
+	rewrite Rplus_0_r; unfold Rdiv in |- *;
+	  replace
+	    (IZR (up (x * / y)) - x * / y + (x * / y + (1 - IZR (up (x * / y))))) with
+	    1; [ idtac | ring ]; elim H0; intros _ H2; unfold Rdiv in H2; 
+	      exact H2.
+  rewrite (Rabs_right _ r); apply Rmult_lt_reg_l with (/ y).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite <- (Rinv_l_sym _ H); rewrite (Rmult_comm (/ y));
+    rewrite Rmult_plus_distr_r; rewrite Rmult_assoc; rewrite <- Rinv_r_sym;
+      [ rewrite Rmult_1_r | assumption ];
+      apply Rplus_lt_reg_r 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 in |- *; 
+	      intros H2 _; exact H2.
+  case (total_order_T 0 y); intro.
+  elim s; intro.
+  assumption.
+  elim H; symmetry  in |- *; exact b.
+  assert (H1 := Rge_le _ _ r); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r0)).
 Qed.
 
 Lemma tech8 : forall n i:nat, (n <= S n + i)%nat.
-intros; induction  i as [| i Hreci].
-replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ].
-replace (S n + S i)%nat with (S (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.
\ No newline at end of file
+Proof.
+  intros; induction  i as [| i Hreci].
+  replace (S n + 0)%nat with (S n); [ apply le_n_Sn | ring ].
+  replace (S n + S i)%nat with (S (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/theories/Reals/Binomial.v b/theories/Reals/Binomial.v
index 940bd628..5be34e71 100644
--- a/theories/Reals/Binomial.v
+++ b/theories/Reals/Binomial.v
@@ -1,12 +1,12 @@
-(************************************************************************)
-(*  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 6295 2004-11-12 16:40:39Z gregoire $ i*)
+  (************************************************************************)
+  (*  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 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -17,188 +17,193 @@ Definition C (n p:nat) : R :=
   INR (fact n) / (INR (fact p) * INR (fact (n - p))).
 
 Lemma pascal_step1 : forall n i:nat, (i <= n)%nat -> C n i = C n (n - i).
-intros; unfold C in |- *; replace (n - (n - i))%nat with i.
-rewrite Rmult_comm.
-reflexivity.
-apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption.
+Proof.
+  intros; unfold C in |- *; replace (n - (n - i))%nat with i.
+  rewrite Rmult_comm.
+  reflexivity.
+  apply plus_minus; rewrite plus_comm; apply le_plus_minus; assumption.
 Qed.
 
 Lemma pascal_step2 :
- forall n i:nat,
-   (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i.
-intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)).
-cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
-intro; repeat rewrite H0.
-unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
-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.
+  forall n i:nat,
+    (i <= n)%nat -> C (S n) i = INR (S n) / INR (S n - i) * C n i.
+Proof.
+  intros; unfold C in |- *; replace (S n - i)%nat with (S (n - i)).
+  cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
+  intro; repeat rewrite H0.
+  unfold Rdiv in |- *; repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
+  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 :
- forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i.
-intros; unfold C in |- *.
-cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
-intro.
-cut ((n - i)%nat = S (n - S i)).
-intro.
-pattern (n - i)%nat at 2 in |- *; rewrite H1.
-repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR;
- repeat rewrite Rinv_mult_distr.
-rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i)));
- repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (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 in |- *; reflexivity.
-apply lt_le_S; assumption.
-intro; reflexivity.
+  forall n i:nat, (i < n)%nat -> C n (S i) = INR (n - i) / INR (S i) * C n i.
+Proof.
+  intros; unfold C in |- *.
+  cut (forall n:nat, fact (S n) = (S n * fact n)%nat).
+  intro.
+  cut ((n - i)%nat = S (n - S i)).
+  intro.
+  pattern (n - i)%nat at 2 in |- *; rewrite H1.
+  repeat rewrite H0; unfold Rdiv in |- *; repeat rewrite mult_INR;
+    repeat rewrite Rinv_mult_distr.
+  rewrite <- H1; rewrite (Rmult_comm (/ INR (n - i)));
+    repeat rewrite Rmult_assoc; rewrite (Rmult_comm (INR (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 in |- *; reflexivity.
+  apply lt_le_S; assumption.
+  intro; reflexivity.
 Qed.
 
-(**********)
+  (**********)
 Lemma pascal :
- forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i).
-intros.
-rewrite pascal_step3; [ idtac | assumption ].
-replace (C n i + INR (n - i) / INR (S i) * C n i) with
- (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ].
-replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)).
-rewrite pascal_step1.
-rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat.
-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 ((n - (n - i))%nat = i).
-intro; rewrite H0; reflexivity.
-symmetry  in |- *; apply plus_minus.
-rewrite plus_comm; rewrite le_plus_minus_r.
-reflexivity.
-apply lt_le_weak; assumption.
-apply le_minusni_n; apply lt_le_weak; assumption.
-apply lt_le_weak; assumption.
-unfold Rdiv in |- *.
-repeat rewrite S_INR.
-rewrite minus_INR.
-cut (INR i + 1 <> 0).
-intro.
-apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ].
-rewrite Rmult_plus_distr_l.
-rewrite Rmult_1_r.
-do 2 rewrite (Rmult_comm (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.
+  forall n i:nat, (i < n)%nat -> C n i + C n (S i) = C (S n) (S i).
+Proof.
+  intros.
+  rewrite pascal_step3; [ idtac | assumption ].
+  replace (C n i + INR (n - i) / INR (S i) * C n i) with
+    (C n i * (1 + INR (n - i) / INR (S i))); [ idtac | ring ].
+  replace (1 + INR (n - i) / INR (S i)) with (INR (S n) / INR (S i)).
+  rewrite pascal_step1.
+  rewrite Rmult_comm; replace (S i) with (S n - (n - i))%nat.
+  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 ((n - (n - i))%nat = i).
+  intro; rewrite H0; reflexivity.
+  symmetry  in |- *; apply plus_minus.
+  rewrite plus_comm; rewrite le_plus_minus_r.
+  reflexivity.
+  apply lt_le_weak; assumption.
+  apply le_minusni_n; apply lt_le_weak; assumption.
+  apply lt_le_weak; assumption.
+  unfold Rdiv in |- *.
+  repeat rewrite S_INR.
+  rewrite minus_INR.
+  cut (INR i + 1 <> 0).
+  intro.
+  apply Rmult_eq_reg_l with (INR i + 1); [ idtac | assumption ].
+  rewrite Rmult_plus_distr_l.
+  rewrite Rmult_1_r.
+  do 2 rewrite (Rmult_comm (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 :
- forall (x y:R) (n:nat),
-   (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n.
-intros; induction  n as [| n Hrecn].
-unfold C in |- *; simpl in |- *; unfold Rdiv in |- *;
- repeat rewrite Rmult_1_r; rewrite Rinv_1; ring.
-pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite pow_add; rewrite Hrecn.
-replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ].
-rewrite tech5.
-cut (forall p:nat, C p p = 1).
-cut (forall p:nat, C p 0 = 1).
-intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l.
-replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ].
-induction  n as [| n Hrecn0].
-simpl in |- *; do 2 rewrite H; ring.
-(* N >= 1 *)
-set (N := S n).
-rewrite Rmult_plus_distr_l.
-replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with
- (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N).
-replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with
- (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N).
-rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N).
-rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ].
-do 2 rewrite Rmult_1_l.
-replace (S N - 0)%nat with (S N); [ idtac | reflexivity ].
-set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)).
-set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)).
-replace (pred N) with n.
-replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n)
- with (sum_f_R0 (fun i:nat => An i + Bn i) n).
-rewrite plus_sum.
-replace (x ^ S N) with (An (S n)).
-rewrite (Rplus_comm (sum_f_R0 An n)).
-repeat rewrite Rplus_assoc.
-rewrite <- tech5.
-fold N in |- *.
-set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)).
-cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i).
-intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n).
-replace (y ^ S N) with (Cn 0%nat).
-rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N).
-replace (pred N) with n.
-ring.
-unfold N in |- *; simpl in |- *; reflexivity.
-unfold N in |- *; apply lt_O_Sn.
-unfold Cn in |- *; rewrite H; simpl in |- *; ring.
-apply sum_eq.
-intros; apply H1.
-unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
-intros; unfold Bn, Cn in |- *.
-replace (S N - S i)%nat with (N - i)%nat; reflexivity.
-unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0;
- simpl in |- *; ring.
-apply sum_eq.
-intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat;
- [ idtac | reflexivity ].
-rewrite <- pascal;
- [ ring
- | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ].
-unfold N in |- *; reflexivity.
-unfold N in |- *; apply lt_O_Sn.
-rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq.
-intros; replace (S N - i)%nat with (S (N - i)).
-replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ].
-rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ];
- ring.
-apply minus_Sn_m; assumption.
-rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq.
-intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add;
- replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; 
- ring.
-intro; unfold C in |- *.
-replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
-replace (p - 0)%nat with p; [ idtac | apply minus_n_O ].
-rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
- [ reflexivity | apply INR_fact_neq_0 ].
-intro; unfold C in |- *.
-replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ].
-replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
-rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
- [ reflexivity | apply INR_fact_neq_0 ].
+  forall (x y:R) (n:nat),
+    (x + y) ^ n = sum_f_R0 (fun i:nat => C n i * x ^ i * y ^ (n - i)) n.
+Proof.
+  intros; induction  n as [| n Hrecn].
+  unfold C in |- *; simpl in |- *; unfold Rdiv in |- *;
+    repeat rewrite Rmult_1_r; rewrite Rinv_1; ring.
+  pattern (S n) at 1 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; rewrite Hrecn.
+  replace ((x + y) ^ 1) with (x + y); [ idtac | simpl in |- *; ring ].
+  rewrite tech5.
+  cut (forall p:nat, C p p = 1).
+  cut (forall p:nat, C p 0 = 1).
+  intros; rewrite H0; rewrite <- minus_n_n; rewrite Rmult_1_l.
+  replace (y ^ 0) with 1; [ rewrite Rmult_1_r | simpl in |- *; reflexivity ].
+  induction  n as [| n Hrecn0].
+  simpl in |- *; do 2 rewrite H; ring.
+  (* N >= 1 *)
+  set (N := S n).
+  rewrite Rmult_plus_distr_l.
+  replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * x) with
+    (sum_f_R0 (fun i:nat => C N i * x ^ S i * y ^ (N - i)) N).
+  replace (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (N - i)) N * y) with
+    (sum_f_R0 (fun i:nat => C N i * x ^ i * y ^ (S N - i)) N).
+  rewrite (decomp_sum (fun i:nat => C (S N) i * x ^ i * y ^ (S N - i)) N).
+  rewrite H; replace (x ^ 0) with 1; [ idtac | reflexivity ].
+  do 2 rewrite Rmult_1_l.
+  replace (S N - 0)%nat with (S N); [ idtac | reflexivity ].
+  set (An := fun i:nat => C N i * x ^ S i * y ^ (N - i)).
+  set (Bn := fun i:nat => C N (S i) * x ^ S i * y ^ (N - i)).
+  replace (pred N) with n.
+  replace (sum_f_R0 (fun i:nat => C (S N) (S i) * x ^ S i * y ^ (S N - S i)) n)
+    with (sum_f_R0 (fun i:nat => An i + Bn i) n).
+  rewrite plus_sum.
+  replace (x ^ S N) with (An (S n)).
+  rewrite (Rplus_comm (sum_f_R0 An n)).
+  repeat rewrite Rplus_assoc.
+  rewrite <- tech5.
+  fold N in |- *.
+  set (Cn := fun i:nat => C N i * x ^ i * y ^ (S N - i)).
+  cut (forall i:nat, (i < N)%nat -> Cn (S i) = Bn i).
+  intro; replace (sum_f_R0 Bn n) with (sum_f_R0 (fun i:nat => Cn (S i)) n).
+  replace (y ^ S N) with (Cn 0%nat).
+  rewrite <- Rplus_assoc; rewrite (decomp_sum Cn N).
+  replace (pred N) with n.
+  ring.
+  unfold N in |- *; simpl in |- *; reflexivity.
+  unfold N in |- *; apply lt_O_Sn.
+  unfold Cn in |- *; rewrite H; simpl in |- *; ring.
+  apply sum_eq.
+  intros; apply H1.
+  unfold N in |- *; apply le_lt_trans with n; [ assumption | apply lt_n_Sn ].
+  intros; unfold Bn, Cn in |- *.
+  replace (S N - S i)%nat with (N - i)%nat; reflexivity.
+  unfold An in |- *; fold N in |- *; rewrite <- minus_n_n; rewrite H0;
+    simpl in |- *; ring.
+  apply sum_eq.
+  intros; unfold An, Bn in |- *; replace (S N - S i)%nat with (N - i)%nat;
+    [ idtac | reflexivity ].
+  rewrite <- pascal;
+    [ ring
+      | apply le_lt_trans with n; [ assumption | unfold N in |- *; apply lt_n_Sn ] ].
+  unfold N in |- *; reflexivity.
+  unfold N in |- *; apply lt_O_Sn.
+  rewrite <- (Rmult_comm y); rewrite scal_sum; apply sum_eq.
+  intros; replace (S N - i)%nat with (S (N - i)).
+  replace (S (N - i)) with (N - i + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; replace (y ^ 1) with y; [ idtac | simpl in |- *; ring ];
+    ring.
+  apply minus_Sn_m; assumption.
+  rewrite <- (Rmult_comm x); rewrite scal_sum; apply sum_eq.
+  intros; replace (S i) with (i + 1)%nat; [ idtac | ring ]; rewrite pow_add;
+    replace (x ^ 1) with x; [ idtac | simpl in |- *; ring ]; 
+      ring.
+  intro; unfold C in |- *.
+  replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
+  replace (p - 0)%nat with p; [ idtac | apply minus_n_O ].
+  rewrite Rmult_1_l; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+    [ reflexivity | apply INR_fact_neq_0 ].
+  intro; unfold C in |- *.
+  replace (p - p)%nat with 0%nat; [ idtac | apply minus_n_n ].
+  replace (INR (fact 0)) with 1; [ idtac | reflexivity ].
+  rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym;
+    [ reflexivity | apply INR_fact_neq_0 ].
 Qed.
diff --git a/theories/Reals/Cauchy_prod.v b/theories/Reals/Cauchy_prod.v
index 7f3727c7..37429a90 100644
--- a/theories/Reals/Cauchy_prod.v
+++ b/theories/Reals/Cauchy_prod.v
@@ -1,12 +1,12 @@
-(************************************************************************)
-(*  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 5920 2004-07-16 20:01:26Z herbelin $ i*)
+  (************************************************************************)
+  (*  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 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -14,445 +14,449 @@ Require Import Rseries.
 Require Import PartSum.
 Open Local Scope R_scope.
 
-(**********)
+  (**********)
 Lemma sum_N_predN :
- forall (An:nat -> R) (N:nat),
-   (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N.
-intros.
-replace N with (S (pred N)).
-rewrite tech5.
-reflexivity.
-symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  forall (An:nat -> R) (N:nat),
+    (0 < N)%nat -> sum_f_R0 An N = sum_f_R0 An (pred N) + An N.
+Proof.
+  intros.
+  replace N with (S (pred N)).
+  rewrite tech5.
+  reflexivity.
+  symmetry  in |- *; apply S_pred with 0%nat; assumption.
 Qed.
 
-(**********)
+  (**********)
 Lemma sum_plus :
- forall (An Bn:nat -> R) (N:nat),
-   sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N.
-intros.
-induction  N as [| N HrecN].
-reflexivity.
-do 3 rewrite tech5.
-rewrite HrecN; ring.
+  forall (An Bn:nat -> R) (N:nat),
+    sum_f_R0 (fun l:nat => An l + Bn l) N = sum_f_R0 An N + sum_f_R0 Bn N.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  reflexivity.
+  do 3 rewrite tech5.
+  rewrite HrecN; ring.
 Qed.
 
-(* The main result *)
+  (* The main result *)
 Theorem cauchy_finite :
- forall (An Bn:nat -> R) (N:nat),
-   (0 < N)%nat ->
-   sum_f_R0 An N * sum_f_R0 Bn N =
-   sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N +
-   sum_f_R0
-     (fun k:nat =>
-        sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat)
-          (pred (N - k))) (pred N). 
-intros; induction  N as [| N HrecN].
-elim (lt_irrefl _ H).
-cut (N = 0%nat \/ (0 < N)%nat).
-intro; elim H0; intro.
-rewrite H1; simpl in |- *; ring.
-replace (pred (S N)) with (S (pred N)).
-do 5 rewrite tech5.
-rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1).
-repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
-replace (pred (S N - S (pred N))) with 0%nat.
-rewrite Rmult_plus_distr_l;
- replace
-  (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with
-  (An (S N) * Bn (S N)).
-repeat rewrite <- Rplus_assoc;
- do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N)));
- repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
-rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat).
-intro; elim H2; intro.
-rewrite H3; simpl in |- *; ring.
-replace
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
-    (pred N)) with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (pred (N - k)))) (pred (pred N)) +
-  sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
-replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with
- (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) +
-  An 0%nat * Bn (S N)).
-repeat rewrite <- Rplus_assoc;
- rewrite <-
-  (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)))
-  ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
-replace
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
-         (pred (S N - k))) (pred N)) with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k))) (pred N) +
-  Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)).
-rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r;
- repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N)));
- repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
-repeat rewrite <- Rplus_assoc;
- rewrite <-
-  (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N)))
-  ;
- rewrite <-
-  (Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N)))
-  ; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc;
- apply Rplus_eq_compat_l.
-replace
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k))) (pred N)) with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (pred (N - k)))) (pred (pred N)) +
-  An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)).
-rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l.
-set
- (Z :=
-  sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (pred (N - k)))) (pred (pred N)));
- set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); 
- ring.
-rewrite
- (sum_N_predN
+  forall (An Bn:nat -> R) (N:nat),
+    (0 < N)%nat ->
+    sum_f_R0 An N * sum_f_R0 Bn N =
+    sum_f_R0 (fun k:nat => sum_f_R0 (fun p:nat => An p * Bn (k - p)%nat) k) N +
+    sum_f_R0
     (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k))) (pred N)).
-replace
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k))) (pred (pred N))) with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (pred (N - k))) + An (S N) * Bn (S k)) (
-    pred (pred N))).
-rewrite
- (sum_plus
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k))
-    (pred (pred N))).
-repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
-replace (pred (N - pred N)) with 0%nat.
-simpl in |- *; rewrite <- minus_n_O.
-replace (S (pred N)) with N.
-replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with
- (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))).
-rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N)));
- rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)).
-replace (S (pred N)) with N.
-ring.
-apply S_pred with 0%nat; assumption.
-apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
-apply sum_eq; intros; apply Rmult_comm.
-apply S_pred with 0%nat; assumption.
-replace (N - pred N)%nat with 1%nat.
-reflexivity.
-pattern N at 1 in |- *; replace N with (S (pred N)).
-rewrite <- minus_Sn_m.
-rewrite <- minus_n_n; reflexivity.
-apply le_n.
-symmetry  in |- *; apply S_pred with 0%nat; assumption.
-apply sum_eq; intros;
- rewrite
-  (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat)
-     (pred (N - i))).
-replace (S (S (pred (N - i) + i))) with (S N).
-replace (N - pred (N - i))%nat 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 Rplus_le_reg_l with (INR i - 1).
-replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
-replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ 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%nat.
-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 (N - i))) with (N - i)%nat.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with i; rewrite le_plus_minus_r.
-replace (i + 0)%nat 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%nat.
-apply lt_n_Sn.
-assumption.
-apply S_pred with 0%nat; assumption.
-assumption.
-apply le_trans with (pred (pred N)).
-assumption.
-apply le_trans with (pred N); apply le_pred_n.
-apply S_pred with 0%nat; 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 Rplus_le_reg_l with (INR i - 1).
-replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
-replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1); [ 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%nat.
-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%nat.
-apply lt_O_Sn.
-apply INR_le.
-rewrite pred_of_minus.
-repeat rewrite minus_INR.
-apply Rplus_le_reg_l with (INR i - 1).
-replace (INR i - 1 + INR 1) with (INR i); [ idtac | ring ].
-replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1).
-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 (fun p n m:nat => plus_le_reg_l n m p) with 1%nat.
-rewrite le_plus_minus_r.
-simpl in |- *; assumption.
-apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
-apply le_trans with 2%nat; [ 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 (fun p n m:nat => plus_le_reg_l n m p) with i.
-rewrite le_plus_minus_r.
-replace (i + 1)%nat 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  in |- *; apply S_pred with 0%nat; assumption.
-apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity.
-apply le_trans with (pred (pred N)).
-assumption.
-apply le_trans with (pred N); apply le_pred_n.
-apply lt_le_trans with 1%nat.
-apply lt_O_Sn.
-apply le_S_n.
-replace (S (pred N)) with N.
-assumption.
-apply S_pred with 0%nat; assumption.
-replace
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
-         (pred (S N - k))) (pred N)) with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k)) + An (S k) * Bn (S N)) (pred N)).
-rewrite
- (sum_plus
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
-         (pred (N - k))) (fun k:nat => An (S k) * Bn (S N)))
- .
-apply Rplus_eq_compat_l.
-rewrite scal_sum; reflexivity.
-apply sum_eq; intros; rewrite Rplus_comm;
- rewrite
-  (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat)
-     (pred (S N - i))).
-replace (0 + i)%nat with i; [ idtac | ring ].
-rewrite <- minus_n_O; apply Rplus_eq_compat_l.
-replace (pred (pred (S N - i))) with (pred (N - i)).
-apply sum_eq; intros.
-replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ].
-replace (S i0 + i)%nat with (S (i0 + i)).
-reflexivity.
-apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring.
-cut ((N - i)%nat = pred (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 (fun p n m:nat => plus_le_reg_l n m p) with i.
-rewrite le_plus_minus_r.
-replace (i + 1)%nat 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 (S N - i)) with (S N - S i)%nat.
-replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ].
-apply plus_lt_reg_l with i.
-rewrite le_plus_minus_r.
-replace (i + 0)%nat 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 (fun p n m:nat => plus_le_reg_l n m p) with i.
-rewrite le_plus_minus_r.
-replace (i + 1)%nat 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_comm.
-rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N).
-rewrite <- minus_n_O.
-apply Rplus_eq_compat_l.
-apply sum_eq; intros.
-reflexivity.
-assumption.
-rewrite Rplus_comm.
-rewrite
- (decomp_sum
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
-    (pred N)).
-rewrite <- minus_n_O.
-replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N))
- with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
-apply Rplus_eq_compat_l.
-apply sum_eq; intros.
-replace (pred (N - S i)) with (pred (pred (N - i))).
-apply sum_eq; intros.
-replace (i0 + S i)%nat with (S (i0 + i)).
-reflexivity.
-apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; ring.
-cut (pred (N - i) = (N - S i)%nat).
-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 0%nat.
-apply lt_S_n.
-replace (S (pred N)) with N.
-apply lt_le_trans with 2%nat.
-apply lt_n_Sn.
-assumption.
-apply S_pred with 0%nat; assumption.
-apply le_trans with (pred (pred N)).
-assumption.
-apply le_trans with (pred N); apply le_pred_n.
-apply (fun p n m:nat => plus_le_reg_l n m p) with i.
-rewrite le_plus_minus_r.
-replace (i + 1)%nat 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  in |- *; apply S_pred with 0%nat; 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 (i + 0)%nat with i; [ reflexivity | trivial ].
-apply lt_S_n.
-replace (S (pred N)) with N.
-apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
-apply S_pred with 0%nat; assumption.
-inversion H1.
-left; reflexivity.
-right; apply le_n_S; assumption.
-simpl in |- *.
-replace (S (pred N)) with N.
-reflexivity.
-apply S_pred with 0%nat; assumption.
-simpl in |- *.
-cut ((N - pred N)%nat = 1%nat).
-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 in |- *; symmetry  in |- *; apply S_pred with 0%nat; assumption.
-inversion H.
-left; reflexivity.
-right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ].
-Qed.
\ No newline at end of file
+      sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat)
+      (pred (N - k))) (pred N). 
+Proof.
+  intros; induction  N as [| N HrecN].
+  elim (lt_irrefl _ H).
+  cut (N = 0%nat \/ (0 < N)%nat).
+  intro; elim H0; intro.
+  rewrite H1; simpl in |- *; ring.
+  replace (pred (S N)) with (S (pred N)).
+  do 5 rewrite tech5.
+  rewrite Rmult_plus_distr_r; rewrite Rmult_plus_distr_l; rewrite (HrecN H1).
+  repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+  replace (pred (S N - S (pred N))) with 0%nat.
+  rewrite Rmult_plus_distr_l;
+    replace
+      (sum_f_R0 (fun l:nat => An (S (l + S (pred N))) * Bn (S N - l)%nat) 0) with
+      (An (S N) * Bn (S N)).
+  repeat rewrite <- Rplus_assoc;
+    do 2 rewrite <- (Rplus_comm (An (S N) * Bn (S N)));
+      repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+  rewrite <- minus_n_n; cut (N = 1%nat \/ (2 <= N)%nat).
+  intro; elim H2; intro.
+  rewrite H3; simpl in |- *; ring.
+  replace
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
+      (pred N)) with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (pred (N - k)))) (pred (pred N)) +
+      sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
+  replace (sum_f_R0 (fun p:nat => An p * Bn (S N - p)%nat) N) with
+    (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N) +
+      An 0%nat * Bn (S N)).
+  repeat rewrite <- Rplus_assoc;
+    rewrite <-
+      (Rplus_comm (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)))
+      ; repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+  replace
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
+        (pred (S N - k))) (pred N)) with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k))) (pred N) +
+      Bn (S N) * sum_f_R0 (fun l:nat => An (S l)) (pred N)).
+  rewrite (decomp_sum An N H1); rewrite Rmult_plus_distr_r;
+    repeat rewrite <- Rplus_assoc; rewrite <- (Rplus_comm (An 0%nat * Bn (S N)));
+      repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+  repeat rewrite <- Rplus_assoc;
+    rewrite <-
+      (Rplus_comm (sum_f_R0 (fun i:nat => An (S i)) (pred N) * Bn (S N)))
+      ;
+      rewrite <-
+	(Rplus_comm (Bn (S N) * sum_f_R0 (fun i:nat => An (S i)) (pred N)))
+	; rewrite (Rmult_comm (Bn (S N))); repeat rewrite Rplus_assoc;
+	  apply Rplus_eq_compat_l.
+  replace
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k))) (pred N)) with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (pred (N - k)))) (pred (pred N)) +
+      An (S N) * sum_f_R0 (fun l:nat => Bn (S l)) (pred N)).
+  rewrite (decomp_sum Bn N H1); rewrite Rmult_plus_distr_l.
+  set
+    (Z :=
+      sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (pred (N - k)))) (pred (pred N)));
+    set (Z2 := sum_f_R0 (fun i:nat => Bn (S i)) (pred N)); 
+      ring.
+  rewrite
+    (sum_N_predN
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k))) (pred N)).
+  replace
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k))) (pred (pred N))) with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (pred (N - k))) + An (S N) * Bn (S k)) (
+	  pred (pred N))).
+  rewrite
+    (sum_plus
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (pred (N - k)))) (fun k:nat => An (S N) * Bn (S k))
+      (pred (pred N))).
+  repeat rewrite Rplus_assoc; apply Rplus_eq_compat_l.
+  replace (pred (N - pred N)) with 0%nat.
+  simpl in |- *; rewrite <- minus_n_O.
+  replace (S (pred N)) with N.
+  replace (sum_f_R0 (fun k:nat => An (S N) * Bn (S k)) (pred (pred N))) with
+    (sum_f_R0 (fun k:nat => Bn (S k) * An (S N)) (pred (pred N))).
+  rewrite <- (scal_sum (fun l:nat => Bn (S l)) (pred (pred N)) (An (S N)));
+    rewrite (sum_N_predN (fun l:nat => Bn (S l)) (pred N)).
+  replace (S (pred N)) with N.
+  ring.
+  apply S_pred with 0%nat; assumption.
+  apply lt_pred; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
+  apply sum_eq; intros; apply Rmult_comm.
+  apply S_pred with 0%nat; assumption.
+  replace (N - pred N)%nat with 1%nat.
+  reflexivity.
+  pattern N at 1 in |- *; replace N with (S (pred N)).
+  rewrite <- minus_Sn_m.
+  rewrite <- minus_n_n; reflexivity.
+  apply le_n.
+  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  apply sum_eq; intros;
+    rewrite
+      (sum_N_predN (fun l:nat => An (S (S (l + i))) * Bn (N - l)%nat)
+	(pred (N - i))).
+  replace (S (S (pred (N - i) + i))) with (S N).
+  replace (N - pred (N - i))%nat with (S i).
+  reflexivity.
+  rewrite pred_of_minus; apply INR_eq; repeat rewrite minus_INR.
+  rewrite S_INR; simpl; 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 Rplus_le_reg_l with (INR i - 1).
+  replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ].
+  replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1);
+    [ idtac | simpl; 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%nat.
+  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 (N - i))) with (N - i)%nat.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
+  apply plus_lt_reg_l with i; rewrite le_plus_minus_r.
+  replace (i + 0)%nat 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%nat.
+  apply lt_n_Sn.
+  assumption.
+  apply S_pred with 0%nat; assumption.
+  assumption.
+  apply le_trans with (pred (pred N)).
+  assumption.
+  apply le_trans with (pred N); apply le_pred_n.
+  apply S_pred with 0%nat; assumption.
+  apply le_pred_n.
+  apply INR_eq; rewrite pred_of_minus; do 3 rewrite S_INR; rewrite plus_INR;
+    repeat rewrite minus_INR.
+  simpl; 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 Rplus_le_reg_l with (INR i - 1).
+  replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ].
+  replace (INR i - 1 + (INR N - INR i)) with (INR N - INR 1);
+    [ idtac | simpl; 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%nat.
+  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%nat.
+  apply lt_O_Sn.
+  apply INR_le.
+  rewrite pred_of_minus.
+  repeat rewrite minus_INR.
+  apply Rplus_le_reg_l with (INR i - 1).
+  replace (INR i - 1 + INR 1) with (INR i); [ idtac | simpl; ring ].
+  replace (INR i - 1 + (INR N - INR i - INR 1)) with (INR N - INR 1 - INR 1).
+  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 (fun p n m:nat => plus_le_reg_l n m p) with 1%nat.
+  rewrite le_plus_minus_r.
+  simpl in |- *; assumption.
+  apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
+  apply le_trans with 2%nat; [ apply le_n_Sn | assumption ].
+  simpl; ring.
+  apply le_trans with (pred (pred N)).
+  assumption.
+  apply le_trans with (pred N); apply le_pred_n.
+  apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+  rewrite le_plus_minus_r.
+  replace (i + 1)%nat 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  in |- *; apply S_pred with 0%nat; assumption.
+  apply INR_eq; rewrite S_INR; rewrite plus_INR; reflexivity.
+  apply le_trans with (pred (pred N)).
+  assumption.
+  apply le_trans with (pred N); apply le_pred_n.
+  apply lt_le_trans with 1%nat.
+  apply lt_O_Sn.
+  apply le_S_n.
+  replace (S (pred N)) with N.
+  assumption.
+  apply S_pred with 0%nat; assumption.
+  replace
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (S N - l)%nat)
+        (pred (S N - k))) (pred N)) with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k)) + An (S k) * Bn (S N)) (pred N)).
+  rewrite
+    (sum_plus
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (S (l + k))) * Bn (N - l)%nat)
+        (pred (N - k))) (fun k:nat => An (S k) * Bn (S N))).
+  apply Rplus_eq_compat_l.
+  rewrite scal_sum; reflexivity.
+  apply sum_eq; intros; rewrite Rplus_comm;
+    rewrite
+      (decomp_sum (fun l:nat => An (S (l + i)) * Bn (S N - l)%nat)
+	(pred (S N - i))).
+  replace (0 + i)%nat with i; [ idtac | ring ].
+  rewrite <- minus_n_O; apply Rplus_eq_compat_l.
+  replace (pred (pred (S N - i))) with (pred (N - i)).
+  apply sum_eq; intros.
+  replace (S N - S i0)%nat with (N - i0)%nat; [ idtac | reflexivity ].
+  replace (S i0 + i)%nat with (S (i0 + i)).
+  reflexivity.
+  apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring.
+  cut ((N - i)%nat = pred (S N - i)).
+  intro; rewrite H5; reflexivity.
+  rewrite pred_of_minus.
+  apply INR_eq; repeat rewrite minus_INR.
+  rewrite S_INR; simpl; ring.
+  apply le_trans with N.
+  apply le_trans with (pred N).
+  assumption.
+  apply le_pred_n.
+  apply le_n_Sn.
+  apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+  rewrite le_plus_minus_r.
+  replace (i + 1)%nat 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; simpl; 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 (S N - i)) with (S N - S i)%nat.
+  replace (S N - S i)%nat with (N - i)%nat; [ idtac | reflexivity ].
+  apply plus_lt_reg_l with i.
+  rewrite le_plus_minus_r.
+  replace (i + 0)%nat 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; simpl; ring.
+  apply le_trans with N.
+  apply le_trans with (pred N).
+  assumption.
+  apply le_pred_n.
+  apply le_n_Sn.
+  apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+  rewrite le_plus_minus_r.
+  replace (i + 1)%nat 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; simpl; 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_comm.
+  rewrite (decomp_sum (fun p:nat => An p * Bn (S N - p)%nat) N).
+  rewrite <- minus_n_O.
+  apply Rplus_eq_compat_l.
+  apply sum_eq; intros.
+  reflexivity.
+  assumption.
+  rewrite Rplus_comm.
+  rewrite
+    (decomp_sum
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => An (S (l + k)) * Bn (N - l)%nat) (pred (N - k)))
+      (pred N)).
+  rewrite <- minus_n_O.
+  replace (sum_f_R0 (fun l:nat => An (S (l + 0)) * Bn (N - l)%nat) (pred N))
+    with (sum_f_R0 (fun l:nat => An (S l) * Bn (N - l)%nat) (pred N)).
+  apply Rplus_eq_compat_l.
+  apply sum_eq; intros.
+  replace (pred (N - S i)) with (pred (pred (N - i))).
+  apply sum_eq; intros.
+  replace (i0 + S i)%nat with (S (i0 + i)).
+  reflexivity.
+  apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; rewrite S_INR; simpl; ring.
+  cut (pred (N - i) = (N - S i)%nat).
+  intro; rewrite H5; reflexivity.
+  rewrite pred_of_minus.
+  apply INR_eq.
+  repeat rewrite minus_INR.
+  repeat rewrite S_INR; simpl; 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 0%nat.
+  apply lt_S_n.
+  replace (S (pred N)) with N.
+  apply lt_le_trans with 2%nat.
+  apply lt_n_Sn.
+  assumption.
+  apply S_pred with 0%nat; assumption.
+  apply le_trans with (pred (pred N)).
+  assumption.
+  apply le_trans with (pred N); apply le_pred_n.
+  apply (fun p n m:nat => plus_le_reg_l n m p) with i.
+  rewrite le_plus_minus_r.
+  replace (i + 1)%nat 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  in |- *; apply S_pred with 0%nat; assumption.
+  apply INR_eq; rewrite S_INR; rewrite plus_INR; simpl; ring.
+  apply le_trans with (pred (pred N)).
+  assumption.
+  apply le_trans with (pred N); apply le_pred_n.
+  apply sum_eq; intros.
+  replace (i + 0)%nat with i; [ reflexivity | trivial ].
+  apply lt_S_n.
+  replace (S (pred N)) with N.
+  apply lt_le_trans with 2%nat; [ apply lt_n_Sn | assumption ].
+  apply S_pred with 0%nat; assumption.
+  inversion H1.
+  left; reflexivity.
+  right; apply le_n_S; assumption.
+  simpl in |- *.
+  replace (S (pred N)) with N.
+  reflexivity.
+  apply S_pred with 0%nat; assumption.
+  simpl in |- *.
+  cut ((N - pred N)%nat = 1%nat).
+  intro; rewrite H2; reflexivity.
+  rewrite pred_of_minus.
+  apply INR_eq; repeat rewrite minus_INR.
+  simpl; ring.
+  apply lt_le_S; assumption.
+  rewrite <- pred_of_minus; apply le_pred_n.
+  simpl in |- *; symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  inversion H.
+  left; reflexivity.
+  right; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | exact H1 ].
+Qed.
diff --git a/theories/Reals/Cos_plus.v b/theories/Reals/Cos_plus.v
index 558632c5..3719d551 100644
--- a/theories/Reals/Cos_plus.v
+++ b/theories/Reals/Cos_plus.v
@@ -1,12 +1,12 @@
-(************************************************************************)
-(*  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 5920 2004-07-16 20:01:26Z herbelin $ i*)
+  (************************************************************************)
+  (*  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 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -19,1043 +19,833 @@ Definition Majxy (x y:R) (n:nat) : R :=
   Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S n) / INR (fact n).
 
 Lemma Majxy_cv_R0 : forall x y:R, Un_cv (Majxy x y) 0.
-intros.
-set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-set (C0 := 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 in |- *; unfold R_dist in |- *; intros.
-cut (0 < eps / C0);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; assumption ] ].
-elim (H1 (eps / C0) H3); intros N0 H4.
-exists N0; intros.
-replace (Majxy x y n) with (C0 ^ S n / INR (fact n)).
-simpl in |- *.
-apply Rmult_lt_reg_l with (Rabs (/ C0)).
-apply Rabs_pos_lt.
-apply Rinv_neq_0_compat.
-red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
-rewrite <- Rabs_mult.
-unfold Rminus in |- *; rewrite Rmult_plus_distr_l.
-rewrite Ropp_0; rewrite Rmult_0_r.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-rewrite (Rabs_right (/ C0)).
-rewrite <- (Rmult_comm eps).
-replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0);
- [ idtac | ring ].
-unfold Rdiv in H4; apply H4; assumption.
-apply Rle_ge; left; apply Rinv_0_lt_compat; assumption.
-red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
-unfold Majxy in |- *.
-unfold C0 in |- *.
-rewrite pow_mult.
-unfold C in |- *; reflexivity.
-unfold C0 in |- *; apply pow_lt; assumption.
-apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *.
-apply RmaxLess1.
+Proof.
+  intros.
+  set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+  set (C0 := 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 in |- *; unfold R_dist in |- *; intros.
+  cut (0 < eps / C0);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+	[ assumption | apply Rinv_0_lt_compat; assumption ] ].
+  elim (H1 (eps / C0) H3); intros N0 H4.
+  exists N0; intros.
+  replace (Majxy x y n) with (C0 ^ S n / INR (fact n)).
+  simpl in |- *.
+  apply Rmult_lt_reg_l with (Rabs (/ C0)).
+  apply Rabs_pos_lt.
+  apply Rinv_neq_0_compat.
+  red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+  rewrite <- Rabs_mult.
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_l.
+  rewrite Ropp_0; rewrite Rmult_0_r.
+  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  rewrite (Rabs_right (/ C0)).
+  rewrite <- (Rmult_comm eps).
+  replace (C0 ^ n * / INR (fact n) + 0) with (C0 ^ n * / INR (fact n) - 0);
+    [ idtac | ring ].
+  unfold Rdiv in H4; apply H4; assumption.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; assumption.
+  red in |- *; intro; rewrite H6 in H0; elim (Rlt_irrefl _ H0).
+  unfold Majxy in |- *.
+  unfold C0 in |- *.
+  rewrite pow_mult.
+  unfold C in |- *; reflexivity.
+  unfold C0 in |- *; apply pow_lt; assumption.
+  apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *.
+  apply RmaxLess1.
 Qed.
 
 Lemma reste1_maj :
- forall (x y:R) (N:nat),
-   (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N).
-intros.
-set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-unfold Reste1 in |- *.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       Rabs
-         (sum_f_R0
-            (fun l:nat =>
-               (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
-               x ^ (2 * S (l + k)) *
-               ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
-               y ^ (2 * (N - l))) (pred (N - k)))) (
-    pred N)).
-apply
- (Rsum_abs
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
+  forall (x y:R) (N:nat),
+    (0 < N)%nat -> Rabs (Reste1 x y N) <= Majxy x y (pred N).
+Proof.
+  intros.
+  set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+  unfold Reste1 in |- *.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	Rabs
+        (sum_f_R0
+          (fun l:nat =>
             (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
-            x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
-            y ^ (2 * (N - l))) (pred (N - k))) (pred N)).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            Rabs
-              ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
-               x ^ (2 * S (l + k)) *
-               ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
-               y ^ (2 * (N - l)))) (pred (N - k))) (
-    pred N)).
-apply sum_Rle.
-intros.
-apply
- (Rsum_abs
-    (fun l:nat =>
-       (-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) *
-       ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * 
-       y ^ (2 * (N - l))) (pred (N - n))).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) *
-            C ^ (2 * S (N + k))) (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-unfold Rdiv in |- *; repeat rewrite Rabs_mult.
-do 2 rewrite pow_1_abs.
-do 2 rewrite Rmult_1_l.
-rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))).
-rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))).
-rewrite mult_INR.
-rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-rewrite <- Rmult_assoc.
-rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))).
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-do 2 rewrite <- RPow_abs.
-apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
-apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-apply pow_incr.
-split.
-apply Rabs_pos.
-unfold C in |- *.
-apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
-apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
-do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))).
-apply Rmult_le_compat_l.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-apply pow_incr.
-split.
-apply Rabs_pos.
-unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
-apply RmaxLess1.
-apply RmaxLess2.
-right.
-replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat.
-rewrite pow_add.
-apply Rmult_comm.
-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 (N - n)).
-exact H1.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N))
-         (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat.
-rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
-apply Rle_pow.
-unfold C in |- *; apply RmaxLess1.
-replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ].
-apply (fun m n p:nat => mult_le_compat_l p n m).
-replace (2 * N)%nat with (S (N + pred N)).
-apply le_n_S.
-apply plus_le_compat_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
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k)))))
-         (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-rewrite <- (Rmult_comm (C ^ (4 * N))).
-apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with
- (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))).
-apply Rle_trans with
- (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))).
-unfold Rdiv in |- *;
- do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply C_maj.
-apply (fun m n p:nat => mult_le_compat_l p n m).
-apply le_n_S.
-apply plus_le_compat_r.
-apply le_trans with (pred (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 in |- *; rewrite Rmult_comm.
-unfold Binomial.C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)).
-rewrite Rinv_mult_distr.
-unfold Rsqr in |- *; reflexivity.
-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 in |- *; rewrite Rmult_comm.
-unfold Binomial.C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat.
-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 (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 (fun m n p:nat => mult_le_compat_l p n m).
-apply le_n_S.
-apply plus_le_compat_r.
-apply le_trans with (pred (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)).
-apply sum_Rle; intros.
-rewrite <-
- (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n))
-    (Rsqr (/ INR (fact (S (N + n)))))).
-rewrite sum_cte.
-rewrite <- Rmult_assoc.
-do 2 rewrite <- (Rmult_comm (C ^ (4 * N))).
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N).
-apply Rmult_le_compat_l.
-apply Rle_0_sqr.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_INR.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
-apply pos_INR.
-apply Rle_trans with (/ INR (fact (S (N + n)))).
-pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r.
-unfold Rsqr in |- *.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
-apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r.
-replace 1 with (INR 1).
-apply le_INR.
-apply lt_le_S.
-apply INR_lt; apply INR_fact_lt_0.
-reflexivity.
-apply INR_fact_neq_0.
-apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
-apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (INR (fact (S N))).
-apply INR_fact_lt_0.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm (INR (fact (S N)))).
-rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-apply le_INR.
-apply fact_le.
-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 (C ^ (4 * N) / INR (fact (pred N))).
-rewrite <- (Rmult_comm (C ^ (4 * N))).
-unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-cut (S (pred N) = N).
-intro; rewrite H0.
-pattern N at 2 in |- *; rewrite <- H0.
-do 2 rewrite fact_simpl.
-rewrite H0.
-repeat rewrite mult_INR.
-repeat rewrite Rinv_mult_distr.
-rewrite (Rmult_comm (/ INR (S N))).
-repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l.
-pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r.
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rmult_le_reg_l with (INR (S N)).
-apply lt_INR_0; apply lt_O_Sn.
-rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; rewrite Rmult_1_l.
-apply le_INR; apply le_n_Sn.
-apply not_O_INR; discriminate.
-apply not_O_INR.
-red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
-apply not_O_INR.
-red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
-apply INR_fact_neq_0.
-apply not_O_INR; discriminate.
-apply prod_neq_R0.
-apply not_O_INR.
-red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
-apply INR_fact_neq_0.
-symmetry  in |- *; apply S_pred with 0%nat; assumption.
-right.
-unfold Majxy in |- *.
-unfold C in |- *.
-replace (S (pred N)) with N.
-reflexivity.
-apply S_pred with 0%nat; assumption.
+            x ^ (2 * S (l + k)) *
+            ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+            y ^ (2 * (N - l))) (pred (N - k)))) (
+	      pred N)).
+  apply
+    (Rsum_abs
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          (-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+          x ^ (2 * S (l + k)) * ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+          y ^ (2 * (N - l))) (pred (N - k))) (pred N)).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          Rabs
+          ((-1) ^ S (l + k) / INR (fact (2 * S (l + k))) *
+            x ^ (2 * S (l + k)) *
+            ((-1) ^ (N - l) / INR (fact (2 * (N - l)))) *
+            y ^ (2 * (N - l)))) (pred (N - k))) (
+	      pred N)).
+  apply sum_Rle.
+  intros.
+  apply
+    (Rsum_abs
+      (fun l:nat =>
+	(-1) ^ S (l + n) / INR (fact (2 * S (l + n))) * x ^ (2 * S (l + n)) *
+	((-1) ^ (N - l) / INR (fact (2 * (N - l)))) * 
+	y ^ (2 * (N - l))) (pred (N - n))).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) *
+          C ^ (2 * S (N + k))) (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+  do 2 rewrite pow_1_abs.
+  do 2 rewrite Rmult_1_l.
+  rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n))))).
+  rewrite (Rabs_right (/ INR (fact (2 * (N - n0))))).
+  rewrite mult_INR.
+  rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  rewrite <- Rmult_assoc.
+  rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0))))).
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  do 2 rewrite <- RPow_abs.
+  apply Rle_trans with (Rabs x ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
+  apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  apply pow_incr.
+  split.
+  apply Rabs_pos.
+  unfold C in |- *.
+  apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
+  apply Rle_trans with (C ^ (2 * S (n0 + n)) * C ^ (2 * (N - n0))).
+  do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0)))).
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  apply pow_incr.
+  split.
+  apply Rabs_pos.
+  unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  apply RmaxLess1.
+  apply RmaxLess2.
+  right.
+  replace (2 * S (N + n))%nat with (2 * (N - n0) + 2 * S (n0 + n))%nat.
+  rewrite pow_add.
+  apply Rmult_comm.
+  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 (N - n)).
+  exact H1.
+  apply le_S_n.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  apply le_trans with N.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
+  apply plus_lt_reg_l with n.
+  rewrite <- le_plus_minus.
+  replace (n + 0)%nat 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_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          / INR (fact (2 * S (l + k)) * fact (2 * (N - l))) * C ^ (4 * N))
+        (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat.
+  rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+  apply Rle_pow.
+  unfold C in |- *; apply RmaxLess1.
+  replace (4 * N)%nat with (2 * (2 * N))%nat; [ idtac | ring ].
+  apply (fun m n p:nat => mult_le_compat_l p n m).
+  replace (2 * N)%nat with (S (N + pred N)).
+  apply le_n_S.
+  apply plus_le_compat_l; assumption.
+  rewrite pred_of_minus.
+  omega.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0 (fun l:nat => C ^ (4 * N) * Rsqr (/ INR (fact (S (N + k)))))
+        (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  rewrite <- (Rmult_comm (C ^ (4 * N))).
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  replace (/ INR (fact (2 * S (n0 + n)) * fact (2 * (N - n0)))) with
+    (Binomial.C (2 * S (N + n)) (2 * S (n0 + n)) / INR (fact (2 * S (N + n)))).
+  apply Rle_trans with
+    (Binomial.C (2 * S (N + n)) (S (N + n)) / INR (fact (2 * S (N + n)))).
+  unfold Rdiv in |- *;
+    do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (N + n))))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply C_maj.
+  omega.
+  right.
+  unfold Rdiv in |- *; rewrite Rmult_comm.
+  unfold Binomial.C in |- *.
+  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (2 * S (N + n) - S (N + n))%nat with (S (N + n)).
+  rewrite Rinv_mult_distr.
+  unfold Rsqr in |- *; reflexivity.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  omega.
+  apply INR_fact_neq_0.
+  unfold Rdiv in |- *; rewrite Rmult_comm.
+  unfold Binomial.C in |- *.
+  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (2 * S (N + n) - 2 * S (n0 + n))%nat with (2 * (N - n0))%nat.
+  rewrite mult_INR.
+  reflexivity.
+  omega.
+  apply INR_fact_neq_0.
+  apply Rle_trans with
+    (sum_f_R0 (fun k:nat => INR N / INR (fact (S N)) * C ^ (4 * N)) (pred N)).
+  apply sum_Rle; intros.
+  rewrite <-
+    (scal_sum (fun _:nat => C ^ (4 * N)) (pred (N - n))
+      (Rsqr (/ INR (fact (S (N + n)))))).
+  rewrite sum_cte.
+  rewrite <- Rmult_assoc.
+  do 2 rewrite <- (Rmult_comm (C ^ (4 * N))).
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  apply Rle_trans with (Rsqr (/ INR (fact (S (N + n)))) * INR N).
+  apply Rmult_le_compat_l.
+  apply Rle_0_sqr.
+  apply le_INR.
+  omega.
+  rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  apply pos_INR.
+  apply Rle_trans with (/ INR (fact (S (N + n)))).
+  pattern (/ INR (fact (S (N + n)))) at 2 in |- *; rewrite <- Rmult_1_r.
+  unfold Rsqr in |- *.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
+  apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r.
+  replace 1 with (INR 1).
+  apply le_INR.
+  apply lt_le_S.
+  apply INR_lt; apply INR_fact_lt_0.
+  reflexivity.
+  apply INR_fact_neq_0.
+  apply Rmult_le_reg_l with (INR (fact (S (N + n)))).
+  apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (INR (fact (S N))).
+  apply INR_fact_lt_0.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (INR (fact (S N)))).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  apply le_INR.
+  apply fact_le.
+  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 (C ^ (4 * N) / INR (fact (pred N))).
+  rewrite <- (Rmult_comm (C ^ (4 * N))).
+  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  cut (S (pred N) = N).
+  intro; rewrite H0.
+  pattern N at 2 in |- *; rewrite <- H0.
+  do 2 rewrite fact_simpl.
+  rewrite H0.
+  repeat rewrite mult_INR.
+  repeat rewrite Rinv_mult_distr.
+  rewrite (Rmult_comm (/ INR (S N))).
+  repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l.
+  pattern (/ INR (fact (pred N))) at 2 in |- *; rewrite <- Rmult_1_r.
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rmult_le_reg_l with (INR (S N)).
+  apply lt_INR_0; apply lt_O_Sn.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; rewrite Rmult_1_l.
+  apply le_INR; apply le_n_Sn.
+  apply not_O_INR; discriminate.
+  apply not_O_INR.
+  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  apply not_O_INR.
+  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  apply INR_fact_neq_0.
+  apply not_O_INR; discriminate.
+  apply prod_neq_R0.
+  apply not_O_INR.
+  red in |- *; intro; rewrite H1 in H; elim (lt_irrefl _ H).
+  apply INR_fact_neq_0.
+  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  right.
+  unfold Majxy in |- *.
+  unfold C in |- *.
+  replace (S (pred N)) with N.
+  reflexivity.
+  apply S_pred with 0%nat; assumption.
 Qed.
 
 Lemma reste2_maj :
- forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N.
-intros.
-set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-unfold Reste2 in |- *.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       Rabs
-         (sum_f_R0
-            (fun l:nat =>
-               (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
-               x ^ (2 * S (l + k) + 1) *
-               ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
-               y ^ (2 * (N - l) + 1)) (pred (N - k)))) (
-    pred N)).
-apply
- (Rsum_abs
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
+  forall (x y:R) (N:nat), (0 < N)%nat -> Rabs (Reste2 x y N) <= Majxy x y N.
+Proof.
+  intros.
+  set (C := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+  unfold Reste2 in |- *.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	Rabs
+        (sum_f_R0
+          (fun l:nat =>
             (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
             x ^ (2 * S (l + k) + 1) *
             ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
-            y ^ (2 * (N - l) + 1)) (pred (N - k))) (
-    pred N)).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            Rabs
-              ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
-               x ^ (2 * S (l + k) + 1) *
-               ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
-               y ^ (2 * (N - l) + 1))) (pred (N - k))) (
-    pred N)).
-apply sum_Rle.
-intros.
-apply
- (Rsum_abs
-    (fun l:nat =>
-       (-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) *
-       x ^ (2 * S (l + n) + 1) *
-       ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
-       y ^ (2 * (N - l) + 1)) (pred (N - n))).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
-            C ^ (2 * S (S (N + k)))) (pred (N - k))) (
-    pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-unfold Rdiv in |- *; repeat rewrite Rabs_mult.
-do 2 rewrite pow_1_abs.
-do 2 rewrite Rmult_1_l.
-rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))).
-rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))).
-rewrite mult_INR.
-rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-rewrite <- Rmult_assoc.
-rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))).
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-do 2 rewrite <- RPow_abs.
-apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
-apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-apply pow_incr.
-split.
-apply Rabs_pos.
-unfold C in |- *.
-apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
-apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
-do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))).
-apply Rmult_le_compat_l.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-apply pow_incr.
-split.
-apply Rabs_pos.
-unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
-apply RmaxLess1.
-apply RmaxLess2.
-right.
-replace (2 * S (S (N + n)))%nat with
- (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat.
-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 (N - n)).
-exact H1.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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_ge; left; apply Rinv_0_lt_compat.
-apply INR_fact_lt_0.
-apply Rle_ge; left; apply Rinv_0_lt_compat.
-apply INR_fact_lt_0.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
-            C ^ (4 * S N)) (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat.
-rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
-apply Rle_pow.
-unfold C in |- *; apply RmaxLess1.
-replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ].
-apply (fun m n p:nat => mult_le_compat_l p n m).
-replace (2 * S N)%nat with (S (S (N + N))).
-repeat apply le_n_S.
-apply plus_le_compat_l.
-apply le_trans with (pred N).
-assumption.
-apply le_pred_n.
-apply INR_eq; do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR.
-repeat rewrite S_INR; ring.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k))))))
-         (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-rewrite <- (Rmult_comm (C ^ (4 * S N))).
-apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with
- (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) /
-  INR (fact (2 * S (S (N + n))))).
-apply Rle_trans with
- (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) /
-  INR (fact (2 * S (S (N + n))))).
-unfold Rdiv in |- *;
- do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply C_maj.
-apply le_trans with (2 * S (S (n0 + n)))%nat.
-replace (2 * S (S (n0 + n)))%nat with (S (2 * S (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 (fun m n p:nat => mult_le_compat_l p n m).
-repeat apply le_n_S.
-apply plus_le_compat_r.
-apply le_trans with (pred (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 in |- *; rewrite Rmult_comm.
-unfold Binomial.C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))).
-rewrite Rinv_mult_distr.
-unfold Rsqr in |- *; reflexivity.
-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 in |- *; rewrite Rmult_comm.
-unfold Binomial.C in |- *.
-unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with
- (2 * (N - n0) + 1)%nat.
-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 (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 (2 * S (S (n0 + n)))%nat.
-replace (2 * S (S (n0 + n)))%nat with (S (2 * S (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 (fun m n p:nat => mult_le_compat_l p n m).
-repeat apply le_n_S.
-apply plus_le_compat_r.
-apply le_trans with (pred (N - n)).
-assumption.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N))
-    (pred N)).
-apply sum_Rle; intros.
-rewrite <-
- (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n))
-    (Rsqr (/ INR (fact (S (S (N + n))))))).
-rewrite sum_cte.
-rewrite <- Rmult_assoc.
-do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))).
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N).
-apply Rmult_le_compat_l.
-apply Rle_0_sqr.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_INR.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
-apply pos_INR.
-apply Rle_trans with (/ INR (fact (S (S (N + n))))).
-pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r.
-unfold Rsqr in |- *.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
-apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r.
-replace 1 with (INR 1).
-apply le_INR.
-apply lt_le_S.
-apply INR_lt; apply INR_fact_lt_0.
-reflexivity.
-apply INR_fact_neq_0.
-apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
-apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with (INR (fact (S (S N)))).
-apply INR_fact_lt_0.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm (INR (fact (S (S N))))).
-rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-apply le_INR.
-apply fact_le.
-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 (C ^ (4 * S N) / INR (fact N)).
-rewrite <- (Rmult_comm (C ^ (4 * S N))).
-unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply pow_le.
-left; apply Rlt_le_trans with 1.
-apply Rlt_0_1.
-unfold C in |- *; apply RmaxLess1.
-cut (S (pred N) = N).
-intro; rewrite H0.
-do 2 rewrite fact_simpl.
-repeat rewrite mult_INR.
-repeat rewrite Rinv_mult_distr.
-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_comm (INR N)).
-rewrite (Rmult_comm (INR (S (S N)))).
-apply Rmult_le_compat_l.
-repeat apply Rmult_le_pos.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-left; apply Rinv_0_lt_compat.
-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_1_l.
-apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)).
-repeat rewrite Rmult_assoc.
-repeat apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply le_INR; apply le_n_Sn.
-rewrite (Rmult_comm (/ INR (S N))).
-rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; 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  in |- *; apply S_pred with 0%nat; assumption.
-right.
-unfold Majxy in |- *.
-unfold C in |- *.
-reflexivity.
+            y ^ (2 * (N - l) + 1)) (pred (N - k)))) (
+	      pred N)).
+  apply
+    (Rsum_abs
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          (-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+          x ^ (2 * S (l + k) + 1) *
+          ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+          y ^ (2 * (N - l) + 1)) (pred (N - k))) (
+	    pred N)).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          Rabs
+          ((-1) ^ S (l + k) / INR (fact (2 * S (l + k) + 1)) *
+            x ^ (2 * S (l + k) + 1) *
+            ((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+            y ^ (2 * (N - l) + 1))) (pred (N - k))) (
+	      pred N)).
+  apply sum_Rle.
+  intros.
+  apply
+    (Rsum_abs
+      (fun l:nat =>
+	(-1) ^ S (l + n) / INR (fact (2 * S (l + n) + 1)) *
+	x ^ (2 * S (l + n) + 1) *
+	((-1) ^ (N - l) / INR (fact (2 * (N - l) + 1))) *
+	y ^ (2 * (N - l) + 1)) (pred (N - n))).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
+          C ^ (2 * S (S (N + k)))) (pred (N - k))) (
+	    pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  unfold Rdiv in |- *; repeat rewrite Rabs_mult.
+  do 2 rewrite pow_1_abs.
+  do 2 rewrite Rmult_1_l.
+  rewrite (Rabs_right (/ INR (fact (2 * S (n0 + n) + 1)))).
+  rewrite (Rabs_right (/ INR (fact (2 * (N - n0) + 1)))).
+  rewrite mult_INR.
+  rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  rewrite <- Rmult_assoc.
+  rewrite <- (Rmult_comm (/ INR (fact (2 * (N - n0) + 1)))).
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  do 2 rewrite <- RPow_abs.
+  apply Rle_trans with (Rabs x ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
+  apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  apply pow_incr.
+  split.
+  apply Rabs_pos.
+  unfold C in |- *.
+  apply Rle_trans with (Rmax (Rabs x) (Rabs y)); apply RmaxLess2.
+  apply Rle_trans with (C ^ (2 * S (n0 + n) + 1) * C ^ (2 * (N - n0) + 1)).
+  do 2 rewrite <- (Rmult_comm (C ^ (2 * (N - n0) + 1))).
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  apply pow_incr.
+  split.
+  apply Rabs_pos.
+  unfold C in |- *; apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  apply RmaxLess1.
+  apply RmaxLess2.
+  right.
+  replace (2 * S (S (N + n)))%nat with
+    (2 * (N - n0) + 1 + (2 * S (n0 + n) + 1))%nat.
+  repeat rewrite pow_add.
+  ring.
+  omega.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply Rle_ge; left; apply Rinv_0_lt_compat.
+  apply INR_fact_lt_0.
+  apply Rle_ge; left; apply Rinv_0_lt_compat.
+  apply INR_fact_lt_0.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat =>
+          / INR (fact (2 * S (l + k) + 1) * fact (2 * (N - l) + 1)) *
+          C ^ (4 * S N)) (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat.
+  rewrite mult_INR; apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+  apply Rle_pow.
+  unfold C in |- *; apply RmaxLess1.
+  replace (4 * S N)%nat with (2 * (2 * S N))%nat; [ idtac | ring ].
+  apply (fun m n p:nat => mult_le_compat_l p n m).
+  replace (2 * S N)%nat with (S (S (N + N))).
+  repeat apply le_n_S.
+  apply plus_le_compat_l.
+  apply le_trans with (pred N).
+  assumption.
+  apply le_pred_n.
+  ring_nat.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+	sum_f_R0
+        (fun l:nat => C ^ (4 * S N) * Rsqr (/ INR (fact (S (S (N + k))))))
+        (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  rewrite <- (Rmult_comm (C ^ (4 * S N))).
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  replace (/ INR (fact (2 * S (n0 + n) + 1) * fact (2 * (N - n0) + 1))) with
+    (Binomial.C (2 * S (S (N + n))) (2 * S (n0 + n) + 1) /
+      INR (fact (2 * S (S (N + n))))).
+  apply Rle_trans with
+    (Binomial.C (2 * S (S (N + n))) (S (S (N + n))) /
+      INR (fact (2 * S (S (N + n))))).
+  unfold Rdiv in |- *;
+    do 2 rewrite <- (Rmult_comm (/ INR (fact (2 * S (S (N + n)))))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply C_maj.
+  apply le_trans with (2 * S (S (n0 + n)))%nat.
+  replace (2 * S (S (n0 + n)))%nat with (S (2 * S (n0 + n) + 1)).
+  apply le_n_Sn.
+  ring_nat.
+  omega.
+  right.
+  unfold Rdiv in |- *; rewrite Rmult_comm.
+  unfold Binomial.C in |- *.
+  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (2 * S (S (N + n)) - S (S (N + n)))%nat with (S (S (N + n))).
+  rewrite Rinv_mult_distr.
+  unfold Rsqr in |- *; reflexivity.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  omega.
+  apply INR_fact_neq_0.
+  unfold Rdiv in |- *; rewrite Rmult_comm.
+  unfold Binomial.C in |- *.
+  unfold Rdiv in |- *; repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (2 * S (S (N + n)) - (2 * S (n0 + n) + 1))%nat with
+    (2 * (N - n0) + 1)%nat.
+  rewrite mult_INR.
+  reflexivity.
+  omega.
+  apply INR_fact_neq_0.
+  apply Rle_trans with
+    (sum_f_R0 (fun k:nat => INR N / INR (fact (S (S N))) * C ^ (4 * S N))
+      (pred N)).
+  apply sum_Rle; intros.
+  rewrite <-
+    (scal_sum (fun _:nat => C ^ (4 * S N)) (pred (N - n))
+      (Rsqr (/ INR (fact (S (S (N + n))))))).
+  rewrite sum_cte.
+  rewrite <- Rmult_assoc.
+  do 2 rewrite <- (Rmult_comm (C ^ (4 * S N))).
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  apply Rle_trans with (Rsqr (/ INR (fact (S (S (N + n))))) * INR N).
+  apply Rmult_le_compat_l.
+  apply Rle_0_sqr.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  apply le_INR.
+  omega.
+  omega.
+  rewrite Rmult_comm; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  apply pos_INR.
+  apply Rle_trans with (/ INR (fact (S (S (N + n))))).
+  pattern (/ INR (fact (S (S (N + n))))) at 2 in |- *; rewrite <- Rmult_1_r.
+  unfold Rsqr in |- *.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
+  apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r.
+  replace 1 with (INR 1).
+  apply le_INR.
+  apply lt_le_S.
+  apply INR_lt; apply INR_fact_lt_0.
+  reflexivity.
+  apply INR_fact_neq_0.
+  apply Rmult_le_reg_l with (INR (fact (S (S (N + n))))).
+  apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with (INR (fact (S (S N)))).
+  apply INR_fact_lt_0.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (INR (fact (S (S N))))).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  apply le_INR.
+  apply fact_le.
+  omega.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  rewrite sum_cte.
+  apply Rle_trans with (C ^ (4 * S N) / INR (fact N)).
+  rewrite <- (Rmult_comm (C ^ (4 * S N))).
+  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply pow_le.
+  left; apply Rlt_le_trans with 1.
+  apply Rlt_0_1.
+  unfold C in |- *; apply RmaxLess1.
+  cut (S (pred N) = N).
+  intro; rewrite H0.
+  do 2 rewrite fact_simpl.
+  repeat rewrite mult_INR.
+  repeat rewrite Rinv_mult_distr.
+  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_comm (INR N)).
+  rewrite (Rmult_comm (INR (S (S N)))).
+  apply Rmult_le_compat_l.
+  repeat apply Rmult_le_pos.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  left; apply Rinv_0_lt_compat.
+  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_1_l.
+  apply Rle_trans with (/ INR (S N) * / INR (fact N) * INR (S N)).
+  repeat rewrite Rmult_assoc.
+  repeat apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply le_INR; apply le_n_Sn.
+  rewrite (Rmult_comm (/ INR (S N))).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; 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  in |- *; apply S_pred with 0%nat; assumption.
+  right.
+  unfold Majxy in |- *.
+  unfold C in |- *.
+  reflexivity.
 Qed.
 
 Lemma reste1_cv_R0 : forall x y:R, Un_cv (Reste1 x y) 0.
-intros.
-assert (H := Majxy_cv_R0 x y).
-unfold Un_cv in H; unfold R_dist in H.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H eps H0); intros N0 H1.
-exists (S N0); intros.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
-apply Rle_lt_trans with (Rabs (Majxy x y (pred n))).
-rewrite (Rabs_right (Majxy x y (pred n))).
-apply reste1_maj.
-apply lt_le_trans with (S N0).
-apply lt_O_Sn.
-assumption.
-apply Rle_ge.
-unfold Majxy in |- *.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ].
-apply H1.
-unfold ge in |- *; apply le_S_n.
-replace (S (pred n)) with n.
-assumption.
-apply S_pred with 0%nat.
-apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ].
+Proof.
+  intros.
+  assert (H := Majxy_cv_R0 x y).
+  unfold Un_cv in H; unfold R_dist in H.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H eps H0); intros N0 H1.
+  exists (S N0); intros.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+  apply Rle_lt_trans with (Rabs (Majxy x y (pred n))).
+  rewrite (Rabs_right (Majxy x y (pred n))).
+  apply reste1_maj.
+  apply lt_le_trans with (S N0).
+  apply lt_O_Sn.
+  assumption.
+  apply Rle_ge.
+  unfold Majxy in |- *.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  replace (Majxy x y (pred n)) with (Majxy x y (pred n) - 0); [ idtac | ring ].
+  apply H1.
+  unfold ge in |- *; apply le_S_n.
+  replace (S (pred n)) with n.
+  assumption.
+  apply S_pred with 0%nat.
+  apply lt_le_trans with (S N0); [ apply lt_O_Sn | assumption ].
 Qed.
 
 Lemma reste2_cv_R0 : forall x y:R, Un_cv (Reste2 x y) 0.
-intros.
-assert (H := Majxy_cv_R0 x y).
-unfold Un_cv in H; unfold R_dist in H.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H eps H0); intros N0 H1.
-exists (S N0); intros.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
-apply Rle_lt_trans with (Rabs (Majxy x y n)).
-rewrite (Rabs_right (Majxy x y n)).
-apply reste2_maj.
-apply lt_le_trans with (S N0).
-apply lt_O_Sn.
-assumption.
-apply Rle_ge.
-unfold Majxy in |- *.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ].
-apply H1.
-unfold ge in |- *; apply le_trans with (S N0).
-apply le_n_Sn.
-exact H2.
+Proof.
+  intros.
+  assert (H := Majxy_cv_R0 x y).
+  unfold Un_cv in H; unfold R_dist in H.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H eps H0); intros N0 H1.
+  exists (S N0); intros.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+  apply Rle_lt_trans with (Rabs (Majxy x y n)).
+  rewrite (Rabs_right (Majxy x y n)).
+  apply reste2_maj.
+  apply lt_le_trans with (S N0).
+  apply lt_O_Sn.
+  assumption.
+  apply Rle_ge.
+  unfold Majxy in |- *.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  replace (Majxy x y n) with (Majxy x y n - 0); [ idtac | ring ].
+  apply H1.
+  unfold ge in |- *; apply le_trans with (S N0).
+  apply le_n_Sn.
+  exact H2.
 Qed.
 
 Lemma reste_cv_R0 : forall x y:R, Un_cv (Reste x y) 0.
-intros.
-unfold Reste in |- *.
-set (An := fun n:nat => Reste2 x y n).
-set (Bn := fun n:nat => Reste1 x y (S n)).
-cut
- (Un_cv (fun n:nat => An n - Bn n) (0 - 0) ->
-  Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0).
-intro.
-apply H.
-apply CV_minus.
-unfold An in |- *.
-replace (fun n:nat => Reste2 x y n) with (Reste2 x y).
-apply reste2_cv_R0.
-reflexivity.
-unfold Bn in |- *.
-assert (H0 := reste1_cv_R0 x y).
-unfold Un_cv in H0; unfold R_dist in H0.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H0 eps H1); intros N0 H2.
-exists N0; intros.
-apply H2.
-unfold ge in |- *; apply le_trans with (S N0).
-apply le_n_Sn.
-apply le_n_S; assumption.
-unfold An, Bn in |- *.
-intro.
-replace 0 with (0 - 0); [ idtac | ring ].
-exact H.
+Proof.
+  intros.
+  unfold Reste in |- *.
+  set (An := fun n:nat => Reste2 x y n).
+  set (Bn := fun n:nat => Reste1 x y (S n)).
+  cut
+    (Un_cv (fun n:nat => An n - Bn n) (0 - 0) ->
+      Un_cv (fun N:nat => Reste2 x y N - Reste1 x y (S N)) 0).
+  intro.
+  apply H.
+  apply CV_minus.
+  unfold An in |- *.
+  replace (fun n:nat => Reste2 x y n) with (Reste2 x y).
+  apply reste2_cv_R0.
+  reflexivity.
+  unfold Bn in |- *.
+  assert (H0 := reste1_cv_R0 x y).
+  unfold Un_cv in H0; unfold R_dist in H0.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H0 eps H1); intros N0 H2.
+  exists N0; intros.
+  apply H2.
+  unfold ge in |- *; apply le_trans with (S N0).
+  apply le_n_Sn.
+  apply le_n_S; assumption.
+  unfold An, Bn in |- *.
+  intro.
+  replace 0 with (0 - 0); [ idtac | ring ].
+  exact H.
 Qed.
 
 Theorem cos_plus : forall 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 in |- *; unfold R_dist in |- *. 
-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 in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. 
-elim (H4 (eps / 3) H7); intros N1 H8. 
-elim (H5 (eps / 3) H7); intros N2 H9. 
-elim (H6 (eps / 3) H7); intros N3 H10.
-set (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
- (Rabs (A1 x n * A1 y n - cos x * cos y) +
-  Rabs (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 Rabs_triang | ring ].
-replace eps with (eps / 3 + (eps / 3 + eps / 3)).
-apply Rplus_lt_compat. 
-apply H8. 
-unfold ge in |- *; apply le_trans with N. 
-unfold N in |- *. 
-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
- (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) +
-  Rabs (Reste x y (pred n))).
-apply Rabs_triang.
-apply Rplus_lt_compat.
-rewrite <- Rabs_Ropp. 
-rewrite Ropp_minus_distr. 
-apply H9. 
-unfold ge in |- *; apply le_trans with (max N1 N2). 
-apply le_max_r. 
-apply le_S_n. 
-rewrite <- H12. 
-apply le_trans with N.
-unfold N in |- *.
-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 in |- *.
-apply le_S_n.
-rewrite <- H12.
-apply le_trans with N.
-unfold N in |- *.
-apply le_n_S.
-apply le_trans with (max (max N1 N2) N3).
-apply le_max_r.
-apply le_n_Sn.
-assumption.
-ring.
-pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
-ring.
-unfold Rdiv in |- *.
-rewrite <- Rmult_assoc.
-apply Rinv_r_simpl_m.
-discrR.
-apply lt_le_trans with (pred N).
-unfold N in |- *; simpl in |- *; apply lt_O_Sn.
-apply le_S_n.
-rewrite <- H12.
-replace (S (pred N)) with N.
-assumption.
-unfold N in |- *; simpl in |- *; reflexivity.
-cut (0 < N)%nat. 
-intro. 
-cut (0 < n)%nat. 
-intro. 
-apply S_pred with 0%nat; assumption.
-apply lt_le_trans with N; assumption. 
-unfold N in |- *; apply lt_O_Sn.
-Qed.
\ No newline at end of file
+Proof.
+  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 in |- *; unfold R_dist in |- *. 
+  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 in |- *; apply Rmult_lt_0_compat;
+	[ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ]. 
+  elim (H4 (eps / 3) H7); intros N1 H8. 
+  elim (H5 (eps / 3) H7); intros N2 H9. 
+  elim (H6 (eps / 3) H7); intros N3 H10.
+  set (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
+    (Rabs (A1 x n * A1 y n - cos x * cos y) +
+      Rabs (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 Rabs_triang | ring ].
+  replace eps with (eps / 3 + (eps / 3 + eps / 3)).
+  apply Rplus_lt_compat. 
+  apply H8. 
+  unfold ge in |- *; apply le_trans with N. 
+  unfold N in |- *. 
+  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
+    (Rabs (sin x * sin y - B1 x (pred n) * B1 y (pred n)) +
+      Rabs (Reste x y (pred n))).
+  apply Rabs_triang.
+  apply Rplus_lt_compat.
+  rewrite <- Rabs_Ropp. 
+  rewrite Ropp_minus_distr. 
+  apply H9. 
+  unfold ge in |- *; apply le_trans with (max N1 N2). 
+  apply le_max_r. 
+  apply le_S_n. 
+  rewrite <- H12. 
+  apply le_trans with N.
+  unfold N in |- *.
+  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 in |- *.
+  apply le_S_n.
+  rewrite <- H12.
+  apply le_trans with N.
+  unfold N in |- *.
+  apply le_n_S.
+  apply le_trans with (max (max N1 N2) N3).
+  apply le_max_r.
+  apply le_n_Sn.
+  assumption.
+  ring.
+  pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+  ring.
+  unfold Rdiv in |- *.
+  rewrite <- Rmult_assoc.
+  apply Rinv_r_simpl_m.
+  discrR.
+  apply lt_le_trans with (pred N).
+  unfold N in |- *; simpl in |- *; apply lt_O_Sn.
+  apply le_S_n.
+  rewrite <- H12.
+  replace (S (pred N)) with N.
+  assumption.
+  unfold N in |- *; simpl in |- *; reflexivity.
+  cut (0 < N)%nat. 
+  intro. 
+  cut (0 < n)%nat. 
+  intro. 
+  apply S_pred with 0%nat; assumption.
+  apply lt_le_trans with N; assumption. 
+  unfold N in |- *; apply lt_O_Sn.
+Qed.
diff --git a/theories/Reals/Cos_rel.v b/theories/Reals/Cos_rel.v
index 8320382c..ac8ffbeb 100644
--- a/theories/Reals/Cos_rel.v
+++ b/theories/Reals/Cos_rel.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
  
-(*i $Id: Cos_rel.v 6245 2004-10-20 13:50:08Z barras $ i*)
+(*i $Id: Cos_rel.v 9178 2006-09-26 11:18:22Z barras $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -83,7 +83,6 @@ replace
             ((-1) ^ (n - l) / INR (fact (2 * (n - l) + 1)) *
              y ^ (2 * (n - l) + 1))) (pred (n - k))) (
     pred n)) with (Reste2 x y n).
-ring.
 replace
  (sum_f_R0
     (fun k:nat =>
@@ -98,7 +97,7 @@ replace
        sum_f_R0
          (fun l:nat => C (2 * k) (2 * l) * x ^ (2 * l) * y ^ (2 * (k - l))) k)
     (S n)).
-set
+pose
  (sin_nnn :=
   fun n:nat =>
     match n with
@@ -109,8 +108,10 @@ set
           (fun l:nat =>
              C (2 * S p) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (p - l))) p
     end).
+ring_simplify.
 replace
- (-
+(* (-   old ring compat *)
+ (-1 *
   sum_f_R0
     (fun k:nat =>
        sum_f_R0
@@ -123,19 +124,13 @@ unfold C1 in |- *.
 apply sum_eq; intros.
 induction  i as [| i Hreci].
 simpl in |- *.
-rewrite Rplus_0_l.
-replace (C 0 0) with 1.
-unfold Rdiv in |- *; rewrite Rinv_1.
-ring.
-unfold C in |- *.
-rewrite <- minus_n_n.
-simpl in |- *.
-unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rinv_1; ring.
+unfold C in |- *; simpl in |- *.
+field; discrR.
 unfold sin_nnn in |- *.
 rewrite <- Rmult_plus_distr_l.
 apply Rmult_eq_compat_l.
 rewrite binomial.
-set (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)).
+pose (Wn := fun i0:nat => C (2 * S i) i0 * x ^ i0 * y ^ (2 * S i - i0)).
 replace
  (sum_f_R0
     (fun l:nat => C (2 * S i) (2 * l) * x ^ (2 * l) * y ^ (2 * (S i - l)))
@@ -145,42 +140,39 @@ replace
     (fun l:nat =>
        C (2 * S i) (S (2 * l)) * x ^ S (2 * l) * y ^ S (2 * (i - l))) i) with
  (sum_f_R0 (fun l:nat => Wn (S (2 * l))) i).
-rewrite Rplus_comm.
+(*rewrite Rplus_comm.*) (* compatibility old ring... *)
 apply sum_decomposition.
 apply sum_eq; intros.
 unfold Wn in |- *.
 apply Rmult_eq_compat_l.
 replace (2 * S i - S (2 * i0))%nat with (S (2 * (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 (2 * S i)%nat with (S (S (2 * i))).
-apply le_n_S.
-apply le_trans with (2 * i)%nat.
-apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
-apply le_n_Sn.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
-assumption.
+omega.
 apply sum_eq; intros.
 unfold Wn in |- *.
 apply Rmult_eq_compat_l.
 replace (2 * S i - 2 * i0)%nat with (2 * (S i - i0))%nat.
 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 (fun m n p:nat => mult_le_compat_l p n m); assumption.
-assumption.
-rewrite <- (Ropp_involutive (sum_f_R0 sin_nnn (S n))).
-apply Ropp_eq_compat.
-replace (- sum_f_R0 sin_nnn (S n)) with (-1 * sum_f_R0 sin_nnn (S n));
- [ idtac | ring ].
+omega.
+replace (sum_f_R0 sin_nnn (S n)) with (-1 * (-1 * sum_f_R0 sin_nnn (S n))).
+(*replace (* compatibility old ring... *)
+ (-
+  sum_f_R0
+    (fun k:nat =>
+       sum_f_R0
+         (fun p:nat =>
+            (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) *
+            ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) *
+             y ^ (2 * (k - p) + 1))) k) n) with
+ (-1 *
+  sum_f_R0
+    (fun k:nat =>
+       sum_f_R0
+         (fun p:nat =>
+            (-1) ^ p / INR (fact (2 * p + 1)) * x ^ (2 * p + 1) *
+            ((-1) ^ (k - p) / INR (fact (2 * (k - p) + 1)) *
+             y ^ (2 * (k - p) + 1))) k) n);[idtac|ring].*)
+apply Rmult_eq_compat_l.
 rewrite scal_sum.
 rewrite decomp_sum.
 replace (sin_nnn 0%nat) with 0.
@@ -218,25 +210,13 @@ replace (S (2 * i0)) with (2 * i0 + 1)%nat;
  [ apply Rmult_eq_compat_l | ring ].
 replace (2 * S i - (2 * i0 + 1))%nat with (2 * (i - i0) + 1)%nat.
 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 (2 * i0 + 1)%nat with (S (2 * i0)).
-replace (2 * S i)%nat with (S (S (2 * i))).
-apply le_n_S.
-apply le_trans with (2 * i)%nat.
-apply (fun m n p:nat => mult_le_compat_l p n m); 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.
+omega.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
 reflexivity.
 apply lt_O_Sn.
+ring.
 apply sum_eq; intros.
 rewrite scal_sum.
 apply sum_eq; intros.
@@ -259,11 +239,7 @@ rewrite Rmult_1_l.
 rewrite Rinv_mult_distr.
 replace (2 * i - 2 * i0)%nat with (2 * (i - i0))%nat.
 reflexivity.
-apply INR_eq.
-rewrite mult_INR; repeat rewrite minus_INR.
-do 2 rewrite mult_INR; repeat rewrite S_INR; ring.
-apply (fun m n p:nat => mult_le_compat_l p n m); assumption.
-assumption.
+omega.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
 apply INR_fact_neq_0.
diff --git a/theories/Reals/DiscrR.v b/theories/Reals/DiscrR.v
index 1c663288..a16af05c 100644
--- a/theories/Reals/DiscrR.v
+++ b/theories/Reals/DiscrR.v
@@ -6,13 +6,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i        $Id: DiscrR.v 5920 2004-07-16 20:01:26Z herbelin $       i*)
+(*i        $Id: DiscrR.v 9178 2006-09-26 11:18:22Z barras $       i*)
 
 Require Import RIneq.
 Require Import Omega. 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 ].
+change 2 with (INR 2); apply lt_INR_0; apply lt_O_Sn.
 Qed.
 
 Lemma Rplus_lt_pos : forall x y:R, 0 < x -> 0 < y -> 0 < x + y.
@@ -36,17 +36,14 @@ Ltac discrR :=
   try
    match goal with
    |  |- (?X1 <> ?X2) =>
-       replace 2 with (IZR 2);
-        [ replace 1 with (IZR 1);
-           [ replace 0 with (IZR 0);
-              [ repeat
-                 rewrite <- plus_IZR ||
-                   rewrite <- mult_IZR ||
-                     rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
-                 apply IZR_neq; try discriminate
-              | reflexivity ]
-           | reflexivity ]
-        | reflexivity ]
+       change 2 with (IZR 2);
+       change 1 with (IZR 1);
+       change 0 with (IZR 0);
+       repeat
+         rewrite <- plus_IZR ||
+           rewrite <- mult_IZR ||
+           rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus;
+       apply IZR_neq; try discriminate
    end.
 
 Ltac prove_sup0 :=
@@ -60,17 +57,13 @@ Ltac prove_sup0 :=
   end.
 
 Ltac omega_sup :=
-  replace 2 with (IZR 2);
-   [ replace 1 with (IZR 1);
-      [ replace 0 with (IZR 0);
-         [ repeat
-            rewrite <- plus_IZR ||
-              rewrite <- mult_IZR ||
-                rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; 
-            apply IZR_lt; omega
-         | reflexivity ]
-      | reflexivity ]
-   | reflexivity ].
+  change 2 with (IZR 2);
+  change 1 with (IZR 1);
+  change 0 with (IZR 0);
+  repeat
+    rewrite <- plus_IZR ||
+      rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; 
+  apply IZR_lt; omega.
   
 Ltac prove_sup :=
   match goal with
@@ -84,14 +77,10 @@ Ltac prove_sup :=
   end.
 
 Ltac Rcompute :=
-  replace 2 with (IZR 2);
-   [ replace 1 with (IZR 1);
-      [ replace 0 with (IZR 0);
-         [ repeat
-            rewrite <- plus_IZR ||
-              rewrite <- mult_IZR ||
-                rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; 
-            apply IZR_eq; try reflexivity
-         | reflexivity ]
-      | reflexivity ]
-   | reflexivity ].
\ No newline at end of file
+  change 2 with (IZR 2);
+  change 1 with (IZR 1);
+  change 0 with (IZR 0);
+  repeat
+    rewrite <- plus_IZR ||
+      rewrite <- mult_IZR || rewrite <- Ropp_Ropp_IZR || rewrite Z_R_minus; 
+  apply IZR_eq; try reflexivity.
diff --git a/theories/Reals/Exp_prop.v b/theories/Reals/Exp_prop.v
index 90ea93ef..5dafec83 100644
--- a/theories/Reals/Exp_prop.v
+++ b/theories/Reals/Exp_prop.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Exp_prop.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: Exp_prop.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -24,988 +24,972 @@ Definition E1 (x:R) (N:nat) : R :=
   sum_f_R0 (fun k:nat => / INR (fact k) * x ^ k) N.
 
 Lemma E1_cvg : forall x:R, Un_cv (E1 x) (exp x).
-intro; unfold exp in |- *; unfold projT1 in |- *.
-case (exist_exp x); intro.
-unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial.
+Proof.
+  intro; unfold exp in |- *; unfold projT1 in |- *.
+  case (exist_exp x); intro.
+  unfold exp_in, Un_cv in |- *; unfold infinit_sum, E1 in |- *; trivial.
 Qed.
 
 Definition Reste_E (x y:R) (N:nat) : R :=
   sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            / INR (fact (S (l + k))) * x ^ S (l + k) *
-            (/ INR (fact (N - l)) * y ^ (N - l))) (
-         pred (N - k))) (pred N).
+  (fun k:nat =>
+    sum_f_R0
+    (fun l:nat =>
+      / INR (fact (S (l + k))) * x ^ S (l + k) *
+      (/ INR (fact (N - l)) * y ^ (N - l))) (
+        pred (N - k))) (pred N).
 
 Lemma exp_form :
- forall (x y:R) (n:nat),
-   (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n.
-intros; unfold E1 in |- *.
-rewrite cauchy_finite.
-unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; 
- intros.
-rewrite binomial.
-rewrite scal_sum; apply sum_eq; intros.
-unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite Rinv_mult_distr.
-ring.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply H.
+  forall (x y:R) (n:nat),
+    (0 < n)%nat -> E1 x n * E1 y n - Reste_E x y n = E1 (x + y) n.
+Proof.
+  intros; unfold E1 in |- *.
+  rewrite cauchy_finite.
+  unfold Reste_E in |- *; unfold Rminus in |- *; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; apply sum_eq; 
+      intros.
+  rewrite binomial.
+  rewrite scal_sum; apply sum_eq; intros.
+  unfold C in |- *; unfold Rdiv in |- *; repeat rewrite Rmult_assoc;
+    rewrite (Rmult_comm (INR (fact i))); repeat rewrite Rmult_assoc;
+      rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite Rinv_mult_distr.
+  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) (N:nat) : R :=
   4 *
   (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * N) /
-   Rsqr (INR (fact (div2 (pred N))))).
+    Rsqr (INR (fact (div2 (pred N))))).
 
 Lemma Rle_Rinv : forall x y:R, 0 < x -> 0 < y -> x <= y -> / y <= / x.
-intros; apply Rmult_le_reg_l with x.
-apply H.
-rewrite <- Rinv_r_sym.
-apply Rmult_le_reg_l with y.
-apply H0.
-rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; apply H1.
-red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
-red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
+Proof.
+  intros; apply Rmult_le_reg_l with x.
+  apply H.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_le_reg_l with y.
+  apply H0.
+  rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; apply H1.
+  red in |- *; intro; rewrite H2 in H0; elim (Rlt_irrefl _ H0).
+  red in |- *; intro; rewrite H2 in H; elim (Rlt_irrefl _ H).
 Qed.
 
 (**********)
 Lemma div2_double : forall N:nat, div2 (2 * N) = N.
-intro; induction  N as [| N HrecN].
-reflexivity.
-replace (2 * S N)%nat with (S (S (2 * N))).
-simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
+Proof.
+  intro; induction  N as [| N HrecN].
+  reflexivity.
+  replace (2 * S N)%nat with (S (S (2 * N))).
+  simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+  ring_nat.
 Qed.
 
 Lemma div2_S_double : forall N:nat, div2 (S (2 * N)) = N.
-intro; induction  N as [| N HrecN].
-reflexivity.
-replace (2 * S N)%nat with (S (S (2 * N))).
-simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
+Proof.
+  intro; induction  N as [| N HrecN].
+  reflexivity.
+  replace (2 * S N)%nat with (S (S (2 * N))).
+  simpl in |- *; simpl in HrecN; rewrite HrecN; reflexivity.
+  ring_nat.
 Qed.
 
 Lemma div2_not_R0 : forall N:nat, (1 < N)%nat -> (0 < div2 N)%nat.
-intros; induction  N as [| N HrecN].
-elim (lt_n_O _ H).
-cut ((1 < N)%nat \/ N = 1%nat).
-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 in |- *; apply lt_O_Sn.
-inversion H.
-right; reflexivity.
-left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
+Proof.
+  intros; induction  N as [| N HrecN].
+  elim (lt_n_O _ H).
+  cut ((1 < N)%nat \/ N = 1%nat).
+  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 in |- *; apply lt_O_Sn.
+  inversion H.
+  right; reflexivity.
+  left; apply lt_le_trans with 2%nat; [ apply lt_n_Sn | apply H1 ].
 Qed.
 
 Lemma Reste_E_maj :
- forall (x y:R) (N:nat),
-   (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N.
-intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))).
-apply Rle_trans with
- (M ^ (2 * N) *
-  sum_f_R0
-    (fun k:nat =>
-       sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N)))))
-         (pred (N - k))) (pred N)). 
-unfold Reste_E in |- *.
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       Rabs
-         (sum_f_R0
-            (fun l:nat =>
-               / INR (fact (S (l + k))) * x ^ S (l + k) *
-               (/ INR (fact (N - l)) * y ^ (N - l))) (
-            pred (N - k)))) (pred N)).
-apply
- (Rsum_abs
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
+  forall (x y:R) (N:nat),
+    (0 < N)%nat -> Rabs (Reste_E x y N) <= maj_Reste_E x y N.
+Proof.
+  intros; set (M := Rmax 1 (Rmax (Rabs x) (Rabs y))).
+  apply Rle_trans with
+    (M ^ (2 * N) *
+      sum_f_R0
+      (fun k:nat =>
+        sum_f_R0 (fun l:nat => / Rsqr (INR (fact (div2 (S N)))))
+        (pred (N - k))) (pred N)). 
+  unfold Reste_E in |- *.
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+        Rabs
+        (sum_f_R0
+          (fun l:nat =>
             / INR (fact (S (l + k))) * x ^ S (l + k) *
             (/ INR (fact (N - l)) * y ^ (N - l))) (
-         pred (N - k))) (pred N)).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            Rabs
-              (/ INR (fact (S (l + k))) * x ^ S (l + k) *
-               (/ INR (fact (N - l)) * y ^ (N - l)))) (
-         pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply
- (Rsum_abs
-    (fun l:nat =>
-       / INR (fact (S (l + n))) * x ^ S (l + n) *
-       (/ INR (fact (N - l)) * y ^ (N - l)))).
-apply Rle_trans with
- (sum_f_R0
-    (fun k:nat =>
-       sum_f_R0
-         (fun l:nat =>
-            M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l)))
-         (pred (N - k))) (pred N)).
-apply sum_Rle; intros.
-apply sum_Rle; intros.
-repeat rewrite Rabs_mult.
-do 2 rewrite <- RPow_abs.
-rewrite (Rabs_right (/ INR (fact (S (n0 + n))))).
-rewrite (Rabs_right (/ INR (fact (N - n0)))).
-replace
- (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
-  (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with
- (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
-  Rabs y ^ (N - n0)); [ idtac | ring ].
-rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
-repeat rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_trans with
- (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)).
-rewrite (Rmult_comm (/ INR (fact (S (n0 + n)))));
- rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc;
- apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-apply Rle_Rinv.
-apply INR_fact_lt_0.
-apply INR_fact_lt_0.
-apply le_INR; apply fact_le; apply le_n_S.
-apply le_plus_l.
-rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc;
- apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)).
-do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))).
-apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-apply pow_incr; split.
-apply Rabs_pos.
-apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
-apply RmaxLess1.
-unfold M in |- *; apply RmaxLess2.
-apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)).
-apply Rmult_le_compat_l.
-apply pow_le; apply Rle_trans with 1.
-left; apply Rlt_0_1.
-unfold M in |- *; apply RmaxLess1.
-apply pow_incr; split.
-apply Rabs_pos.
-apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
-apply RmaxLess2.
-unfold M in |- *; apply RmaxLess2.
-rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat.
-apply Rle_pow.
-unfold M in |- *; apply RmaxLess1.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
-apply plus_le_compat_l.
-replace N with (S (pred N)).
-apply le_n_S; apply H0.
-symmetry  in |- *; apply S_pred with 0%nat; apply H.
-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 (N - n)).
-apply H1.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-rewrite scal_sum.
-apply sum_Rle; intros.
-rewrite <- Rmult_comm.
-rewrite scal_sum.
-apply sum_Rle; intros.
-rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
-rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-unfold M in |- *; 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 (N - n0))).
-do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_Rinv.
-apply INR_fact_lt_0.
-apply INR_fact_lt_0.
-apply le_INR.
-apply fact_le.
-apply le_n_Sn.
-replace (/ INR (fact n0) * / INR (fact (N - n0))) with
- (C N n0 / INR (fact N)).
-pattern N at 1 in |- *; rewrite H4.
-apply Rle_trans with (C N N0 / INR (fact N)).
-unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-rewrite H4.
-apply C_maj.
-rewrite <- H4; apply le_trans with (pred (N - n)).
-apply H1.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 in |- *.
-repeat rewrite Rinv_mult_distr.
-rewrite (Rmult_comm (INR (fact N))).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; replace (N - N0)%nat with N0.
-ring.
-replace N with (N0 + N0)%nat.
-symmetry  in |- *; 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 in |- *.
-rewrite (Rmult_comm (INR (fact N))).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rinv_mult_distr.
-rewrite Rmult_1_r; ring.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with
- (C (S N) (S n0) / INR (fact (S N))).
-apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))).
-unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-cut (S N = (2 * S N0)%nat).
-intro; rewrite H5; apply C_maj.
-rewrite <- H5; apply le_n_S.
-apply le_trans with (pred (N - n)).
-apply H1.
-apply le_S_n.
-replace (S (pred (N - n))) with (N - n)%nat.
-apply le_trans with N.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 = (2 * S N0)%nat).
-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 in |- *.
-repeat rewrite Rinv_mult_distr.
-replace (S N - S N0)%nat with (S N0).
-rewrite (Rmult_comm (INR (fact (S N)))).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; reflexivity.
-apply INR_fact_neq_0.
-replace (S N) with (S N0 + S N0)%nat.
-symmetry  in |- *; 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 in |- *.
-rewrite (Rmult_comm (INR (fact (S N)))).
-rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; rewrite Rinv_mult_distr.
-reflexivity.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-unfold maj_Reste_E in |- *.
-unfold Rdiv in |- *; rewrite (Rmult_comm 4).
-rewrite Rmult_assoc.
-apply Rmult_le_compat_l.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-apply Rle_trans with
- (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N)))))
-    (pred N)).
-apply sum_Rle; intros.
-rewrite sum_cte.
-replace (S (pred (N - n))) with (N - n)%nat.
-right; apply Rmult_comm.
-apply S_pred with 0%nat.
-apply plus_lt_reg_l with n.
-rewrite <- le_plus_minus.
-replace (n + 0)%nat 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 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)).
-apply sum_Rle; intros.
-do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt.
-apply INR_fact_neq_0.
-apply le_INR.
-apply (fun p n m:nat => plus_le_reg_l n m p) 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_comm; rewrite mult_INR; rewrite Rsqr_mult.
-rewrite Rinv_mult_distr.
-rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc;
- apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
-rewrite <- H0.
-cut (INR N <= INR (2 * div2 (S N))).
-intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))).
-apply Rsqr_pos_lt.
-apply not_O_INR; red in |- *; intro.
-cut (1 < S N)%nat.
-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_1_l.
-replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ].
-rewrite Rmult_assoc.
-rewrite Rmult_comm.
-replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
-rewrite <- Rsqr_mult.
-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_0_compat.
-prove_sup0.
-apply lt_INR_0; apply div2_not_R0.
-apply lt_n_S; apply H.
-cut (1 < S N)%nat.
-intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro;
- assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; 
- elim (lt_n_O _ H4).
-apply lt_n_S; apply H.
-assert (H1 := even_odd_cor N).
-elim H1; intros N0 H2.
-elim H2; intro.
-pattern N at 2 in |- *; rewrite H3.
-rewrite div2_S_double.
-right; rewrite H3; reflexivity.
-pattern N at 2 in |- *; rewrite H3.
-replace (S (S (2 * N0))) with (2 * S N0)%nat.
-rewrite div2_double.
-rewrite H3.
-rewrite S_INR; do 2 rewrite mult_INR.
-rewrite (S_INR N0).
-rewrite Rmult_plus_distr_l.
-apply Rplus_le_compat_l.
-rewrite Rmult_1_r.
-simpl in |- *.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- apply Rlt_0_1.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
-unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0.
-unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate.
-assert (H0 := even_odd_cor N).
-elim H0; intros N0 H1.
-elim H1; intro.
-cut (0 < N0)%nat.
-intro; rewrite H2.
-rewrite div2_S_double.
-replace (2 * N0)%nat with (S (S (2 * pred N0))).
-replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)).
-rewrite div2_S_double.
-apply S_pred with 0%nat; 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  in |- *; apply S_pred with 0%nat; apply H3.
-rewrite H2 in H.
-apply neq_O_lt.
-red in |- *; intro.
-rewrite <- H3 in H.
-simpl in H.
-elim (lt_n_O _ H).
-rewrite H2.
-replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ].
-replace (S (S (2 * N0))) with (2 * S N0)%nat.
-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 0%nat; apply H.
+              pred (N - k)))) (pred N)).
+  apply
+    (Rsum_abs
+      (fun k:nat =>
+        sum_f_R0
+        (fun l:nat =>
+          / INR (fact (S (l + k))) * x ^ S (l + k) *
+          (/ INR (fact (N - l)) * y ^ (N - l))) (
+            pred (N - k))) (pred N)).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+        sum_f_R0
+        (fun l:nat =>
+          Rabs
+          (/ INR (fact (S (l + k))) * x ^ S (l + k) *
+            (/ INR (fact (N - l)) * y ^ (N - l)))) (
+              pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply
+    (Rsum_abs
+      (fun l:nat =>
+        / INR (fact (S (l + n))) * x ^ S (l + n) *
+        (/ INR (fact (N - l)) * y ^ (N - l)))).
+  apply Rle_trans with
+    (sum_f_R0
+      (fun k:nat =>
+        sum_f_R0
+        (fun l:nat =>
+          M ^ (2 * N) * / INR (fact (S l)) * / INR (fact (N - l)))
+        (pred (N - k))) (pred N)).
+  apply sum_Rle; intros.
+  apply sum_Rle; intros.
+  repeat rewrite Rabs_mult.
+  do 2 rewrite <- RPow_abs.
+  rewrite (Rabs_right (/ INR (fact (S (n0 + n))))).
+  rewrite (Rabs_right (/ INR (fact (N - n0)))).
+  replace
+  (/ INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
+    (/ INR (fact (N - n0)) * Rabs y ^ (N - n0))) with
+  (/ INR (fact (N - n0)) * / INR (fact (S (n0 + n))) * Rabs x ^ S (n0 + n) *
+    Rabs y ^ (N - n0)); [ idtac | ring ].
+  rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
+  repeat rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_trans with
+    (/ INR (fact (S n0)) * Rabs x ^ S (n0 + n) * Rabs y ^ (N - n0)).
+  rewrite (Rmult_comm (/ INR (fact (S (n0 + n)))));
+    rewrite (Rmult_comm (/ INR (fact (S n0)))); repeat rewrite Rmult_assoc;
+      apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  rewrite (Rmult_comm (/ INR (fact (S n0)))); apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  apply Rle_Rinv.
+  apply INR_fact_lt_0.
+  apply INR_fact_lt_0.
+  apply le_INR; apply fact_le; apply le_n_S.
+  apply le_plus_l.
+  rewrite (Rmult_comm (M ^ (2 * N))); rewrite Rmult_assoc;
+    apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_trans with (M ^ S (n0 + n) * Rabs y ^ (N - n0)).
+  do 2 rewrite <- (Rmult_comm (Rabs y ^ (N - n0))).
+  apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  apply pow_incr; split.
+  apply Rabs_pos.
+  apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  apply RmaxLess1.
+  unfold M in |- *; apply RmaxLess2.
+  apply Rle_trans with (M ^ S (n0 + n) * M ^ (N - n0)).
+  apply Rmult_le_compat_l.
+  apply pow_le; apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  unfold M in |- *; apply RmaxLess1.
+  apply pow_incr; split.
+  apply Rabs_pos.
+  apply Rle_trans with (Rmax (Rabs x) (Rabs y)).
+  apply RmaxLess2.
+  unfold M in |- *; apply RmaxLess2.
+  rewrite <- pow_add; replace (S (n0 + n) + (N - n0))%nat with (N + S n)%nat.
+  apply Rle_pow.
+  unfold M in |- *; apply RmaxLess1.
+  replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
+  apply plus_le_compat_l.
+  replace N with (S (pred N)).
+  apply le_n_S; apply H0.
+  symmetry  in |- *; apply S_pred with 0%nat; apply H.
+  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 (N - n)).
+  apply H1.
+  apply le_S_n.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  apply le_trans with N.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
+  apply plus_lt_reg_l with n.
+  rewrite <- le_plus_minus.
+  replace (n + 0)%nat 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_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  rewrite scal_sum.
+  apply sum_Rle; intros.
+  rewrite <- Rmult_comm.
+  rewrite scal_sum.
+  apply sum_Rle; intros.
+  rewrite (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
+  rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  unfold M in |- *; 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 (N - n0))).
+  do 2 rewrite <- (Rmult_comm (/ INR (fact (N - n0)))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_Rinv.
+  apply INR_fact_lt_0.
+  apply INR_fact_lt_0.
+  apply le_INR.
+  apply fact_le.
+  apply le_n_Sn.
+  replace (/ INR (fact n0) * / INR (fact (N - n0))) with
+  (C N n0 / INR (fact N)).
+  pattern N at 1 in |- *; rewrite H4.
+  apply Rle_trans with (C N N0 / INR (fact N)).
+  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact N))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  rewrite H4.
+  apply C_maj.
+  rewrite <- H4; apply le_trans with (pred (N - n)).
+  apply H1.
+  apply le_S_n.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  apply le_trans with N.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
+  apply plus_lt_reg_l with n.
+  rewrite <- le_plus_minus.
+  replace (n + 0)%nat 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 in |- *.
+  repeat rewrite Rinv_mult_distr.
+  rewrite (Rmult_comm (INR (fact N))).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; replace (N - N0)%nat with N0.
+  ring.
+  replace N with (N0 + N0)%nat.
+  symmetry  in |- *; apply minus_plus.
+  rewrite H4.
+  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 in |- *.
+  rewrite (Rmult_comm (INR (fact N))).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rinv_mult_distr.
+  rewrite Rmult_1_r; ring.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  replace (/ INR (fact (S n0)) * / INR (fact (N - n0))) with
+  (C (S N) (S n0) / INR (fact (S N))).
+  apply Rle_trans with (C (S N) (S N0) / INR (fact (S N))).
+  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ INR (fact (S N)))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  cut (S N = (2 * S N0)%nat).
+  intro; rewrite H5; apply C_maj.
+  rewrite <- H5; apply le_n_S.
+  apply le_trans with (pred (N - n)).
+  apply H1.
+  apply le_S_n.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  apply le_trans with N.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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 0%nat.
+  apply plus_lt_reg_l with n.
+  rewrite <- le_plus_minus.
+  replace (n + 0)%nat 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.
+  rewrite H4; ring_nat.
+  cut (S N = (2 * S N0)%nat).
+  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 in |- *.
+  repeat rewrite Rinv_mult_distr.
+  replace (S N - S N0)%nat with (S N0).
+  rewrite (Rmult_comm (INR (fact (S N)))).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; reflexivity.
+  apply INR_fact_neq_0.
+  replace (S N) with (S N0 + S N0)%nat.
+  symmetry  in |- *; apply minus_plus.
+  rewrite H5; ring.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  rewrite H4; ring_nat.
+  unfold C, Rdiv in |- *.
+  rewrite (Rmult_comm (INR (fact (S N)))).
+  rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; rewrite Rinv_mult_distr.
+  reflexivity.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  unfold maj_Reste_E in |- *.
+  unfold Rdiv in |- *; rewrite (Rmult_comm 4).
+  rewrite Rmult_assoc.
+  apply Rmult_le_compat_l.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  apply Rle_trans with
+    (sum_f_R0 (fun k:nat => INR (N - k) * / Rsqr (INR (fact (div2 (S N)))))
+      (pred N)).
+  apply sum_Rle; intros.
+  rewrite sum_cte.
+  replace (S (pred (N - n))) with (N - n)%nat.
+  right; apply Rmult_comm.
+  apply S_pred with 0%nat.
+  apply plus_lt_reg_l with n.
+  rewrite <- le_plus_minus.
+  replace (n + 0)%nat 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 (fun k:nat => INR N * / Rsqr (INR (fact (div2 (S N))))) (pred N)).
+  apply sum_Rle; intros.
+  do 2 rewrite <- (Rmult_comm (/ Rsqr (INR (fact (div2 (S N)))))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt.
+  apply INR_fact_neq_0.
+  apply le_INR.
+  apply (fun p n m:nat => plus_le_reg_l n m p) 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_comm; rewrite mult_INR; rewrite Rsqr_mult.
+  rewrite Rinv_mult_distr.
+  rewrite (Rmult_comm (INR N)); repeat rewrite Rmult_assoc;
+    apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
+  rewrite <- H0.
+  cut (INR N <= INR (2 * div2 (S N))).
+  intro; apply Rmult_le_reg_l with (Rsqr (INR (div2 (S N)))).
+  apply Rsqr_pos_lt.
+  apply not_O_INR; red in |- *; intro.
+  cut (1 < S N)%nat.
+  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_1_l.
+  replace (INR N * INR N) with (Rsqr (INR N)); [ idtac | reflexivity ].
+  rewrite Rmult_assoc.
+  rewrite Rmult_comm.
+  replace 4 with (Rsqr 2); [ idtac | ring_Rsqr ].
+  rewrite <- Rsqr_mult.
+  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_0_compat.
+  prove_sup0.
+  apply lt_INR_0; apply div2_not_R0.
+  apply lt_n_S; apply H.
+  cut (1 < S N)%nat.
+  intro; unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; intro;
+    assert (H4 := div2_not_R0 _ H2); rewrite H3 in H4; 
+      elim (lt_n_O _ H4).
+  apply lt_n_S; apply H.
+  assert (H1 := even_odd_cor N).
+  elim H1; intros N0 H2.
+  elim H2; intro.
+  pattern N at 2 in |- *; rewrite H3.
+  rewrite div2_S_double.
+  right; rewrite H3; reflexivity.
+  pattern N at 2 in |- *; rewrite H3.
+  replace (S (S (2 * N0))) with (2 * S N0)%nat.
+  rewrite div2_double.
+  rewrite H3.
+  rewrite S_INR; do 2 rewrite mult_INR.
+  rewrite (S_INR N0).
+  rewrite Rmult_plus_distr_l.
+  apply Rplus_le_compat_l.
+  rewrite Rmult_1_r.
+  simpl in |- *.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    apply Rlt_0_1.
+  ring_nat.
+  unfold Rsqr in |- *; apply prod_neq_R0; apply INR_fact_neq_0.
+  unfold Rsqr in |- *; apply prod_neq_R0; apply not_O_INR; discriminate.
+  assert (H0 := even_odd_cor N).
+  elim H0; intros N0 H1.
+  elim H1; intro.
+  cut (0 < N0)%nat.
+  intro; rewrite H2.
+  rewrite div2_S_double.
+  replace (2 * N0)%nat with (S (S (2 * pred N0))).
+  replace (pred (S (S (2 * pred N0)))) with (S (2 * pred N0)).
+  rewrite div2_S_double.
+  apply S_pred with 0%nat; apply H3.
+  reflexivity.
+  omega.
+  omega.
+  rewrite H2.
+  replace (pred (S (2 * N0))) with (2 * N0)%nat; [ idtac | reflexivity ].
+  replace (S (S (2 * N0))) with (2 * S N0)%nat.
+  do 2 rewrite div2_double.
+  reflexivity.
+  ring_nat.
+  apply S_pred with 0%nat; apply H.
 Qed.
 
 Lemma maj_Reste_cv_R0 : forall 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 in |- *; intros.
-cut (0 < eps / 4);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H _ H1); intros N0 H2.
-exists (max (2 * S N0) 2); intros.
-unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r;
- unfold Majxy in H2; unfold maj_Reste_E in |- *.
-rewrite Rabs_right.
-apply Rle_lt_trans with
- (4 *
+Proof.
+  intros; assert (H := Majxy_cv_R0 x y).
+  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  cut (0 < eps / 4);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H _ H1); intros N0 H2.
+  exists (max (2 * S N0) 2); intros.
+  unfold R_dist in H2; unfold R_dist in |- *; rewrite Rminus_0_r;
+    unfold Majxy in H2; unfold maj_Reste_E in |- *.
+  rewrite Rabs_right.
+  apply Rle_lt_trans with
+    (4 *
+      (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
+        INR (fact (div2 (pred n))))).
+  apply Rmult_le_compat_l.
+  left; prove_sup0.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)));
+    rewrite
+      (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n)))))
+      ; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)).
+  rewrite Rmult_comm;
+    pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *;
+      rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
+  apply pow_le; apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))).
+  apply INR_fact_lt_0.
+  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+  replace 1 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 (0 < N1)%nat.
+  intro.
+  rewrite H6.
+  replace (pred (2 * N1)) with (S (2 * pred N1)).
+  rewrite div2_S_double.
+  omega.
+  omega.
+  assert (0 < n)%nat.
+  apply lt_le_trans with 2%nat.
+  apply lt_O_Sn.
+  apply le_trans with (max (2 * S N0) 2).
+  apply le_max_r.
+  apply H3.
+  omega.
+  rewrite H6.
+  replace (pred (S (2 * N1))) with (2 * N1)%nat.
+  rewrite div2_double.
+  replace (4 * S N1)%nat with (2 * (2 * S N1))%nat.
+  apply (fun m n p:nat => mult_le_compat_l p n m).
+  replace (2 * S N1)%nat with (S (S (2 * N1))).
+  apply le_n_Sn.
+  ring_nat.
+  ring_nat.
+  reflexivity.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply Rmult_lt_reg_l with (/ 4).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite Rmult_comm.
+  replace
   (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
-   INR (fact (div2 (pred n))))).
-apply Rmult_le_compat_l.
-left; prove_sup0.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
-rewrite (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)));
- rewrite
-  (Rmult_comm (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n)))))
-  ; rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Rle_trans with (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)).
-rewrite Rmult_comm;
- pattern (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (2 * n)) at 2 in |- *;
- rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
-apply pow_le; apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-apply Rmult_le_reg_l with (INR (fact (div2 (pred n)))).
-apply INR_fact_lt_0.
-rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
-replace 1 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 (0 < N1)%nat.
-intro.
-rewrite H6.
-replace (pred (2 * N1)) with (S (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 0%nat; apply H7.
-replace (2 * N1)%nat with (S (S (2 * pred N1))).
-reflexivity.
-pattern N1 at 2 in |- *; 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  in |- *; apply S_pred with 0%nat; apply H7.
-apply INR_lt.
-apply Rmult_lt_reg_l with (INR 2).
-simpl in |- *; prove_sup0.
-rewrite Rmult_0_r; rewrite <- mult_INR.
-apply lt_INR_0.
-rewrite <- H6.
-apply lt_le_trans with 2%nat.
-apply lt_O_Sn.
-apply le_trans with (max (2 * S N0) 2).
-apply le_max_r.
-apply H3.
-rewrite H6.
-replace (pred (S (2 * N1))) with (2 * N1)%nat.
-rewrite div2_double.
-replace (4 * S N1)%nat with (2 * (2 * S N1))%nat.
-apply (fun m n p:nat => mult_le_compat_l p n m).
-replace (2 * S N1)%nat with (S (S (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 Rmult_lt_reg_l with (/ 4).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite Rmult_comm.
-replace
- (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
-  INR (fact (div2 (pred n)))) with
- (Rabs
+    INR (fact (div2 (pred n)))) with
+  (Rabs
     (Rmax 1 (Rmax (Rabs x) (Rabs y)) ^ (4 * S (div2 (pred n))) /
-     INR (fact (div2 (pred n))) - 0)).
-apply H2; unfold ge in |- *.
-cut (2 * S N0 <= n)%nat.
-intro; apply le_S_n.
-apply INR_le; apply Rmult_le_reg_l with (INR 2).
-simpl in |- *; prove_sup0.
-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 (0 < N1)%nat.
-intro.
-rewrite H7.
-apply (fun m n p:nat => mult_le_compat_l p n m).
-replace (pred (2 * N1)) with (S (2 * pred N1)).
-rewrite div2_S_double.
-replace (S (pred N1)) with N1.
-apply le_n.
-apply S_pred with 0%nat; apply H8.
-replace (2 * N1)%nat with (S (S (2 * pred N1))).
-reflexivity.
-pattern N1 at 2 in |- *; replace N1 with (S (pred N1)).
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
-symmetry  in |- *; apply S_pred with 0%nat; apply H8.
-apply INR_lt.
-apply Rmult_lt_reg_l with (INR 2).
-simpl in |- *; prove_sup0.
-rewrite Rmult_0_r; rewrite <- mult_INR.
-apply lt_INR_0.
-rewrite <- H7.
-apply lt_le_trans with 2%nat.
-apply lt_O_Sn.
-apply le_trans with (max (2 * S N0) 2).
-apply le_max_r.
-apply H3.
-rewrite H7.
-replace (pred (S (2 * N1))) with (2 * N1)%nat.
-rewrite div2_double.
-replace (2 * S N1)%nat with (S (S (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 (2 * S N0) 2).
-apply le_max_l.
-apply H3.
-rewrite Rminus_0_r; apply Rabs_right.
-apply Rle_ge.
-unfold Rdiv in |- *; repeat apply Rmult_le_pos.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-discrR.
-apply Rle_ge.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-left; prove_sup0.
-apply Rmult_le_pos.
-apply pow_le.
-apply Rle_trans with 1.
-left; apply Rlt_0_1.
-apply RmaxLess1.
-left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
+      INR (fact (div2 (pred n))) - 0)).
+  apply H2; unfold ge in |- *.
+  cut (2 * S N0 <= n)%nat.
+  intro; apply le_S_n.
+  apply INR_le; apply Rmult_le_reg_l with (INR 2).
+  simpl in |- *; prove_sup0.
+  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 (0 < N1)%nat.
+  intro.
+  rewrite H7.
+  apply (fun m n p:nat => mult_le_compat_l p n m).
+  replace (pred (2 * N1)) with (S (2 * pred N1)).
+  rewrite div2_S_double.
+  replace (S (pred N1)) with N1.
+  apply le_n.
+  apply S_pred with 0%nat; apply H8.
+  replace (2 * N1)%nat with (S (S (2 * pred N1))).
+  reflexivity.
+  pattern N1 at 2 in |- *; replace N1 with (S (pred N1)).
+  ring_nat.
+  symmetry  in |- *; apply S_pred with 0%nat; apply H8.
+  apply INR_lt.
+  apply Rmult_lt_reg_l with (INR 2).
+  simpl in |- *; prove_sup0.
+  rewrite Rmult_0_r; rewrite <- mult_INR.
+  apply lt_INR_0.
+  rewrite <- H7.
+  apply lt_le_trans with 2%nat.
+  apply lt_O_Sn.
+  apply le_trans with (max (2 * S N0) 2).
+  apply le_max_r.
+  apply H3.
+  rewrite H7.
+  replace (pred (S (2 * N1))) with (2 * N1)%nat.
+  rewrite div2_double.
+  replace (2 * S N1)%nat with (S (S (2 * N1))).
+  apply le_n_Sn.
+  ring_nat.
+  reflexivity.
+  apply le_trans with (max (2 * S N0) 2).
+  apply le_max_l.
+  apply H3.
+  rewrite Rminus_0_r; apply Rabs_right.
+  apply Rle_ge.
+  unfold Rdiv in |- *; repeat apply Rmult_le_pos.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  left; apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  discrR.
+  apply Rle_ge.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  left; prove_sup0.
+  apply Rmult_le_pos.
+  apply pow_le.
+  apply Rle_trans with 1.
+  left; apply Rlt_0_1.
+  apply RmaxLess1.
+  left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; apply INR_fact_neq_0.
 Qed.
 
 (**********)
 Lemma Reste_E_cv : forall x y:R, Un_cv (Reste_E x y) 0.
-intros; assert (H := maj_Reste_cv_R0 x y).
-unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros.
-exists (max x0 1); intros.
-unfold R_dist in |- *; rewrite Rminus_0_r.
-apply Rle_lt_trans with (maj_Reste_E x y n).
-apply Reste_E_maj.
-apply lt_le_trans with 1%nat.
-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) 0).
-apply H1.
-unfold ge in |- *; apply le_trans with (max x0 1).
-apply le_max_l.
-apply H2.
-unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right.
-apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)).
-apply Rabs_pos.
-apply Reste_E_maj.
-apply lt_le_trans with 1%nat.
-apply lt_O_Sn.
-apply le_trans with (max x0 1).
-apply le_max_r.
-apply H2.
+Proof.
+  intros; assert (H := maj_Reste_cv_R0 x y).
+  unfold Un_cv in H; unfold Un_cv in |- *; intros; elim (H _ H0); intros.
+  exists (max x0 1); intros.
+  unfold R_dist in |- *; rewrite Rminus_0_r.
+  apply Rle_lt_trans with (maj_Reste_E x y n).
+  apply Reste_E_maj.
+  apply lt_le_trans with 1%nat.
+  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) 0).
+  apply H1.
+  unfold ge in |- *; apply le_trans with (max x0 1).
+  apply le_max_l.
+  apply H2.
+  unfold R_dist in |- *; rewrite Rminus_0_r; apply Rabs_right.
+  apply Rle_ge; apply Rle_trans with (Rabs (Reste_E x y n)).
+  apply Rabs_pos.
+  apply Reste_E_maj.
+  apply lt_le_trans with 1%nat.
+  apply lt_O_Sn.
+  apply le_trans with (max x0 1).
+  apply le_max_r.
+  apply H2.
 Qed.
 
 (**********)
 Lemma exp_plus : forall 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 in |- *; unfold Un_cv in H3; intros.
-elim (H3 _ H4); intros.
-exists (S x0); intros.
-rewrite <- (exp_form x y n).
-rewrite Rminus_0_r in H5.
-apply H5.
-unfold ge in |- *; apply le_trans with (S x0).
-apply le_n_Sn.
-apply H6.
-apply lt_le_trans with (S x0).
-apply lt_O_Sn.
-apply H6.
+Proof.
+  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 in |- *; unfold Un_cv in H3; intros.
+  elim (H3 _ H4); intros.
+  exists (S x0); intros.
+  rewrite <- (exp_form x y n).
+  rewrite Rminus_0_r in H5.
+  apply H5.
+  unfold ge in |- *; apply le_trans with (S x0).
+  apply le_n_Sn.
+  apply H6.
+  apply lt_le_trans with (S x0).
+  apply lt_O_Sn.
+  apply H6.
 Qed.
 
 (**********)
 Lemma exp_pos_pos : forall x:R, 0 < x -> 0 < exp x.
-intros; set (An := fun N:nat => / INR (fact N) * x ^ N).
-cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)).
-intro; apply Rlt_le_trans with (sum_f_R0 An 0).
-unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r;
- apply Rlt_0_1.
-apply sum_incr.
-assumption.
-intro; unfold An in |- *; left; apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply (pow_lt _ n H).
-unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro.
-unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial.
+Proof.
+  intros; set (An := fun N:nat => / INR (fact N) * x ^ N).
+  cut (Un_cv (fun n:nat => sum_f_R0 An n) (exp x)).
+  intro; apply Rlt_le_trans with (sum_f_R0 An 0).
+  unfold An in |- *; simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r;
+    apply Rlt_0_1.
+  apply sum_incr.
+  assumption.
+  intro; unfold An in |- *; left; apply Rmult_lt_0_compat.
+  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply (pow_lt _ n H).
+  unfold exp in |- *; unfold projT1 in |- *; case (exist_exp x); intro.
+  unfold exp_in in |- *; unfold infinit_sum, Un_cv in |- *; trivial.
 Qed.
 
 (**********)
 Lemma exp_pos : forall x:R, 0 < exp x.
-intro; case (total_order_T 0 x); intro.
-elim s; intro.
-apply (exp_pos_pos _ a).
-rewrite <- b; rewrite exp_0; apply Rlt_0_1.
-replace (exp x) with (1 / exp (- x)).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rlt_0_1.
-apply Rinv_0_lt_compat; apply exp_pos_pos.
-apply (Ropp_0_gt_lt_contravar _ r).
-cut (exp (- x) <> 0).
-intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)).
-rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
-rewrite <- exp_plus.
-rewrite Rplus_opp_l; rewrite exp_0; reflexivity.
-apply H.
-apply H.
-assert (H := exp_plus x (- x)).
-rewrite Rplus_opp_r in H; rewrite exp_0 in H.
-red in |- *; intro; rewrite H0 in H.
-rewrite Rmult_0_r in H.
-elim R1_neq_R0; assumption.
+Proof.
+  intro; case (total_order_T 0 x); intro.
+  elim s; intro.
+  apply (exp_pos_pos _ a).
+  rewrite <- b; rewrite exp_0; apply Rlt_0_1.
+  replace (exp x) with (1 / exp (- x)).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rlt_0_1.
+  apply Rinv_0_lt_compat; apply exp_pos_pos.
+  apply (Ropp_0_gt_lt_contravar _ r).
+  cut (exp (- x) <> 0).
+  intro; unfold Rdiv in |- *; apply Rmult_eq_reg_l with (exp (- x)).
+  rewrite Rmult_1_l; rewrite <- Rinv_r_sym.
+  rewrite <- exp_plus.
+  rewrite Rplus_opp_l; rewrite exp_0; reflexivity.
+  apply H.
+  apply H.
+  assert (H := exp_plus x (- x)).
+  rewrite Rplus_opp_r in H; rewrite exp_0 in H.
+  red in |- *; intro; rewrite H0 in H.
+  rewrite Rmult_0_r 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 in |- *; intros.
-set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))).
-cut (CVN_R fn).
-intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
-intro cv; cut (forall n:nat, continuity (fn n)).
-intro; cut (continuity (SFL fn cv)).
-intro; unfold continuity in H1.
-assert (H2 := H1 0).
-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_0_l; rewrite exp_0.
-replace ((exp h - 1) / h) with (SFL fn cv h).
-replace 1 with (SFL fn cv 0).
-apply H5.
-split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-apply (sym_not_eq H6).
-rewrite Rminus_0_r; apply H7.
-unfold SFL in |- *.
-case (cv 0); intros.
-eapply UL_sequence.
-apply u.
-unfold Un_cv, SP in |- *.
-intros; exists 1%nat; intros.
-unfold R_dist in |- *; rewrite decomp_sum.
-rewrite (Rplus_comm (fn 0%nat 0)).
-replace (fn 0%nat 0) with 1.
-unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r;
- rewrite Rplus_0_r.
-replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0.
-rewrite Rabs_R0; apply H8.
-symmetry  in |- *; apply sum_eq_R0; intros.
-unfold fn in |- *.
-simpl in |- *.
-unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity.
-unfold fn in |- *; simpl in |- *.
-unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
-apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
-unfold SFL, exp in |- *.
-unfold projT1 in |- *.
-case (cv h); case (exist_exp h); intros.
-eapply UL_sequence.
-apply u.
-unfold Un_cv in |- *; intros.
-unfold exp_in in e.
-unfold infinit_sum in e.
-cut (0 < eps0 * Rabs h).
-intro; elim (e _ H9); intros N0 H10.
-exists N0; intros.
-unfold R_dist in |- *.
-apply Rmult_lt_reg_l with (Rabs h).
-apply Rabs_pos_lt; assumption.
-rewrite <- Rabs_mult.
-rewrite Rmult_minus_distr_l.
-replace (h * ((x - 1) / h)) with (x - 1).
-unfold R_dist in H10.
-replace (h * SP fn n h - (x - 1)) with
- (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x).
-rewrite (Rmult_comm (Rabs h)).
-apply H10.
-unfold ge in |- *.
-apply le_trans with (S N0).
-apply le_n_Sn.
-apply le_n_S; apply H11.
-rewrite decomp_sum.
-replace (/ INR (fact 0) * h ^ 0) with 1.
-unfold Rminus in |- *.
-rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-rewrite <- (Rplus_comm (- x)).
-rewrite <- (Rplus_comm (- x + 1)).
-rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l.
-replace (pred (S n)) with n; [ idtac | reflexivity ].
-unfold SP in |- *.
-rewrite scal_sum.
-apply sum_eq; intros.
-unfold fn in |- *.
-replace (h ^ S i) with (h * h ^ i).
-unfold Rdiv in |- *; ring.
-simpl in |- *; ring.
-simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
-apply lt_O_Sn.
-unfold Rdiv in |- *.
-rewrite <- Rmult_assoc.
-symmetry  in |- *; apply Rinv_r_simpl_m.
-assumption.
-apply Rmult_lt_0_compat.
-apply H8.
-apply Rabs_pos_lt; assumption.
-apply SFL_continuity; assumption.
-intro; unfold fn in |- *.
-replace (fun x:R => x ^ n / INR (fact (S n))) with
- (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ].
-apply continuity_div.
-apply derivable_continuous; apply (derivable_pow n).
-apply derivable_continuous; apply derivable_const.
-intro; unfold fct_cte in |- *; apply INR_fact_neq_0.
-apply (CVN_R_CVS _ X).
-assert (H0 := Alembert_exp).
-unfold CVN_R in |- *.
-intro; unfold CVN_r in |- *.
-apply existT with (fun N:nat => r ^ N / INR (fact (S N))).
-cut
- (sigT
-    (fun l:R =>
-       Un_cv
-         (fun n:nat =>
-            sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)).
-intro X.
-elim X; intros.
-exists x; intros.
-split.
-apply p.
-unfold Boule in |- *; intros.
-rewrite Rminus_0_r in H1.
-unfold fn in |- *.
-unfold Rdiv in |- *; rewrite Rabs_mult.
-cut (0 < INR (fact (S n))).
-intro.
-rewrite (Rabs_right (/ INR (fact (S n)))).
-do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))).
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply H2.
-rewrite <- RPow_abs.
-apply pow_maj_Rabs.
-rewrite Rabs_Rabsolu; left; apply H1.
-apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2.
-apply INR_fact_lt_0.
-cut ((r:R) <> 0).
-intro; apply Alembert_C2.
-intro; apply Rabs_no_R0.
-unfold Rdiv in |- *; apply prod_neq_R0.
-apply pow_nonzero; assumption.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-unfold Un_cv in H0.
-unfold Un_cv in |- *; intros.
-cut (0 < eps0 / r);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ].
-elim (H0 _ H3); intros N0 H4.
-exists N0; intros.
-cut (S n >= N0)%nat.
-intro hyp_sn.
-assert (H6 := H4 _ hyp_sn).
-unfold R_dist in H6; rewrite Rminus_0_r in H6.
-rewrite Rabs_Rabsolu in H6.
-unfold R_dist in |- *; rewrite Rminus_0_r.
-rewrite Rabs_Rabsolu.
-replace
- (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n))))
- with (r * / INR (fact (S (S n))) * / / INR (fact (S n))).
-rewrite Rmult_assoc; rewrite Rabs_mult.
-rewrite (Rabs_right r).
-apply Rmult_lt_reg_l with (/ r).
-apply Rinv_0_lt_compat; apply (cond_pos r).
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0).
-apply H6.
-assumption.
-apply Rle_ge; left; apply (cond_pos r).
-unfold Rdiv in |- *.
-repeat rewrite Rabs_mult.
-repeat rewrite Rabs_Rinv.
-rewrite Rinv_mult_distr.
-repeat rewrite Rabs_right.
-rewrite Rinv_involutive.
-rewrite (Rmult_comm r).
-rewrite (Rmult_comm (r ^ S n)).
-repeat rewrite Rmult_assoc.
-apply Rmult_eq_compat_l.
-rewrite (Rmult_comm r).
-rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))).
-apply Rmult_eq_compat_l.
-simpl in |- *.
-rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-ring.
-apply pow_nonzero; assumption.
-apply INR_fact_neq_0.
-apply Rle_ge; left; apply INR_fact_lt_0.
-apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
-apply Rle_ge; left; apply INR_fact_lt_0.
-apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
-apply Rabs_no_R0; apply pow_nonzero; assumption.
-apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-unfold ge in |- *; apply le_trans with n.
-apply H5.
-apply le_n_Sn.
-assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1;
- elim (Rlt_irrefl _ H1).
+Proof.
+  unfold derivable_pt_lim in |- *; intros.
+  set (fn := fun (N:nat) (x:R) => x ^ N / INR (fact (S N))).
+  cut (CVN_R fn).
+  intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+  intro cv; cut (forall n:nat, continuity (fn n)).
+  intro; cut (continuity (SFL fn cv)).
+  intro; unfold continuity in H1.
+  assert (H2 := H1 0).
+  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_0_l; rewrite exp_0.
+  replace ((exp h - 1) / h) with (SFL fn cv h).
+  replace 1 with (SFL fn cv 0).
+  apply H5.
+  split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  apply (sym_not_eq H6).
+  rewrite Rminus_0_r; apply H7.
+  unfold SFL in |- *.
+  case (cv 0); intros.
+  eapply UL_sequence.
+  apply u.
+  unfold Un_cv, SP in |- *.
+  intros; exists 1%nat; intros.
+  unfold R_dist in |- *; rewrite decomp_sum.
+  rewrite (Rplus_comm (fn 0%nat 0)).
+  replace (fn 0%nat 0) with 1.
+  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r;
+    rewrite Rplus_0_r.
+  replace (sum_f_R0 (fun i:nat => fn (S i) 0) (pred n)) with 0.
+  rewrite Rabs_R0; apply H8.
+  symmetry  in |- *; apply sum_eq_R0; intros.
+  unfold fn in |- *.
+  simpl in |- *.
+  unfold Rdiv in |- *; do 2 rewrite Rmult_0_l; reflexivity.
+  unfold fn in |- *; simpl in |- *.
+  unfold Rdiv in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+  apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H9 ].
+  unfold SFL, exp in |- *.
+  unfold projT1 in |- *.
+  case (cv h); case (exist_exp h); intros.
+  eapply UL_sequence.
+  apply u.
+  unfold Un_cv in |- *; intros.
+  unfold exp_in in e.
+  unfold infinit_sum in e.
+  cut (0 < eps0 * Rabs h).
+  intro; elim (e _ H9); intros N0 H10.
+  exists N0; intros.
+  unfold R_dist in |- *.
+  apply Rmult_lt_reg_l with (Rabs h).
+  apply Rabs_pos_lt; assumption.
+  rewrite <- Rabs_mult.
+  rewrite Rmult_minus_distr_l.
+  replace (h * ((x - 1) / h)) with (x - 1).
+  unfold R_dist in H10.
+  replace (h * SP fn n h - (x - 1)) with
+  (sum_f_R0 (fun i:nat => / INR (fact i) * h ^ i) (S n) - x).
+  rewrite (Rmult_comm (Rabs h)).
+  apply H10.
+  unfold ge in |- *.
+  apply le_trans with (S N0).
+  apply le_n_Sn.
+  apply le_n_S; apply H11.
+  rewrite decomp_sum.
+  replace (/ INR (fact 0) * h ^ 0) with 1.
+  unfold Rminus in |- *.
+  rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  rewrite <- (Rplus_comm (- x)).
+  rewrite <- (Rplus_comm (- x + 1)).
+  rewrite Rplus_assoc; repeat apply Rplus_eq_compat_l.
+  replace (pred (S n)) with n; [ idtac | reflexivity ].
+  unfold SP in |- *.
+  rewrite scal_sum.
+  apply sum_eq; intros.
+  unfold fn in |- *.
+  replace (h ^ S i) with (h * h ^ i).
+  unfold Rdiv in |- *; ring.
+  simpl in |- *; ring.
+  simpl in |- *; rewrite Rinv_1; rewrite Rmult_1_r; reflexivity.
+  apply lt_O_Sn.
+  unfold Rdiv in |- *.
+  rewrite <- Rmult_assoc.
+  symmetry  in |- *; apply Rinv_r_simpl_m.
+  assumption.
+  apply Rmult_lt_0_compat.
+  apply H8.
+  apply Rabs_pos_lt; assumption.
+  apply SFL_continuity; assumption.
+  intro; unfold fn in |- *.
+  replace (fun x:R => x ^ n / INR (fact (S n))) with
+  (pow_fct n / fct_cte (INR (fact (S n))))%F; [ idtac | reflexivity ].
+  apply continuity_div.
+  apply derivable_continuous; apply (derivable_pow n).
+  apply derivable_continuous; apply derivable_const.
+  intro; unfold fct_cte in |- *; apply INR_fact_neq_0.
+  apply (CVN_R_CVS _ X).
+  assert (H0 := Alembert_exp).
+  unfold CVN_R in |- *.
+  intro; unfold CVN_r in |- *.
+  apply existT with (fun N:nat => r ^ N / INR (fact (S N))).
+  cut
+    (sigT
+      (fun l:R =>
+        Un_cv
+        (fun n:nat =>
+          sum_f_R0 (fun k:nat => Rabs (r ^ k / INR (fact (S k)))) n) l)).
+  intro X.
+  elim X; intros.
+  exists x; intros.
+  split.
+  apply p.
+  unfold Boule in |- *; intros.
+  rewrite Rminus_0_r in H1.
+  unfold fn in |- *.
+  unfold Rdiv in |- *; rewrite Rabs_mult.
+  cut (0 < INR (fact (S n))).
+  intro.
+  rewrite (Rabs_right (/ INR (fact (S n)))).
+  do 2 rewrite <- (Rmult_comm (/ INR (fact (S n)))).
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply H2.
+  rewrite <- RPow_abs.
+  apply pow_maj_Rabs.
+  rewrite Rabs_Rabsolu; left; apply H1.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; apply H2.
+  apply INR_fact_lt_0.
+  cut ((r:R) <> 0).
+  intro; apply Alembert_C2.
+  intro; apply Rabs_no_R0.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  apply pow_nonzero; assumption.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  unfold Un_cv in H0.
+  unfold Un_cv in |- *; intros.
+  cut (0 < eps0 / r);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; apply (cond_pos r) ] ].
+  elim (H0 _ H3); intros N0 H4.
+  exists N0; intros.
+  cut (S n >= N0)%nat.
+  intro hyp_sn.
+  assert (H6 := H4 _ hyp_sn).
+  unfold R_dist in H6; rewrite Rminus_0_r in H6.
+  rewrite Rabs_Rabsolu in H6.
+  unfold R_dist in |- *; rewrite Rminus_0_r.
+  rewrite Rabs_Rabsolu.
+  replace
+  (Rabs (r ^ S n / INR (fact (S (S n)))) / Rabs (r ^ n / INR (fact (S n))))
+    with (r * / INR (fact (S (S n))) * / / INR (fact (S n))).
+  rewrite Rmult_assoc; rewrite Rabs_mult.
+  rewrite (Rabs_right r).
+  apply Rmult_lt_reg_l with (/ r).
+  apply Rinv_0_lt_compat; apply (cond_pos r).
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps0).
+  apply H6.
+  assumption.
+  apply Rle_ge; left; apply (cond_pos r).
+  unfold Rdiv in |- *.
+  repeat rewrite Rabs_mult.
+  repeat rewrite Rabs_Rinv.
+  rewrite Rinv_mult_distr.
+  repeat rewrite Rabs_right.
+  rewrite Rinv_involutive.
+  rewrite (Rmult_comm r).
+  rewrite (Rmult_comm (r ^ S n)).
+  repeat rewrite Rmult_assoc.
+  apply Rmult_eq_compat_l.
+  rewrite (Rmult_comm r).
+  rewrite <- Rmult_assoc; rewrite <- (Rmult_comm (INR (fact (S n)))).
+  apply Rmult_eq_compat_l.
+  simpl in |- *.
+  rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  ring.
+  apply pow_nonzero; assumption.
+  apply INR_fact_neq_0.
+  apply Rle_ge; left; apply INR_fact_lt_0.
+  apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
+  apply Rle_ge; left; apply INR_fact_lt_0.
+  apply Rle_ge; left; apply pow_lt; apply (cond_pos r).
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply Rinv_neq_0_compat; apply Rabs_no_R0; apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  unfold ge in |- *; apply le_trans with n.
+  apply H5.
+  apply le_n_Sn.
+  assert (H1 := cond_pos r); red in |- *; intro; rewrite H2 in H1;
+    elim (Rlt_irrefl _ H1).
 Qed.
 
 (**********)
 Lemma derivable_pt_lim_exp : forall 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 in |- *; intros.
-cut (0 < eps / exp x);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ].
-elim (H0 _ H1); intros del H2.
-exists del; intros.
-assert (H5 := H2 _ H3 H4).
-rewrite Rplus_0_l 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 Rabs_mult; rewrite (Rabs_right (exp x)).
-apply Rmult_lt_reg_l with (/ exp x).
-apply Rinv_0_lt_compat; apply exp_pos.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
-apply H5.
-assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6;
- elim (Rlt_irrefl _ H6).
-apply Rle_ge; left; apply exp_pos.
-rewrite Rmult_minus_distr_l.
-rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
- rewrite Rmult_minus_distr_l.
-rewrite Rmult_1_r; rewrite exp_plus; reflexivity.
+Proof.
+  intro; assert (H0 := derivable_pt_lim_exp_0).
+  unfold derivable_pt_lim in H0; unfold derivable_pt_lim in |- *; intros.
+  cut (0 < eps / exp x);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ apply H | apply Rinv_0_lt_compat; apply exp_pos ] ].
+  elim (H0 _ H1); intros del H2.
+  exists del; intros.
+  assert (H5 := H2 _ H3 H4).
+  rewrite Rplus_0_l 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 Rabs_mult; rewrite (Rabs_right (exp x)).
+  apply Rmult_lt_reg_l with (/ exp x).
+  apply Rinv_0_lt_compat; apply exp_pos.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
+  apply H5.
+  assert (H6 := exp_pos x); red in |- *; intro; rewrite H7 in H6;
+    elim (Rlt_irrefl _ H6).
+  apply Rle_ge; left; apply exp_pos.
+  rewrite Rmult_minus_distr_l.
+  rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+    rewrite Rmult_minus_distr_l.
+  rewrite Rmult_1_r; rewrite exp_plus; reflexivity.
 Qed.
diff --git a/theories/Reals/LegacyRfield.v b/theories/Reals/LegacyRfield.v
new file mode 100644
index 00000000..b33274af
--- /dev/null
+++ b/theories/Reals/LegacyRfield.v
@@ -0,0 +1,40 @@
+(************************************************************************)
+(*  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$ i*)
+
+Require Export Raxioms.
+Require Export LegacyField.
+Import LegacyRing_theory.
+
+Section LegacyRfield.
+
+Open Scope R_scope.
+
+Lemma RLegacyTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false).
+  split.
+  exact Rplus_comm.
+  symmetry  in |- *; apply Rplus_assoc.
+  exact Rmult_comm.
+  symmetry  in |- *; apply Rmult_assoc.
+  intro; apply Rplus_0_l.
+  intro; apply Rmult_1_l.
+  exact Rplus_opp_r.
+  intros.
+  rewrite Rmult_comm.
+  rewrite (Rmult_comm n p).
+  rewrite (Rmult_comm m p).
+  apply Rmult_plus_distr_l.
+  intros; contradiction.
+Defined.
+
+End LegacyRfield.
+
+Add Legacy Field
+R Rplus Rmult 1%R 0%R Ropp (fun x y:R => false) Rinv RLegacyTheory Rinv_l
+  with minus := Rminus div := Rdiv.
diff --git a/theories/Reals/MVT.v b/theories/Reals/MVT.v
index 241313a0..8bb9298a 100644
--- a/theories/Reals/MVT.v
+++ b/theories/Reals/MVT.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: MVT.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: MVT.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -15,685 +15,707 @@ Require Import Rtopology. Open Local Scope R_scope.
 
 (* The Mean Value Theorem *)
 Theorem MVT :
- forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c)
-   (pr2:forall c:R, a < c < b -> derivable_pt g c),
-   a < b ->
-   (forall c:R, a <= c <= b -> continuity_pt f c) ->
-   (forall c:R, a <= c <= b -> continuity_pt g c) ->
+  forall (f g:R -> R) (a b:R) (pr1:forall c:R, a < c < b -> derivable_pt f c)
+    (pr2:forall c:R, a < c < b -> derivable_pt g c),
+    a < b ->
+    (forall c:R, a <= c <= b -> continuity_pt f c) ->
+    (forall c:R, a <= c <= b -> continuity_pt g c) ->
     exists c : R,
-     (exists P : a < c < b,
+      (exists 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).
-set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y).
-cut (forall c:R, a < c < b -> derivable_pt h c).
-intro X; cut (forall 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; set (M := h Mx); set (m := h mx).
-cut
- (forall (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_dec (h a) M); intro.
-case (Req_dec (h a) m); intro.
-cut (forall c:R, a <= c <= b -> h c = M).
-intro; cut (a < (a + b) / 2 < b).
+Proof.
+  intros; assert (H2 := Rlt_le _ _ H).
+  set (h := fun y:R => (g b - g a) * f y - (f b - f a) * g y).
+  cut (forall c:R, a < c < b -> derivable_pt h c).
+  intro X; cut (forall 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; set (M := h Mx); set (m := h mx).
+  cut
+    (forall (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_dec (h a) M); intro.
+  case (Req_dec (h a) m); intro.
+  cut (forall 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_diag_uniq; 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 Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H.
-discrR.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double;
- apply Rplus_lt_compat_l; 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).
+  intro; exists ((a + b) / 2).
+  exists H13.
+  apply Rminus_diag_uniq; 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 Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H.
+  discrR.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite Rplus_comm; rewrite double;
+    apply Rplus_lt_compat_l; 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_diag_uniq; 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).
+  intro; exists mx.
+  exists H12.
+  apply Rminus_diag_uniq; 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_diag_uniq; 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 in |- *;
- replace
-  (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P))
-  with
-  (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) 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_0_l; 
- do 2 rewrite Rplus_0_l; reflexivity.
-unfold h in |- *; ring.
-intros; unfold h in |- *;
- change
-   (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
-      c) in |- *.
-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 ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
-      c) in |- *.
-apply derivable_pt_minus; apply derivable_pt_mult.
-apply derivable_pt_const.
-apply (pr1 _ H3).
-apply derivable_pt_const.
-apply (pr2 _ H3).
+  intro; exists Mx.
+  exists H11.
+  apply Rminus_diag_uniq; 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 in |- *;
+    replace
+    (derive_pt (fun y:R => (g b - g a) * f y - (f b - f a) * g y) c (X c P))
+    with
+      (derive_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F) 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_0_l; 
+      do 2 rewrite Rplus_0_l; reflexivity.
+  unfold h in |- *; ring.
+  intros; unfold h in |- *;
+    change
+      (continuity_pt ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
+        c) in |- *.
+  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 ((fct_cte (g b - g a) * f)%F - (fct_cte (f b - f a) * g)%F)
+        c) in |- *.
+  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 :
- forall (f:R -> R) (a b:R) (pr:derivable f),
-   a < b ->
+  forall (f:R -> R) (a b:R) (pr:derivable f),
+    a < b ->
     exists c : R, f b - f a = derive_pt f c (pr c) * (b - a) /\ a < c < b.
-intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c);
- [ intro X | intros; apply pr ].
-cut (forall c:R, a < c < b -> derivable_pt id c);
- [ intro X0 | intros; apply derivable_pt_id ].
-cut (forall c:R, a <= c <= b -> continuity_pt f c);
- [ intro | intros; apply derivable_continuous_pt; apply pr ].
-cut (forall 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_1_r 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_comm.
-apply x.
+Proof.
+  intros f a b pr H; cut (forall c:R, a < c < b -> derivable_pt f c);
+    [ intro X | intros; apply pr ].
+  cut (forall c:R, a < c < b -> derivable_pt id c);
+    [ intro X0 | intros; apply derivable_pt_id ].
+  cut (forall c:R, a <= c <= b -> continuity_pt f c);
+    [ intro | intros; apply derivable_continuous_pt; apply pr ].
+  cut (forall 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_1_r 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_comm.
+  apply x.
 Qed.
 
 Theorem MVT_cor2 :
- forall (f f':R -> R) (a b:R),
-   a < b ->
-   (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) ->
+  forall (f f':R -> R) (a b:R),
+    a < b ->
+    (forall c:R, a <= c <= b -> derivable_pt_lim f c (f' c)) ->
     exists c : R, f b - f a = f' c * (b - a) /\ a < c < b.
-intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c).
-intro X; cut (forall c:R, a < c < b -> derivable_pt f c).
-intro X0; cut (forall c:R, a <= c <= b -> continuity_pt f c).
-intro; cut (forall c:R, a <= c <= b -> derivable_pt id c).
-intro X1; cut (forall c:R, a < c < b -> derivable_pt id c).
-intro X2; cut (forall 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) = 1).
-cut (derive_pt f x (X0 x x0) = f' x).
-intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3;
- rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry  in |- *; 
- 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 in |- *; apply existT with (f' c); apply H0;
- apply H1.
+Proof.
+  intros f f' a b H H0; cut (forall c:R, a <= c <= b -> derivable_pt f c).
+  intro X; cut (forall c:R, a < c < b -> derivable_pt f c).
+  intro X0; cut (forall c:R, a <= c <= b -> continuity_pt f c).
+  intro; cut (forall c:R, a <= c <= b -> derivable_pt id c).
+  intro X1; cut (forall c:R, a < c < b -> derivable_pt id c).
+  intro X2; cut (forall 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) = 1).
+  cut (derive_pt f x (X0 x x0) = f' x).
+  intros; rewrite H4 in H3; rewrite H5 in H3; unfold id in H3;
+    rewrite Rmult_1_r in H3; rewrite Rmult_comm; symmetry  in |- *; 
+      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 in |- *; apply existT with (f' c); apply H0;
+    apply H1.
 Qed.
 
 Lemma MVT_cor3 :
- forall (f f':R -> R) (a b:R),
-   a < b ->
-   (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) ->
+  forall (f f':R -> R) (a b:R),
+    a < b ->
+    (forall x:R, a <= x -> x <= b -> derivable_pt_lim f x (f' x)) ->
     exists c : R, a <= c /\ c <= b /\ f b = f a + f' c * (b - a).
-intros f f' a b H H0;
- assert (H1 :  exists 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 ] ] ].
+Proof.
+  intros f f' a b H H0;
+    assert (H1 :  exists 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 :
- forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   a < b ->
-   f a = f b ->
+  forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    a < b ->
+    f a = f b ->
     exists c : R, (exists P : a < c < b, derive_pt f c (pr c P) = 0).
-intros; assert (H2 : forall 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 : forall 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_opp_r in H6;
- rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
- [ rewrite Rmult_0_r; apply H6
- | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0;
-    elim (Rlt_irrefl _ H0) ].
+Proof.
+  intros; assert (H2 : forall 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 : forall 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_opp_r in H6;
+      rewrite Rmult_0_l in H6; apply Rmult_eq_reg_l with (b - a);
+        [ rewrite Rmult_0_r; apply H6
+          | apply Rminus_eq_contra; red in |- *; intro; rewrite H7 in H0;
+            elim (Rlt_irrefl _ H0) ].
 Qed.
 
 (**********)
 Lemma nonneg_derivative_1 :
- forall (f:R -> R) (pr:derivable f),
-   (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f.
-intros.
-unfold increasing in |- *.
-intros.
-case (total_order_T x y); intro.
-elim s; intro.
-apply Rplus_le_reg_l with (- f x).
-rewrite Rplus_opp_l; rewrite Rplus_comm.
-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 Rplus_le_reg_l with x.
-rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
-rewrite b; right; reflexivity.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
+  forall (f:R -> R) (pr:derivable f),
+    (forall x:R, 0 <= derive_pt f x (pr x)) -> increasing f.
+Proof.
+  intros.
+  unfold increasing in |- *.
+  intros.
+  case (total_order_T x y); intro.
+  elim s; intro.
+  apply Rplus_le_reg_l with (- f x).
+  rewrite Rplus_opp_l; rewrite Rplus_comm.
+  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 Rplus_le_reg_l with x.
+  rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
+  rewrite b; right; reflexivity.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r)).
 Qed.
- 
+
 (**********)
 Lemma nonpos_derivative_0 :
- forall (f:R -> R) (pr:derivable f),
-   decreasing f -> forall 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 (Rtotal_order l 0); 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 /\ Rabs (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 Rabs in |- *;
- case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
-intros;
- generalize
-  (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l))
-     (l / 2) H14); unfold Rminus in |- *.
-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
- (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2)))
-    (- (l / 2)) H15). 
-repeat rewrite Ropp_involutive.
-intro.
-generalize
- (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16);
- intro.
-elim
- (Rlt_irrefl 0
-    (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)).
-ring.
-pattern l at 3 in |- *; rewrite double_var.
-ring.
-intros.
-generalize
- (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r).
-rewrite Ropp_0.
-intro.
-elim
- (Rlt_irrefl 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 in |- *.
-apply Rplus_le_lt_0_compat.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-cut (x <= x + delta * / 2).
-intro; generalize (H0 x (x + delta * / 2) H13); intro;
- generalize
-  (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14);
- rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
- left; assumption.
-left; apply Rinv_0_lt_compat; assumption.
-assumption.
-rewrite Ropp_minus_distr.
-unfold Rminus in |- *.
-rewrite (Rplus_comm l).
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-rewrite (Rplus_comm (f x)).
-reflexivity.
-replace ((f (x + delta / 2) - f x) / (delta / 2)) with
- (- ((f x - f (x + delta / 2)) / (delta / 2))).
-rewrite <- Ropp_0.
-apply Ropp_ge_le_contravar.
-apply Rle_ge.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-cut (x <= x + delta * / 2).
-intro; generalize (H0 x (x + delta * / 2) H10); intro.
-generalize
- (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13);
- rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
- left; assumption.
-left; apply Rinv_0_lt_compat; assumption.
-unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
-rewrite Ropp_minus_distr.
-reflexivity.
-split.
-unfold Rdiv in |- *; apply prod_neq_R0.
-generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8;
- elim (Rlt_irrefl 0 H8).
-apply Rinv_neq_0_compat; discrR.
-split.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-rewrite Rabs_right.
-unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *;
- rewrite <- Rplus_0_r.
-apply Rplus_lt_compat_l; apply (cond_pos delta).
-discrR.
-apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat.
-apply (cond_pos delta).
-apply Rinv_0_lt_compat; prove_sup0.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ].
+  forall (f:R -> R) (pr:derivable f),
+    decreasing f -> forall x:R, derive_pt f x (pr x) <= 0.
+Proof.
+  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 (Rtotal_order l 0); 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 /\ Rabs (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 Rabs in |- *;
+    case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+  intros;
+    generalize
+      (Rplus_lt_compat_r (- l) (- ((f (x + delta / 2) - f x) / (delta / 2) - l))
+        (l / 2) H14); unfold Rminus in |- *.
+  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
+    (Ropp_lt_gt_contravar (- ((f (x + delta / 2) + - f x) / (delta / 2)))
+      (- (l / 2)) H15). 
+  repeat rewrite Ropp_involutive.
+  intro.
+  generalize
+    (Rlt_trans 0 (l / 2) ((f (x + delta / 2) - f x) / (delta / 2)) H6 H16);
+    intro.
+  elim
+    (Rlt_irrefl 0
+      (Rlt_le_trans 0 ((f (x + delta / 2) - f x) / (delta / 2)) 0 H17 H10)).
+  ring.
+  pattern l at 3 in |- *; rewrite double_var.
+  ring.
+  intros.
+  generalize
+    (Ropp_ge_le_contravar ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 r).
+  rewrite Ropp_0.
+  intro.
+  elim
+    (Rlt_irrefl 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 in |- *.
+  apply Rplus_le_lt_0_compat.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  cut (x <= x + delta * / 2).
+  intro; generalize (H0 x (x + delta * / 2) H13); intro;
+    generalize
+      (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H14);
+      rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+    left; assumption.
+  left; apply Rinv_0_lt_compat; assumption.
+  assumption.
+  rewrite Ropp_minus_distr.
+  unfold Rminus in |- *.
+  rewrite (Rplus_comm l).
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  rewrite (Rplus_comm (f x)).
+  reflexivity.
+  replace ((f (x + delta / 2) - f x) / (delta / 2)) with
+  (- ((f x - f (x + delta / 2)) / (delta / 2))).
+  rewrite <- Ropp_0.
+  apply Ropp_ge_le_contravar.
+  apply Rle_ge.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  cut (x <= x + delta * / 2).
+  intro; generalize (H0 x (x + delta * / 2) H10); intro.
+  generalize
+    (Rplus_le_compat_l (- f (x + delta / 2)) (f (x + delta / 2)) (f x) H13);
+    rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+    left; assumption.
+  left; apply Rinv_0_lt_compat; assumption.
+  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+  rewrite Ropp_minus_distr.
+  reflexivity.
+  split.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H8;
+    elim (Rlt_irrefl 0 H8).
+  apply Rinv_neq_0_compat; discrR.
+  split.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  rewrite Rabs_right.
+  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite double; pattern (pos delta) at 1 in |- *;
+    rewrite <- Rplus_0_r.
+  apply Rplus_lt_compat_l; apply (cond_pos delta).
+  discrR.
+  apply Rle_ge; unfold Rdiv in |- *; left; apply Rmult_lt_0_compat.
+  apply (cond_pos delta).
+  apply Rinv_0_lt_compat; prove_sup0.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply H4 | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
 (**********)
 Lemma increasing_decreasing_opp :
- forall f:R -> R, increasing f -> decreasing (- f)%F.
-unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0);
- intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption.
+  forall f:R -> R, increasing f -> decreasing (- f)%F.
+Proof.
+  unfold increasing, decreasing, opp_fct in |- *; intros; generalize (H x y H0);
+    intro; apply Ropp_ge_le_contravar; apply Rle_ge; assumption.
 Qed.
 
 (**********)
 Lemma nonpos_derivative_1 :
- forall (f:R -> R) (pr:derivable f),
-   (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f.
-intros.
-cut (forall h:R, - - f h = f h).
-intro.
-generalize (increasing_decreasing_opp (- f)%F).
-unfold decreasing in |- *.
-unfold opp_fct in |- *.
-intros.
-rewrite <- (H0 x); rewrite <- (H0 y).
-apply H1.
-cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)).
-intros.
-replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ].
-apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3).
-intro.
-assert (H3 := derive_pt_opp f x0 (pr x0)).
-cut
- (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
-  derive_pt (- f) x0 (derivable_opp f pr x0)).
-intro.
-rewrite <- H4.
-rewrite H3.
-rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0).
-apply pr_nu.
-assumption.
-intro; ring.
+  forall (f:R -> R) (pr:derivable f),
+    (forall x:R, derive_pt f x (pr x) <= 0) -> decreasing f.
+Proof.
+  intros.
+  cut (forall h:R, - - f h = f h).
+  intro.
+  generalize (increasing_decreasing_opp (- f)%F).
+  unfold decreasing in |- *.
+  unfold opp_fct in |- *.
+  intros.
+  rewrite <- (H0 x); rewrite <- (H0 y).
+  apply H1.
+  cut (forall x:R, 0 <= derive_pt (- f) x (derivable_opp f pr x)).
+  intros.
+  replace (fun x:R => - f x) with (- f)%F; [ idtac | reflexivity ].
+  apply (nonneg_derivative_1 (- f)%F (derivable_opp f pr) H3).
+  intro.
+  assert (H3 := derive_pt_opp f x0 (pr x0)).
+  cut
+    (derive_pt (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
+      derive_pt (- f) x0 (derivable_opp f pr x0)).
+  intro.
+  rewrite <- H4.
+  rewrite H3.
+  rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; apply (H x0).
+  apply pr_nu.
+  assumption.
+  intro; ring.
 Qed.
- 
+
 (**********)
 Lemma positive_derivative :
- forall (f:R -> R) (pr:derivable f),
-   (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f.
-intros.
-unfold strict_increasing in |- *.
-intros.
-apply Rplus_lt_reg_r with (- f x).
-rewrite Rplus_opp_l; rewrite Rplus_comm.
-assert (H1 := MVT_cor1 f _ _ pr H0).
-elim H1; intros.
-elim H2; intros.
-unfold Rminus in H3.
-rewrite H3.
-apply Rmult_lt_0_compat.
-apply H.
-apply Rplus_lt_reg_r with x.
-rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
+  forall (f:R -> R) (pr:derivable f),
+    (forall x:R, 0 < derive_pt f x (pr x)) -> strict_increasing f.
+Proof.
+  intros.
+  unfold strict_increasing in |- *.
+  intros.
+  apply Rplus_lt_reg_r with (- f x).
+  rewrite Rplus_opp_l; rewrite Rplus_comm.
+  assert (H1 := MVT_cor1 f _ _ pr H0).
+  elim H1; intros.
+  elim H2; intros.
+  unfold Rminus in H3.
+  rewrite H3.
+  apply Rmult_lt_0_compat.
+  apply H.
+  apply Rplus_lt_reg_r with x.
+  rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
 Qed.
 
 (**********)
 Lemma strictincreasing_strictdecreasing_opp :
- forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F.
-unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros;
- generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; 
- assumption.
+  forall f:R -> R, strict_increasing f -> strict_decreasing (- f)%F.
+Proof.
+  unfold strict_increasing, strict_decreasing, opp_fct in |- *; intros;
+    generalize (H x y H0); intro; apply Ropp_lt_gt_contravar; 
+      assumption.
 Qed.
- 
+
 (**********)
 Lemma negative_derivative :
- forall (f:R -> R) (pr:derivable f),
-   (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f.
-intros.
-cut (forall h:R, - - f h = f h).
-intros.
-generalize (strictincreasing_strictdecreasing_opp (- f)%F).
-unfold strict_decreasing, opp_fct in |- *.
-intros.
-rewrite <- (H0 x).
-rewrite <- (H0 y).
-apply H1; [ idtac | assumption ].
-cut (forall x:R, 0 < derive_pt (- 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 (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
-  derive_pt (- f) x0 (derivable_opp f pr x0)).
-intro.
-rewrite <- H4; rewrite H3.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0).
-apply pr_nu.
-intro; ring.
+  forall (f:R -> R) (pr:derivable f),
+    (forall x:R, derive_pt f x (pr x) < 0) -> strict_decreasing f.
+Proof.
+  intros.
+  cut (forall h:R, - - f h = f h).
+  intros.
+  generalize (strictincreasing_strictdecreasing_opp (- f)%F).
+  unfold strict_decreasing, opp_fct in |- *.
+  intros.
+  rewrite <- (H0 x).
+  rewrite <- (H0 y).
+  apply H1; [ idtac | assumption ].
+  cut (forall x:R, 0 < derive_pt (- 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 (- f) x0 (derivable_pt_opp f x0 (pr x0)) =
+      derive_pt (- f) x0 (derivable_opp f pr x0)).
+  intro.
+  rewrite <- H4; rewrite H3.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply (H x0).
+  apply pr_nu.
+  intro; ring.
 Qed.
- 
+
 (**********)
 Lemma null_derivative_0 :
- forall (f:R -> R) (pr:derivable f),
-   constant f -> forall x:R, derive_pt f x (pr x) = 0. 
-intros.
-unfold constant in H.
-apply derive_pt_eq_0.
-intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros.
-rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *;
- rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; 
- rewrite Rabs_R0; assumption.
+  forall (f:R -> R) (pr:derivable f),
+    constant f -> forall x:R, derive_pt f x (pr x) = 0. 
+Proof.
+  intros.
+  unfold constant in H.
+  apply derive_pt_eq_0.
+  intros; exists (mkposreal 1 Rlt_0_1); simpl in |- *; intros.
+  rewrite (H x (x + h)); unfold Rminus in |- *; unfold Rdiv in |- *;
+    rewrite Rplus_opp_r; rewrite Rmult_0_l; rewrite Rplus_opp_r; 
+      rewrite Rabs_R0; assumption.
 Qed.
 
 (**********)
 Lemma increasing_decreasing :
- forall f:R -> R, increasing f -> decreasing f -> constant f.
-unfold increasing, decreasing, constant in |- *; intros;
- case (Rtotal_order x y); intro.
-generalize (Rlt_le x y H1); intro;
- apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
-elim H1; intro.
-rewrite H2; reflexivity.
-generalize (Rlt_le y x H2); intro; symmetry  in |- *;
- apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
+  forall f:R -> R, increasing f -> decreasing f -> constant f.
+Proof.
+  unfold increasing, decreasing, constant in |- *; intros;
+    case (Rtotal_order x y); intro.
+  generalize (Rlt_le x y H1); intro;
+    apply (Rle_antisym (f x) (f y) (H x y H2) (H0 x y H2)).
+  elim H1; intro.
+  rewrite H2; reflexivity.
+  generalize (Rlt_le y x H2); intro; symmetry  in |- *;
+    apply (Rle_antisym (f y) (f x) (H y x H3) (H0 y x H3)).
 Qed.
 
 (**********)
 Lemma null_derivative_1 :
- forall (f:R -> R) (pr:derivable f),
-   (forall x:R, derive_pt f x (pr x) = 0) -> constant f.
-intros.
-cut (forall x:R, derive_pt f x (pr x) <= 0).
-cut (forall 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  in |- *; apply (H x).
-intro; right; apply (H x).
+  forall (f:R -> R) (pr:derivable f),
+    (forall x:R, derive_pt f x (pr x) = 0) -> constant f.
+Proof.
+  intros.
+  cut (forall x:R, derive_pt f x (pr x) <= 0).
+  cut (forall 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  in |- *; apply (H x).
+  intro; right; apply (H x).
 Qed.
 
 (**********)
 Lemma derive_increasing_interv_ax :
- forall (a b:R) (f:R -> R) (pr:derivable f),
-   a < b ->
-   ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
-    forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\
-   ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
-    forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y).
-intros.
-split; intros.
-apply Rplus_lt_reg_r with (- f x).
-rewrite Rplus_opp_l; rewrite Rplus_comm.
-assert (H4 := MVT_cor1 f _ _ pr H3).
-elim H4; intros.
-elim H5; intros.
-unfold Rminus in H6.
-rewrite H6.
-apply Rmult_lt_0_compat.
-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 Rplus_lt_reg_r with x.
-rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
-apply Rplus_le_reg_l with (- f x).
-rewrite Rplus_opp_l; rewrite Rplus_comm.
-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 Rplus_le_reg_l with x.
-rewrite Rplus_0_r; replace (x + (y + - x)) with y;
- [ left; assumption | ring ].
+  forall (a b:R) (f:R -> R) (pr:derivable f),
+    a < b ->
+    ((forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
+      forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y) /\
+    ((forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
+      forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y).
+Proof.
+  intros.
+  split; intros.
+  apply Rplus_lt_reg_r with (- f x).
+  rewrite Rplus_opp_l; rewrite Rplus_comm.
+  assert (H4 := MVT_cor1 f _ _ pr H3).
+  elim H4; intros.
+  elim H5; intros.
+  unfold Rminus in H6.
+  rewrite H6.
+  apply Rmult_lt_0_compat.
+  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 Rplus_lt_reg_r with x.
+  rewrite Rplus_0_r; replace (x + (y + - x)) with y; [ assumption | ring ].
+  apply Rplus_le_reg_l with (- f x).
+  rewrite Rplus_opp_l; rewrite Rplus_comm.
+  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 Rplus_le_reg_l with x.
+  rewrite Rplus_0_r; replace (x + (y + - x)) with y;
+    [ left; assumption | ring ].
 Qed.
 
 (**********)
 Lemma derive_increasing_interv :
- forall (a b:R) (f:R -> R) (pr:derivable f),
-   a < b ->
-   (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
-   forall 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).
+  forall (a b:R) (f:R -> R) (pr:derivable f),
+    a < b ->
+    (forall t:R, a < t < b -> 0 < derive_pt f t (pr t)) ->
+    forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x < f y.
+Proof.
+  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 :
- forall (a b:R) (f:R -> R) (pr:derivable f),
-   a < b ->
-   (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
-   forall 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).
+  forall (a b:R) (f:R -> R) (pr:derivable f),
+    a < b ->
+    (forall t:R, a < t < b -> 0 <= derive_pt f t (pr t)) ->
+    forall x y:R, a <= x <= b -> a <= y <= b -> x < y -> f x <= f y.
+Proof.
+  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 :
- forall (f:R -> R) (a b k:R) (pr:derivable f),
-   a <= b ->
-   (forall 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_comm (b - a)).
-apply Rmult_le_compat_l.
-apply Rplus_le_reg_l with a; rewrite Rplus_0_r.
-replace (a + (b - a)) with b; [ assumption | ring ].
-apply H0.
-elim H4; intros.
-split; left; assumption.
-rewrite b0.
-unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
-rewrite Rmult_0_r; right; reflexivity.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+  forall (f:R -> R) (a b k:R) (pr:derivable f),
+    a <= b ->
+    (forall c:R, a <= c <= b -> derive_pt f c (pr c) <= k) ->
+    f b - f a <= k * (b - a).
+Proof.
+  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_comm (b - a)).
+  apply Rmult_le_compat_l.
+  apply Rplus_le_reg_l with a; rewrite Rplus_0_r.
+  replace (a + (b - a)) with b; [ assumption | ring ].
+  apply H0.
+  elim H4; intros.
+  split; left; assumption.
+  rewrite b0.
+  unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+  rewrite Rmult_0_r; right; reflexivity.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
 Qed.
 
 Lemma IAF_var :
- forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g),
-   a <= b ->
-   (forall 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 (g - f)).
-intro X.
-cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0).
-intro. 
-assert (H2 := IAF (g - f)%F a b 0 X H H1).
-rewrite Rmult_0_l in H2; unfold minus_fct in H2.
-apply Rplus_le_reg_l with (- f b + f a).
-replace (- f b + f a + (f b - f a)) with 0; [ 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 (g - f) c (X c) =
-  derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))).
-intro.
-rewrite H2.
-rewrite derive_pt_minus.
-apply Rplus_le_reg_l with (derive_pt f c (pr1 c)).
-rewrite Rplus_0_r.
-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.
+  forall (f g:R -> R) (a b:R) (pr1:derivable f) (pr2:derivable g),
+    a <= b ->
+    (forall 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.
+Proof.
+  intros.
+  cut (derivable (g - f)).
+  intro X.
+  cut (forall c:R, a <= c <= b -> derive_pt (g - f) c (X c) <= 0).
+  intro. 
+  assert (H2 := IAF (g - f)%F a b 0 X H H1).
+  rewrite Rmult_0_l in H2; unfold minus_fct in H2.
+  apply Rplus_le_reg_l with (- f b + f a).
+  replace (- f b + f a + (f b - f a)) with 0; [ 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 (g - f) c (X c) =
+      derive_pt (g - f) c (derivable_pt_minus _ _ _ (pr2 c) (pr1 c))).
+  intro.
+  rewrite H2.
+  rewrite derive_pt_minus.
+  apply Rplus_le_reg_l with (derive_pt f c (pr1 c)).
+  rewrite Rplus_0_r.
+  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 :
- forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) ->
-   constant_D_eq f (fun x:R => a <= x <= b) (f a).
-intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro.
-elim s; intro.
-assert (H2 : forall y:R, a < y < x -> derivable_pt id y).
-intros; apply derivable_pt_id.
-assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y).
-intros; apply derivable_continuous; apply derivable_id.
-assert (H4 : forall 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 : forall 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_0_r in H9;
- rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry  in |- *;
- 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_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)).
+  forall (f:R -> R) (a b:R) (pr:forall x:R, a < x < b -> derivable_pt f x),
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    (forall (x:R) (P:a < x < b), derive_pt f x (pr x P) = 0) ->
+    constant_D_eq f (fun x:R => a <= x <= b) (f a).
+Proof.
+  intros; unfold constant_D_eq in |- *; intros; case (total_order_T a b); intro.
+  elim s; intro.
+  assert (H2 : forall y:R, a < y < x -> derivable_pt id y).
+  intros; apply derivable_pt_id.
+  assert (H3 : forall y:R, a <= y <= x -> continuity_pt id y).
+  intros; apply derivable_continuous; apply derivable_id.
+  assert (H4 : forall 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 : forall 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_0_r in H9;
+    rewrite Rmult_1_r in H9; apply Rminus_diag_uniq; symmetry  in |- *;
+      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_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H2 H3) r)).
 Qed.
 
 (* Unicity of the antiderivative *)
 Lemma antiderivative_Ucte :
- forall (f g1 g2:R -> R) (a b:R),
-   antiderivative f g1 a b ->
-   antiderivative f g2 a b ->
+  forall (f g1 g2:R -> R) (a b:R),
+    antiderivative f g1 a b ->
+    antiderivative f g2 a b ->
     exists c : R, (forall x:R, a <= x <= b -> g1 x = g2 x + c).
-unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
- clear H0; intros H0 _; exists (g1 a - g2 a); intros;
- assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x).
-intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3);
- intros; eapply derive_pt_eq_1; symmetry  in |- *; 
- apply H4.
-assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x).
-intros; unfold derivable_pt in |- *; apply existT with (f x0);
- elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry  in |- *; 
- apply H5.
-assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x).
-intros; elim H5; intros; apply derivable_pt_minus;
- [ apply H3; split; left; assumption | apply H4; split; left; assumption ].
-assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x).
-intros; apply derivable_continuous_pt; apply derivable_pt_minus;
- [ apply H3 | apply H4 ]; assumption.
-assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0).
-intros; elim P; intros; apply derive_pt_eq_0; replace 0 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  in |- *; apply H10.
-assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7);
- unfold constant_D_eq in H8; assert (H9 := H8 _ H2); 
- unfold minus_fct in H9; rewrite <- H9; ring.
+Proof.
+  unfold antiderivative in |- *; intros; elim H; clear H; intros; elim H0;
+    clear H0; intros H0 _; exists (g1 a - g2 a); intros;
+      assert (H3 : forall x:R, a <= x <= b -> derivable_pt g1 x).
+  intros; unfold derivable_pt in |- *; apply existT with (f x0); elim (H x0 H3);
+    intros; eapply derive_pt_eq_1; symmetry  in |- *; 
+      apply H4.
+  assert (H4 : forall x:R, a <= x <= b -> derivable_pt g2 x).
+  intros; unfold derivable_pt in |- *; apply existT with (f x0);
+    elim (H0 x0 H4); intros; eapply derive_pt_eq_1; symmetry  in |- *; 
+      apply H5.
+  assert (H5 : forall x:R, a < x < b -> derivable_pt (g1 - g2) x).
+  intros; elim H5; intros; apply derivable_pt_minus;
+    [ apply H3; split; left; assumption | apply H4; split; left; assumption ].
+  assert (H6 : forall x:R, a <= x <= b -> continuity_pt (g1 - g2) x).
+  intros; apply derivable_continuous_pt; apply derivable_pt_minus;
+    [ apply H3 | apply H4 ]; assumption.
+  assert (H7 : forall (x:R) (P:a < x < b), derive_pt (g1 - g2) x (H5 x P) = 0).
+  intros; elim P; intros; apply derive_pt_eq_0; replace 0 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  in |- *; apply H10.
+  assert (H8 := null_derivative_loc (g1 - g2)%F a b H5 H6 H7);
+    unfold constant_D_eq in H8; assert (H9 := H8 _ H2); 
+      unfold minus_fct in H9; rewrite <- H9; ring.
 Qed.
diff --git a/theories/Reals/NewtonInt.v b/theories/Reals/NewtonInt.v
index 62c53e6d..306d5ac4 100644
--- a/theories/Reals/NewtonInt.v
+++ b/theories/Reals/NewtonInt.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: NewtonInt.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: NewtonInt.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -23,767 +23,782 @@ Definition Newton_integrable (f:R -> R) (a b:R) : Type :=
 
 Definition NewtonInt (f:R -> R) (a b:R) (pr:Newton_integrable f a b) : R :=
   let g := match pr with
-           | existT a b => a
+             | existT a b => a
            end in g b - g a.
 
 (* If f is differentiable, then f' is Newton integrable (Tautology ?) *)
 Lemma FTCN_step1 :
- forall (f:Differential) (a b:R),
-   Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b.
-intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f);
- unfold antiderivative in |- *; intros; case (Rle_dec 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 ] ].
+  forall (f:Differential) (a b:R),
+    Newton_integrable (fun x:R => derive_pt f x (cond_diff f x)) a b.
+Proof.
+  intros f a b; unfold Newton_integrable in |- *; apply existT with (d1 f);
+    unfold antiderivative in |- *; intros; case (Rle_dec 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 :
- forall (f:Differential) (a b:R),
-   NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b
-     (FTCN_step1 f a b) = f b - f a.
-intros; unfold NewtonInt in |- *; reflexivity.
+  forall (f:Differential) (a b:R),
+    NewtonInt (fun x:R => derive_pt f x (cond_diff f x)) a b
+    (FTCN_step1 f a b) = f b - f a.
+Proof.
+  intros; unfold NewtonInt in |- *; reflexivity.
 Qed.
 
 (* $\int_a^a f$ exists forall a:R and f:R->R *)
 Lemma NewtonInt_P1 : forall (f:R -> R) (a:R), Newton_integrable f a a.
-intros f a; unfold Newton_integrable in |- *;
- apply existT with (fct_cte (f a) * id)%F; left;
- unfold antiderivative in |- *; split.
-intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x).
-apply derivable_pt_mult.
-apply derivable_pt_const.
-apply derivable_pt_id.
-exists H1; assert (H2 : x = a).
-elim H; intros; apply Rle_antisym; assumption.
-symmetry  in |- *; apply derive_pt_eq_0;
- replace (f x) with (0 * id x + fct_cte (f a) x * 1);
- [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x);
-    [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
- | unfold id, fct_cte in |- *; rewrite H2; ring ].
-right; reflexivity.
+Proof.
+  intros f a; unfold Newton_integrable in |- *;
+    apply existT with (fct_cte (f a) * id)%F; left;
+      unfold antiderivative in |- *; split.
+  intros; assert (H1 : derivable_pt (fct_cte (f a) * id) x).
+  apply derivable_pt_mult.
+  apply derivable_pt_const.
+  apply derivable_pt_id.
+  exists H1; assert (H2 : x = a).
+  elim H; intros; apply Rle_antisym; assumption.
+  symmetry  in |- *; apply derive_pt_eq_0;
+    replace (f x) with (0 * id x + fct_cte (f a) x * 1);
+    [ apply (derivable_pt_lim_mult (fct_cte (f a)) id x);
+      [ apply derivable_pt_lim_const | apply derivable_pt_lim_id ]
+      | unfold id, fct_cte in |- *; rewrite H2; ring ].
+  right; reflexivity.
 Defined.
 
 (* $\int_a^a f = 0$ *)
 Lemma NewtonInt_P2 :
- forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
-intros; unfold NewtonInt in |- *; simpl in |- *;
- unfold mult_fct, fct_cte, id in |- *; ring.
+  forall (f:R -> R) (a:R), NewtonInt f a a (NewtonInt_P1 f a) = 0.
+Proof.
+  intros; unfold NewtonInt in |- *; simpl in |- *;
+    unfold mult_fct, fct_cte, id in |- *; ring.
 Qed.
 
 (* If $\int_a^b f$ exists, then $\int_b^a f$ exists too *)
 Lemma NewtonInt_P3 :
- forall (f:R -> R) (a b:R) (X:Newton_integrable f a b),
-   Newton_integrable f b a.
-unfold Newton_integrable in |- *; intros; elim X; intros g H;
- apply existT with g; tauto.
+  forall (f:R -> R) (a b:R) (X:Newton_integrable f a b),
+    Newton_integrable f b a.
+Proof.
+  unfold Newton_integrable in |- *; intros; elim X; intros g H;
+    apply existT with g; tauto.
 Defined.
 
 (* $\int_a^b f = -\int_b^a f$ *)
 Lemma NewtonInt_P4 :
- forall (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 in |- *;
- case
-  (NewtonInt_P3 f a b
-     (existT
+  forall (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).
+Proof.
+  intros; unfold Newton_integrable in pr; elim pr; intros; elim p; intro.
+  unfold NewtonInt in |- *;
+    case
+    (NewtonInt_P3 f a b
+      (existT
         (fun 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_irrefl _ (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 in |- *;
- case
-  (NewtonInt_P3 f a b
-     (existT
+  intros; elim o; intro.
+  unfold antiderivative in H0; elim H0; intros; elim H2; intro.
+  unfold antiderivative in H; elim H; intros;
+    elim (Rlt_irrefl _ (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 in |- *;
+    case
+    (NewtonInt_P3 f a b
+      (existT
         (fun 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_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
-rewrite H3; ring.
+  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_irrefl _ (Rle_lt_trans _ _ _ H5 H3)).
+  rewrite H3; ring.
 Qed.
 
 (* The set of Newton integrable functions is a vectorial space *)
 Lemma NewtonInt_P5 :
- forall (f g:R -> R) (l a b:R),
-   Newton_integrable f a b ->
-   Newton_integrable g a b ->
-   Newton_integrable (fun x:R => l * f x + g x) a b.
-unfold Newton_integrable in |- *; intros f g l a b X X0;
- elim X; intros; elim X0; intros;
- exists (fun y:R => l * x y + x0 y).
-elim p; intro.
-elim p0; intro.
-left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
- clear H; intros; elim H0; clear H0; intros H0 _.
-split.
-intros; elim (H _ H2); elim (H0 _ H2); intros.
-assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
-reg.
-exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
-assumption.
-unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
-left; rewrite <- H5; unfold antiderivative in |- *; split.
-intros; elim H6; intros; assert (H9 : x1 = a).
-apply Rle_antisym; assumption.
-assert (H10 : a <= x1 <= b).
-split; right; [ symmetry  in |- *; assumption | rewrite <- H5; assumption ].
-assert (H11 : b <= x1 <= a).
-split; right; [ rewrite <- H5; symmetry  in |- *; assumption | assumption ].
-assert (H12 : derivable_pt x x1).
-unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros;
- eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
-assert (H13 : derivable_pt x0 x1).
-unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros;
- eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
-assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
-reg.
-exists H14; symmetry  in |- *; 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_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
-left; rewrite H5; unfold antiderivative in |- *; split.
-intros; elim H6; intros; assert (H9 : x1 = a).
-apply Rle_antisym; assumption.
-assert (H10 : a <= x1 <= b).
-split; right; [ symmetry  in |- *; assumption | rewrite H5; assumption ].
-assert (H11 : b <= x1 <= a).
-split; right; [ rewrite H5; symmetry  in |- *; assumption | assumption ].
-assert (H12 : derivable_pt x x1).
-unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros;
- eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
-assert (H13 : derivable_pt x0 x1).
-unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros;
- eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
-assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
-reg.
-exists H14; symmetry  in |- *; reg.
-assert (H15 : derive_pt x0 x1 H13 = g x1).
-elim (H1 _ H10); intros; rewrite H15; apply pr_nu.
-assert (H16 : derive_pt x x1 H12 = f x1).
-elim (H3 _ H11); intros; rewrite H16; apply pr_nu.
-rewrite H15; rewrite H16; ring.
-right; reflexivity.
-right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
- clear H; intros; elim H0; clear H0; intros H0 _; split.
-intros; elim (H _ H2); elim (H0 _ H2); intros.
-assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
-reg.
-exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
-assumption.
+  forall (f g:R -> R) (l a b:R),
+    Newton_integrable f a b ->
+    Newton_integrable g a b ->
+    Newton_integrable (fun x:R => l * f x + g x) a b.
+Proof.
+  unfold Newton_integrable in |- *; intros f g l a b X X0;
+    elim X; intros; elim X0; intros;
+      exists (fun y:R => l * x y + x0 y).
+  elim p; intro.
+  elim p0; intro.
+  left; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+    clear H; intros; elim H0; clear H0; intros H0 _.
+  split.
+  intros; elim (H _ H2); elim (H0 _ H2); intros.
+  assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+  reg.
+  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+  assumption.
+  unfold antiderivative in H, H0; elim H; elim H0; intros; elim H4; intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
+  left; rewrite <- H5; unfold antiderivative in |- *; split.
+  intros; elim H6; intros; assert (H9 : x1 = a).
+  apply Rle_antisym; assumption.
+  assert (H10 : a <= x1 <= b).
+  split; right; [ symmetry  in |- *; assumption | rewrite <- H5; assumption ].
+  assert (H11 : b <= x1 <= a).
+  split; right; [ rewrite <- H5; symmetry  in |- *; assumption | assumption ].
+  assert (H12 : derivable_pt x x1).
+  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H10); intros;
+    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
+  assert (H13 : derivable_pt x0 x1).
+  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H11); intros;
+    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
+  assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+  reg.
+  exists H14; symmetry  in |- *; 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_irrefl _ (Rlt_le_trans _ _ _ H5 H2)).
+  left; rewrite H5; unfold antiderivative in |- *; split.
+  intros; elim H6; intros; assert (H9 : x1 = a).
+  apply Rle_antisym; assumption.
+  assert (H10 : a <= x1 <= b).
+  split; right; [ symmetry  in |- *; assumption | rewrite H5; assumption ].
+  assert (H11 : b <= x1 <= a).
+  split; right; [ rewrite H5; symmetry  in |- *; assumption | assumption ].
+  assert (H12 : derivable_pt x x1).
+  unfold derivable_pt in |- *; exists (f x1); elim (H3 _ H11); intros;
+    eapply derive_pt_eq_1; symmetry  in |- *; apply H12.
+  assert (H13 : derivable_pt x0 x1).
+  unfold derivable_pt in |- *; exists (g x1); elim (H1 _ H10); intros;
+    eapply derive_pt_eq_1; symmetry  in |- *; apply H13.
+  assert (H14 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+  reg.
+  exists H14; symmetry  in |- *; reg.
+  assert (H15 : derive_pt x0 x1 H13 = g x1).
+  elim (H1 _ H10); intros; rewrite H15; apply pr_nu.
+  assert (H16 : derive_pt x x1 H12 = f x1).
+  elim (H3 _ H11); intros; rewrite H16; apply pr_nu.
+  rewrite H15; rewrite H16; ring.
+  right; reflexivity.
+  right; unfold antiderivative in |- *; unfold antiderivative in H, H0; elim H;
+    clear H; intros; elim H0; clear H0; intros H0 _; split.
+  intros; elim (H _ H2); elim (H0 _ H2); intros.
+  assert (H5 : derivable_pt (fun y:R => l * x y + x0 y) x1).
+  reg.
+  exists H5; symmetry  in |- *; reg; rewrite <- H3; rewrite <- H4; reflexivity.
+  assumption.
 Defined.
 
 (**********)
 Lemma antiderivative_P1 :
- forall (f g F G:R -> R) (l a b:R),
-   antiderivative f F a b ->
-   antiderivative g G a b ->
-   antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b.
-unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros;
- split.
-intros; elim (H _ H3); elim (H1 _ H3); intros.
-assert (H6 : derivable_pt (fun x:R => l * F x + G x) x).
-reg.
-exists H6; symmetry  in |- *; reg; rewrite <- H4; rewrite <- H5; ring.
-assumption.
+  forall (f g F G:R -> R) (l a b:R),
+    antiderivative f F a b ->
+    antiderivative g G a b ->
+    antiderivative (fun x:R => l * f x + g x) (fun x:R => l * F x + G x) a b.
+Proof.
+  unfold antiderivative in |- *; intros; elim H; elim H0; clear H H0; intros;
+    split.
+  intros; elim (H _ H3); elim (H1 _ H3); intros.
+  assert (H6 : derivable_pt (fun x:R => l * F x + G x) x).
+  reg.
+  exists H6; symmetry  in |- *; reg; rewrite <- H4; rewrite <- H5; ring.
+  assumption.
 Qed.
 
 (* $\int_a^b \lambda f + g = \lambda \int_a^b f + \int_a^b f *)
 Lemma NewtonInt_P6 :
- forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b)
-   (pr2:Newton_integrable g a b),
-   NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) =
-   l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
-intros f g l a b pr1 pr2; unfold NewtonInt in |- *;
- 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_irrefl _ (Rle_lt_trans _ _ _ H3 a0)).
-unfold antiderivative in H0; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
-unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)).
-rewrite b0; ring.
-elim o; intro.
-unfold antiderivative in H; elim H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)).
-elim o0; intro.
-unfold antiderivative in H0; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
-elim o1; intro.
-unfold antiderivative in H1; elim H1; intros;
- elim (Rlt_irrefl _ (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.
+  forall (f g:R -> R) (l a b:R) (pr1:Newton_integrable f a b)
+    (pr2:Newton_integrable g a b),
+    NewtonInt (fun x:R => l * f x + g x) a b (NewtonInt_P5 f g l a b pr1 pr2) =
+    l * NewtonInt f a b pr1 + NewtonInt g a b pr2.
+Proof.
+  intros f g l a b pr1 pr2; unfold NewtonInt in |- *;
+    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_irrefl _ (Rle_lt_trans _ _ _ H3 a0)).
+  unfold antiderivative in H0; elim H0; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+  unfold antiderivative in H; elim H; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 a0)).
+  rewrite b0; ring.
+  elim o; intro.
+  unfold antiderivative in H; elim H; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 r)).
+  elim o0; intro.
+  unfold antiderivative in H0; elim H0; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 r)).
+  elim o1; intro.
+  unfold antiderivative in H1; elim H1; intros;
+    elim (Rlt_irrefl _ (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 :
- forall (f F0 F1:R -> R) (a b c:R),
-   antiderivative f F0 a b ->
-   antiderivative f F1 b c ->
-   antiderivative f
-     (fun x:R =>
-        match Rle_dec x b with
+  forall (f F0 F1:R -> R) (a b c:R),
+    antiderivative f F0 a b ->
+    antiderivative f F1 b c ->
+    antiderivative f
+    (fun x:R =>
+      match Rle_dec x b with
         | left _ => F0 x
         | right _ => F1 x + (F0 b - F1 b)
-        end) a c.
-unfold antiderivative in |- *; 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
-     (fun x:R =>
+      end) a c.
+Proof.
+  unfold antiderivative in |- *; 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
+        (fun x:R =>
+          match Rle_dec x b with
+            | left _ => F0 x
+            | right _ => F1 x + (F0 b - F1 b)
+          end) x (f x)).
+  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x).
+  symmetry  in |- *; assumption.
+  assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
+    intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)).
+  assert (H11 : 0 < D).
+  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro.
+  apply (cond_pos x1).
+  apply Rlt_Rminus; assumption.
+  exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
+  case (Rle_dec (x + h) b); intro.
+  apply H10.
+  assumption.
+  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+  elim n; left; apply Rlt_le_trans with (x + D).
+  apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
+  apply RRle_abs.
+  apply H13.
+  apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+    rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; 
+      apply Rmin_r.
+  elim n; left; assumption.
+  assert
+    (H8 :
+      derivable_pt
+      (fun x:R =>
         match Rle_dec x b with
-        | left _ => F0 x
-        | right _ => F1 x + (F0 b - F1 b)
-        end) x (f x)).
-unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F0 x x0 = f x).
-symmetry  in |- *; assumption.
-assert (H8 := derive_pt_eq_1 F0 x (f x) x0 H7); unfold derivable_pt_lim in H8;
- intros; elim (H8 _ H9); intros; set (D := Rmin x1 (b - x)).
-assert (H11 : 0 < D).
-unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - x)); intro.
-apply (cond_pos x1).
-apply Rlt_Rminus; assumption.
-exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
-case (Rle_dec (x + h) b); intro.
-apply H10.
-assumption.
-apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
-elim n; left; apply Rlt_le_trans with (x + D).
-apply Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h).
-apply RRle_abs.
-apply H13.
-apply Rplus_le_reg_l with (- x); rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_l; rewrite Rplus_comm; unfold D in |- *; 
- apply Rmin_r.
-elim n; left; assumption.
-assert
- (H8 :
-  derivable_pt
-    (fun x:R =>
-       match Rle_dec x b with
-       | left _ => F0 x
-       | right _ => F1 x + (F0 b - F1 b)
-       end) x).
-unfold derivable_pt in |- *; apply existT with (f x); apply H7.
-exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
-assert (H5 : a <= x <= b).
-split; [ assumption | right; assumption ].
-assert (H6 : b <= x <= c).
-split; [ right; symmetry  in |- *; assumption | assumption ].
-elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x).
-symmetry  in |- *; assumption.
-assert (H10 : derive_pt F1 x x0 = f x).
-symmetry  in |- *; 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
-     (fun x:R =>
+          | left _ => F0 x
+          | right _ => F1 x + (F0 b - F1 b)
+        end) x).
+  unfold derivable_pt in |- *; apply existT with (f x); apply H7.
+  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
+  assert (H5 : a <= x <= b).
+  split; [ assumption | right; assumption ].
+  assert (H6 : b <= x <= c).
+  split; [ right; symmetry  in |- *; assumption | assumption ].
+  elim (H _ H5); elim (H0 _ H6); intros; assert (H9 : derive_pt F0 x x1 = f x).
+  symmetry  in |- *; assumption.
+  assert (H10 : derive_pt F1 x x0 = f x).
+  symmetry  in |- *; 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
+          (fun x:R =>
+            match Rle_dec x b with
+              | left _ => F0 x
+              | right _ => F1 x + (F0 b - F1 b)
+            end) x (f x)).
+  unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros;
+    elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3);
+      assert (H16 : 0 < D).
+  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro.
+  apply (cond_pos x2).
+  apply (cond_pos x3).
+  exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
+  case (Rle_dec (x + h) b); intro.
+  apply H15.
+  assumption.
+  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ].
+  replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x).
+  apply H14.
+  assumption.
+  apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
+  rewrite b0; ring.
+  elim n; right; assumption.
+  assert
+    (H14 :
+      derivable_pt
+      (fun x:R =>
         match Rle_dec x b with
-        | left _ => F0 x
-        | right _ => F1 x + (F0 b - F1 b)
-        end) x (f x)).
-unfold derivable_pt_lim in |- *; unfold derivable_pt_lim in H11, H12; intros;
- elim (H11 _ H13); elim (H12 _ H13); intros; set (D := Rmin x2 x3);
- assert (H16 : 0 < D).
-unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x2 x3); intro.
-apply (cond_pos x2).
-apply (cond_pos x3).
-exists (mkposreal _ H16); intros; case (Rle_dec x b); intro.
-case (Rle_dec (x + h) b); intro.
-apply H15.
-assumption.
-apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_r ].
-replace (F1 (x + h) + (F0 b - F1 b) - F0 x) with (F1 (x + h) - F1 x).
-apply H14.
-assumption.
-apply Rlt_le_trans with D; [ assumption | unfold D in |- *; apply Rmin_l ].
-rewrite b0; ring.
-elim n; right; assumption.
-assert
- (H14 :
-  derivable_pt
-    (fun x:R =>
-       match Rle_dec x b with
-       | left _ => F0 x
-       | right _ => F1 x + (F0 b - F1 b)
-       end) x).
-unfold derivable_pt in |- *; apply existT with (f x); apply H13.
-exists H14; symmetry  in |- *; 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
-     (fun x:R =>
+          | left _ => F0 x
+          | right _ => F1 x + (F0 b - F1 b)
+        end) x).
+  unfold derivable_pt in |- *; apply existT with (f x); apply H13.
+  exists H14; symmetry  in |- *; 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
+        (fun x:R =>
+          match Rle_dec x b with
+            | left _ => F0 x
+            | right _ => F1 x + (F0 b - F1 b)
+          end) x (f x)).
+  unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x).
+  symmetry  in |- *; assumption.
+  assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8;
+    intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b));
+      assert (H11 : 0 < D).
+  unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro.
+  apply (cond_pos x1).
+  apply Rlt_Rminus; assumption.
+  exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
+  case (Rle_dec (x + h) b); intro.
+  cut (b < x + h).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)).
+  apply Rplus_lt_reg_r 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 (Rabs h).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  apply Rlt_le_trans with D.
+  apply H13.
+  unfold D in |- *; apply Rmin_r.
+  replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with
+  (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10.
+  assumption.
+  apply Rlt_le_trans with D.
+  assumption.
+  unfold D in |- *; apply Rmin_l.
+  assert
+    (H8 :
+      derivable_pt
+      (fun x:R =>
         match Rle_dec x b with
-        | left _ => F0 x
-        | right _ => F1 x + (F0 b - F1 b)
-        end) x (f x)).
-unfold derivable_pt_lim in |- *; assert (H7 : derive_pt F1 x x0 = f x).
-symmetry  in |- *; assumption.
-assert (H8 := derive_pt_eq_1 F1 x (f x) x0 H7); unfold derivable_pt_lim in H8;
- intros; elim (H8 _ H9); intros; set (D := Rmin x1 (x - b));
- assert (H11 : 0 < D).
-unfold D in |- *; unfold Rmin in |- *; case (Rle_dec x1 (x - b)); intro.
-apply (cond_pos x1).
-apply Rlt_Rminus; assumption.
-exists (mkposreal _ H11); intros; case (Rle_dec x b); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
-case (Rle_dec (x + h) b); intro.
-cut (b < x + h).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14)).
-apply Rplus_lt_reg_r 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 (Rabs h).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-apply Rlt_le_trans with D.
-apply H13.
-unfold D in |- *; apply Rmin_r.
-replace (F1 (x + h) + (F0 b - F1 b) - (F1 x + (F0 b - F1 b))) with
- (F1 (x + h) - F1 x); [ idtac | ring ]; apply H10.
-assumption.
-apply Rlt_le_trans with D.
-assumption.
-unfold D in |- *; apply Rmin_l.
-assert
- (H8 :
-  derivable_pt
-    (fun x:R =>
-       match Rle_dec x b with
-       | left _ => F0 x
-       | right _ => F1 x + (F0 b - F1 b)
-       end) x).
-unfold derivable_pt in |- *; apply existT with (f x); apply H7.
-exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
+          | left _ => F0 x
+          | right _ => F1 x + (F0 b - F1 b)
+        end) x).
+  unfold derivable_pt in |- *; apply existT with (f x); apply H7.
+  exists H8; symmetry  in |- *; apply derive_pt_eq_0; apply H7.
 Qed.
 
 Lemma antiderivative_P3 :
- forall (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 in |- *; split.
-intros; apply H1; elim H3; intros; split;
- [ assumption | apply Rle_trans with c; assumption ].
-left; assumption.
-right; unfold antiderivative in |- *; split.
-intros; apply H1; elim H3; intros; split;
- [ assumption | apply Rle_trans with c; assumption ].
-right; assumption.
-left; unfold antiderivative in |- *; split.
-intros; apply H; elim H3; intros; split;
- [ assumption | apply Rle_trans with a; assumption ].
-left; assumption.
+  forall (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.
+Proof.
+  intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
+    intros; case (total_order_T a c); intro.
+  elim s; intro.
+  right; unfold antiderivative in |- *; split.
+  intros; apply H1; elim H3; intros; split;
+    [ assumption | apply Rle_trans with c; assumption ].
+  left; assumption.
+  right; unfold antiderivative in |- *; split.
+  intros; apply H1; elim H3; intros; split;
+    [ assumption | apply Rle_trans with c; assumption ].
+  right; assumption.
+  left; unfold antiderivative in |- *; split.
+  intros; apply H; elim H3; intros; split;
+    [ assumption | apply Rle_trans with a; assumption ].
+  left; assumption.
 Qed.
 
 Lemma antiderivative_P4 :
- forall (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 in |- *; split.
-intros; apply H1; elim H3; intros; split;
- [ apply Rle_trans with c; assumption | assumption ].
-left; assumption.
-right; unfold antiderivative in |- *; split.
-intros; apply H1; elim H3; intros; split;
- [ apply Rle_trans with c; assumption | assumption ].
-right; assumption.
-left; unfold antiderivative in |- *; split.
-intros; apply H; elim H3; intros; split;
- [ apply Rle_trans with b; assumption | assumption ].
-left; assumption.
+  forall (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.
+Proof.
+  intros; unfold antiderivative in H, H0; elim H; clear H; elim H0; clear H0;
+    intros; case (total_order_T c b); intro.
+  elim s; intro.
+  right; unfold antiderivative in |- *; split.
+  intros; apply H1; elim H3; intros; split;
+    [ apply Rle_trans with c; assumption | assumption ].
+  left; assumption.
+  right; unfold antiderivative in |- *; split.
+  intros; apply H1; elim H3; intros; split;
+    [ apply Rle_trans with c; assumption | assumption ].
+  right; assumption.
+  left; unfold antiderivative in |- *; split.
+  intros; apply H; elim H3; intros; split;
+    [ apply Rle_trans with b; assumption | assumption ].
+  left; assumption.
 Qed.
 
 Lemma NewtonInt_P7 :
- forall (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 in |- *; intros f a b c Hab Hbc X X0; elim X;
- clear X; intros F0 H0; elim X0; clear X0; intros F1 H1;
- set
-  (g :=
-   fun x:R =>
-     match Rle_dec x b with
-     | left _ => F0 x
-     | right _ => F1 x + (F0 b - F1 b)
-     end); apply existT with g; left; unfold g in |- *;
- apply antiderivative_P2.
-elim H0; intro.
-assumption.
-unfold antiderivative in H; elim H; clear H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)).
-elim H1; intro.
-assumption.
-unfold antiderivative in H; elim H; clear H; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)).
+  forall (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.
+Proof.
+  unfold Newton_integrable in |- *; intros f a b c Hab Hbc X X0; elim X;
+    clear X; intros F0 H0; elim X0; clear X0; intros F1 H1;
+      set
+        (g :=
+          fun x:R =>
+            match Rle_dec x b with
+              | left _ => F0 x
+              | right _ => F1 x + (F0 b - F1 b)
+            end); apply existT with g; left; unfold g in |- *;
+        apply antiderivative_P2.
+  elim H0; intro.
+  assumption.
+  unfold antiderivative in H; elim H; clear H; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hab)).
+  elim H1; intro.
+  assumption.
+  unfold antiderivative in H; elim H; clear H; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 Hbc)).
 Qed.
 
 Lemma NewtonInt_P8 :
- forall (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.
+  forall (f:R -> R) (a b c:R),
+    Newton_integrable f a b ->
+    Newton_integrable f b c -> Newton_integrable f a c.
+Proof.
+  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 in |- *;
- apply existT with
-  (fun x:R =>
-     match Rle_dec x b with
-     | left _ => F0 x
-     | right _ => 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_irrefl _ (Rle_lt_trans _ _ _ H2 a1)).
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+  unfold Newton_integrable in |- *;
+    apply existT with
+      (fun x:R =>
+        match Rle_dec x b with
+          | left _ => F0 x
+          | right _ => 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_irrefl _ (Rle_lt_trans _ _ _ H2 a1)).
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
 (* a<b & b=c *)
-rewrite b0 in X; apply X.
+  rewrite b0 in X; apply X.
 (* a<b & b>c *)
-case (total_order_T a c); intro.
-elim s0; intro.
-unfold Newton_integrable in |- *; apply existT with F0.
-left.
-elim H1; intro.
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
-assumption.
-unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
-rewrite b0; apply NewtonInt_P1.
-unfold Newton_integrable in |- *; apply existT with F1.
-right.
-elim H1; intro.
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
-unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+  case (total_order_T a c); intro.
+  elim s0; intro.
+  unfold Newton_integrable in |- *; apply existT with F0.
+  left.
+  elim H1; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+  assumption.
+  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+  rewrite b0; apply NewtonInt_P1.
+  unfold Newton_integrable in |- *; apply existT with F1.
+  right.
+  elim H1; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
 (* a=b *)
-rewrite b0; apply X0.
-case (total_order_T b c); intro.
-elim s; intro.
+  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 in |- *; apply existT with F1.
-left.
-elim H1; intro.
+  case (total_order_T a c); intro.
+  elim s0; intro.
+  unfold Newton_integrable in |- *; apply existT with F1.
+  left.
+  elim H1; intro.
 (*****************)
-elim H0; intro.
-unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
-elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
-rewrite b0; apply NewtonInt_P1.
-unfold Newton_integrable in |- *; apply existT with F0.
-right.
-elim H0; intro.
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
-assumption.
-unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
+  elim H0; intro.
+  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+  elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 a1)).
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+  rewrite b0; apply NewtonInt_P1.
+  unfold Newton_integrable in |- *; apply existT with F0.
+  right.
+  elim H0; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H4 r0)).
+  assumption.
+  unfold antiderivative in H2; elim H2; clear H2; intros _ H2.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H2 a0)).
 (* a>b & b=c *)
-rewrite b0 in X; apply X.
+  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.
+  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 :
- forall (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 in |- *.
-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.
+  forall (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.
+Proof.
+  intros; unfold NewtonInt in |- *.
+  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
-    (fun x:R =>
-       match Rle_dec x b with
-       | left _ => x0 x
-       | right _ => 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 (Rle_dec a b); intro.
-case (Rle_dec c b); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)).
-ring.
-elim n; left; assumption.
-unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))).
-unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)).
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+  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
+      (fun x:R =>
+        match Rle_dec x b with
+          | left _ => x0 x
+          | right _ => 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 (Rle_dec a b); intro.
+  case (Rle_dec c b); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a1)).
+  ring.
+  elim n; left; assumption.
+  unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 (Rlt_trans _ _ _ a0 a1))).
+  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 a1)).
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
 (* a<b & b=c *)
-rewrite <- b0.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
-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_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
+  rewrite <- b0.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+  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_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H a0)).
 (* a<b & b>c *)
-elim o1; intro.
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (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 (Rle_dec b c); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
-case (Rle_dec 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 (Rle_dec b a); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)).
-case (Rle_dec 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_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+  elim o1; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (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 (Rle_dec b c); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 r)).
+  case (Rle_dec 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 (Rle_dec b a); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 a0)).
+  case (Rle_dec 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_irrefl _ (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 ].
+  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_irrefl _ (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 (Rle_dec b a); intro.
-case (Rle_dec 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 (Rle_dec b c); intro.
-case (Rle_dec 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_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
+  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_irrefl _ (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 (Rle_dec b a); intro.
+  case (Rle_dec 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 (Rle_dec b c); intro.
+  case (Rle_dec 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_irrefl _ (Rle_lt_trans _ _ _ H0 a0)).
 (* a>b & b=c *)
-rewrite <- b0.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
-rewrite <- b0 in o.
-elim o0; intro.
-unfold antiderivative in H; elim H; clear H; intros _ H.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
-elim o; intro.
-unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
-elim (Rlt_irrefl _ (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 ].
+  rewrite <- b0.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r.
+  rewrite <- b0 in o.
+  elim o0; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+  elim o; intro.
+  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+  elim (Rlt_irrefl _ (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_irrefl _ (Rle_lt_trans _ _ _ H r)).
-elim o1; intro.
-unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)).
-elim o; intro.
-unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
-elim (Rlt_irrefl _ (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 (Rle_dec a b); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)).
-case (Rle_dec c b); intro.
-ring.
-elim n0; left; assumption.
-split; [ assumption | right; reflexivity ].
-split; [ right; reflexivity | assumption ].
+  elim o0; intro.
+  unfold antiderivative in H; elim H; clear H; intros _ H.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+  elim o1; intro.
+  unfold antiderivative in H0; elim H0; clear H0; intros _ H0.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 r0)).
+  elim o; intro.
+  unfold antiderivative in H1; elim H1; clear H1; intros _ H1.
+  elim (Rlt_irrefl _ (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 (Rle_dec a b); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r1 r)).
+  case (Rle_dec c b); intro.
+  ring.
+  elim n0; left; assumption.
+  split; [ assumption | right; reflexivity ].
+  split; [ right; reflexivity | assumption ].
 Qed.
diff --git a/theories/Reals/PSeries_reg.v b/theories/Reals/PSeries_reg.v
index d6dc352c..64b8e0af 100644
--- a/theories/Reals/PSeries_reg.v
+++ b/theories/Reals/PSeries_reg.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: PSeries_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: PSeries_reg.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -17,243 +17,249 @@ Require Import Even. Open Local Scope R_scope.
 
 Definition Boule (x:R) (r:posreal) (y:R) : Prop := Rabs (y - x) < r.
 
-(* Uniform convergence *)
+(** Uniform convergence *)
 Definition CVU (fn:nat -> R -> R) (f:R -> R) (x:R) 
   (r:posreal) : Prop :=
   forall eps:R,
     0 < eps ->
-     exists N : nat,
+    exists N : nat,
       (forall (n:nat) (y:R),
-         (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). 
+        (N <= n)%nat -> Boule x r y -> Rabs (f y - fn n y) < eps). 
 
-(* Normal convergence *)
+(** Normal convergence *)
 Definition CVN_r (fn:nat -> R -> R) (r:posreal) : Type :=
   sigT
-    (fun An:nat -> R =>
-       sigT
-         (fun l:R =>
-            Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\
-            (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))).
+  (fun An:nat -> R =>
+    sigT
+    (fun l:R =>
+      Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n) l /\
+      (forall (n:nat) (y:R), Boule 0 r y -> Rabs (fn n y) <= An n))).
 
 Definition CVN_R (fn:nat -> R -> R) : Type := forall r:posreal, CVN_r fn r.
 
 Definition SFL (fn:nat -> R -> R)
   (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)) 
   (y:R) : R := match cv y with
-               | existT a b => a
+                 | existT a b => a
                end.
 
-(* In a complete space, normal convergence implies uniform convergence *)
+(** In a complete space, normal convergence implies uniform convergence *)
 Lemma CVN_CVU :
- forall (fn:nat -> R -> R)
-   (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
-   (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r.
-intros; unfold CVU in |- *; intros.
-unfold CVN_r in X.
-elim X; intros An X0.
-elim X0; intros s H0.
-elim H0; intros.
-cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0).
-intro; unfold Un_cv in H3.
-elim (H3 eps H); intros N0 H4.
-exists N0; intros.
-apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)).
-rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s));
- rewrite Ropp_minus_distr';
- rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)).
-eapply sum_maj1.
-unfold SFL in |- *; case (cv y); intro.
-trivial.
-apply H1.
-intro; elim H0; intros.
-rewrite (Rabs_right (An n0)).
-apply H8; apply H6.
-apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)).
-apply Rabs_pos.
-apply H8; apply H6.
-apply Rle_ge;
- apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n).
-rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s);
- rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l;
- apply sum_incr.
-apply H1.
-intro; apply Rabs_pos.
-unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4.
-assert (H7 := H4 n H5).
-rewrite Rplus_0_r in H7; apply H7.
-unfold Un_cv in H1; unfold Un_cv in |- *; intros.
-elim (H1 _ H3); intros.
-exists x; intros.
-unfold R_dist in |- *; unfold R_dist in H4.
-rewrite Rminus_0_r; apply H4; assumption.
+  forall (fn:nat -> R -> R)
+    (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
+    (r:posreal), CVN_r fn r -> CVU (fun n:nat => SP fn n) (SFL fn cv) 0 r.
+Proof.
+  intros; unfold CVU in |- *; intros.
+  unfold CVN_r in X.
+  elim X; intros An X0.
+  elim X0; intros s H0.
+  elim H0; intros.
+  cut (Un_cv (fun n:nat => sum_f_R0 (fun k:nat => Rabs (An k)) n - s) 0).
+  intro; unfold Un_cv in H3.
+  elim (H3 eps H); intros N0 H4.
+  exists N0; intros.
+  apply Rle_lt_trans with (Rabs (sum_f_R0 (fun k:nat => Rabs (An k)) n - s)).
+  rewrite <- (Rabs_Ropp (sum_f_R0 (fun k:nat => Rabs (An k)) n - s));
+    rewrite Ropp_minus_distr';
+      rewrite (Rabs_right (s - sum_f_R0 (fun k:nat => Rabs (An k)) n)).
+  eapply sum_maj1.
+  unfold SFL in |- *; case (cv y); intro.
+  trivial.
+  apply H1.
+  intro; elim H0; intros.
+  rewrite (Rabs_right (An n0)).
+  apply H8; apply H6.
+  apply Rle_ge; apply Rle_trans with (Rabs (fn n0 y)).
+  apply Rabs_pos.
+  apply H8; apply H6.
+  apply Rle_ge;
+    apply Rplus_le_reg_l with (sum_f_R0 (fun k:nat => Rabs (An k)) n).
+  rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm s);
+    rewrite <- Rplus_assoc; rewrite Rplus_opp_r; rewrite Rplus_0_l;
+      apply sum_incr.
+  apply H1.
+  intro; apply Rabs_pos.
+  unfold R_dist in H4; unfold Rminus in H4; rewrite Ropp_0 in H4.
+  assert (H7 := H4 n H5).
+  rewrite Rplus_0_r in H7; apply H7.
+  unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+  elim (H1 _ H3); intros.
+  exists x; intros.
+  unfold R_dist in |- *; unfold R_dist in H4.
+  rewrite Rminus_0_r; apply H4; assumption.
 Qed.
 
-(* Each limit of a sequence of functions which converges uniformly is continue *)
+(** Each limit of a sequence of functions which converges uniformly is continue *)
 Lemma CVU_continuity :
- forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal),
-   CVU fn f x r ->
-   (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) ->
-   forall y:R, Boule x r y -> continuity_pt f y.
-intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros.
-unfold CVU in H.
-cut (0 < eps / 3);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H _ H3); intros N0 H4.
-assert (H5 := H0 N0 y H1).
-cut (exists del : posreal, (forall h:R, Rabs 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.
-set (del := Rmin del1 del2).
-exists del; intros.
-split.
-unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
-apply (cond_pos del1).
-elim H8; intros; assumption.
-intros;
- apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)).
-replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y));
- [ apply Rabs_triang | ring ].
-apply Rle_lt_trans with
- (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)).
-rewrite Rplus_assoc; apply Rplus_le_compat_l.
-replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y));
- [ apply Rabs_triang | ring ].
-replace eps with (eps / 3 + eps / 3 + eps / 3).
-repeat apply Rplus_lt_compat.
-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 in |- *; apply Rmin_l.
-elim H8; intros.
-apply H11.
-split.
-elim H9; intros; assumption.
-elim H9; intros; apply Rlt_le_trans with del.
-assumption.
-unfold del in |- *; apply Rmin_r.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4.
-apply le_n.
-assumption.
-apply Rmult_eq_reg_l with 3.
-do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
- rewrite Rinv_r_simpl_m.
-ring.
-discrR.
-discrR.
-cut (0 < r - Rabs (x - y)).
-intro; exists (mkposreal _ H6).
-simpl in |- *; intros.
-unfold Boule in |- *; replace (y + h - x) with (h + (y - x));
- [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)).
-apply Rabs_triang.
-apply Rplus_lt_reg_r with (- Rabs (x - y)).
-rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'.
-replace (- Rabs (x - y) + r) with (r - Rabs (x - y)).
-replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h).
-apply H7.
-ring.
-ring.
-unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr';
- apply Rplus_lt_reg_r with (Rabs (y - x)).
-rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r);
- [ apply H1 | ring ].
+  forall (fn:nat -> R -> R) (f:R -> R) (x:R) (r:posreal),
+    CVU fn f x r ->
+    (forall (n:nat) (y:R), Boule x r y -> continuity_pt (fn n) y) ->
+    forall y:R, Boule x r y -> continuity_pt f y.
+Proof.
+  intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros.
+  unfold CVU in H.
+  cut (0 < eps / 3);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H _ H3); intros N0 H4.
+  assert (H5 := H0 N0 y H1).
+  cut (exists del : posreal, (forall h:R, Rabs 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.
+  set (del := Rmin del1 del2).
+  exists del; intros.
+  split.
+  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+  apply (cond_pos del1).
+  elim H8; intros; assumption.
+  intros;
+    apply Rle_lt_trans with (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - f y)).
+  replace (f x0 - f y) with (f x0 - fn N0 x0 + (fn N0 x0 - f y));
+  [ apply Rabs_triang | ring ].
+  apply Rle_lt_trans with
+    (Rabs (f x0 - fn N0 x0) + Rabs (fn N0 x0 - fn N0 y) + Rabs (fn N0 y - f y)).
+  rewrite Rplus_assoc; apply Rplus_le_compat_l.
+  replace (fn N0 x0 - f y) with (fn N0 x0 - fn N0 y + (fn N0 y - f y));
+  [ apply Rabs_triang | ring ].
+  replace eps with (eps / 3 + eps / 3 + eps / 3).
+  repeat apply Rplus_lt_compat.
+  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 in |- *; apply Rmin_l.
+  elim H8; intros.
+  apply H11.
+  split.
+  elim H9; intros; assumption.
+  elim H9; intros; apply Rlt_le_trans with del.
+  assumption.
+  unfold del in |- *; apply Rmin_r.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H4.
+  apply le_n.
+  assumption.
+  apply Rmult_eq_reg_l with 3.
+  do 2 rewrite Rmult_plus_distr_l; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+    rewrite Rinv_r_simpl_m.
+  ring.
+  discrR.
+  discrR.
+  cut (0 < r - Rabs (x - y)).
+  intro; exists (mkposreal _ H6).
+  simpl in |- *; intros.
+  unfold Boule in |- *; replace (y + h - x) with (h + (y - x));
+    [ idtac | ring ]; apply Rle_lt_trans with (Rabs h + Rabs (y - x)).
+  apply Rabs_triang.
+  apply Rplus_lt_reg_r with (- Rabs (x - y)).
+  rewrite <- (Rabs_Ropp (y - x)); rewrite Ropp_minus_distr'.
+  replace (- Rabs (x - y) + r) with (r - Rabs (x - y)).
+  replace (- Rabs (x - y) + (Rabs h + Rabs (x - y))) with (Rabs h).
+  apply H7.
+  ring.
+  ring.
+  unfold Boule in H1; rewrite <- (Rabs_Ropp (x - y)); rewrite Ropp_minus_distr';
+    apply Rplus_lt_reg_r with (Rabs (y - x)).
+  rewrite Rplus_0_r; replace (Rabs (y - x) + (r - Rabs (y - x))) with (pos r);
+    [ apply H1 | ring ].
 Qed.
 
 (**********)
 Lemma continuity_pt_finite_SF :
- forall (fn:nat -> R -> R) (N:nat) (x:R),
-   (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) ->
-   continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x.
-intros; induction  N as [| N HrecN].
-simpl in |- *; apply (H 0%nat); apply le_n.
-simpl in |- *;
- replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with
-  ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F;
- [ idtac | reflexivity ].
-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.
+  forall (fn:nat -> R -> R) (N:nat) (x:R),
+    (forall n:nat, (n <= N)%nat -> continuity_pt (fn n) x) ->
+    continuity_pt (fun y:R => sum_f_R0 (fun k:nat => fn k y) N) x.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; apply (H 0%nat); apply le_n.
+  simpl in |- *;
+    replace (fun y:R => sum_f_R0 (fun k:nat => fn k y) N + fn (S N) y) with
+    ((fun y:R => sum_f_R0 (fun k:nat => fn k y) N) + (fun y:R => fn (S N) y))%F;
+    [ idtac | reflexivity ].
+  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 *)
+(** Continuity and normal convergence *)
 Lemma SFL_continuity_pt :
- forall (fn:nat -> R -> R)
-   (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
-   (r:posreal),
-   CVN_r fn r ->
-   (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) ->
-   forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y.
-intros; eapply CVU_continuity.
-apply CVN_CVU.
-apply X.
-intros; unfold SP in |- *; apply continuity_pt_finite_SF.
-intros; apply H.
-apply H1.
-apply H0.
+  forall (fn:nat -> R -> R)
+    (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l))
+    (r:posreal),
+    CVN_r fn r ->
+    (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y) ->
+    forall y:R, Boule 0 r y -> continuity_pt (SFL fn cv) y.
+Proof.
+  intros; eapply CVU_continuity.
+  apply CVN_CVU.
+  apply X.
+  intros; unfold SP in |- *; apply continuity_pt_finite_SF.
+  intros; apply H.
+  apply H1.
+  apply H0.
 Qed.
 
 Lemma SFL_continuity :
- forall (fn:nat -> R -> R)
-   (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)),
-   CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv).
-intros; unfold continuity in |- *; intro.
-cut (0 < Rabs x + 1);
- [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ].
-cut (Boule 0 (mkposreal _ H0) x).
-intro; eapply SFL_continuity_pt with (mkposreal _ H0).
-apply X.
-intros; apply (H n y).
-apply H1.
-unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r;
- pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; 
- apply Rplus_lt_compat_l; apply Rlt_0_1.
+  forall (fn:nat -> R -> R)
+    (cv:forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)),
+    CVN_R fn -> (forall n:nat, continuity (fn n)) -> continuity (SFL fn cv).
+Proof.
+  intros; unfold continuity in |- *; intro.
+  cut (0 < Rabs x + 1);
+    [ intro | apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ] ].
+  cut (Boule 0 (mkposreal _ H0) x).
+  intro; eapply SFL_continuity_pt with (mkposreal _ H0).
+  apply X.
+  intros; apply (H n y).
+  apply H1.
+  unfold Boule in |- *; simpl in |- *; rewrite Rminus_0_r;
+    pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; 
+      apply Rplus_lt_compat_l; apply Rlt_0_1.
 Qed.
 
-(* As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) 
+(** As R is complete, normal convergence implies that (fn) is simply-uniformly convergent *) 
 Lemma CVN_R_CVS :
- forall fn:nat -> R -> R,
-   CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l).
-intros; apply R_complete.
-unfold SP in |- *; set (An := fun N:nat => fn N x).
-change (Cauchy_crit_series An) in |- *.
-apply cauchy_abs.
-unfold Cauchy_crit_series in |- *; apply CV_Cauchy.
-unfold CVN_R in X; cut (0 < Rabs x + 1).
-intro; assert (H0 := X (mkposreal _ H)).
-unfold CVN_r in H0; elim H0; intros Bn H1.
-elim H1; intros l H2.
-elim H2; intros.
-apply Rseries_CV_comp with Bn.
-intro; split.
-apply Rabs_pos.
-unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
- rewrite Rminus_0_r.
-pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- apply Rlt_0_1.
-apply existT with l.
-cut (forall n:nat, 0 <= Bn n).
-intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros.
-elim (H3 _ H6); intros.
-exists x0; intros.
-replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n).
-apply H7; assumption.
-apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5.
-intro; apply Rle_trans with (Rabs (An n)).
-apply Rabs_pos.
-unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
- rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; 
- rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1.
-apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ].
+  forall fn:nat -> R -> R,
+    CVN_R fn -> forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l).
+Proof.
+  intros; apply R_complete.
+  unfold SP in |- *; set (An := fun N:nat => fn N x).
+  change (Cauchy_crit_series An) in |- *.
+  apply cauchy_abs.
+  unfold Cauchy_crit_series in |- *; apply CV_Cauchy.
+  unfold CVN_R in X; cut (0 < Rabs x + 1).
+  intro; assert (H0 := X (mkposreal _ H)).
+  unfold CVN_r in H0; elim H0; intros Bn H1.
+  elim H1; intros l H2.
+  elim H2; intros.
+  apply Rseries_CV_comp with Bn.
+  intro; split.
+  apply Rabs_pos.
+  unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
+    rewrite Rminus_0_r.
+  pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    apply Rlt_0_1.
+  apply existT with l.
+  cut (forall n:nat, 0 <= Bn n).
+  intro; unfold Un_cv in H3; unfold Un_cv in |- *; intros.
+  elim (H3 _ H6); intros.
+  exists x0; intros.
+  replace (sum_f_R0 Bn n) with (sum_f_R0 (fun k:nat => Rabs (Bn k)) n).
+  apply H7; assumption.
+  apply sum_eq; intros; apply Rabs_right; apply Rle_ge; apply H5.
+  intro; apply Rle_trans with (Rabs (An n)).
+  apply Rabs_pos.
+  unfold An in |- *; apply H4; unfold Boule in |- *; simpl in |- *;
+    rewrite Rminus_0_r; pattern (Rabs x) at 1 in |- *; 
+      rewrite <- Rplus_0_r; apply Rplus_lt_compat_l; apply Rlt_0_1.
+  apply Rplus_le_lt_0_compat; [ apply Rabs_pos | apply Rlt_0_1 ].
 Qed.
diff --git a/theories/Reals/PartSum.v b/theories/Reals/PartSum.v
index bace7b9d..11c6378e 100644
--- a/theories/Reals/PartSum.v
+++ b/theories/Reals/PartSum.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: PartSum.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: PartSum.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -16,340 +16,361 @@ Require Import Max.
 Open Local Scope R_scope.
 
 Lemma tech1 :
- forall (An:nat -> R) (N:nat),
-   (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; apply H; apply le_n.
-simpl in |- *; apply Rplus_lt_0_compat.
-apply HrecN; intros; apply H; apply le_S; assumption.
-apply H; apply le_n.
+  forall (An:nat -> R) (N:nat),
+    (forall n:nat, (n <= N)%nat -> 0 < An n) -> 0 < sum_f_R0 An N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; apply H; apply le_n.
+  simpl in |- *; apply Rplus_lt_0_compat.
+  apply HrecN; intros; apply H; apply le_S; assumption.
+  apply H; apply le_n.
 Qed.
 
 (* Chasles' relation *)
 Lemma tech2 :
- forall (An:nat -> R) (m n:nat),
-   (m < n)%nat ->
-   sum_f_R0 An n =
-   sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). 
-intros; induction  n as [| n Hrecn].
-elim (lt_n_O _ H).
-cut ((m < n)%nat \/ 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 (S n - S m)%nat with (S (n - S m)).
-replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with
- (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) +
-  An (S m + S (n - S m))%nat); [ idtac | reflexivity ].
-replace (S m + S (n - S m))%nat 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 in |- *.
-replace (n + 0)%nat with n; [ reflexivity | ring ].
-inversion H.
-right; reflexivity.
-left; apply lt_le_trans with (S m); [ apply lt_n_Sn | assumption ].
+  forall (An:nat -> R) (m n:nat),
+    (m < n)%nat ->
+    sum_f_R0 An n =
+    sum_f_R0 An m + sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m). 
+Proof.
+  intros; induction  n as [| n Hrecn].
+  elim (lt_n_O _ H).
+  cut ((m < n)%nat \/ 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 (S n - S m)%nat with (S (n - S m)).
+  replace (sum_f_R0 (fun i:nat => An (S m + i)%nat) (S (n - S m))) with
+  (sum_f_R0 (fun i:nat => An (S m + i)%nat) (n - S m) +
+    An (S m + S (n - S m))%nat); [ idtac | reflexivity ].
+  replace (S m + S (n - S m))%nat 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 in |- *.
+  replace (n + 0)%nat 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 :
- forall (k:R) (N:nat),
-   k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k).
-intros; cut (1 - k <> 0).
-intro; induction  N as [| N HrecN].
-simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
-reflexivity.
-apply H0.
-replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with
- (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ];
- rewrite HrecN;
- replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with
-  ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)).
-apply Rmult_eq_reg_l with (1 - k).
-unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k)));
- repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
- [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ].
-apply H0.
-unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k));
- repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; reflexivity.
-apply H0.
-apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry  in |- *;
- assumption.
+  forall (k:R) (N:nat),
+    k <> 1 -> sum_f_R0 (fun i:nat => k ^ i) N = (1 - k ^ S N) / (1 - k).
+Proof.
+  intros; cut (1 - k <> 0).
+  intro; induction  N as [| N HrecN].
+  simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+  reflexivity.
+  apply H0.
+  replace (sum_f_R0 (fun i:nat => k ^ i) (S N)) with
+  (sum_f_R0 (fun i:nat => k ^ i) N + k ^ S N); [ idtac | reflexivity ];
+  rewrite HrecN;
+    replace ((1 - k ^ S N) / (1 - k) + k ^ S N) with
+    ((1 - k ^ S N + (1 - k) * k ^ S N) / (1 - k)).
+  apply Rmult_eq_reg_l with (1 - k).
+  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ (1 - k)));
+    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+      [ do 2 rewrite Rmult_1_l; simpl in |- *; ring | apply H0 ].
+  apply H0.
+  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r; rewrite (Rmult_comm (1 - k));
+    repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; reflexivity.
+  apply H0.
+  apply Rminus_eq_contra; red in |- *; intro; elim H; symmetry  in |- *;
+    assumption.
 Qed.
 
 Lemma tech4 :
- forall (An:nat -> R) (k:R) (N:nat),
-   0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; right; ring.
-apply Rle_trans with (k * An N).
-left; apply (H0 N).
-replace (S N) with (N + 1)%nat; [ idtac | ring ].
-rewrite pow_add; simpl in |- *; rewrite Rmult_1_r;
- replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N));
- [ idtac | ring ]; apply Rmult_le_compat_l.
-assumption.
-apply HrecN.
+  forall (An:nat -> R) (k:R) (N:nat),
+    0 <= k -> (forall i:nat, An (S i) < k * An i) -> An N <= An 0%nat * k ^ N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; right; ring.
+  apply Rle_trans with (k * An N).
+  left; apply (H0 N).
+  replace (S N) with (N + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; simpl in |- *; rewrite Rmult_1_r;
+    replace (An 0%nat * (k ^ N * k)) with (k * (An 0%nat * k ^ N));
+    [ idtac | ring ]; apply Rmult_le_compat_l.
+  assumption.
+  apply HrecN.
 Qed.
 
 Lemma tech5 :
- forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N).
-intros; reflexivity.
+  forall (An:nat -> R) (N:nat), sum_f_R0 An (S N) = sum_f_R0 An N + An (S N).
+Proof.
+  intros; reflexivity.
 Qed.
 
 Lemma tech6 :
- forall (An:nat -> R) (k:R) (N:nat),
-   0 <= k ->
-   (forall i:nat, An (S i) < k * An i) ->
-   sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; right; ring.
-apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)).
-rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N)));
- apply Rplus_le_compat_l.
-apply HrecN.
-rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l.
-apply tech4; assumption.
+  forall (An:nat -> R) (k:R) (N:nat),
+    0 <= k ->
+    (forall i:nat, An (S i) < k * An i) ->
+    sum_f_R0 An N <= An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; right; ring.
+  apply Rle_trans with (An 0%nat * sum_f_R0 (fun i:nat => k ^ i) N + An (S N)).
+  rewrite tech5; do 2 rewrite <- (Rplus_comm (An (S N)));
+    apply Rplus_le_compat_l.
+  apply HrecN.
+  rewrite tech5; rewrite Rmult_plus_distr_l; apply Rplus_le_compat_l.
+  apply tech4; assumption.
 Qed.
 
 Lemma tech7 : forall r1 r2:R, r1 <> 0 -> r2 <> 0 -> r1 <> r2 -> / r1 <> / r2.
-intros; red in |- *; intro.
-assert (H3 := Rmult_eq_compat_l r1 _ _ H2).
-rewrite <- Rinv_r_sym in H3; [ idtac | assumption ].
-assert (H4 := Rmult_eq_compat_l r2 _ _ H3).
-rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4.
-rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ].
-elim H1; symmetry  in |- *; assumption.
+Proof.
+  intros; red in |- *; intro.
+  assert (H3 := Rmult_eq_compat_l r1 _ _ H2).
+  rewrite <- Rinv_r_sym in H3; [ idtac | assumption ].
+  assert (H4 := Rmult_eq_compat_l r2 _ _ H3).
+  rewrite Rmult_1_r in H4; rewrite <- Rmult_assoc in H4.
+  rewrite Rinv_r_simpl_m in H4; [ idtac | assumption ].
+  elim H1; symmetry  in |- *; assumption.
 Qed.
 
 Lemma tech11 :
- forall (An Bn Cn:nat -> R) (N:nat),
-   (forall 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 as [| N HrecN].
-simpl in |- *; apply H.
-do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring.
+  forall (An Bn Cn:nat -> R) (N:nat),
+    (forall i:nat, An i = Bn i - Cn i) ->
+    sum_f_R0 An N = sum_f_R0 Bn N - sum_f_R0 Cn N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; apply H.
+  do 3 rewrite tech5; rewrite HrecN; rewrite (H (S N)); ring.
 Qed.
 
 Lemma tech12 :
- forall (An:nat -> R) (x l:R),
-   Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l ->
-   Pser An x l.
-intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H;
- assumption.
+  forall (An:nat -> R) (x l:R),
+    Un_cv (fun N:nat => sum_f_R0 (fun i:nat => An i * x ^ i) N) l ->
+    Pser An x l.
+Proof.
+  intros; unfold Pser in |- *; unfold infinit_sum in |- *; unfold Un_cv in H;
+    assumption.
 Qed. 
 
 Lemma scal_sum :
- forall (An:nat -> R) (N:nat) (x:R),
-   x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; ring.
-do 2 rewrite tech5.
-rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring.
+  forall (An:nat -> R) (N:nat) (x:R),
+    x * sum_f_R0 An N = sum_f_R0 (fun i:nat => An i * x) N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; ring.
+  do 2 rewrite tech5.
+  rewrite Rmult_plus_distr_l; rewrite <- HrecN; ring.
 Qed.
 
 Lemma decomp_sum :
- forall (An:nat -> R) (N:nat),
-   (0 < N)%nat ->
-   sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N).
-intros; induction  N as [| N HrecN].
-elim (lt_irrefl _ H).
-cut ((0 < N)%nat \/ N = 0%nat).
-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 in |- *; reflexivity.
-assert (H2 := O_or_S N).
-elim H2; intros.
-elim a; intros.
-rewrite <- p.
-simpl in |- *; reflexivity.
-rewrite <- b in H1; elim (lt_irrefl _ H1).
-rewrite H1; simpl in |- *; reflexivity.
-inversion H.
-right; reflexivity.
-left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
+  forall (An:nat -> R) (N:nat),
+    (0 < N)%nat ->
+    sum_f_R0 An N = An 0%nat + sum_f_R0 (fun i:nat => An (S i)) (pred N).
+Proof.
+  intros; induction  N as [| N HrecN].
+  elim (lt_irrefl _ H).
+  cut ((0 < N)%nat \/ N = 0%nat).
+  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 in |- *; reflexivity.
+  assert (H2 := O_or_S N).
+  elim H2; intros.
+  elim a; intros.
+  rewrite <- p.
+  simpl in |- *; reflexivity.
+  rewrite <- b in H1; elim (lt_irrefl _ H1).
+  rewrite H1; simpl in |- *; reflexivity.
+  inversion H.
+  right; reflexivity.
+  left; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
 Qed.
 
 Lemma plus_sum :
- forall (An Bn:nat -> R) (N:nat),
-   sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; ring.
-do 3 rewrite tech5; rewrite HrecN; ring.
+  forall (An Bn:nat -> R) (N:nat),
+    sum_f_R0 (fun i:nat => An i + Bn i) N = sum_f_R0 An N + sum_f_R0 Bn N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; ring.
+  do 3 rewrite tech5; rewrite HrecN; ring.
 Qed.
 
 Lemma sum_eq :
- forall (An Bn:nat -> R) (N:nat),
-   (forall i:nat, (i <= N)%nat -> An i = Bn i) ->
-   sum_f_R0 An N = sum_f_R0 Bn N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; 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 ].
+  forall (An Bn:nat -> R) (N:nat),
+    (forall i:nat, (i <= N)%nat -> An i = Bn i) ->
+    sum_f_R0 An N = sum_f_R0 Bn N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; 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 uniqueness_sum :
- forall (An:nat -> R) (l1 l2:R),
-   infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2.
-unfold infinit_sum in |- *; intros.
-case (Req_dec l1 l2); intro.
-assumption.
-cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ].
-elim (H (Rabs ((l1 - l2) / 2)) H2); intros.
-elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros.
-set (N := max x0 x); cut (N >= x0)%nat.
-cut (N >= x)%nat.
-intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6).
-cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2).
-intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8);
- assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11;
- rewrite Rabs_mult in H11.
-cut (Rabs (/ 2) = / 2).
-intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13;
- rewrite <- H13 in H11.
-elim (Rlt_irrefl _ H11).
-apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat;
- cut (0%nat <> 2%nat);
- [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *;
-    intro; assumption
- | discriminate ].
-unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1));
- rewrite Ropp_minus_distr'.
-replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2));
- [ idtac | ring ].
-apply Rabs_triang.
-unfold ge in |- *; unfold N in |- *; apply le_max_r.
-unfold ge in |- *; unfold N in |- *; apply le_max_l.
-unfold Rdiv in |- *; apply prod_neq_R0.
-apply Rminus_eq_contra; assumption.
-apply Rinv_neq_0_compat; discrR.
+  forall (An:nat -> R) (l1 l2:R),
+    infinit_sum An l1 -> infinit_sum An l2 -> l1 = l2.
+Proof.
+  unfold infinit_sum in |- *; intros.
+  case (Req_dec l1 l2); intro.
+  assumption.
+  cut (0 < Rabs ((l1 - l2) / 2)); [ intro | apply Rabs_pos_lt ].
+  elim (H (Rabs ((l1 - l2) / 2)) H2); intros.
+  elim (H0 (Rabs ((l1 - l2) / 2)) H2); intros.
+  set (N := max x0 x); cut (N >= x0)%nat.
+  cut (N >= x)%nat.
+  intros; assert (H7 := H3 N H5); assert (H8 := H4 N H6).
+  cut (Rabs (l1 - l2) <= R_dist (sum_f_R0 An N) l1 + R_dist (sum_f_R0 An N) l2).
+  intro; assert (H10 := Rplus_lt_compat _ _ _ _ H7 H8);
+    assert (H11 := Rle_lt_trans _ _ _ H9 H10); unfold Rdiv in H11;
+      rewrite Rabs_mult in H11.
+  cut (Rabs (/ 2) = / 2).
+  intro; rewrite H12 in H11; assert (H13 := double_var); unfold Rdiv in H13;
+    rewrite <- H13 in H11.
+  elim (Rlt_irrefl _ H11).
+  apply Rabs_right; left; change (0 < / 2) in |- *; apply Rinv_0_lt_compat;
+    cut (0%nat <> 2%nat);
+      [ intro H20; generalize (lt_INR_0 2 (neq_O_lt 2 H20)); unfold INR in |- *;
+        intro; assumption
+        | discriminate ].
+  unfold R_dist in |- *; rewrite <- (Rabs_Ropp (sum_f_R0 An N - l1));
+    rewrite Ropp_minus_distr'.
+  replace (l1 - l2) with (l1 - sum_f_R0 An N + (sum_f_R0 An N - l2));
+  [ idtac | ring ].
+  apply Rabs_triang.
+  unfold ge in |- *; unfold N in |- *; apply le_max_r.
+  unfold ge in |- *; unfold N in |- *; apply le_max_l.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  apply Rminus_eq_contra; assumption.
+  apply Rinv_neq_0_compat; discrR.
 Qed.
 
 Lemma minus_sum :
- forall (An Bn:nat -> R) (N:nat),
-   sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. 
-intros; induction  N as [| N HrecN]. 
-simpl in |- *; ring. 
-do 3 rewrite tech5; rewrite HrecN; ring. 
+  forall (An Bn:nat -> R) (N:nat),
+    sum_f_R0 (fun i:nat => An i - Bn i) N = sum_f_R0 An N - sum_f_R0 Bn N. 
+Proof.
+  intros; induction  N as [| N HrecN]. 
+  simpl in |- *; ring. 
+  do 3 rewrite tech5; rewrite HrecN; ring. 
 Qed. 
 
 Lemma sum_decomposition :
- forall (An:nat -> R) (N:nat),
-   sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) +
-   sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N).
-intros.
-induction  N as [| N HrecN].
-simpl in |- *; ring.
-rewrite tech5.
-rewrite (tech5 (fun l:nat => An (S (2 * l))) N).
-replace (2 * S (S N))%nat with (S (S (2 * S N))).
-rewrite (tech5 An (S (2 * S N))).
-rewrite (tech5 An (2 * S N)).
-rewrite <- HrecN.
-ring.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR.
-ring.
+  forall (An:nat -> R) (N:nat),
+    sum_f_R0 (fun l:nat => An (2 * l)%nat) (S N) +
+    sum_f_R0 (fun l:nat => An (S (2 * l))) N = sum_f_R0 An (2 * S N).
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *; ring.
+  rewrite tech5.
+  rewrite (tech5 (fun l:nat => An (S (2 * l))) N).
+  replace (2 * S (S N))%nat with (S (S (2 * S N))).
+  rewrite (tech5 An (S (2 * S N))).
+  rewrite (tech5 An (2 * S N)).
+  rewrite <- HrecN.
+  ring.
+  ring_nat.
 Qed.
 
 Lemma sum_Rle :
- forall (An Bn:nat -> R) (N:nat),
-   (forall n:nat, (n <= N)%nat -> An n <= Bn n) ->
-   sum_f_R0 An N <= sum_f_R0 Bn N.
-intros.
-induction  N as [| N HrecN].
-simpl in |- *; apply H.
-apply le_n.
-do 2 rewrite tech5.
-apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
-apply Rplus_le_compat_l.
-apply H.
-apply le_n.
-do 2 rewrite <- (Rplus_comm (Bn (S N))).
-apply Rplus_le_compat_l.
-apply HrecN.
-intros; apply H.
-apply le_trans with N; [ assumption | apply le_n_Sn ].
+  forall (An Bn:nat -> R) (N:nat),
+    (forall n:nat, (n <= N)%nat -> An n <= Bn n) ->
+    sum_f_R0 An N <= sum_f_R0 Bn N.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *; apply H.
+  apply le_n.
+  do 2 rewrite tech5.
+  apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
+  apply Rplus_le_compat_l.
+  apply H.
+  apply le_n.
+  do 2 rewrite <- (Rplus_comm (Bn (S N))).
+  apply Rplus_le_compat_l.
+  apply HrecN.
+  intros; apply H.
+  apply le_trans with N; [ assumption | apply le_n_Sn ].
 Qed.
 
 Lemma Rsum_abs :
- forall (An:nat -> R) (N:nat),
-   Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N.
-intros.
-induction  N as [| N HrecN].
-simpl in |- *.
-right; reflexivity.
-do 2 rewrite tech5.
-apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
-apply Rabs_triang.
-do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
-apply Rplus_le_compat_l.
-apply HrecN.
+  forall (An:nat -> R) (N:nat),
+    Rabs (sum_f_R0 An N) <= sum_f_R0 (fun l:nat => Rabs (An l)) N.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *.
+  right; reflexivity.
+  do 2 rewrite tech5.
+  apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
+  apply Rabs_triang.
+  do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
+  apply Rplus_le_compat_l.
+  apply HrecN.
 Qed.
 
 Lemma sum_cte :
- forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N).
-intros.
-induction  N as [| N HrecN].
-simpl in |- *; ring.
-rewrite tech5.
-rewrite HrecN; repeat rewrite S_INR; ring.
+  forall (x:R) (N:nat), sum_f_R0 (fun _:nat => x) N = x * INR (S N).
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *; ring.
+  rewrite tech5.
+  rewrite HrecN; repeat rewrite S_INR; ring.
 Qed.
 
 (**********)
 Lemma sum_growing :
- forall (An Bn:nat -> R) (N:nat),
-   (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N.
-intros.
-induction  N as [| N HrecN].
-simpl in |- *; apply H.
-do 2 rewrite tech5.
-apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
-apply Rplus_le_compat_l; apply H.
-do 2 rewrite <- (Rplus_comm (Bn (S N))).
-apply Rplus_le_compat_l; apply HrecN.
+  forall (An Bn:nat -> R) (N:nat),
+    (forall n:nat, An n <= Bn n) -> sum_f_R0 An N <= sum_f_R0 Bn N.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *; apply H.
+  do 2 rewrite tech5.
+  apply Rle_trans with (sum_f_R0 An N + Bn (S N)).
+  apply Rplus_le_compat_l; apply H.
+  do 2 rewrite <- (Rplus_comm (Bn (S N))).
+  apply Rplus_le_compat_l; apply HrecN.
 Qed.
 
 (**********)
 Lemma Rabs_triang_gen :
- forall (An:nat -> R) (N:nat),
-   Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. 
-intros.
-induction  N as [| N HrecN].
-simpl in |- *.
-right; reflexivity.
-do 2 rewrite tech5.
-apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
-apply Rabs_triang.
-do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
-apply Rplus_le_compat_l; apply HrecN.
+  forall (An:nat -> R) (N:nat),
+    Rabs (sum_f_R0 An N) <= sum_f_R0 (fun i:nat => Rabs (An i)) N. 
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *.
+  right; reflexivity.
+  do 2 rewrite tech5.
+  apply Rle_trans with (Rabs (sum_f_R0 An N) + Rabs (An (S N))).
+  apply Rabs_triang.
+  do 2 rewrite <- (Rplus_comm (Rabs (An (S N)))).
+  apply Rplus_le_compat_l; apply HrecN.
 Qed.
 
 (**********)
 Lemma cond_pos_sum :
- forall (An:nat -> R) (N:nat),
-   (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N.
-intros.
-induction  N as [| N HrecN].
-simpl in |- *; apply H.
-rewrite tech5.
-apply Rplus_le_le_0_compat.
-apply HrecN.
-apply H.
+  forall (An:nat -> R) (N:nat),
+    (forall n:nat, 0 <= An n) -> 0 <= sum_f_R0 An N.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *; apply H.
+  rewrite tech5.
+  apply Rplus_le_le_0_compat.
+  apply HrecN.
+  apply H.
 Qed.
 
 (* Cauchy's criterion for series *)
@@ -358,122 +379,126 @@ Definition Cauchy_crit_series (An:nat -> R) : Prop :=
 
 (* If (|An|) satisfies the Cauchy's criterion for series, then (An) too *)
 Lemma cauchy_abs :
- forall An:nat -> R,
-   Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An.
-unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
-intros.
-elim (H eps H0); intros.
-exists x.
-intros.
-cut
- (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <=
-  R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
-    (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
-intro.
-apply Rle_lt_trans with
- (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
-    (sum_f_R0 (fun i:nat => Rabs (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 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ].
-unfold R_dist in |- *.
-unfold Rminus in |- *.
-do 2 rewrite Ropp_plus_distr.
-do 2 rewrite <- Rplus_assoc.
-do 2 rewrite Rplus_opp_r.
-do 2 rewrite Rplus_0_l.
-do 2 rewrite Rabs_Ropp.
-rewrite
- (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n)))
- .
-set (Bn := fun i:nat => An (S n + i)%nat).
-replace (fun i:nat => Rabs (An (S n + i)%nat)) with
- (fun i:nat => Rabs (Bn i)).
-apply Rabs_triang_gen.
-unfold Bn in |- *; reflexivity.
-apply Rle_ge.
-apply cond_pos_sum.
-intro; apply Rabs_pos.
-rewrite b.
-unfold R_dist in |- *.
-unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
-rewrite Rabs_R0; right; reflexivity.
-rewrite (tech2 An m n); [ idtac | assumption ].
-rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ].
-unfold R_dist in |- *.
-unfold Rminus in |- *.
-do 2 rewrite Rplus_assoc.
-rewrite (Rplus_comm (sum_f_R0 An m)).
-rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
-do 2 rewrite Rplus_assoc.
-do 2 rewrite Rplus_opp_l.
-do 2 rewrite Rplus_0_r.
-rewrite
- (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m)))
- .
-set (Bn := fun i:nat => An (S m + i)%nat).
-replace (fun i:nat => Rabs (An (S m + i)%nat)) with
- (fun i:nat => Rabs (Bn i)).
-apply Rabs_triang_gen.
-unfold Bn in |- *; reflexivity.
-apply Rle_ge.
-apply cond_pos_sum.
-intro; apply Rabs_pos.
+  forall An:nat -> R,
+    Cauchy_crit_series (fun i:nat => Rabs (An i)) -> Cauchy_crit_series An.
+Proof.
+  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  intros.
+  elim (H eps H0); intros.
+  exists x.
+  intros.
+  cut
+    (R_dist (sum_f_R0 An n) (sum_f_R0 An m) <=
+      R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
+      (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
+  intro.
+  apply Rle_lt_trans with
+    (R_dist (sum_f_R0 (fun i:nat => Rabs (An i)) n)
+      (sum_f_R0 (fun i:nat => Rabs (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 (fun i:nat => Rabs (An i)) n m); [ idtac | assumption ].
+  unfold R_dist in |- *.
+  unfold Rminus in |- *.
+  do 2 rewrite Ropp_plus_distr.
+  do 2 rewrite <- Rplus_assoc.
+  do 2 rewrite Rplus_opp_r.
+  do 2 rewrite Rplus_0_l.
+  do 2 rewrite Rabs_Ropp.
+  rewrite
+    (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S n + i)%nat)) (m - S n)))
+    .
+  set (Bn := fun i:nat => An (S n + i)%nat).
+  replace (fun i:nat => Rabs (An (S n + i)%nat)) with
+  (fun i:nat => Rabs (Bn i)).
+  apply Rabs_triang_gen.
+  unfold Bn in |- *; reflexivity.
+  apply Rle_ge.
+  apply cond_pos_sum.
+  intro; apply Rabs_pos.
+  rewrite b.
+  unfold R_dist in |- *.
+  unfold Rminus in |- *; do 2 rewrite Rplus_opp_r.
+  rewrite Rabs_R0; right; reflexivity.
+  rewrite (tech2 An m n); [ idtac | assumption ].
+  rewrite (tech2 (fun i:nat => Rabs (An i)) m n); [ idtac | assumption ].
+  unfold R_dist in |- *.
+  unfold Rminus in |- *.
+  do 2 rewrite Rplus_assoc.
+  rewrite (Rplus_comm (sum_f_R0 An m)).
+  rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (An i)) m)).
+  do 2 rewrite Rplus_assoc.
+  do 2 rewrite Rplus_opp_l.
+  do 2 rewrite Rplus_0_r.
+  rewrite
+    (Rabs_right (sum_f_R0 (fun i:nat => Rabs (An (S m + i)%nat)) (n - S m)))
+    .
+  set (Bn := fun i:nat => An (S m + i)%nat).
+  replace (fun i:nat => Rabs (An (S m + i)%nat)) with
+  (fun i:nat => Rabs (Bn i)).
+  apply Rabs_triang_gen.
+  unfold Bn in |- *; reflexivity.
+  apply Rle_ge.
+  apply cond_pos_sum.
+  intro; apply Rabs_pos.
 Qed.
 
 (**********)
 Lemma cv_cauchy_1 :
- forall An:nat -> R,
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
-   Cauchy_crit_series An.
-intros An X.
-elim X; intros.
-unfold Un_cv in p.
-unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
-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 in |- *.
-replace (sum_f_R0 An n - sum_f_R0 An m) with
- (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ].
-rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)).
-apply Rabs_triang.
-apply Rlt_le_trans with (eps / 2 + eps / 2).
-apply Rplus_lt_compat.
-apply H1; assumption.
-apply H1; assumption.
-right; symmetry  in |- *; apply double_var.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  forall An:nat -> R,
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l) ->
+    Cauchy_crit_series An.
+Proof.
+  intros An X.
+  elim X; intros.
+  unfold Un_cv in p.
+  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  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 in |- *.
+  replace (sum_f_R0 An n - sum_f_R0 An m) with
+  (sum_f_R0 An n - x + - (sum_f_R0 An m - x)); [ idtac | ring ].
+  rewrite <- (Rabs_Ropp (sum_f_R0 An m - x)).
+  apply Rabs_triang.
+  apply Rlt_le_trans with (eps / 2 + eps / 2).
+  apply Rplus_lt_compat.
+  apply H1; assumption.
+  apply H1; assumption.
+  right; symmetry  in |- *; apply double_var.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
 Lemma cv_cauchy_2 :
- forall An:nat -> R,
-   Cauchy_crit_series An ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros.
-apply R_complete.
-unfold Cauchy_crit_series in H.
-exact H.
+  forall An:nat -> R,
+    Cauchy_crit_series An ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros.
+  apply R_complete.
+  unfold Cauchy_crit_series in H.
+  exact H.
 Qed.
 
 (**********)
 Lemma sum_eq_R0 :
- forall (An:nat -> R) (N:nat),
-   (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0.
-intros; induction  N as [| N HrecN].
-simpl in |- *; apply H; apply le_n.
-rewrite tech5; rewrite HrecN;
- [ rewrite Rplus_0_l; apply H; apply le_n
- | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ].
+  forall (An:nat -> R) (N:nat),
+    (forall n:nat, (n <= N)%nat -> An n = 0) -> sum_f_R0 An N = 0.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; apply H; apply le_n.
+  rewrite tech5; rewrite HrecN;
+    [ rewrite Rplus_0_l; apply H; apply le_n
+      | intros; apply H; apply le_trans with N; [ assumption | apply le_n_Sn ] ].
 Qed.
 
 Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R :=
@@ -481,122 +506,124 @@ Definition SP (fn:nat -> R -> R) (N:nat) (x:R) : R :=
 
 (**********)
 Lemma sum_incr :
- forall (An:nat -> R) (N:nat) (l:R),
-   Un_cv (fun n:nat => sum_f_R0 An n) l ->
-   (forall 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 (fun n:nat => sum_f_R0 An n)).
-intro; set (l1 := sum_f_R0 An N) in r.
-unfold Un_cv in H; cut (0 < l1 - l).
-intro; elim (H _ H2); intros.
-set (N0 := max x N); cut (N0 >= x)%nat.
-intro; assert (H5 := H3 N0 H4).
-cut (l1 <= sum_f_R0 An N0).
-intro; unfold R_dist in H5; rewrite Rabs_right in H5.
-cut (sum_f_R0 An N0 < l1).
-intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)).
-apply Rplus_lt_reg_r with (- l).
-do 2 rewrite (Rplus_comm (- l)).
-apply H5.
-apply Rle_ge; apply Rplus_le_reg_l with l.
-rewrite Rplus_0_r; 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 in |- *; apply Rge_le;
- apply (growing_prop (fun k:nat => sum_f_R0 An k)).
-apply H1.
-unfold ge, N0 in |- *; apply le_max_r.
-unfold ge, N0 in |- *; apply le_max_l.
-apply Rplus_lt_reg_r with l; rewrite Rplus_0_r;
- replace (l + (l1 - l)) with l1; [ apply r | ring ].
-unfold Un_growing in |- *; intro; simpl in |- *;
- pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l; apply H0.
+  forall (An:nat -> R) (N:nat) (l:R),
+    Un_cv (fun n:nat => sum_f_R0 An n) l ->
+    (forall n:nat, 0 <= An n) -> sum_f_R0 An N <= l.
+Proof.
+  intros; case (total_order_T (sum_f_R0 An N) l); intro.
+  elim s; intro.
+  left; apply a.
+  right; apply b.
+  cut (Un_growing (fun n:nat => sum_f_R0 An n)).
+  intro; set (l1 := sum_f_R0 An N) in r.
+  unfold Un_cv in H; cut (0 < l1 - l).
+  intro; elim (H _ H2); intros.
+  set (N0 := max x N); cut (N0 >= x)%nat.
+  intro; assert (H5 := H3 N0 H4).
+  cut (l1 <= sum_f_R0 An N0).
+  intro; unfold R_dist in H5; rewrite Rabs_right in H5.
+  cut (sum_f_R0 An N0 < l1).
+  intro; elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H7 H6)).
+  apply Rplus_lt_reg_r with (- l).
+  do 2 rewrite (Rplus_comm (- l)).
+  apply H5.
+  apply Rle_ge; apply Rplus_le_reg_l with l.
+  rewrite Rplus_0_r; 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 in |- *; apply Rge_le;
+    apply (growing_prop (fun k:nat => sum_f_R0 An k)).
+  apply H1.
+  unfold ge, N0 in |- *; apply le_max_r.
+  unfold ge, N0 in |- *; apply le_max_l.
+  apply Rplus_lt_reg_r with l; rewrite Rplus_0_r;
+    replace (l + (l1 - l)) with l1; [ apply r | ring ].
+  unfold Un_growing in |- *; intro; simpl in |- *;
+    pattern (sum_f_R0 An n) at 1 in |- *; rewrite <- Rplus_0_r;
+      apply Rplus_le_compat_l; apply H0.
 Qed.
 
 (**********)
 Lemma sum_cv_maj :
- forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R),
-   Un_cv (fun n:nat => SP fn n x) l1 ->
-   Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
-   (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2.
-intros; case (total_order_T (Rabs l1) l2); intro.
-elim s; intro.
-left; apply a.
-right; apply b.
-cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0).
-intro; cut (0 < (Rabs l1 - l2) / 2).
-intro; unfold Un_cv in H, H0.
-elim (H _ H3); intros Na H4.
-elim (H0 _ H3); intros Nb H5.
-set (N := max Na Nb).
-unfold R_dist in H4, H5.
-cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2).
-intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2).
-intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2).
-intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)).
-intro; cut (sum_f_R0 An N < Rabs (SP fn N x)).
-intro; assert (H11 := H2 N).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)).
-apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption.
-case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro.
-apply Rlt_trans with (Rabs l1).
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r.
-discrR.
-apply (Rminus_lt _ _ r0).
-rewrite (Rabs_right _ r0) in H7.
-apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
-replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with
- (Rabs l1 - Rabs (SP fn N x)).
-unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_r; apply H7.
-unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
- rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l;
- repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *;
- rewrite double_var; unfold Rdiv in |- *; ring.
-case (Rcase_abs (sum_f_R0 An N - l2)); intro.
-apply Rlt_trans with l2.
-apply (Rminus_lt _ _ r0).
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2);
- rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l;
- apply r.
-discrR.
-rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2).
-replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2).
-rewrite Rplus_comm; apply H6.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
- rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r;
- pattern l2 at 2 in |- *; rewrite double_var;
- repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr;
- unfold Rdiv in |- *; ring.
-apply Rle_lt_trans with (Rabs (SP fn N x - l1)).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2.
-apply H4; unfold ge, N in |- *; apply le_max_l.
-apply H5; unfold ge, N in |- *; apply le_max_r.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rplus_lt_reg_r with l2.
-rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1);
- [ apply r | ring ].
-apply Rinv_0_lt_compat; prove_sup0.
-intros; induction  n0 as [| n0 Hrecn0].
-unfold SP in |- *; simpl in |- *; apply H1.
-unfold SP in |- *; simpl in |- *.
-apply Rle_trans with
- (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)).
-apply Rabs_triang.
-apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)).
-do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))).
-apply Rplus_le_compat_l; apply Hrecn0.
-apply Rplus_le_compat_l; apply H1.
+  forall (An:nat -> R) (fn:nat -> R -> R) (x l1 l2:R),
+    Un_cv (fun n:nat => SP fn n x) l1 ->
+    Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
+    (forall n:nat, Rabs (fn n x) <= An n) -> Rabs l1 <= l2.
+Proof.
+  intros; case (total_order_T (Rabs l1) l2); intro.
+  elim s; intro.
+  left; apply a.
+  right; apply b.
+  cut (forall n0:nat, Rabs (SP fn n0 x) <= sum_f_R0 An n0).
+  intro; cut (0 < (Rabs l1 - l2) / 2).
+  intro; unfold Un_cv in H, H0.
+  elim (H _ H3); intros Na H4.
+  elim (H0 _ H3); intros Nb H5.
+  set (N := max Na Nb).
+  unfold R_dist in H4, H5.
+  cut (Rabs (sum_f_R0 An N - l2) < (Rabs l1 - l2) / 2).
+  intro; cut (Rabs (Rabs l1 - Rabs (SP fn N x)) < (Rabs l1 - l2) / 2).
+  intro; cut (sum_f_R0 An N < (Rabs l1 + l2) / 2).
+  intro; cut ((Rabs l1 + l2) / 2 < Rabs (SP fn N x)).
+  intro; cut (sum_f_R0 An N < Rabs (SP fn N x)).
+  intro; assert (H11 := H2 N).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H10)).
+  apply Rlt_trans with ((Rabs l1 + l2) / 2); assumption.
+  case (Rcase_abs (Rabs l1 - Rabs (SP fn N x))); intro.
+  apply Rlt_trans with (Rabs l1).
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite double; apply Rplus_lt_compat_l; apply r.
+  discrR.
+  apply (Rminus_lt _ _ r0).
+  rewrite (Rabs_right _ r0) in H7.
+  apply Rplus_lt_reg_r with ((Rabs l1 - l2) / 2 - Rabs (SP fn N x)).
+  replace ((Rabs l1 - l2) / 2 - Rabs (SP fn N x) + (Rabs l1 + l2) / 2) with
+  (Rabs l1 - Rabs (SP fn N x)).
+  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+    rewrite Rplus_0_r; apply H7.
+  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+    rewrite <- (Rmult_comm (/ 2)); rewrite Rmult_minus_distr_l;
+      repeat rewrite (Rmult_comm (/ 2)); pattern (Rabs l1) at 1 in |- *;
+        rewrite double_var; unfold Rdiv in |- *; ring.
+  case (Rcase_abs (sum_f_R0 An N - l2)); intro.
+  apply Rlt_trans with l2.
+  apply (Rminus_lt _ _ r0).
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite (double l2); unfold Rdiv in |- *; rewrite (Rmult_comm 2);
+    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite (Rplus_comm (Rabs l1)); apply Rplus_lt_compat_l;
+    apply r.
+  discrR.
+  rewrite (Rabs_right _ r0) in H6; apply Rplus_lt_reg_r with (- l2).
+  replace (- l2 + (Rabs l1 + l2) / 2) with ((Rabs l1 - l2) / 2).
+  rewrite Rplus_comm; apply H6.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+    rewrite Rmult_minus_distr_l; rewrite Rmult_plus_distr_r;
+      pattern l2 at 2 in |- *; rewrite double_var;
+        repeat rewrite (Rmult_comm (/ 2)); rewrite Ropp_plus_distr;
+          unfold Rdiv in |- *; ring.
+  apply Rle_lt_trans with (Rabs (SP fn N x - l1)).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply Rabs_triang_inv2.
+  apply H4; unfold ge, N in |- *; apply le_max_l.
+  apply H5; unfold ge, N in |- *; apply le_max_r.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rplus_lt_reg_r with l2.
+  rewrite Rplus_0_r; replace (l2 + (Rabs l1 - l2)) with (Rabs l1);
+    [ apply r | ring ].
+  apply Rinv_0_lt_compat; prove_sup0.
+  intros; induction  n0 as [| n0 Hrecn0].
+  unfold SP in |- *; simpl in |- *; apply H1.
+  unfold SP in |- *; simpl in |- *.
+  apply Rle_trans with
+    (Rabs (sum_f_R0 (fun k:nat => fn k x) n0) + Rabs (fn (S n0) x)).
+  apply Rabs_triang.
+  apply Rle_trans with (sum_f_R0 An n0 + Rabs (fn (S n0) x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (fn (S n0) x))).
+  apply Rplus_le_compat_l; apply Hrecn0.
+  apply Rplus_le_compat_l; apply H1.
 Qed.
diff --git a/theories/Reals/RIneq.v b/theories/Reals/RIneq.v
index 3e1dbccf..51c66afa 100644
--- a/theories/Reals/RIneq.v
+++ b/theories/Reals/RIneq.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: RIneq.v 6897 2005-03-29 15:39:12Z herbelin $ i*)
+(*i $Id: RIneq.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (***************************************************************************)
 (**              Basic lemmas for the classical reals numbers              *)
@@ -15,63 +15,44 @@
 Require Export Raxioms.
 Require Export ZArithRing.
 Require Import Omega.
-Require Export Field.
+Require Export RealField.
 
 Open Local Scope Z_scope.
 Open Local Scope R_scope.
 
 Implicit Type r : R.
 
-(***************************************************************************)
-(**       Instantiating Ring tactic on reals                               *)
-(***************************************************************************)
-
-Lemma RTheory : Ring_Theory Rplus Rmult 1 0 Ropp (fun x y:R => false).
-  split.
-  exact Rplus_comm.
-  symmetry  in |- *; apply Rplus_assoc.
-  exact Rmult_comm.
-  symmetry  in |- *; apply Rmult_assoc.
-  intro; apply Rplus_0_l.
-  intro; apply Rmult_1_l.
-  exact Rplus_opp_r.
-  intros.
-  rewrite Rmult_comm.
-  rewrite (Rmult_comm n p).
-  rewrite (Rmult_comm m p).
-  apply Rmult_plus_distr_l.
-  intros; contradiction.
-Defined.
-
-Add Field R Rplus Rmult 1 0 Ropp (fun x y:R => false) Rinv RTheory Rinv_l
- with minus := Rminus div := Rdiv.
-
 (**************************************************************************)
-(**  Relation between orders and equality                                 *)
+(** * Relation between orders and equality                                *)
 (**************************************************************************)
 
 (**********)
 Lemma Rlt_irrefl : forall r, ~ r < r.
+Proof.
   generalize Rlt_asym. intuition eauto.
 Qed.
 Hint Resolve Rlt_irrefl: real.
 
 Lemma Rle_refl : forall r, r <= r.
-intro; right; reflexivity.
+Proof.
+  intro; right; reflexivity.
 Qed.
 
 Lemma Rlt_not_eq : forall r1 r2, r1 < r2 -> r1 <> r2.
+Proof.
   red in |- *; intros r1 r2 H H0; apply (Rlt_irrefl r1).
   pattern r1 at 2 in |- *; rewrite H0; trivial.
 Qed.
 
 Lemma Rgt_not_eq : forall r1 r2, r1 > r2 -> r1 <> r2.
-intros; apply sym_not_eq; apply Rlt_not_eq; auto with real.
+Proof.
+  intros; apply sym_not_eq; apply Rlt_not_eq; auto with real.
 Qed.
 
 (**********)
 Lemma Rlt_dichotomy_converse : forall r1 r2, r1 < r2 \/ r1 > r2 -> r1 <> r2.
-generalize Rlt_not_eq Rgt_not_eq. intuition eauto.
+Proof.
+  generalize Rlt_not_eq Rgt_not_eq. intuition eauto.
 Qed.
 Hint Resolve Rlt_dichotomy_converse: real.
 
@@ -79,61 +60,70 @@ Hint Resolve Rlt_dichotomy_converse: real.
 
 (**********)
 Lemma Req_dec : forall r1 r2, r1 = r2 \/ r1 <> r2.
-intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
- intuition eauto 3. 
+Proof.
+  intros; generalize (total_order_T r1 r2) Rlt_dichotomy_converse;
+    intuition eauto 3. 
 Qed.
 Hint Resolve Req_dec: real.
 
 (**********)
 Lemma Rtotal_order : forall r1 r2, r1 < r2 \/ r1 = r2 \/ r1 > r2.
-intros; generalize (total_order_T r1 r2); tauto.
+Proof.
+  intros; generalize (total_order_T r1 r2); tauto.
 Qed.
 
 (**********)
 Lemma Rdichotomy : forall r1 r2, r1 <> r2 -> r1 < r2 \/ r1 > r2.
-intros; generalize (total_order_T r1 r2); tauto.
+Proof.
+  intros; generalize (total_order_T r1 r2); tauto.
 Qed.
 
 
 (*********************************************************************************)
-(**       Order Lemma  : relating [<], [>], [<=] and [>=]  	                 *)
+(** *     Order Lemma  : relating [<], [>], [<=] and [>=]  	                 *)
 (*********************************************************************************)
 
 (**********)
 Lemma Rlt_le : forall r1 r2, r1 < r2 -> r1 <= r2.
-intros; red in |- *; tauto.
+Proof.
+  intros; red in |- *; tauto.
 Qed.
 Hint Resolve Rlt_le: real.
 
 (**********)
 Lemma Rle_ge : forall r1 r2, r1 <= r2 -> r2 >= r1.
-destruct 1; red in |- *; auto with real.
+Proof.
+  destruct 1; red in |- *; auto with real.
 Qed.
 
 Hint Immediate Rle_ge: real.
 
 (**********)
 Lemma Rge_le : forall r1 r2, r1 >= r2 -> r2 <= r1.
-destruct 1; red in |- *; auto with real.
+Proof.
+  destruct 1; red in |- *; auto with real.
 Qed.
 
 Hint Resolve Rge_le: real.
 
 (**********)
 Lemma Rnot_le_lt : forall r1 r2, ~ r1 <= r2 -> r2 < r1.
-intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto.
+Proof.
+  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rle in |- *; tauto.
 Qed.
 
 Hint Immediate Rnot_le_lt: real.
 
 Lemma Rnot_ge_lt : forall r1 r2, ~ r1 >= r2 -> r1 < r2.
-intros; apply Rnot_le_lt; auto with real.
+Proof.
+  intros; apply Rnot_le_lt; auto with real.
 Qed.
 
 (**********)
 Lemma Rlt_not_le : forall r1 r2, r2 < r1 -> ~ r1 <= r2.
-generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *.
-intuition eauto 3.
+Proof.
+  generalize Rlt_asym Rlt_dichotomy_converse; unfold Rle in |- *.
+  intuition eauto 3.
 Qed.
 
 Lemma Rgt_not_le : forall r1 r2, r1 > r2 -> ~ r1 <= r2.
@@ -142,134 +132,157 @@ Proof Rlt_not_le.
 Hint Immediate Rlt_not_le: real.
 
 Lemma Rle_not_lt : forall r1 r2, r2 <= r1 -> ~ r1 < r2.
-intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2).
-unfold Rle in |- *; intuition.
+Proof.
+  intros r1 r2. generalize (Rlt_asym r1 r2) (Rlt_dichotomy_converse r1 r2).
+  unfold Rle in |- *; intuition.
 Qed.
 
 (**********)
 Lemma Rlt_not_ge : forall r1 r2, r1 < r2 -> ~ r1 >= r2.
-generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3.
+Proof.
+  generalize Rlt_not_le. unfold Rle, Rge in |- *. intuition eauto 3.
 Qed.
 
 Hint Immediate Rlt_not_ge: real.
 
 (**********)
 Lemma Req_le : forall r1 r2, r1 = r2 -> r1 <= r2.
-unfold Rle in |- *; tauto.
+Proof.
+  unfold Rle in |- *; tauto.
 Qed.
 Hint Immediate Req_le: real.
 
 Lemma Req_ge : forall r1 r2, r1 = r2 -> r1 >= r2.
-unfold Rge in |- *; tauto.
+Proof.
+  unfold Rge in |- *; tauto.
 Qed.
 Hint Immediate Req_ge: real.
 
 Lemma Req_le_sym : forall r1 r2, r2 = r1 -> r1 <= r2.
-unfold Rle in |- *; auto.
+Proof.
+  unfold Rle in |- *; auto.
 Qed.
 Hint Immediate Req_le_sym: real.
 
 Lemma Req_ge_sym : forall r1 r2, r2 = r1 -> r1 >= r2.
-unfold Rge in |- *; auto.
+Proof.
+  unfold Rge in |- *; auto.
 Qed.
 Hint Immediate Req_ge_sym: real.
 
 Lemma Rle_antisym : forall r1 r2, r1 <= r2 -> r2 <= r1 -> r1 = r2.
-intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition.
+Proof.
+  intros r1 r2; generalize (Rlt_asym r1 r2); unfold Rle in |- *; intuition.
 Qed.
 Hint Resolve Rle_antisym: real.
 
 (**********)
 Lemma Rle_le_eq : forall r1 r2, r1 <= r2 /\ r2 <= r1 <-> r1 = r2.
-intuition.
+Proof.
+  intuition.
 Qed.
 
 Lemma Rlt_eq_compat :
- forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3.
-intros x x' y y'; intros; replace x with x'; replace y with y'; assumption.
+  forall r1 r2 r3 r4, r1 = r2 -> r2 < r4 -> r4 = r3 -> r1 < r3.
+Proof.
+  intros x x' y y'; intros; replace x with x'; replace y with y'; assumption.
 Qed.
 
 (**********)
 Lemma Rle_trans : forall r1 r2 r3, r1 <= r2 -> r2 <= r3 -> r1 <= r3.
-generalize trans_eq Rlt_trans Rlt_eq_compat.
-unfold Rle in |- *.
-intuition eauto 2.
+Proof.
+  generalize trans_eq Rlt_trans Rlt_eq_compat.
+  unfold Rle in |- *.
+  intuition eauto 2.
 Qed.
 
 (**********)
 Lemma Rle_lt_trans : forall r1 r2 r3, r1 <= r2 -> r2 < r3 -> r1 < r3.
-generalize Rlt_trans Rlt_eq_compat. 
-unfold Rle in |- *.
-intuition eauto 2.
+Proof.
+  generalize Rlt_trans Rlt_eq_compat. 
+  unfold Rle in |- *.
+  intuition eauto 2.
 Qed.
 
 (**********)
 Lemma Rlt_le_trans : forall r1 r2 r3, r1 < r2 -> r2 <= r3 -> r1 < r3.
-generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2.
+Proof.
+  generalize Rlt_trans Rlt_eq_compat; unfold Rle in |- *; intuition eauto 2.
 Qed.
 
 
 (** Decidability of the order *)
 Lemma Rlt_dec : forall r1 r2, {r1 < r2} + {~ r1 < r2}.
-intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2);
- intuition.
+Proof.
+  intros; generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2);
+    intuition.
 Qed.
 
 (**********)
 Lemma Rle_dec : forall r1 r2, {r1 <= r2} + {~ r1 <= r2}.
-intros r1 r2.
-generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2).
-intuition eauto 4 with real.
+Proof.
+  intros r1 r2.
+  generalize (total_order_T r1 r2) (Rlt_dichotomy_converse r1 r2).
+  intuition eauto 4 with real.
 Qed.
 
 (**********)
 Lemma Rgt_dec : forall r1 r2, {r1 > r2} + {~ r1 > r2}.
-intros; unfold Rgt in |- *; intros; apply Rlt_dec.
+Proof.
+  intros; unfold Rgt in |- *; intros; apply Rlt_dec.
 Qed.
 
 (**********)
 Lemma Rge_dec : forall r1 r2, {r1 >= r2} + {~ r1 >= r2}.
-intros; generalize (Rle_dec r2 r1); intuition.
+Proof.
+  intros; generalize (Rle_dec r2 r1); intuition.
 Qed.
 
 Lemma Rlt_le_dec : forall r1 r2, {r1 < r2} + {r2 <= r1}.
-intros; generalize (total_order_T r1 r2); intuition.
+Proof.
+  intros; generalize (total_order_T r1 r2); intuition.
 Qed.
 
 Lemma Rle_or_lt : forall r1 r2, r1 <= r2 \/ r2 < r1.
-intros n m; elim (Rlt_le_dec m n); auto with real.
+Proof.
+  intros n m; elim (Rlt_le_dec m n); auto with real.
 Qed.
 
 Lemma Rle_lt_or_eq_dec : forall r1 r2, r1 <= r2 -> {r1 < r2} + {r1 = r2}.
-intros r1 r2 H; generalize (total_order_T r1 r2); intuition.
+Proof.
+  intros r1 r2 H; generalize (total_order_T r1 r2); intuition.
 Qed.
 
 (**********)
 Lemma inser_trans_R :
- forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}.
-intros n m p q; intros; generalize (Rlt_le_dec m q); intuition.
+  forall r1 r2 r3 r4, r1 <= r2 < r3 -> {r1 <= r2 < r4} + {r4 <= r2 < r3}.
+Proof.
+  intros n m p q; intros; generalize (Rlt_le_dec m q); intuition.
 Qed.
 
 (****************************************************************)
-(**        Field Lemmas                                         *)
+(** *      Field Lemmas                                         *)
 (* This part contains lemma involving the Fields operations     *)
 (****************************************************************)
 (*********************************************************)
-(**      Addition                                        *)
+(** **   Addition                                        *)
 (*********************************************************)
 
 Lemma Rplus_ne : forall r, r + 0 = r /\ 0 + r = r.
-intro; split; ring.
+Proof.
+  split; ring.
 Qed.
 Hint Resolve Rplus_ne: real v62.
 
 Lemma Rplus_0_r : forall r, r + 0 = r.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rplus_0_r: real.
 
 (**********)
 Lemma Rplus_opp_l : forall r, - r + r = 0.
+Proof.
   intro; ring.
 Qed.
 Hint Resolve Rplus_opp_l: real.
@@ -277,14 +290,17 @@ Hint Resolve Rplus_opp_l: real.
 
 (**********)
 Lemma Rplus_opp_r_uniq : forall r1 r2, r1 + r2 = 0 -> r2 = - r1.
-  intros x y H; replace y with (- x + x + y);
-   [ rewrite Rplus_assoc; rewrite H; ring | ring ].
+Proof.
+  intros x y H;
+    replace y with (- x + x + y) by ring.
+  rewrite Rplus_assoc; rewrite H; ring.
 Qed.
 
 (*i New i*)
 Hint Resolve (f_equal (A:=R)): real.
 
 Lemma Rplus_eq_compat_l : forall r r1 r2, r1 = r2 -> r + r1 = r + r2.
+Proof.
   auto with real.
 Qed.
 
@@ -292,6 +308,7 @@ Qed.
 
 (**********)
 Lemma Rplus_eq_reg_l : forall r r1 r2, r + r1 = r + r2 -> r1 = r2.
+Proof.
   intros; transitivity (- r + r + r1).
   ring.
   transitivity (- r + r + r2).
@@ -302,55 +319,64 @@ Hint Resolve Rplus_eq_reg_l: real.
 
 (**********)
 Lemma Rplus_0_r_uniq : forall r r1, r + r1 = r -> r1 = 0.
+Proof.
   intros r b; pattern r at 2 in |- *; replace r with (r + 0); eauto with real.
 Qed.
 
 (***********************************************************)       
-(**       Multiplication                                   *)
+(** **    Multiplication                                   *)
 (***********************************************************)
 
 (**********)
 Lemma Rinv_r : forall r, r <> 0 -> r * / r = 1.
-  intros; rewrite Rmult_comm; auto with real.
+Proof.
+  intros; field; trivial.
 Qed.
 Hint Resolve Rinv_r: real.
 
 Lemma Rinv_l_sym : forall r, r <> 0 -> 1 = / r * r.
-  symmetry  in |- *; auto with real.
+Proof.
+  intros; field; trivial.
 Qed.
 
 Lemma Rinv_r_sym : forall r, r <> 0 -> 1 = r * / r.
-  symmetry  in |- *; auto with real.
+Proof.
+  intros; field; trivial.
 Qed.
 Hint Resolve Rinv_l_sym Rinv_r_sym: real.
 
 
 (**********)
 Lemma Rmult_0_r : forall r, r * 0 = 0.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rmult_0_r: real v62.
 
 (**********)
 Lemma Rmult_0_l : forall r, 0 * r = 0.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rmult_0_l: real v62.
 
 (**********)
 Lemma Rmult_ne : forall r, r * 1 = r /\ 1 * r = r.
-intro; split; ring.
+Proof.
+  intro; split; ring.
 Qed.
 Hint Resolve Rmult_ne: real v62.
 
 (**********)
 Lemma Rmult_1_r : forall r, r * 1 = r.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rmult_1_r: real.
 
 (**********)
 Lemma Rmult_eq_compat_l : forall r r1 r2, r1 = r2 -> r * r1 = r * r2.
+Proof.
   auto with real.
 Qed.
 
@@ -358,15 +384,17 @@ Qed.
 
 (**********)
 Lemma Rmult_eq_reg_l : forall r r1 r2, r * r1 = r * r2 -> r <> 0 -> r1 = r2.
+Proof.
   intros; transitivity (/ r * r * r1).
-  rewrite Rinv_l; auto with real.
+  field; trivial.
   transitivity (/ r * r * r2).
   repeat rewrite Rmult_assoc; rewrite H; trivial.
-  rewrite Rinv_l; auto with real.
+  field; trivial.
 Qed.
 
 (**********)
 Lemma Rmult_integral : forall r1 r2, r1 * r2 = 0 -> r1 = 0 \/ r2 = 0.
+Proof.
   intros; case (Req_dec r1 0); [ intro Hz | intro Hnotz ].
   auto.
   right; apply Rmult_eq_reg_l with r1; trivial.
@@ -375,6 +403,7 @@ Qed.
 
 (**********)
 Lemma Rmult_eq_0_compat : forall r1 r2, r1 = 0 \/ r2 = 0 -> r1 * r2 = 0.
+Proof.
   intros r1 r2 [H| H]; rewrite H; auto with real.
 Qed.
 
@@ -382,35 +411,40 @@ Hint Resolve Rmult_eq_0_compat: real.
 
 (**********)
 Lemma Rmult_eq_0_compat_r : forall r1 r2, r1 = 0 -> r1 * r2 = 0.
+Proof.
   auto with real.
 Qed.
 
 (**********)
 Lemma Rmult_eq_0_compat_l : forall r1 r2, r2 = 0 -> r1 * r2 = 0.
+Proof.
   auto with real.
 Qed.
 
 
 (**********) 
 Lemma Rmult_neq_0_reg : forall r1 r2, r1 * r2 <> 0 -> r1 <> 0 /\ r2 <> 0.
-intros r1 r2 H; split; red in |- *; intro; apply H; auto with real.
+Proof.
+  intros r1 r2 H; split; red in |- *; intro; apply H; auto with real.
 Qed.
 
 (**********) 
 Lemma Rmult_integral_contrapositive :
- forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0.
-red in |- *; intros r1 r2 [H1 H2] H.
-case (Rmult_integral r1 r2); auto with real.
+  forall r1 r2, r1 <> 0 /\ r2 <> 0 -> r1 * r2 <> 0.
+Proof.
+  red in |- *; intros r1 r2 [H1 H2] H.
+  case (Rmult_integral r1 r2); auto with real.
 Qed.
 Hint Resolve Rmult_integral_contrapositive: real.
 
 (**********) 
 Lemma Rmult_plus_distr_r :
- forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3.
-intros; ring.
+  forall r1 r2 r3, (r1 + r2) * r3 = r1 * r3 + r2 * r3.
+Proof.
+  intros; ring.
 Qed.
 
-(** Square function *)
+(** ** Square function *)
 
 (***********)
 Definition Rsqr r : R := r * r.
@@ -422,695 +456,802 @@ Qed.
 
 (***********)
 Lemma Rsqr_0_uniq : forall r, Rsqr r = 0 -> r = 0.
-unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial.
+  unfold Rsqr in |- *; intros; elim (Rmult_integral r r H); trivial.
 Qed.
 
 (*********************************************************)
-(**      Opposite                                        *)
+(** **   Opposite                                        *)
 (*********************************************************)
 
 (**********)
 Lemma Ropp_eq_compat : forall r1 r2, r1 = r2 -> - r1 = - r2.
+Proof.
   auto with real.
 Qed.
 Hint Resolve Ropp_eq_compat: real.
 
 (**********)
 Lemma Ropp_0 : -0 = 0.
+Proof.
   ring.
 Qed.
 Hint Resolve Ropp_0: real v62.
 
 (**********)
 Lemma Ropp_eq_0_compat : forall r, r = 0 -> - r = 0.
+Proof.
   intros; rewrite H; auto with real.
 Qed.
 Hint Resolve Ropp_eq_0_compat: real.
 
 (**********)
 Lemma Ropp_involutive : forall r, - - r = r.
+Proof.
   intro; ring.
 Qed.
 Hint Resolve Ropp_involutive: real.
 
 (*********)
 Lemma Ropp_neq_0_compat : forall r, r <> 0 -> - r <> 0.
-red in |- *; intros r H H0.
-apply H.
-transitivity (- - r); auto with real.
+Proof.
+  red in |- *; intros r H H0.
+  apply H.
+  transitivity (- - r); auto with real.
 Qed.
 Hint Resolve Ropp_neq_0_compat: real.
 
 (**********)
 Lemma Ropp_plus_distr : forall r1 r2, - (r1 + r2) = - r1 + - r2.
+Proof.
   intros; ring.
 Qed.
 Hint Resolve Ropp_plus_distr: real.
 
-(** Opposite and multiplication *)
+
+(** ** Opposite and multiplication *)
 
 Lemma Ropp_mult_distr_l_reverse : forall r1 r2, - r1 * r2 = - (r1 * r2).
+Proof.
   intros; ring.
 Qed.
 Hint Resolve Ropp_mult_distr_l_reverse: real.
 
 (**********)
 Lemma Rmult_opp_opp : forall r1 r2, - r1 * - r2 = r1 * r2.
+Proof.
   intros; ring.
 Qed.
 Hint Resolve Rmult_opp_opp: real.
 
 Lemma Ropp_mult_distr_r_reverse : forall r1 r2, r1 * - r2 = - (r1 * r2).
-intros; rewrite <- Ropp_mult_distr_l_reverse; ring.
+Proof.
+  intros; ring.
 Qed.
 
-(** Substraction *)
+(** ** Substraction *)
 
 Lemma Rminus_0_r : forall r, r - 0 = r.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rminus_0_r: real.
 
 Lemma Rminus_0_l : forall r, 0 - r = - r.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 Hint Resolve Rminus_0_l: real.
 
 (**********)
 Lemma Ropp_minus_distr : forall r1 r2, - (r1 - r2) = r2 - r1.
+Proof.
   intros; ring.
 Qed.
 Hint Resolve Ropp_minus_distr: real.
 
 Lemma Ropp_minus_distr' : forall r1 r2, - (r2 - r1) = r1 - r2.
-intros; ring.
+Proof.
+  intros; ring.
 Qed.
 Hint Resolve Ropp_minus_distr': real. 
 
 (**********)
 Lemma Rminus_diag_eq : forall r1 r2, r1 = r2 -> r1 - r2 = 0.
+Proof.
   intros; rewrite H; ring.
 Qed.
 Hint Resolve Rminus_diag_eq: real.
 
 (**********)
 Lemma Rminus_diag_uniq : forall r1 r2, r1 - r2 = 0 -> r1 = r2.
+Proof.
   intros r1 r2; unfold Rminus in |- *; rewrite Rplus_comm; intro.
   rewrite <- (Ropp_involutive r2); apply (Rplus_opp_r_uniq (- r2) r1 H).
 Qed.
 Hint Immediate Rminus_diag_uniq: real.
 
 Lemma Rminus_diag_uniq_sym : forall r1 r2, r2 - r1 = 0 -> r1 = r2.
-intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H;
- ring.
+Proof.
+  intros; generalize (Rminus_diag_uniq r2 r1 H); clear H; intro H; rewrite H;
+    ring.
 Qed.
 Hint Immediate Rminus_diag_uniq_sym: real.
 
 Lemma Rplus_minus : forall r1 r2, r1 + (r2 - r1) = r2.
-intros; ring.
+Proof.
+  intros; ring.
 Qed.
 Hint Resolve Rplus_minus: real.
 
 (**********)
 Lemma Rminus_eq_contra : forall r1 r2, r1 <> r2 -> r1 - r2 <> 0.
-red in |- *; intros r1 r2 H H0.
-apply H; auto with real.
+Proof.
+  red in |- *; intros r1 r2 H H0.
+  apply H; auto with real.
 Qed.
 Hint Resolve Rminus_eq_contra: real.
 
 Lemma Rminus_not_eq : forall r1 r2, r1 - r2 <> 0 -> r1 <> r2.
-red in |- *; intros; elim H; apply Rminus_diag_eq; auto.
+Proof.
+  red in |- *; intros; elim H; apply Rminus_diag_eq; auto.
 Qed.
 Hint Resolve Rminus_not_eq: real.
 
 Lemma Rminus_not_eq_right : forall r1 r2, r2 - r1 <> 0 -> r1 <> r2.
-red in |- *; intros; elim H; rewrite H0; ring.
+Proof.
+  red in |- *; intros; elim H; rewrite H0; ring.
 Qed.
 Hint Resolve Rminus_not_eq_right: real. 
 
 
 (**********)
 Lemma Rmult_minus_distr_l :
- forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3.
-intros; ring.
+  forall r1 r2 r3, r1 * (r2 - r3) = r1 * r2 - r1 * r3.
+Proof.
+  intros; ring.
 Qed.
 
-(** Inverse *)
+(** ** Inverse *)
 Lemma Rinv_1 : / 1 = 1.
-field; auto with real.
+Proof.
+  field.
 Qed.
 Hint Resolve Rinv_1: real.
 
 (*********)
 Lemma Rinv_neq_0_compat : forall r, r <> 0 -> / r <> 0.
-red in |- *; intros; apply R1_neq_R0.
-replace 1 with (/ r * r); auto with real.
+Proof.
+  red in |- *; intros; apply R1_neq_R0.
+  replace 1 with (/ r * r); auto with real.
 Qed.
 Hint Resolve Rinv_neq_0_compat: real.
 
 (*********)
 Lemma Rinv_involutive : forall r, r <> 0 -> / / r = r.
-intros; field; auto with real.
+Proof.
+  intros; field; trivial.
 Qed.
 Hint Resolve Rinv_involutive: real.
 
 (*********)
 Lemma Rinv_mult_distr :
- forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2.
-intros; field; auto with real.
+  forall r1 r2, r1 <> 0 -> r2 <> 0 -> / (r1 * r2) = / r1 * / r2.
+Proof.
+  intros; field; auto.
 Qed.
 
 (*********)
 Lemma Ropp_inv_permute : forall r, r <> 0 -> - / r = / - r.
-intros; field; auto with real.
+Proof.
+  intros; field; trivial.
 Qed.
 
 Lemma Rinv_r_simpl_r : forall r1 r2, r1 <> 0 -> r1 * / r1 * r2 = r2.
-intros; transitivity (1 * r2); auto with real.
-rewrite Rinv_r; auto with real.
+Proof.
+  intros; transitivity (1 * r2); auto with real.
+  rewrite Rinv_r; auto with real.
 Qed.
 
 Lemma Rinv_r_simpl_l : forall r1 r2, r1 <> 0 -> r2 * r1 * / r1 = r2.
-intros; transitivity (r2 * 1); auto with real.
-transitivity (r2 * (r1 * / r1)); auto with real.
+Proof.
+  intros; transitivity (r2 * 1); auto with real.
+  transitivity (r2 * (r1 * / r1)); auto with real.
 Qed.
 
 Lemma Rinv_r_simpl_m : forall r1 r2, r1 <> 0 -> r1 * r2 * / r1 = r2.
-intros; transitivity (r2 * 1); auto with real.
-transitivity (r2 * (r1 * / r1)); auto with real.
-ring.
+Proof.
+  intros; transitivity (r2 * 1); auto with real.
+  transitivity (r2 * (r1 * / r1)); auto with real.
+  ring.
 Qed.
 Hint Resolve Rinv_r_simpl_l Rinv_r_simpl_r Rinv_r_simpl_m: real.
 
 (*********)
 Lemma Rinv_mult_simpl :
- forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2.
-intros a b c; intros.
-transitivity (a * / a * (c * / b)); auto with real.
-ring.
+  forall r1 r2 r3, r1 <> 0 -> r1 * / r2 * (r3 * / r1) = r3 * / r2.
+Proof.
+  intros a b c; intros.
+  transitivity (a * / a * (c * / b)); auto with real.
+  ring.
 Qed.
 
-(** Order and addition *)
+(** * Field operations and order *)
+
+(** ** Order and addition *)
 
 Lemma Rplus_lt_compat_r : forall r r1 r2, r1 < r2 -> r1 + r < r2 + r.
-intros.
-rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real.
+Proof.
+  intros.
+  rewrite (Rplus_comm r1 r); rewrite (Rplus_comm r2 r); auto with real.
 Qed.
 
 Hint Resolve Rplus_lt_compat_r: real.
 
 (**********)
 Lemma Rplus_lt_reg_r : forall r r1 r2, r + r1 < r + r2 -> r1 < r2.
-intros; cut (- r + r + r1 < - r + r + r2).
-rewrite Rplus_opp_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 (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H).
+Proof.
+  intros; cut (- r + r + r1 < - r + r + r2).
+  rewrite Rplus_opp_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 (Rplus_lt_compat_l (- r) (r + r1) (r + r2) H).
 Qed.
 
 (**********)
 Lemma Rplus_le_compat_l : forall r r1 r2, r1 <= r2 -> r + r1 <= r + r2.
-unfold Rle in |- *; intros; elim H; intro.
-left; apply (Rplus_lt_compat_l r r1 r2 H0).
-right; rewrite <- H0; auto with zarith real.
+Proof.
+  unfold Rle in |- *; intros; elim H; intro.
+  left; apply (Rplus_lt_compat_l r r1 r2 H0).
+  right; rewrite <- H0; auto with zarith real.
 Qed.
 
 (**********)
 Lemma Rplus_le_compat_r : forall r r1 r2, r1 <= r2 -> r1 + r <= r2 + r.
-unfold Rle in |- *; intros; elim H; intro.
-left; apply (Rplus_lt_compat_r r r1 r2 H0).
-right; rewrite <- H0; auto with real.
+Proof.
+  unfold Rle in |- *; intros; elim H; intro.
+  left; apply (Rplus_lt_compat_r r r1 r2 H0).
+  right; rewrite <- H0; auto with real.
 Qed.
 
 Hint Resolve Rplus_le_compat_l Rplus_le_compat_r: real.
 
 (**********)
 Lemma Rplus_le_reg_l : forall r r1 r2, r + r1 <= r + r2 -> r1 <= r2.
-unfold Rle in |- *; intros; elim H; intro.
-left; apply (Rplus_lt_reg_r r r1 r2 H0).
-right; apply (Rplus_eq_reg_l r r1 r2 H0).
+Proof.
+  unfold Rle in |- *; intros; elim H; intro.
+  left; apply (Rplus_lt_reg_r r r1 r2 H0).
+  right; apply (Rplus_eq_reg_l r r1 r2 H0).
 Qed.
 
 (**********)
 Lemma sum_inequa_Rle_lt :
- forall 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.
+  forall a x b c y d:R,
+    a <= x -> x < b -> c < y -> y <= d -> a + c < x + y < b + d.
+Proof.
+  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_compat :
- forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
-intros; apply Rlt_trans with (r2 + r3); auto with real.
+  forall r1 r2 r3 r4, r1 < r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
+Proof.
+  intros; apply Rlt_trans with (r2 + r3); auto with real.
 Qed.
 
 Lemma Rplus_le_compat :
- forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4.
-intros; apply Rle_trans with (r2 + r3); auto with real.
+  forall r1 r2 r3 r4, r1 <= r2 -> r3 <= r4 -> r1 + r3 <= r2 + r4.
+Proof.
+  intros; apply Rle_trans with (r2 + r3); auto with real.
 Qed.
 
 (*********)
 Lemma Rplus_lt_le_compat :
- forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4.
-intros; apply Rlt_le_trans with (r2 + r3); auto with real.
+  forall r1 r2 r3 r4, r1 < r2 -> r3 <= r4 -> r1 + r3 < r2 + r4.
+Proof.
+  intros; apply Rlt_le_trans with (r2 + r3); auto with real.
 Qed.
 
 (*********)
 Lemma Rplus_le_lt_compat :
- forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
-intros; apply Rle_lt_trans with (r2 + r3); auto with real.
+  forall r1 r2 r3 r4, r1 <= r2 -> r3 < r4 -> r1 + r3 < r2 + r4.
+Proof.
+  intros; apply Rle_lt_trans with (r2 + r3); auto with real.
 Qed.
 
 Hint Immediate Rplus_lt_compat Rplus_le_compat Rplus_lt_le_compat
   Rplus_le_lt_compat: real.
 
-(** Order and Opposite *)
+(** ** Order and Opposite *)
 
 (**********)
 Lemma Ropp_gt_lt_contravar : forall r1 r2, r1 > r2 -> - r1 < - r2.
-unfold Rgt in |- *; intros.
-apply (Rplus_lt_reg_r (r2 + r1)).
-replace (r2 + r1 + - r1) with r2.
-replace (r2 + r1 + - r2) with r1.
-trivial.
-ring.
-ring.
+Proof.
+  unfold Rgt in |- *; intros.
+  apply (Rplus_lt_reg_r (r2 + r1)).
+  replace (r2 + r1 + - r1) with r2.
+  replace (r2 + r1 + - r2) with r1.
+  trivial.
+  ring.
+  ring.
 Qed.
 Hint Resolve Ropp_gt_lt_contravar.
 
 (**********)
 Lemma Ropp_lt_gt_contravar : forall r1 r2, r1 < r2 -> - r1 > - r2.
-unfold Rgt in |- *; auto with real.
+Proof.
+  unfold Rgt in |- *; auto with real.
 Qed.
 Hint Resolve Ropp_lt_gt_contravar: real.
 
 Lemma Ropp_lt_cancel : forall r1 r2, - r2 < - r1 -> r1 < r2.
-intros x y H'.
-rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
- auto with real.
+Proof.
+  intros x y H'.
+  rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
+    auto with real.
 Qed.
 Hint Immediate Ropp_lt_cancel: real.
 
 Lemma Ropp_lt_contravar : forall r1 r2, r2 < r1 -> - r1 < - r2.
-auto with real.
+Proof.
+  auto with real.
 Qed.
 Hint Resolve Ropp_lt_contravar: real.
 
 (**********)
 Lemma Ropp_le_ge_contravar : forall r1 r2, r1 <= r2 -> - r1 >= - r2.
-unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
+Proof.
+  unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
 Qed.
 Hint Resolve Ropp_le_ge_contravar: real.
 
 Lemma Ropp_le_cancel : forall r1 r2, - r2 <= - r1 -> r1 <= r2.
-intros x y H.
-elim H; auto with real.
-intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
- rewrite H1; auto with real.
+Proof.
+  intros x y H.
+  elim H; auto with real.
+  intro H1; rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive y);
+    rewrite H1; auto with real.
 Qed.
 Hint Immediate Ropp_le_cancel: real.
 
 Lemma Ropp_le_contravar : forall r1 r2, r2 <= r1 -> - r1 <= - r2.
-intros r1 r2 H; elim H; auto with real.
+Proof.
+  intros r1 r2 H; elim H; auto with real.
 Qed.
 Hint Resolve Ropp_le_contravar: real.
 
 (**********)
 Lemma Ropp_ge_le_contravar : forall r1 r2, r1 >= r2 -> - r1 <= - r2.
-unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
+Proof.
+  unfold Rge in |- *; intros r1 r2 [H| H]; auto with real.
 Qed.
 Hint Resolve Ropp_ge_le_contravar: real.
 
 (**********)
 Lemma Ropp_0_lt_gt_contravar : forall r, 0 < r -> 0 > - r.
-intros; replace 0 with (-0); auto with real.
+Proof.
+  intros; replace 0 with (-0); auto with real.
 Qed.
 Hint Resolve Ropp_0_lt_gt_contravar: real.
 
 (**********)
 Lemma Ropp_0_gt_lt_contravar : forall r, 0 > r -> 0 < - r.
-intros; replace 0 with (-0); auto with real.
+Proof.
+  intros; replace 0 with (-0); auto with real.
 Qed.
 Hint Resolve Ropp_0_gt_lt_contravar: real.
 
 (**********)
 Lemma Ropp_lt_gt_0_contravar : forall r, r > 0 -> - r < 0.
-intros; rewrite <- Ropp_0; auto with real.
+Proof.
+  intros; rewrite <- Ropp_0; auto with real.
 Qed.
 
 (**********)
 Lemma Ropp_gt_lt_0_contravar : forall r, r < 0 -> - r > 0.
-intros; rewrite <- Ropp_0; auto with real.
+Proof.
+  intros; rewrite <- Ropp_0; auto with real.
 Qed.
 Hint Resolve Ropp_lt_gt_0_contravar Ropp_gt_lt_0_contravar: real.
 
 (**********)
 Lemma Ropp_0_le_ge_contravar : forall r, 0 <= r -> 0 >= - r.
-intros; replace 0 with (-0); auto with real.
+Proof.
+  intros; replace 0 with (-0); auto with real.
 Qed.
 Hint Resolve Ropp_0_le_ge_contravar: real.
 
 (**********)
 Lemma Ropp_0_ge_le_contravar : forall r, 0 >= r -> 0 <= - r.
-intros; replace 0 with (-0); auto with real.
+Proof.
+  intros; replace 0 with (-0); auto with real.
 Qed.
 Hint Resolve Ropp_0_ge_le_contravar: real.
 
-(** Order and multiplication *)
+(** ** Order and multiplication *)
 
 Lemma Rmult_lt_compat_r : forall r r1 r2, 0 < r -> r1 < r2 -> r1 * r < r2 * r.
-intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real.
+Proof.
+  intros; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r); auto with real.
 Qed.
 Hint Resolve Rmult_lt_compat_r.
 
 Lemma Rmult_lt_reg_l : forall r r1 r2, 0 < r -> r * r1 < r * r2 -> r1 < r2.
-intros z x y H H0.
-case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0.
- rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto.
-generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False;
- generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); 
- intro; apply (Rlt_irrefl (z * x)); auto.
+Proof.
+  intros z x y H H0.
+  case (Rtotal_order x y); intros Eq0; auto; elim Eq0; clear Eq0; intros Eq0.
+  rewrite Eq0 in H0; elimtype False; apply (Rlt_irrefl (z * y)); auto.
+  generalize (Rmult_lt_compat_l z y x H Eq0); intro; elimtype False;
+    generalize (Rlt_trans (z * x) (z * y) (z * x) H0 H1); 
+      intro; apply (Rlt_irrefl (z * x)); auto.
 Qed.
 
 
 Lemma Rmult_lt_gt_compat_neg_l :
- forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2.
-intros; replace r with (- - r); auto with real.
-rewrite (Ropp_mult_distr_l_reverse (- r));
- rewrite (Ropp_mult_distr_l_reverse (- r)).
-apply Ropp_lt_gt_contravar; auto with real.
+  forall r r1 r2, r < 0 -> r1 < r2 -> r * r1 > r * r2.
+Proof.
+  intros; replace r with (- - r); auto with real.
+  rewrite (Ropp_mult_distr_l_reverse (- r));
+    rewrite (Ropp_mult_distr_l_reverse (- r)).
+  apply Ropp_lt_gt_contravar; auto with real.
 Qed.
 
 (**********)
 Lemma Rmult_le_compat_l :
- forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2.
-intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *;
- auto with real.
-right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity.
+  forall r r1 r2, 0 <= r -> r1 <= r2 -> r * r1 <= r * r2.
+Proof.
+  intros r r1 r2 H H0; destruct H; destruct H0; unfold Rle in |- *;
+    auto with real.
+  right; rewrite <- H; do 2 rewrite Rmult_0_l; reflexivity.
 Qed.
 Hint Resolve Rmult_le_compat_l: real.
 
 Lemma Rmult_le_compat_r :
- forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r.
-intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r);
- auto with real.
+  forall r r1 r2, 0 <= r -> r1 <= r2 -> r1 * r <= r2 * r.
+Proof.
+  intros r r1 r2 H; rewrite (Rmult_comm r1 r); rewrite (Rmult_comm r2 r);
+    auto with real.
 Qed.
 Hint Resolve Rmult_le_compat_r: real.
 
 Lemma Rmult_le_reg_l : forall r r1 r2, 0 < r -> r * r1 <= r * r2 -> r1 <= r2.
-intros z x y H H0; case H0; auto with real.
-intros H1; apply Rlt_le.
-apply Rmult_lt_reg_l with (r := z); auto.
-intros H1; replace x with (/ z * (z * x)); auto with real.
-replace y with (/ z * (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.
+Proof.
+  intros z x y H H0; case H0; auto with real.
+  intros H1; apply Rlt_le.
+  apply Rmult_lt_reg_l with (r := z); auto.
+  intros H1; replace x with (/ z * (z * x)); auto with real.
+  replace y with (/ z * (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.
 
 Lemma Rmult_le_compat_neg_l :
- forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1.
-intros; replace r with (- - r); auto with real.
-do 2 rewrite (Ropp_mult_distr_l_reverse (- r)).
-apply Ropp_le_contravar; auto with real.
+  forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r2 <= r * r1.
+Proof.
+  intros; replace r with (- - r); auto with real.
+  do 2 rewrite (Ropp_mult_distr_l_reverse (- r)).
+  apply Ropp_le_contravar; auto with real.
 Qed.
 Hint Resolve Rmult_le_compat_neg_l: real.
 
 Lemma Rmult_le_ge_compat_neg_l :
- forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2.
-intros; apply Rle_ge; auto with real.
+  forall r r1 r2, r <= 0 -> r1 <= r2 -> r * r1 >= r * r2.
+Proof.
+  intros; apply Rle_ge; auto with real.
 Qed.
 Hint Resolve Rmult_le_ge_compat_neg_l: real.
 
 Lemma Rmult_le_compat :
- forall r1 r2 r3 r4,
-   0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4.
-intros x y z t H' H'0 H'1 H'2.
-apply Rle_trans with (r2 := x * t); auto with real.
-repeat rewrite (fun x => Rmult_comm x t).
-apply Rmult_le_compat_l; auto.
-apply Rle_trans with z; auto.
+  forall r1 r2 r3 r4,
+    0 <= r1 -> 0 <= r3 -> r1 <= r2 -> r3 <= r4 -> r1 * r3 <= r2 * r4.
+Proof.
+  intros x y z t H' H'0 H'1 H'2.
+  apply Rle_trans with (r2 := x * t); auto with real.
+  repeat rewrite (fun x => Rmult_comm x t).
+  apply Rmult_le_compat_l; auto.
+  apply Rle_trans with z; auto.
 Qed.
 Hint Resolve Rmult_le_compat: real.
 
 Lemma Rmult_gt_0_lt_compat :
- forall r1 r2 r3 r4,
-   r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
-intros; apply Rlt_trans with (r2 * r3); auto with real.
+  forall r1 r2 r3 r4,
+    r3 > 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+Proof.
+  intros; apply Rlt_trans with (r2 * r3); auto with real.
 Qed.
 
 (*********)
 Lemma Rmult_ge_0_gt_0_lt_compat :
- forall r1 r2 r3 r4,
-   r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
-intros; apply Rle_lt_trans with (r2 * r3); auto with real.
+  forall r1 r2 r3 r4,
+    r3 >= 0 -> r2 > 0 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+Proof.
+  intros; apply Rle_lt_trans with (r2 * r3); auto with real.
 Qed.
 
-(** Order and Substractions *)
+
+(** ** Order and Substractions *)
+
 Lemma Rlt_minus : forall r1 r2, r1 < r2 -> r1 - r2 < 0.
-intros; apply (Rplus_lt_reg_r r2).
-replace (r2 + (r1 - r2)) with r1.
-replace (r2 + 0) with r2; auto with real.
-ring.
+Proof.
+  intros; apply (Rplus_lt_reg_r r2).
+  replace (r2 + (r1 - r2)) with r1.
+  replace (r2 + 0) with r2; auto with real.
+  ring.
 Qed.
 Hint Resolve Rlt_minus: real.
 
 (**********)
 Lemma Rle_minus : forall r1 r2, r1 <= r2 -> r1 - r2 <= 0.
-destruct 1; unfold Rle in |- *; auto with real.
+Proof.
+  destruct 1; unfold Rle in |- *; auto with real.
 Qed.
 
 (**********)
 Lemma Rminus_lt : forall r1 r2, r1 - r2 < 0 -> r1 < r2.
-intros; replace r1 with (r1 - r2 + r2).
-pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
-ring.
+Proof.
+  intros; replace r1 with (r1 - r2 + r2).
+  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+  ring.
 Qed.
 
 (**********)
 Lemma Rminus_le : forall r1 r2, r1 - r2 <= 0 -> r1 <= r2.
-intros; replace r1 with (r1 - r2 + r2).
-pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
-ring.
+Proof.
+  intros; replace r1 with (r1 - r2 + r2).
+  pattern r2 at 3 in |- *; replace r2 with (0 + r2); auto with real.
+  ring.
 Qed.
 
 (**********)
 Lemma tech_Rplus : forall r (s:R), 0 <= r -> 0 < s -> r + s <> 0.
-intros; apply sym_not_eq; apply Rlt_not_eq.
-rewrite Rplus_comm; replace 0 with (0 + 0); auto with real.
+Proof.
+  intros; apply sym_not_eq; apply Rlt_not_eq.
+  rewrite Rplus_comm; replace 0 with (0 + 0); auto with real.
 Qed.
 Hint Immediate tech_Rplus: real.
 
-(** Order and the square function *)
+
+(** ** Order and the square function *)
+
 Lemma Rle_0_sqr : forall r, 0 <= Rsqr r.
-intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; 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.
+Proof.
+  intro; case (Rlt_le_dec r 0); unfold Rsqr in |- *; 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 Rlt_0_sqr : forall r, r <> 0 -> 0 < Rsqr r.
-intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; 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.
+Proof.
+  intros; case (Rdichotomy r 0); trivial; unfold Rsqr in |- *; 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.
 Hint Resolve Rle_0_sqr Rlt_0_sqr: real.
 
-(** Zero is less than one *)
+(** ** Zero is less than one *)
 Lemma Rlt_0_1 : 0 < 1.
-replace 1 with (Rsqr 1); auto with real.
-unfold Rsqr in |- *; auto with real.
+Proof.
+  replace 1 with (Rsqr 1); auto with real.
+  unfold Rsqr in |- *; auto with real.
 Qed.
 Hint Resolve Rlt_0_1: real.
 
 Lemma Rle_0_1 : 0 <= 1.
-left.
-exact Rlt_0_1.
+Proof.
+  left.
+  exact Rlt_0_1.
 Qed.
 
-(** Order and inverse *)
+(** ** Order and inverse *)
 Lemma Rinv_0_lt_compat : forall r, 0 < r -> 0 < / r.
-intros; apply Rnot_le_lt; red in |- *; intros.
-absurd (1 <= 0); auto with real.
-replace 1 with (r * / r); auto with real.
-replace 0 with (r * 0); auto with real.
+Proof.
+  intros; apply Rnot_le_lt; red in |- *; intros.
+  absurd (1 <= 0); auto with real.
+  replace 1 with (r * / r); auto with real.
+  replace 0 with (r * 0); auto with real.
 Qed.
 Hint Resolve Rinv_0_lt_compat: real.
 
 (*********)
 Lemma Rinv_lt_0_compat : forall r, r < 0 -> / r < 0.
-intros; apply Rnot_le_lt; red in |- *; intros.
-absurd (1 <= 0); auto with real.
-replace 1 with (r * / r); auto with real.
-replace 0 with (r * 0); auto with real.
+Proof.
+  intros; apply Rnot_le_lt; red in |- *; intros.
+  absurd (1 <= 0); auto with real.
+  replace 1 with (r * / r); auto with real.
+  replace 0 with (r * 0); auto with real.
 Qed.
 Hint Resolve Rinv_lt_0_compat: real.
 
 (*********)
 Lemma Rinv_lt_contravar : forall r1 r2, 0 < r1 * r2 -> r1 < r2 -> / r2 < / r1.
-intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real.
-case (Rmult_neq_0_reg r1 r2); intros; auto with real.
-replace (r1 * r2 * / r2) with r1.
-replace (r1 * r2 * / r1) with r2; trivial.
-symmetry  in |- *; auto with real.
-symmetry  in |- *; auto with real.
+Proof.
+  intros; apply Rmult_lt_reg_l with (r1 * r2); auto with real.
+  case (Rmult_neq_0_reg r1 r2); intros; auto with real.
+  replace (r1 * r2 * / r2) with r1.
+  replace (r1 * r2 * / r1) with r2; trivial.
+  symmetry  in |- *; auto with real.
+  symmetry  in |- *; auto with real.
 Qed.
 
 Lemma Rinv_1_lt_contravar : forall r1 r2, 1 <= r1 -> r1 < r2 -> / r2 < / r1.
-intros x y H' H'0.
-cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ];
- auto with real.
-apply Rmult_lt_reg_l with (r := x); auto with real.
-rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real.
-apply Rmult_lt_reg_l with (r := y); auto with real.
-apply Rlt_trans with (r2 := x); auto.
-cut (y * (x * / y) = x).
-intro H1; rewrite H1; rewrite (Rmult_1_r y); auto.
-rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y));
- rewrite Rinv_l; auto with real.
-apply Rlt_dichotomy_converse; right.
-red in |- *; apply Rlt_trans with (r2 := x); auto with real.
+Proof.
+  intros x y H' H'0.
+  cut (0 < x); [ intros Lt0 | apply Rlt_le_trans with (r2 := 1) ];
+    auto with real.
+  apply Rmult_lt_reg_l with (r := x); auto with real.
+  rewrite (Rmult_comm x (/ x)); rewrite Rinv_l; auto with real.
+  apply Rmult_lt_reg_l with (r := y); auto with real.
+  apply Rlt_trans with (r2 := x); auto.
+  cut (y * (x * / y) = x).
+  intro H1; rewrite H1; rewrite (Rmult_1_r y); auto.
+  rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite (Rmult_comm y (/ y));
+    rewrite Rinv_l; auto with real.
+  apply Rlt_dichotomy_converse; right.
+  red in |- *; apply Rlt_trans with (r2 := x); auto with real.
 Qed.
 Hint Resolve Rinv_1_lt_contravar: real.
 
-(*********************************************************)        
-(**      Greater                                         *)
-(*********************************************************)
+(********************************************************)        
+(** *     Greater                                       *)
+(********************************************************)
 
 (**********)
 Lemma Rge_antisym : forall r1 r2, r1 >= r2 -> r2 >= r1 -> r1 = r2.
-intros; apply Rle_antisym; auto with real.
+Proof.
+  intros; apply Rle_antisym; auto with real.
 Qed.
 
 (**********)
 Lemma Rnot_lt_ge : forall r1 r2, ~ r1 < r2 -> r1 >= r2.
-intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro.
-absurd (r1 < r2); trivial.
-case H0; auto.
+Proof.
+  intros; unfold Rge in |- *; elim (Rtotal_order r1 r2); intro.
+  absurd (r1 < r2); trivial.
+  case H0; auto.
 Qed.
 
 (**********)
 Lemma Rnot_lt_le : forall r1 r2, ~ r1 < r2 -> r2 <= r1.
-intros; apply Rge_le; apply Rnot_lt_ge; assumption.
+Proof.
+  intros; apply Rge_le; apply Rnot_lt_ge; assumption.
 Qed.
 
 (**********)
 Lemma Rnot_gt_le : forall r1 r2, ~ r1 > r2 -> r1 <= r2.
-intros r1 r2 H; apply Rge_le.
-exact (Rnot_lt_ge r2 r1 H).
+Proof.
+  intros r1 r2 H; apply Rge_le.
+  exact (Rnot_lt_ge r2 r1 H).
 Qed.
 
 (**********)
 Lemma Rgt_ge : forall r1 r2, r1 > r2 -> r1 >= r2.
-red in |- *; auto with real.
+Proof.
+  red in |- *; auto with real.
 Qed.
 
 
 (**********)
 Lemma Rge_gt_trans : forall r1 r2 r3, r1 >= r2 -> r2 > r3 -> r1 > r3.
-unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real.
+Proof.
+  unfold Rgt in |- *; intros; apply Rlt_le_trans with r2; auto with real.
 Qed.
 
 (**********)
 Lemma Rgt_ge_trans : forall r1 r2 r3, r1 > r2 -> r2 >= r3 -> r1 > r3.
-unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real.
+Proof.
+  unfold Rgt in |- *; intros; apply Rle_lt_trans with r2; auto with real.
 Qed.
 
 (**********)
 Lemma Rgt_trans : forall r1 r2 r3, r1 > r2 -> r2 > r3 -> r1 > r3.
-unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real.
+Proof.
+  unfold Rgt in |- *; intros; apply Rlt_trans with r2; auto with real.
 Qed.
 
 (**********)
 Lemma Rge_trans : forall r1 r2 r3, r1 >= r2 -> r2 >= r3 -> r1 >= r3.
-intros; apply Rle_ge.
-apply Rle_trans with r2; auto with real.
+Proof.
+  intros; apply Rle_ge.
+  apply Rle_trans with r2; auto with real.
 Qed.
 
 (**********)
 Lemma Rle_lt_0_plus_1 : forall r, 0 <= r -> 0 < r + 1.
-intros.
-apply Rlt_le_trans with 1; auto with real.
-pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real.
+Proof.
+  intros.
+  apply Rlt_le_trans with 1; auto with real.
+  pattern 1 at 1 in |- *; replace 1 with (0 + 1); auto with real.
 Qed.
 Hint Resolve Rle_lt_0_plus_1: real.
 
 (**********)
 Lemma Rlt_plus_1 : forall r, r < r + 1.
-intros.
-pattern r at 1 in |- *; replace r with (r + 0); auto with real.
+Proof.
+  intros.
+  pattern r at 1 in |- *; replace r with (r + 0); auto with real.
 Qed.
 Hint Resolve Rlt_plus_1: real.
 
 (**********)
 Lemma tech_Rgt_minus : forall r1 r2, 0 < r2 -> r1 > r1 - r2.
-red in |- *; unfold Rminus in |- *; intros.
-pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real.
+Proof.
+  red in |- *; unfold Rminus in |- *; intros.
+  pattern r1 at 2 in |- *; replace r1 with (r1 + 0); auto with real.
 Qed.
 
 (***********)
 Lemma Rplus_gt_compat_l : forall r r1 r2, r1 > r2 -> r + r1 > r + r2.
-unfold Rgt in |- *; auto with real.
+Proof.
+  unfold Rgt in |- *; auto with real.
 Qed.
 Hint Resolve Rplus_gt_compat_l: real.
 
 (***********)
 Lemma Rplus_gt_reg_l : forall r r1 r2, r + r1 > r + r2 -> r1 > r2.
-unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H).
+Proof.
+  unfold Rgt in |- *; intros; apply (Rplus_lt_reg_r r r2 r1 H).
 Qed.
 
 (***********)
 Lemma Rplus_ge_compat_l : forall r r1 r2, r1 >= r2 -> r + r1 >= r + r2.
-intros; apply Rle_ge; auto with real.
+Proof.
+  intros; apply Rle_ge; auto with real.
 Qed.
 Hint Resolve Rplus_ge_compat_l: real.
 
 (***********)
 Lemma Rplus_ge_reg_l : forall r r1 r2, r + r1 >= r + r2 -> r1 >= r2.
-intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real.
+Proof.
+  intros; apply Rle_ge; apply Rplus_le_reg_l with r; auto with real.
 Qed.
 
 (***********)
 Lemma Rmult_ge_compat_r :
- forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r.
-intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; assumption.
+  forall r r1 r2, r >= 0 -> r1 >= r2 -> r1 * r >= r2 * r.
+Proof.
+  intros; apply Rle_ge; apply Rmult_le_compat_r; apply Rge_le; assumption.
 Qed.
 
 (***********)
 Lemma Rgt_minus : forall r1 r2, r1 > r2 -> r1 - r2 > 0.
-intros; replace 0 with (r2 - r2); auto with real.
-unfold Rgt, Rminus in |- *; auto with real.
+Proof.
+  intros; replace 0 with (r2 - r2); auto with real.
+  unfold Rgt, Rminus in |- *; auto with real.
 Qed.
 
 (*********)
 Lemma minus_Rgt : forall r1 r2, r1 - r2 > 0 -> r1 > r2.
-intros; replace r2 with (r2 + 0); auto with real.
-intros; replace r1 with (r2 + (r1 - r2)); auto with real.
+Proof.
+  intros; replace r2 with (r2 + 0); auto with real.
+  intros; replace r1 with (r2 + (r1 - r2)); auto with real.
 Qed.
 
 (**********)
 Lemma Rge_minus : forall r1 r2, r1 >= r2 -> r1 - r2 >= 0.
-unfold Rge in |- *; intros; elim H; intro.
-left; apply (Rgt_minus r1 r2 H0).
-right; apply (Rminus_diag_eq r1 r2 H0).
+Proof.
+  unfold Rge in |- *; intros; elim H; intro.
+  left; apply (Rgt_minus r1 r2 H0).
+  right; apply (Rminus_diag_eq r1 r2 H0).
 Qed.
 
 (*********)
 Lemma minus_Rge : forall r1 r2, r1 - r2 >= 0 -> r1 >= r2.
-intros; replace r2 with (r2 + 0); auto with real.
-intros; replace r1 with (r2 + (r1 - r2)); auto with real.
+Proof.
+  intros; replace r2 with (r2 + 0); auto with real.
+  intros; replace r1 with (r2 + (r1 - r2)); auto with real.
 Qed.
 
 
 (*********)
 Lemma Rmult_gt_0_compat : forall r1 r2, r1 > 0 -> r2 > 0 -> r1 * r2 > 0.
-unfold Rgt in |- *; intros.
-replace 0 with (0 * r2); auto with real.
+Proof.
+  unfold Rgt in |- *; intros.
+  replace 0 with (0 * r2); auto with real.
 Qed.
 
 (*********)
@@ -1119,377 +1260,421 @@ Proof Rmult_gt_0_compat.
 
 (***********)
 Lemma Rplus_eq_0_l :
- forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 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.
+  forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0.
+Proof.
+  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 :
- forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0.
-intros a b; split.
-apply Rplus_eq_0_l with b; auto with real.
-apply Rplus_eq_0_l with a; auto with real.
-rewrite Rplus_comm; auto with real.
+  forall r1 r2, 0 <= r1 -> 0 <= r2 -> r1 + r2 = 0 -> r1 = 0 /\ r2 = 0.
+Proof.
+  intros a b; split.
+  apply Rplus_eq_0_l with b; auto with real.
+  apply Rplus_eq_0_l with a; auto with real.
+  rewrite Rplus_comm; auto with real.
 Qed.
 
 
 (***********)
 Lemma Rplus_sqr_eq_0_l : forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0.
-intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b);
- auto with real.
+Proof.
+  intros a b; intros; apply Rsqr_0_uniq; apply Rplus_eq_0_l with (Rsqr b);
+    auto with real.
 Qed.
 
 Lemma Rplus_sqr_eq_0 :
- forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0.
-intros a b; split.
-apply Rplus_sqr_eq_0_l with b; auto with real.
-apply Rplus_sqr_eq_0_l with a; auto with real.
-rewrite Rplus_comm; auto with real.
+  forall r1 r2, Rsqr r1 + Rsqr r2 = 0 -> r1 = 0 /\ r2 = 0.
+Proof.
+  intros a b; split.
+  apply Rplus_sqr_eq_0_l with b; auto with real.
+  apply Rplus_sqr_eq_0_l with a; auto with real.
+  rewrite Rplus_comm; auto with real.
 Qed.
 
 
 (**********************************************************) 
-(**       Injection from [N] to [R]                       *)
+(** *     Injection from [N] to [R]                       *)
 (**********************************************************)
 
 (**********)
 Lemma S_INR : forall n:nat, INR (S n) = INR n + 1.
-intro; case n; auto with real.
+Proof.
+  intro; case n; auto with real.
 Qed.
 
 (**********)
 Lemma S_O_plus_INR : forall n:nat, INR (1 + n) = INR 1 + INR n.
-intro; simpl in |- *; case n; intros; auto with real.
+Proof.
+  intro; simpl in |- *; case n; intros; auto with real.
 Qed.
 
 (**********)
 Lemma plus_INR : forall n m:nat, INR (n + m) = INR n + INR m. 
-intros n m; induction  n as [| n Hrecn].
-simpl in |- *; auto with real.
-replace (S n + m)%nat with (S (n + m)); auto with arith.
-repeat rewrite S_INR.
-rewrite Hrecn; ring.
+Proof.
+  intros n m; induction  n as [| n Hrecn].
+  simpl in |- *; auto with real.
+  replace (S n + m)%nat with (S (n + m)); auto with arith.
+  repeat rewrite S_INR.
+  rewrite Hrecn; ring.
 Qed.
 
 (**********)
 Lemma minus_INR : forall n m:nat, (m <= n)%nat -> INR (n - m) = INR n - INR m.
-intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real.
-intros; rewrite <- minus_n_O; auto with real.
-intros; repeat rewrite S_INR; simpl in |- *.
-rewrite H0; ring.
+Proof.
+  intros n m le; pattern m, n in |- *; apply le_elim_rel; auto with real.
+  intros; rewrite <- minus_n_O; auto with real.
+  intros; repeat rewrite S_INR; simpl in |- *.
+  rewrite H0; ring.
 Qed.
 
 (*********)
 Lemma mult_INR : forall n m:nat, INR (n * m) = INR n * INR m.
-intros n m; induction  n as [| n Hrecn].
-simpl in |- *; auto with real.
-intros; repeat rewrite S_INR; simpl in |- *.
-rewrite plus_INR; rewrite Hrecn; ring.
+Proof.
+  intros n m; induction  n as [| n Hrecn].
+  simpl in |- *; auto with real.
+  intros; repeat rewrite S_INR; simpl in |- *.
+  rewrite plus_INR; rewrite Hrecn; ring.
 Qed.
 
 Hint Resolve plus_INR minus_INR mult_INR: real.
 
 (*********)
 Lemma lt_INR_0 : forall n:nat, (0 < n)%nat -> 0 < INR n.
-simple induction 1; intros; auto with real.
-rewrite S_INR; auto with real.
+Proof.
+  simple induction 1; intros; auto with real.
+  rewrite S_INR; auto with real.
 Qed.
 Hint Resolve lt_INR_0: real.
 
 Lemma lt_INR : forall n m:nat, (n < m)%nat -> INR n < INR m.
-simple induction 1; intros; auto with real.
-rewrite S_INR; auto with real.
-rewrite S_INR; apply Rlt_trans with (INR m0); auto with real.
+Proof.
+  simple 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.
 Hint Resolve lt_INR: real.
 
 Lemma INR_lt_1 : forall n:nat, (1 < n)%nat -> 1 < INR n.
-intros; replace 1 with (INR 1); auto with real.
+Proof.
+  intros; replace 1 with (INR 1); auto with real.
 Qed.
 Hint Resolve INR_lt_1: real.
 
 (**********)
 Lemma INR_pos : forall p:positive, 0 < INR (nat_of_P p).
-intro; apply lt_INR_0.
-simpl in |- *; auto with real.
-apply lt_O_nat_of_P.
+Proof.
+  intro; apply lt_INR_0.
+  simpl in |- *; auto with real.
+  apply lt_O_nat_of_P.
 Qed.
 Hint Resolve INR_pos: real.
 
 (**********)
 Lemma pos_INR : forall n:nat, 0 <= INR n.
-intro n; case n.
-simpl in |- *; auto with real.
-auto with arith real.
+Proof.
+  intro n; case n.
+  simpl in |- *; auto with real.
+  auto with arith real.
 Qed.
 Hint Resolve pos_INR: real.
 
 Lemma INR_lt : forall n m:nat, INR n < INR m -> (n < m)%nat.
-double induction n m; intros.
-simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto.
-auto with arith.
-generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
- [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. 
-generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False;
- apply (Rlt_irrefl 0); auto.
-do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
-intro H2; generalize (H0 n0 H2); intro; auto with arith.
-apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)).
-rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
+Proof.
+  double induction n m; intros.
+  simpl in |- *; elimtype False; apply (Rlt_irrefl 0); auto.
+  auto with arith.
+  generalize (pos_INR (S n0)); intro; cut (INR 0 = 0);
+    [ intro H2; rewrite H2 in H0; idtac | simpl in |- *; trivial ]. 
+  generalize (Rle_lt_trans 0 (INR (S n0)) 0 H1 H0); intro; elimtype False;
+    apply (Rlt_irrefl 0); auto.
+  do 2 rewrite S_INR in H1; cut (INR n1 < INR n0).
+  intro H2; generalize (H0 n0 H2); intro; auto with arith.
+  apply (Rplus_lt_reg_r 1 (INR n1) (INR n0)).
+  rewrite Rplus_comm; rewrite (Rplus_comm 1 (INR n0)); trivial.
 Qed.
 Hint Resolve INR_lt: real.
 
 (*********)
 Lemma le_INR : forall n m:nat, (n <= m)%nat -> INR n <= INR m.
-simple induction 1; intros; auto with real.
-rewrite S_INR.
-apply Rle_trans with (INR m0); auto with real.
+Proof.
+  simple induction 1; intros; auto with real.
+  rewrite S_INR.
+  apply Rle_trans with (INR m0); auto with real.
 Qed.
 Hint Resolve le_INR: real.
 
 (**********)
 Lemma not_INR_O : forall n:nat, INR n <> 0 -> n <> 0%nat.
-red in |- *; intros n H H1.
-apply H.
-rewrite H1; trivial.
+Proof.
+  red in |- *; intros n H H1.
+  apply H.
+  rewrite H1; trivial.
 Qed.
 Hint Immediate not_INR_O: real.
 
 (**********)
 Lemma not_O_INR : forall n:nat, n <> 0%nat -> INR n <> 0.
-intro n; case n.
-intro; absurd (0%nat = 0%nat); trivial.
-intros; rewrite S_INR.
-apply Rgt_not_eq; red in |- *; auto with real.
+Proof.
+  intro n; case n.
+  intro; absurd (0%nat = 0%nat); trivial.
+  intros; rewrite S_INR.
+  apply Rgt_not_eq; red in |- *; auto with real.
 Qed.
 Hint Resolve not_O_INR: real.
 
 Lemma not_nm_INR : forall 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 Rlt_dichotomy_converse; auto with real.
-elimtype False; auto.
-apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real.
+Proof.
+  intros n m H; case (le_or_lt n m); intros H1.
+  case (le_lt_or_eq _ _ H1); intros H2.
+  apply Rlt_dichotomy_converse; auto with real.
+  elimtype False; auto.
+  apply sym_not_eq; apply Rlt_dichotomy_converse; auto with real.
 Qed.
 Hint Resolve not_nm_INR: real.
 
 Lemma INR_eq : forall 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  in |- *; cut (m <> n).
-intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto.
-omega.
+Proof.
+  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  in |- *; cut (m <> n).
+  intro H3; generalize (not_nm_INR m n H3); intro H4; elimtype False; auto.
+  omega.
 Qed.
 Hint Resolve INR_eq: real.
 
 Lemma INR_le : forall n m:nat, INR n <= INR m -> (n <= m)%nat.
-intros; elim H; intro.
-generalize (INR_lt n m H0); intro; auto with arith.
-generalize (INR_eq n m H0); intro; rewrite H1; auto.
+Proof.
+  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.
 Hint Resolve INR_le: real.
 
 Lemma not_1_INR : forall n:nat, n <> 1%nat -> INR n <> 1.
-replace 1 with (INR 1); auto with real.
+Proof.
+  replace 1 with (INR 1); auto with real.
 Qed.
 Hint Resolve not_1_INR: real.
 
 (**********************************************************) 
-(**      Injection from [Z] to [R]                        *)
+(** *    Injection from [Z] to [R]                        *)
 (**********************************************************)
 
 
 (**********)
 Lemma IZN : forall n:Z, (0 <= n)%Z ->  exists m : nat, n = Z_of_nat m.
-intros z; idtac; apply Z_of_nat_complete; assumption.
+Proof.
+  intros z; idtac; apply Z_of_nat_complete; assumption.
 Qed.
 
 (**********)
 Lemma INR_IZR_INZ : forall n:nat, INR n = IZR (Z_of_nat n).
-simple induction n; auto with real.
-intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
- auto with real.
+Proof.
+  simple induction n; auto with real.
+  intros; simpl in |- *; rewrite nat_of_P_o_P_of_succ_nat_eq_succ;
+    auto with real.
 Qed.
 
 Lemma plus_IZR_NEG_POS :
- forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
-intros.
-case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)).
-intros [H| H]; simpl in |- *.
-rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial.
-rewrite (nat_of_P_minus_morphism q p).
-rewrite minus_INR; auto with arith; ring.
-apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
-rewrite (nat_of_P_inj p q); trivial.
-rewrite Pcompare_refl; simpl in |- *; auto with real.
-intro H; simpl in |- *.
-rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *;
- auto with arith.
-rewrite (nat_of_P_minus_morphism p q).
-rewrite minus_INR; auto with arith; ring.
-apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
+  forall p q:positive, IZR (Zpos p + Zneg q) = IZR (Zpos p) + IZR (Zneg q).
+Proof.
+  intros.
+  case (lt_eq_lt_dec (nat_of_P p) (nat_of_P q)).
+  intros [H| H]; simpl in |- *.
+  rewrite nat_of_P_lt_Lt_compare_complement_morphism; simpl in |- *; trivial.
+  rewrite (nat_of_P_minus_morphism q p).
+  rewrite minus_INR; auto with arith; ring.
+  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
+  rewrite (nat_of_P_inj p q); trivial.
+  rewrite Pcompare_refl; simpl in |- *; auto with real.
+  intro H; simpl in |- *.
+  rewrite nat_of_P_gt_Gt_compare_complement_morphism; simpl in |- *;
+    auto with arith.
+  rewrite (nat_of_P_minus_morphism p q).
+  rewrite minus_INR; auto with arith; ring.
+  apply ZC2; apply nat_of_P_lt_Lt_compare_complement_morphism; trivial.
 Qed.
 
 (**********)
 Lemma plus_IZR : forall n m:Z, IZR (n + m) = IZR n + IZR m.
-intro z; destruct z; intro t; destruct t; intros; auto with real.
-simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real.
-apply plus_IZR_NEG_POS.
-rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
-simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR;
- auto with real.
+Proof.
+  intro z; destruct z; intro t; destruct t; intros; auto with real.
+  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; auto with real.
+  apply plus_IZR_NEG_POS.
+  rewrite Zplus_comm; rewrite Rplus_comm; apply plus_IZR_NEG_POS.
+  simpl in |- *; intros; rewrite nat_of_P_plus_morphism; rewrite plus_INR;
+    auto with real.
 Qed.
 
 (**********)
 Lemma mult_IZR : forall n m:Z, IZR (n * m) = IZR n * IZR m.
-intros z t; case z; case t; simpl in |- *; auto with real.
-intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
-intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
-rewrite Rmult_comm.
-rewrite Ropp_mult_distr_l_reverse; auto with real.
-apply Ropp_eq_compat; rewrite mult_comm; auto with real.
-intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
-rewrite Ropp_mult_distr_l_reverse; auto with real.
-intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
-rewrite Rmult_opp_opp; auto with real.
+Proof.
+  intros z t; case z; case t; simpl in |- *; auto with real.
+  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  rewrite Rmult_comm.
+  rewrite Ropp_mult_distr_l_reverse; auto with real.
+  apply Ropp_eq_compat; rewrite mult_comm; auto with real.
+  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  rewrite Ropp_mult_distr_l_reverse; auto with real.
+  intros t1 z1; rewrite nat_of_P_mult_morphism; auto with real.
+  rewrite Rmult_opp_opp; auto with real.
 Qed.
 
 (**********)
 Lemma Ropp_Ropp_IZR : forall n:Z, IZR (- n) = - IZR n.
-intro z; case z; simpl in |- *; auto with real.
+Proof.
+  intro z; case z; simpl in |- *; auto with real.
 Qed.
 
 (**********)
 Lemma Z_R_minus : forall n m:Z, IZR n - IZR m = IZR (n - m).
-intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *.
-rewrite <- (Ropp_Ropp_IZR z2); symmetry  in |- *; apply plus_IZR.
+Proof.
+  intros z1 z2; unfold Rminus in |- *; unfold Zminus in |- *.
+  rewrite <- (Ropp_Ropp_IZR z2); symmetry  in |- *; apply plus_IZR.
 Qed. 
 
 (**********)
 Lemma lt_O_IZR : forall n:Z, 0 < IZR n -> (0 < n)%Z.
-intro z; case z; simpl in |- *; intros.
-absurd (0 < 0); auto with real.
-unfold Zlt in |- *; simpl in |- *; trivial.
-case Rlt_not_le with (1 := H).
-replace 0 with (-0); auto with real.
+Proof.
+  intro z; case z; simpl in |- *; intros.
+  absurd (0 < 0); auto with real.
+  unfold Zlt in |- *; simpl in |- *; trivial.
+  case Rlt_not_le with (1 := H).
+  replace 0 with (-0); auto with real.
 Qed.
 
 (**********)
 Lemma lt_IZR : forall n m:Z, IZR n < IZR m -> (n < m)%Z.
-intros z1 z2 H; apply Zlt_0_minus_lt. 
-apply lt_O_IZR.
-rewrite <- Z_R_minus.
-exact (Rgt_minus (IZR z2) (IZR z1) H).
+Proof.
+  intros z1 z2 H; apply Zlt_0_minus_lt. 
+  apply lt_O_IZR.
+  rewrite <- Z_R_minus.
+  exact (Rgt_minus (IZR z2) (IZR z1) H).
 Qed.
 
 (**********)
 Lemma eq_IZR_R0 : forall n:Z, IZR n = 0 -> n = 0%Z.
-intro z; destruct z; simpl in |- *; intros; auto with zarith.
-case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real.
-case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real.
-apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos.
+Proof.
+  intro z; destruct z; simpl in |- *; intros; auto with zarith.
+  case (Rlt_not_eq 0 (INR (nat_of_P p))); auto with real.
+  case (Rlt_not_eq (- INR (nat_of_P p)) 0); auto with real.
+  apply Ropp_lt_gt_0_contravar. unfold Rgt in |- *; apply INR_pos.
 Qed.
 
 (**********)
 Lemma eq_IZR : forall n m:Z, IZR n = IZR m -> n = m.
-intros z1 z2 H; generalize (Rminus_diag_eq (IZR z1) (IZR z2) H);
- rewrite (Z_R_minus z1 z2); intro; generalize (eq_IZR_R0 (z1 - z2) H0); 
- intro; omega.
+Proof.
+  intros z1 z2 H; generalize (Rminus_diag_eq (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 : forall n:Z, n <> 0%Z -> IZR n <> 0.
-intros z H; red in |- *; intros H0; case H.
-apply eq_IZR; auto.
+Proof.
+  intros z H; red in |- *; intros H0; case H.
+  apply eq_IZR; auto.
 Qed.
 
 (*********)
 Lemma le_O_IZR : forall n:Z, 0 <= IZR n -> (0 <= n)%Z.
-unfold Rle in |- *; intros z [H| H].
-red in |- *; intro; apply (Zlt_le_weak 0 z (lt_O_IZR z H)); assumption.
-rewrite (eq_IZR_R0 z); auto with zarith real.
+Proof.
+  unfold Rle in |- *; intros z [H| H].
+  red in |- *; 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 : forall n m:Z, IZR n <= IZR m -> (n <= m)%Z.
-unfold Rle in |- *; 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.
+Proof.
+  unfold Rle in |- *; 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 : forall n:Z, IZR n <= 1 -> (n <= 1)%Z.
-pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto.
-apply le_IZR; trivial.
+Proof.
+  pattern 1 at 1 in |- *; replace 1 with (IZR 1); intros; auto.
+  apply le_IZR; trivial.
 Qed.
 
 (**********)
 Lemma IZR_ge : forall n m:Z, (n >= m)%Z -> IZR n >= IZR m.
-intros m n H; apply Rnot_lt_ge; red in |- *; intro.
-generalize (lt_IZR m n H0); intro; omega.
+Proof.
+  intros m n H; apply Rnot_lt_ge; red in |- *; intro.
+  generalize (lt_IZR m n H0); intro; omega.
 Qed.
 
 Lemma IZR_le : forall n m:Z, (n <= m)%Z -> IZR n <= IZR m.
-intros m n H; apply Rnot_gt_le; red in |- *; intro.
-unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega.
+Proof.
+  intros m n H; apply Rnot_gt_le; red in |- *; intro.
+  unfold Rgt in H0; generalize (lt_IZR n m H0); intro; omega.
 Qed.
 
 Lemma IZR_lt : forall n m:Z, (n < m)%Z -> IZR n < IZR m.
-intros m n H; cut (m <= n)%Z.
-intro H0; elim (IZR_le m n H0); intro; auto.
-generalize (eq_IZR m n H1); intro; elimtype False; omega.
-omega.
+Proof.
+  intros m n H; cut (m <= n)%Z.
+  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 : forall n:Z, -1 < IZR n < 1 -> n = 0%Z.
-intros z [H1 H2].
-apply Zle_antisym.
-apply Zlt_succ_le; apply lt_IZR; trivial.
-replace 0%Z with (Zsucc (-1)); trivial.
-apply Zlt_le_succ; apply lt_IZR; trivial.
+Proof.
+  intros z [H1 H2].
+  apply Zle_antisym.
+  apply Zlt_succ_le; apply lt_IZR; trivial.
+  replace 0%Z with (Zsucc (-1)); trivial.
+  apply Zlt_le_succ; apply lt_IZR; trivial.
 Qed.
 
 Lemma one_IZR_r_R1 :
- forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m.
-intros r z x [H1 H2] [H3 H4].
-cut ((z - x)%Z = 0%Z); auto with zarith.
-apply one_IZR_lt1.
-rewrite <- Z_R_minus; split.
-replace (-1) with (r - (r + 1)).
-unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real.
-ring.
-replace 1 with (r + 1 - r).
-unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real.
-ring.
+  forall r (n m:Z), r < IZR n <= r + 1 -> r < IZR m <= r + 1 -> n = m.
+Proof.
+  intros r z x [H1 H2] [H3 H4].
+  cut ((z - x)%Z = 0%Z); auto with zarith.
+  apply one_IZR_lt1.
+  rewrite <- Z_R_minus; split.
+  replace (-1) with (r - (r + 1)).
+  unfold Rminus in |- *; apply Rplus_lt_le_compat; auto with real.
+  ring.
+  replace 1 with (r + 1 - r).
+  unfold Rminus in |- *; apply Rplus_le_lt_compat; auto with real.
+  ring.
 Qed.
 
 
 (**********)
 Lemma single_z_r_R1 :
- forall r (n m:Z),
-   r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m.
-intros; apply one_IZR_r_R1 with r; auto.
+  forall r (n m:Z),
+    r < IZR n -> IZR n <= r + 1 -> r < IZR m -> IZR m <= r + 1 -> n = m.
+Proof.
+  intros; apply one_IZR_r_R1 with r; auto.
 Qed.
 
 (**********)
 Lemma tech_single_z_r_R1 :
- forall r (n:Z),
-   r < IZR n ->
-   IZR n <= r + 1 ->
-   (exists s : Z, s <> n /\ 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.
+  forall r (n:Z),
+    r < IZR n ->
+    IZR n <= r + 1 ->
+    (exists s : Z, s <> n /\ r < IZR s /\ IZR s <= r + 1) -> False.
+Proof.
+  intros r z H1 H2 [s [H3 [H4 H5]]].
+  apply H3; apply single_z_r_R1 with r; trivial.
 Qed.
 
 (*****************************************************************)
-(** Definitions of new types                                     *)
+(** * Definitions of new types                                   *)
 (*****************************************************************)
 
 Record nonnegreal : Type := mknonnegreal
@@ -1507,125 +1692,138 @@ Record nonzeroreal : Type := mknonzeroreal
 
 (**********)
 Lemma prod_neq_R0 : forall r1 r2, r1 <> 0 -> r2 <> 0 -> r1 * r2 <> 0.
-intros x y; intros; red in |- *; intro; generalize (Rmult_integral x y H1);
- intro; elim H2; intro;
- [ rewrite H3 in H; elim H | rewrite H3 in H0; elim H0 ]; 
- reflexivity.
+Proof.
+  intros x y; intros; red in |- *; intro; generalize (Rmult_integral 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 : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 * r2.
-intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x);
- apply (Rmult_le_compat_l x 0 y H H0).
+Proof.
+  intros x y H H0; rewrite <- (Rmult_0_l x); rewrite <- (Rmult_comm x);
+    apply (Rmult_le_compat_l x 0 y H H0).
 Qed.
 
 Lemma double : forall r1, 2 * r1 = r1 + r1.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 
 Lemma double_var : forall r1, r1 = r1 / 2 + r1 / 2.
-intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
- symmetry  in |- *; apply Rinv_r_simpl_m.
-replace 2 with (INR 2);
- [ apply not_O_INR; discriminate | unfold INR in |- *; ring ].
+Proof.
+  intro; rewrite <- double; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+    symmetry  in |- *; apply Rinv_r_simpl_m.
+  replace 2 with (INR 2);
+  [ apply not_O_INR; discriminate | unfold INR in |- *; ring ].
 Qed.
 
 (**********************************************************)
-(** Other rules about < and <=                            *)
+(** * Other rules about < and <=                          *)
 (**********************************************************)
 
 Lemma Rplus_lt_0_compat : forall r1 r2, 0 < r1 -> 0 < r2 -> 0 < r1 + r2.
-intros x y; intros; apply Rlt_trans with x;
- [ assumption
- | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
-    assumption ].
+Proof.
+  intros x y; intros; apply Rlt_trans with x;
+    [ assumption
+      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+        assumption ].
 Qed.
 
 Lemma Rplus_le_lt_0_compat : forall r1 r2, 0 <= r1 -> 0 < r2 -> 0 < r1 + r2.
-intros x y; intros; apply Rle_lt_trans with x;
- [ assumption
- | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
-    assumption ].
+Proof.
+  intros x y; intros; apply Rle_lt_trans with x;
+    [ assumption
+      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_lt_compat_l;
+        assumption ].
 Qed.
 
 Lemma Rplus_lt_le_0_compat : forall r1 r2, 0 < r1 -> 0 <= r2 -> 0 < r1 + r2.
-intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat;
- assumption.
+Proof.
+  intros x y; intros; rewrite <- Rplus_comm; apply Rplus_le_lt_0_compat;
+    assumption.
 Qed.
 
 Lemma Rplus_le_le_0_compat : forall r1 r2, 0 <= r1 -> 0 <= r2 -> 0 <= r1 + r2.
-intros x y; intros; apply Rle_trans with x;
- [ assumption
- | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
-    assumption ].
+Proof.
+  intros x y; intros; apply Rle_trans with x;
+    [ assumption
+      | pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+        assumption ].
 Qed.
 
 Lemma plus_le_is_le : forall r1 r2 r3, 0 <= r2 -> r1 + r2 <= r3 -> r1 <= r3.
-intros x y z; intros; apply Rle_trans with (x + y);
- [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
-    assumption
- | assumption ].
+Proof.
+  intros x y z; intros; apply Rle_trans with (x + y);
+    [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+      assumption
+      | assumption ].
 Qed.
 
 Lemma plus_lt_is_lt : forall r1 r2 r3, 0 <= r2 -> r1 + r2 < r3 -> r1 < r3.
-intros x y z; intros; apply Rle_lt_trans with (x + y);
- [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
-    assumption
- | assumption ].
+Proof.
+  intros x y z; intros; apply Rle_lt_trans with (x + y);
+    [ pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+      assumption
+      | assumption ].
 Qed.
 
 Lemma Rmult_le_0_lt_compat :
- forall r1 r2 r3 r4,
-   0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
-intros; apply Rle_lt_trans with (r2 * r3);
- [ apply Rmult_le_compat_r; [ assumption | left; assumption ]
- | apply Rmult_lt_compat_l;
-    [ apply Rle_lt_trans with r1; assumption | assumption ] ].
+  forall r1 r2 r3 r4,
+    0 <= r1 -> 0 <= r3 -> r1 < r2 -> r3 < r4 -> r1 * r3 < r2 * r4.
+Proof.
+  intros; apply Rle_lt_trans with (r2 * r3);
+    [ apply Rmult_le_compat_r; [ assumption | left; assumption ]
+      | apply Rmult_lt_compat_l;
+        [ apply Rle_lt_trans with r1; assumption | assumption ] ].
 Qed.
 
 Lemma le_epsilon :
- forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2.
-intros x y; intros; elim (Rtotal_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_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0));
- intro H3; generalize (H ((x - y) * / 2) H3);
- replace (y + (x - y) * / 2) with ((y + x) * / 2).
-intro H4;
- generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4);
- rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; replace (2 * x) with (x + x).
-rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
-ring. 
-replace 2 with (INR 2); [ apply not_O_INR; discriminate | ring ].
-pattern y at 2 in |- *; replace y with (y / 2 + y / 2).
-unfold Rminus, Rdiv in |- *.
-repeat rewrite Rmult_plus_distr_r.
-ring.
-cut (forall z:R, 2 * z = z + z).
-intro.
-rewrite <- (H4 (y / 2)).
-unfold Rdiv in |- *.
-rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-replace 2 with (INR 2).
-apply not_O_INR.
-discriminate.
-unfold INR in |- *; reflexivity.
-intro; ring.
-cut (0%nat <> 2%nat);
- [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *;
-    intro; assumption
- | discriminate ].
+  forall r1 r2, (forall eps:R, 0 < eps -> r1 <= r2 + eps) -> r1 <= r2.
+Proof.
+  intros x y; intros; elim (Rtotal_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_0_compat (x - y) (/ 2) H2 (Rinv_0_lt_compat 2 H0));
+    intro H3; generalize (H ((x - y) * / 2) H3);
+      replace (y + (x - y) * / 2) with ((y + x) * / 2).
+  intro H4;
+    generalize (Rmult_le_compat_l 2 x ((y + x) * / 2) (Rlt_le 0 2 H0) H4);
+      rewrite <- (Rmult_comm ((y + x) * / 2)); rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; replace (2 * x) with (x + x).
+  rewrite (Rplus_comm y); intro H5; apply Rplus_le_reg_l with x; assumption.
+  ring. 
+  replace 2 with (INR 2); [ apply not_O_INR; discriminate | reflexivity ].
+  pattern y at 2 in |- *; replace y with (y / 2 + y / 2).
+  unfold Rminus, Rdiv in |- *.
+  repeat rewrite Rmult_plus_distr_r.
+  ring.
+  cut (forall z:R, 2 * z = z + z).
+  intro.
+  rewrite <- (H4 (y / 2)).
+  unfold Rdiv in |- *.
+  rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  replace 2 with (INR 2).
+  apply not_O_INR.
+  discriminate.
+  unfold INR in |- *; reflexivity.
+  intro; ring.
+  cut (0%nat <> 2%nat);
+    [ intro H0; generalize (lt_INR_0 2 (neq_O_lt 2 H0)); unfold INR in |- *;
+      intro; assumption
+      | discriminate ].
 Qed.
 
 (**********)
 Lemma completeness_weak :
- forall E:R -> Prop,
-   bound E -> (exists x : R, E x) ->  exists m : R, is_lub E m.
-intros; elim (completeness E H H0); intros; split with x; assumption.
+  forall E:R -> Prop,
+    bound E -> (exists x : R, E x) ->  exists m : R, is_lub E m.
+Proof.
+  intros; elim (completeness E H H0); intros; split with x; assumption.
 Qed.
diff --git a/theories/Reals/RList.v b/theories/Reals/RList.v
index 551aec98..19f2b4ff 100644
--- a/theories/Reals/RList.v
+++ b/theories/Reals/RList.v
@@ -5,208 +5,217 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: RList.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: RList.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
 Open Local Scope R_scope.
 
 Inductive Rlist : Type :=
-  | nil : Rlist
-  | cons : R -> Rlist -> Rlist.
+| nil : Rlist
+| cons : R -> Rlist -> Rlist.
 
 Fixpoint In (x:R) (l:Rlist) {struct l} : Prop :=
   match l with
-  | nil => False
-  | cons a l' => x = a \/ In x l'
+    | nil => False
+    | cons a l' => x = a \/ In x l'
   end.
 
 Fixpoint Rlength (l:Rlist) : nat :=
   match l with
-  | nil => 0%nat
-  | cons a l' => S (Rlength l')
+    | nil => 0%nat
+    | cons a l' => S (Rlength l')
   end.
 
 Fixpoint MaxRlist (l:Rlist) : R :=
   match l with
-  | nil => 0
-  | cons a l1 =>
+    | nil => 0
+    | cons a l1 =>
       match l1 with
-      | nil => a
-      | cons a' l2 => Rmax a (MaxRlist l1)
+        | nil => a
+        | cons a' l2 => Rmax a (MaxRlist l1)
       end
   end.
 
 Fixpoint MinRlist (l:Rlist) : R :=
   match l with
-  | nil => 1
-  | cons a l1 =>
+    | nil => 1
+    | cons a l1 =>
       match l1 with
-      | nil => a
-      | cons a' l2 => Rmin a (MinRlist l1)
+        | nil => a
+        | cons a' l2 => Rmin a (MinRlist l1)
       end
   end.
 
 Lemma MaxRlist_P1 : forall (l:Rlist) (x:R), In x l -> x <= MaxRlist l.
-intros; induction  l as [| r l Hrecl].
-simpl in H; elim H.
-induction  l as [| r0 l Hrecl0].
-simpl in H; elim H; intro.
-simpl in |- *; right; assumption.
-elim H0.
-replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
-simpl in H; decompose [or] H.
-rewrite H0; apply RmaxLess1.
-unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
-apply Hrecl; simpl in |- *; tauto.
-apply Rle_trans with (MaxRlist (cons r0 l));
- [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
-unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
-apply Hrecl; simpl in |- *; tauto.
-apply Rle_trans with (MaxRlist (cons r0 l));
- [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
-reflexivity.
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  simpl in H; elim H.
+  induction  l as [| r0 l Hrecl0].
+  simpl in H; elim H; intro.
+  simpl in |- *; right; assumption.
+  elim H0.
+  replace (MaxRlist (cons r (cons r0 l))) with (Rmax r (MaxRlist (cons r0 l))).
+  simpl in H; decompose [or] H.
+  rewrite H0; apply RmaxLess1.
+  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+  apply Hrecl; simpl in |- *; tauto.
+  apply Rle_trans with (MaxRlist (cons r0 l));
+    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
+  unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); intro.
+  apply Hrecl; simpl in |- *; tauto.
+  apply Rle_trans with (MaxRlist (cons r0 l));
+    [ apply Hrecl; simpl in |- *; tauto | left; auto with real ].
+  reflexivity.
 Qed.
 
 Fixpoint AbsList (l:Rlist) (x:R) {struct l} : Rlist :=
   match l with
-  | nil => nil
-  | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x)
+    | nil => nil
+    | cons a l' => cons (Rabs (a - x) / 2) (AbsList l' x)
   end.
 
 Lemma MinRlist_P1 : forall (l:Rlist) (x:R), In x l -> MinRlist l <= x.
-intros; induction  l as [| r l Hrecl].
-simpl in H; elim H.
-induction  l as [| r0 l Hrecl0].
-simpl in H; elim H; intro.
-simpl in |- *; right; symmetry  in |- *; assumption.
-elim H0.
-replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-simpl in H; decompose [or] H.
-rewrite H0; apply Rmin_l.
-unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
-apply Rle_trans with (MinRlist (cons r0 l)).
-assumption.
-apply Hrecl; simpl in |- *; tauto.
-apply Hrecl; simpl in |- *; tauto.
-apply Rle_trans with (MinRlist (cons r0 l)).
-apply Rmin_r.
-apply Hrecl; simpl in |- *; tauto.
-reflexivity.
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  simpl in H; elim H.
+  induction  l as [| r0 l Hrecl0].
+  simpl in H; elim H; intro.
+  simpl in |- *; right; symmetry  in |- *; assumption.
+  elim H0.
+  replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
+  simpl in H; decompose [or] H.
+  rewrite H0; apply Rmin_l.
+  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+  apply Rle_trans with (MinRlist (cons r0 l)).
+  assumption.
+  apply Hrecl; simpl in |- *; tauto.
+  apply Hrecl; simpl in |- *; tauto.
+  apply Rle_trans with (MinRlist (cons r0 l)).
+  apply Rmin_r.
+  apply Hrecl; simpl in |- *; tauto.
+  reflexivity.
 Qed.
 
 Lemma AbsList_P1 :
- forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x).
-intros; induction  l as [| r l Hrecl].
-elim H.
-simpl in |- *; simpl in H; elim H; intro.
-left; rewrite H0; reflexivity.
-right; apply Hrecl; assumption.
+  forall (l:Rlist) (x y:R), In y l -> In (Rabs (y - x) / 2) (AbsList l x).
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  elim H.
+  simpl in |- *; simpl in H; elim H; intro.
+  left; rewrite H0; reflexivity.
+  right; apply Hrecl; assumption.
 Qed.
 
 Lemma MinRlist_P2 :
- forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l.
-intros; induction  l as [| r l Hrecl].
-apply Rlt_0_1.
-induction  l as [| r0 l Hrecl0].
-simpl in |- *; apply H; simpl in |- *; tauto.
-replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
-unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
-apply H; simpl in |- *; tauto.
-apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto.
-reflexivity.
+  forall l:Rlist, (forall y:R, In y l -> 0 < y) -> 0 < MinRlist l.
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  apply Rlt_0_1.
+  induction  l as [| r0 l Hrecl0].
+  simpl in |- *; apply H; simpl in |- *; tauto.
+  replace (MinRlist (cons r (cons r0 l))) with (Rmin r (MinRlist (cons r0 l))).
+  unfold Rmin in |- *; case (Rle_dec r (MinRlist (cons r0 l))); intro.
+  apply H; simpl in |- *; tauto.
+  apply Hrecl; intros; apply H; simpl in |- *; simpl in H0; tauto.
+  reflexivity.
 Qed.
 
 Lemma AbsList_P2 :
- forall (l:Rlist) (x y:R),
-   In y (AbsList l x) ->  exists z : R, In z l /\ y = Rabs (z - x) / 2.
-intros; induction  l as [| r l Hrecl].
-elim H.
-elim H; intro.
-exists r; split.
-simpl in |- *; tauto.
-assumption.
-assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros;
- exists x0; simpl in |- *; simpl in H2; tauto.
+  forall (l:Rlist) (x y:R),
+    In y (AbsList l x) ->  exists z : R, In z l /\ y = Rabs (z - x) / 2.
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  elim H.
+  elim H; intro.
+  exists r; split.
+  simpl in |- *; tauto.
+  assumption.
+  assert (H1 := Hrecl H0); elim H1; intros; elim H2; clear H2; intros;
+    exists x0; simpl in |- *; simpl in H2; tauto.
 Qed.
 
 Lemma MaxRlist_P2 :
- forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l.
-intros; induction  l as [| r l Hrecl].
-simpl in H; elim H; trivial.
-induction  l as [| r0 l Hrecl0].
-simpl in |- *; left; reflexivity.
-change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *;
- unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); 
- intro.
-right; apply Hrecl; exists r0; left; reflexivity.
-left; reflexivity.
+  forall l:Rlist, (exists y : R, In y l) -> In (MaxRlist l) l.
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  simpl in H; elim H; trivial.
+  induction  l as [| r0 l Hrecl0].
+  simpl in |- *; left; reflexivity.
+  change (In (Rmax r (MaxRlist (cons r0 l))) (cons r (cons r0 l))) in |- *;
+    unfold Rmax in |- *; case (Rle_dec r (MaxRlist (cons r0 l))); 
+      intro.
+  right; apply Hrecl; exists r0; left; reflexivity.
+  left; reflexivity.
 Qed.
 
 Fixpoint pos_Rl (l:Rlist) (i:nat) {struct l} : R :=
   match l with
-  | nil => 0
-  | cons a l' => match i with
-                 | O => a
-                 | S i' => pos_Rl l' i'
-                 end
+    | nil => 0
+    | cons a l' => match i with
+                     | O => a
+                     | S i' => pos_Rl l' i'
+                   end
   end.
 
 Lemma pos_Rl_P1 :
- forall (l:Rlist) (a:R),
-   (0 < Rlength l)%nat ->
-   pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)).
-intros; induction  l as [| r l Hrecl];
- [ elim (lt_n_O _ H)
- | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
+  forall (l:Rlist) (a:R),
+    (0 < Rlength l)%nat ->
+    pos_Rl (cons a l) (Rlength l) = pos_Rl l (pred (Rlength l)).
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ elim (lt_n_O _ H)
+      | simpl in |- *; case (Rlength l); [ reflexivity | intro; reflexivity ] ].
 Qed.
 
 Lemma pos_Rl_P2 :
- forall (l:Rlist) (x:R),
-   In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i).
-intros; induction  l as [| r l Hrecl].
-split; intro;
- [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ].
-split; intro.
-elim H; intro.
-exists 0%nat; split;
- [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ].
-elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
- exists (S x0); split;
- [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ].
-elim H; intros; elim H0; intros; elim (zerop x0); intro.
-rewrite a in H2; simpl in H2; left; assumption.
-right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
-symmetry  in |- *; apply S_pred with 0%nat; assumption.
-exists (pred x0); split;
- [ simpl in H1; apply lt_S_n; rewrite H5; assumption
- | rewrite <- H5 in H2; simpl in H2; assumption ].
+  forall (l:Rlist) (x:R),
+    In x l <-> (exists i : nat, (i < Rlength l)%nat /\ x = pos_Rl l i).
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  split; intro;
+    [ elim H | elim H; intros; elim H0; intros; elim (lt_n_O _ H1) ].
+  split; intro.
+  elim H; intro.
+  exists 0%nat; split;
+    [ simpl in |- *; apply lt_O_Sn | simpl in |- *; apply H0 ].
+  elim Hrecl; intros; assert (H3 := H1 H0); elim H3; intros; elim H4; intros;
+    exists (S x0); split;
+      [ simpl in |- *; apply lt_n_S; assumption | simpl in |- *; assumption ].
+  elim H; intros; elim H0; intros; elim (zerop x0); intro.
+  rewrite a in H2; simpl in H2; left; assumption.
+  right; elim Hrecl; intros; apply H4; assert (H5 : S (pred x0) = x0).
+  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  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 :
- forall (l:Rlist) (P:R -> R -> Prop),
-   (forall x:R, In x l ->  exists y : R, P x y) ->
+  forall (l:Rlist) (P:R -> R -> Prop),
+    (forall x:R, In x l ->  exists y : R, P x y) ->
     exists l' : Rlist,
-     Rlength l = Rlength l' /\
-     (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)).
-intros; induction  l as [| r l Hrecl].
-exists nil; intros; split;
- [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ].
-assert (H0 : In r (cons r l)).
-simpl in |- *; left; reflexivity.
-assert (H1 := H _ H0);
- assert (H2 : forall x:R, In x l ->  exists y : R, P x y).
-intros; apply H; simpl in |- *; right; assumption.
-assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
- intros; elim H5; clear H5; intros; split.
-simpl in |- *; rewrite H5; reflexivity.
-intros; elim (zerop i); intro.
-rewrite a; simpl in |- *; assumption.
-assert (H8 : i = S (pred i)).
-apply S_pred with 0%nat; assumption.
-rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
- assumption.
+      Rlength l = Rlength l' /\
+      (forall i:nat, (i < Rlength l)%nat -> P (pos_Rl l i) (pos_Rl l' i)).
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  exists nil; intros; split;
+    [ reflexivity | intros; simpl in H0; elim (lt_n_O _ H0) ].
+  assert (H0 : In r (cons r l)).
+  simpl in |- *; left; reflexivity.
+  assert (H1 := H _ H0);
+    assert (H2 : forall x:R, In x l ->  exists y : R, P x y).
+  intros; apply H; simpl in |- *; right; assumption.
+  assert (H3 := Hrecl H2); elim H1; intros; elim H3; intros; exists (cons x x0);
+    intros; elim H5; clear H5; intros; split.
+  simpl in |- *; rewrite H5; reflexivity.
+  intros; elim (zerop i); intro.
+  rewrite a; simpl in |- *; assumption.
+  assert (H8 : i = S (pred i)).
+  apply S_pred with 0%nat; assumption.
+  rewrite H8; simpl in |- *; apply H6; simpl in H7; apply lt_S_n; rewrite <- H8;
+    assumption.
 Qed.
 
 Definition ordered_Rlist (l:Rlist) : Prop :=
@@ -214,531 +223,561 @@ Definition ordered_Rlist (l:Rlist) : Prop :=
 
 Fixpoint insert (l:Rlist) (x:R) {struct l} : Rlist :=
   match l with
-  | nil => cons x nil
-  | cons a l' =>
+    | nil => cons x nil
+    | cons a l' =>
       match Rle_dec a x with
-      | left _ => cons a (insert l' x)
-      | right _ => cons x l
+        | left _ => cons a (insert l' x)
+        | right _ => cons x l
       end
   end.
 
 Fixpoint cons_Rlist (l k:Rlist) {struct l} : Rlist :=
   match l with
-  | nil => k
-  | cons a l' => cons a (cons_Rlist l' k)
+    | nil => k
+    | cons a l' => cons a (cons_Rlist l' k)
   end.
 
 Fixpoint cons_ORlist (k l:Rlist) {struct k} : Rlist :=
   match k with
-  | nil => l
-  | cons a k' => cons_ORlist k' (insert l a)
+    | nil => l
+    | cons a k' => cons_ORlist k' (insert l a)
   end.
 
 Fixpoint app_Rlist (l:Rlist) (f:R -> R) {struct l} : Rlist :=
   match l with
-  | nil => nil
-  | cons a l' => cons (f a) (app_Rlist l' f)
+    | nil => nil
+    | cons a l' => cons (f a) (app_Rlist l' f)
   end.
 
 Fixpoint mid_Rlist (l:Rlist) (x:R) {struct l} : Rlist :=
   match l with
-  | nil => nil
-  | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a)
+    | nil => nil
+    | cons a l' => cons ((x + a) / 2) (mid_Rlist l' a)
   end.
 
 Definition Rtail (l:Rlist) : Rlist :=
   match l with
-  | nil => nil
-  | cons a l' => l'
+    | nil => nil
+    | cons a l' => l'
   end.
 
 Definition FF (l:Rlist) (f:R -> R) : Rlist :=
   match l with
-  | nil => nil
-  | cons a l' => app_Rlist (mid_Rlist l' a) f
+    | nil => nil
+    | cons a l' => app_Rlist (mid_Rlist l' a) f
   end.
 
 Lemma RList_P0 :
- forall (l:Rlist) (a:R),
-   pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0.
-intros; induction  l as [| r l Hrecl];
- [ left; reflexivity
- | simpl in |- *; case (Rle_dec r a); intro;
-    [ right; reflexivity | left; reflexivity ] ].
+  forall (l:Rlist) (a:R),
+    pos_Rl (insert l a) 0 = a \/ pos_Rl (insert l a) 0 = pos_Rl l 0.
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ left; reflexivity
+      | simpl in |- *; case (Rle_dec r a); intro;
+        [ right; reflexivity | left; reflexivity ] ].
 Qed.
 
 Lemma RList_P1 :
- forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a).
-intros; induction  l as [| r l Hrecl].
-simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0;
- elim (lt_n_O _ H0).
-simpl in |- *; case (Rle_dec r a); intro.
-assert (H1 : ordered_Rlist l).
-unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros;
- assert (H1 : (S i < pred (Rlength (cons r l)))%nat);
- [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l)));
-    [ apply lt_n_S; assumption
-    | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
-       intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ]
- | apply (H _ H1) ].
-assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro.
-rewrite H4; assumption.
-induction  l as [| r1 l Hrecl0];
- [ simpl in |- *; assumption
- | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ].
-simpl in |- *; apply H2; simpl in H0; apply lt_S_n;
- replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a));
- [ assumption
- | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
-    rewrite <- H3 in H0; elim (lt_n_O _ H0) ].
-unfold ordered_Rlist in |- *; intros; induction  i as [| i Hreci];
- [ simpl in |- *; auto with real
- | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H;
-    simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ].
+  forall (l:Rlist) (a:R), ordered_Rlist l -> ordered_Rlist (insert l a).
+Proof.
+  intros; induction  l as [| r l Hrecl].
+  simpl in |- *; unfold ordered_Rlist in |- *; intros; simpl in H0;
+    elim (lt_n_O _ H0).
+  simpl in |- *; case (Rle_dec r a); intro.
+  assert (H1 : ordered_Rlist l).
+  unfold ordered_Rlist in |- *; unfold ordered_Rlist in H; intros;
+    assert (H1 : (S i < pred (Rlength (cons r l)))%nat);
+      [ simpl in |- *; replace (Rlength l) with (S (pred (Rlength l)));
+        [ apply lt_n_S; assumption
+          | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+            intro; rewrite <- H1 in H0; simpl in H0; elim (lt_n_O _ H0) ]
+        | apply (H _ H1) ].
+  assert (H2 := Hrecl H1); unfold ordered_Rlist in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; assert (H3 := RList_P0 l a); elim H3; intro.
+  rewrite H4; assumption.
+  induction  l as [| r1 l Hrecl0];
+    [ simpl in |- *; assumption
+      | rewrite H4; apply (H 0%nat); simpl in |- *; apply lt_O_Sn ].
+  simpl in |- *; apply H2; simpl in H0; apply lt_S_n;
+    replace (S (pred (Rlength (insert l a)))) with (Rlength (insert l a));
+    [ assumption
+      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+        rewrite <- H3 in H0; elim (lt_n_O _ H0) ].
+  unfold ordered_Rlist in |- *; intros; induction  i as [| i Hreci];
+    [ simpl in |- *; auto with real
+      | change (pos_Rl (cons r l) i <= pos_Rl (cons r l) (S i)) in |- *; apply H;
+        simpl in H0; simpl in |- *; apply (lt_S_n _ _ H0) ].
 Qed.
 
 Lemma RList_P2 :
- forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2).
-simple induction l1;
- [ intros; simpl in |- *; apply H
- | intros; simpl in |- *; apply H; apply RList_P1; assumption ].
+  forall l1 l2:Rlist, ordered_Rlist l2 -> ordered_Rlist (cons_ORlist l1 l2).
+Proof.
+  simple induction l1;
+    [ intros; simpl in |- *; apply H
+      | intros; simpl in |- *; apply H; apply RList_P1; assumption ].
 Qed.
 
 Lemma RList_P3 :
- forall (l:Rlist) (x:R),
-   In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat).
-intros; split; intro;
- [ induction  l as [| r l Hrecl] | induction  l as [| r l Hrecl] ].
-elim H.
-elim H; intro;
- [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ]
- | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split;
-    [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ].
-elim H; intros; elim H0; intros; elim (lt_n_O _ H2).
-simpl in |- *; elim H; intros; elim H0; clear H0; intros;
- induction  x0 as [| x0 Hrecx0];
- [ left; apply H0
- | right; apply Hrecl; exists x0; split;
-    [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ].
+  forall (l:Rlist) (x:R),
+    In x l <-> (exists i : nat, x = pos_Rl l i /\ (i < Rlength l)%nat).
+Proof.
+  intros; split; intro;
+    [ induction  l as [| r l Hrecl] | induction  l as [| r l Hrecl] ].
+  elim H.
+  elim H; intro;
+    [ exists 0%nat; split; [ apply H0 | simpl in |- *; apply lt_O_Sn ]
+      | elim (Hrecl H0); intros; elim H1; clear H1; intros; exists (S x0); split;
+        [ apply H1 | simpl in |- *; apply lt_n_S; assumption ] ].
+  elim H; intros; elim H0; intros; elim (lt_n_O _ H2).
+  simpl in |- *; elim H; intros; elim H0; clear H0; intros;
+    induction  x0 as [| x0 Hrecx0];
+      [ left; apply H0
+        | right; apply Hrecl; exists x0; split;
+          [ apply H0 | simpl in H1; apply lt_S_n; assumption ] ].
 Qed.
 
 Lemma RList_P4 :
- forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1.
-intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *;
- replace (Rlength l1) with (S (pred (Rlength l1)));
- [ apply lt_n_S; assumption
- | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
-    intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ].
+  forall (l1:Rlist) (a:R), ordered_Rlist (cons a l1) -> ordered_Rlist l1.
+Proof.
+  intros; unfold ordered_Rlist in |- *; intros; apply (H (S i)); simpl in |- *;
+    replace (Rlength l1) with (S (pred (Rlength l1)));
+    [ apply lt_n_S; assumption
+      | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+        intro; rewrite <- H1 in H0; elim (lt_n_O _ H0) ].
 Qed.
 
 Lemma RList_P5 :
- forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x.
-intros; induction  l as [| r l Hrecl];
- [ elim H0
- | simpl in |- *; elim H0; intro;
-    [ rewrite H1; right; reflexivity
-    | apply Rle_trans with (pos_Rl l 0);
-       [ apply (H 0%nat); simpl in |- *; induction  l as [| r0 l Hrecl0];
-          [ elim H1 | simpl in |- *; apply lt_O_Sn ]
-       | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ].
+  forall (l:Rlist) (x:R), ordered_Rlist l -> In x l -> pos_Rl l 0 <= x.
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ elim H0
+      | simpl in |- *; elim H0; intro;
+        [ rewrite H1; right; reflexivity
+          | apply Rle_trans with (pos_Rl l 0);
+            [ apply (H 0%nat); simpl in |- *; induction  l as [| r0 l Hrecl0];
+              [ elim H1 | simpl in |- *; apply lt_O_Sn ]
+              | apply Hrecl; [ eapply RList_P4; apply H | assumption ] ] ] ].
 Qed.
 
 Lemma RList_P6 :
- forall l:Rlist,
-   ordered_Rlist l <->
-   (forall i j:nat,
+  forall l:Rlist,
+    ordered_Rlist l <->
+    (forall i j:nat,
       (i <= j)%nat -> (j < Rlength l)%nat -> pos_Rl l i <= pos_Rl l j).
-simple induction l; split; intro.
-intros; right; reflexivity.
-unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0).
-intros; induction  i as [| i Hreci];
- [ induction  j as [| j Hrecj];
-    [ right; reflexivity
-    | simpl in |- *; apply Rle_trans with (pos_Rl r0 0);
-       [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt;
-          red in |- *; intro; rewrite <- H3 in H2;
-          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 as [| j Hrecj];
-    [ elim (le_Sn_O _ H1)
-    | simpl in |- *; elim H; intros; apply H3;
-       [ apply RList_P4 with r; assumption
-       | apply le_S_n; assumption
-       | simpl in H2; apply lt_S_n; assumption ] ] ].
-unfold ordered_Rlist in |- *; intros; apply H0;
- [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ].
+Proof.
+  simple induction l; split; intro.
+  intros; right; reflexivity.
+  unfold ordered_Rlist in |- *; intros; simpl in H0; elim (lt_n_O _ H0).
+  intros; induction  i as [| i Hreci];
+    [ induction  j as [| j Hrecj];
+      [ right; reflexivity
+        | simpl in |- *; apply Rle_trans with (pos_Rl r0 0);
+          [ apply (H0 0%nat); simpl in |- *; simpl in H2; apply neq_O_lt;
+            red in |- *; intro; rewrite <- H3 in H2;
+              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 as [| j Hrecj];
+        [ elim (le_Sn_O _ H1)
+          | simpl in |- *; elim H; intros; apply H3;
+            [ apply RList_P4 with r; assumption
+              | apply le_S_n; assumption
+              | simpl in H2; apply lt_S_n; assumption ] ] ].
+  unfold ordered_Rlist in |- *; intros; apply H0;
+    [ apply le_n_Sn | simpl in |- *; simpl in H1; apply lt_n_S; assumption ].
 Qed.
 
 Lemma RList_P7 :
- forall (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 0%nat; apply neq_O_lt; red in |- *; intro;
- rewrite <- H6 in H5; elim (lt_n_O _ H5).
-apply H3;
- [ rewrite H6 in H5; apply lt_n_Sm_le; assumption
- | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5;
-    elim (lt_n_O _ H5) ].
+  forall (l:Rlist) (x:R),
+    ordered_Rlist l -> In x l -> x <= pos_Rl l (pred (Rlength l)).
+Proof.
+  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 0%nat; apply neq_O_lt; red in |- *; intro;
+    rewrite <- H6 in H5; elim (lt_n_O _ H5).
+  apply H3;
+    [ rewrite H6 in H5; apply lt_n_Sm_le; assumption
+      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H7 in H5;
+        elim (lt_n_O _ H5) ].
 Qed.
 
 Lemma RList_P8 :
- forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l.
-simple induction l.
-intros; split; intro; simpl in H; apply H.
-intros; split; intro;
- [ simpl in H0; generalize H0; case (Rle_dec 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 in |- *; case (Rle_dec 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 ].
+  forall (l:Rlist) (a x:R), In x (insert l a) <-> x = a \/ In x l.
+Proof.
+  simple induction l.
+  intros; split; intro; simpl in H; apply H.
+  intros; split; intro;
+    [ simpl in H0; generalize H0; case (Rle_dec 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 in |- *; case (Rle_dec 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 :
- forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2.
-simple induction l1.
-intros; split; intro;
- [ simpl in H; right; assumption
- | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ].
-intros; split.
-simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
- elim H3; intro;
- [ left; right; assumption
- | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro;
-    [ left; left; assumption | right; assumption ] ].
-intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1;
- 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 ].
+  forall (l1 l2:Rlist) (x:R), In x (cons_ORlist l1 l2) <-> In x l1 \/ In x l2.
+Proof.
+  simple induction l1.
+  intros; split; intro;
+    [ simpl in H; right; assumption
+      | simpl in |- *; elim H; intro; [ elim H0 | assumption ] ].
+  intros; split.
+  simpl in |- *; intros; elim (H (insert l2 r) x); intros; assert (H3 := H1 H0);
+    elim H3; intro;
+      [ left; right; assumption
+        | elim (RList_P8 l2 r x); intros H5 _; assert (H6 := H5 H4); elim H6; intro;
+          [ left; left; assumption | right; assumption ] ].
+  intro; simpl in |- *; elim (H (insert l2 r) x); intros _ H1; apply H1;
+    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 :
- forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l).
-intros; induction  l as [| r l Hrecl];
- [ reflexivity
- | simpl in |- *; case (Rle_dec r a); intro;
-    [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ].
+  forall (l:Rlist) (a:R), Rlength (insert l a) = S (Rlength l).
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ reflexivity
+      | simpl in |- *; case (Rle_dec r a); intro;
+        [ simpl in |- *; rewrite Hrecl; reflexivity | reflexivity ] ].
 Qed.
 
 Lemma RList_P11 :
- forall l1 l2:Rlist,
-   Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
-simple induction l1;
- [ intro; reflexivity
- | intros; simpl in |- *; rewrite (H (insert l2 r)); rewrite RList_P10;
-    apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR; 
-    rewrite S_INR; ring ].
+  forall l1 l2:Rlist,
+    Rlength (cons_ORlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
+Proof.
+  simple induction l1;
+    [ intro; reflexivity
+      | intros; simpl in |- *; 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 :
- forall (l:Rlist) (i:nat) (f:R -> R),
-   (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i).
-simple induction l;
- [ intros; elim (lt_n_O _ H)
- | intros; induction  i as [| i Hreci];
-    [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ].
+  forall (l:Rlist) (i:nat) (f:R -> R),
+    (i < Rlength l)%nat -> pos_Rl (app_Rlist l f) i = f (pos_Rl l i).
+Proof.
+  simple induction l;
+    [ intros; elim (lt_n_O _ H)
+      | intros; induction  i as [| i Hreci];
+        [ reflexivity | simpl in |- *; apply H; apply lt_S_n; apply H0 ] ].
 Qed.
 
 Lemma RList_P13 :
- forall (l:Rlist) (i:nat) (a:R),
-   (i < pred (Rlength l))%nat ->
-   pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2.
-simple induction l.
-intros; simpl in H; elim (lt_n_O _ H).
-simple induction r0.
-intros; simpl in H0; elim (lt_n_O _ H0).
-intros; simpl in H1; induction  i as [| i Hreci].
-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) 
- in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption.
+  forall (l:Rlist) (i:nat) (a:R),
+    (i < pred (Rlength l))%nat ->
+    pos_Rl (mid_Rlist l a) (S i) = (pos_Rl l i + pos_Rl l (S i)) / 2.
+Proof.
+  simple induction l.
+  intros; simpl in H; elim (lt_n_O _ H).
+  simple induction r0.
+  intros; simpl in H0; elim (lt_n_O _ H0).
+  intros; simpl in H1; induction  i as [| i Hreci].
+  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) 
+    in |- *; apply H0; simpl in |- *; apply lt_S_n; assumption.
 Qed.
 
 Lemma RList_P14 : forall (l:Rlist) (a:R), Rlength (mid_Rlist l a) = Rlength l.
-simple induction l; intros;
- [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ].
+Proof.
+  simple induction l; intros;
+    [ reflexivity | simpl in |- *; rewrite (H r); reflexivity ].
 Qed.
 
 Lemma RList_P15 :
- forall l1 l2:Rlist,
-   ordered_Rlist l1 ->
-   ordered_Rlist l2 ->
-   pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0.
-intros; apply Rle_antisym.
-induction  l1 as [| r l1 Hrecl1];
- [ simpl in |- *; simpl in H1; right; symmetry  in |- *; 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 as [| r l1 Hrecl1];
- [ simpl in |- *; 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 0%nat; split;
-       [ reflexivity | rewrite RList_P11; simpl in |- *; 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 ] ] ].
+  forall l1 l2:Rlist,
+    ordered_Rlist l1 ->
+    ordered_Rlist l2 ->
+    pos_Rl l1 0 = pos_Rl l2 0 -> pos_Rl (cons_ORlist l1 l2) 0 = pos_Rl l1 0.
+Proof.
+  intros; apply Rle_antisym.
+  induction  l1 as [| r l1 Hrecl1];
+    [ simpl in |- *; simpl in H1; right; symmetry  in |- *; 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 as [| r l1 Hrecl1];
+    [ simpl in |- *; 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 0%nat; split;
+            [ reflexivity | rewrite RList_P11; simpl in |- *; 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 :
- forall 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 as [| r l1 Hrecl1].
-simpl in |- *; simpl in H1; right; symmetry  in |- *; 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 in |- *; apply lt_n_Sn ]
- | elim
-    (RList_P9 (cons r l1) l2
-       (pos_Rl (cons_ORlist (cons r l1) l2)
+  forall 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)).
+Proof.
+  intros; apply Rle_antisym.
+  induction  l1 as [| r l1 Hrecl1].
+  simpl in |- *; simpl in H1; right; symmetry  in |- *; 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; assert (H5 := H3 H2); elim H5; intro;
-    [ apply RList_P7; assumption | rewrite H1; apply RList_P7; assumption ] ].
-induction  l1 as [| r l1 Hrecl1].
-simpl in |- *; simpl in H1; right; assumption.
-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)) in |- *;
-    elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); 
-    intros; apply H5; exists (Rlength l1); split;
-    [ reflexivity | simpl in |- *; apply lt_n_Sn ]
- | 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 in |- *; apply lt_n_Sn ] ] ].
+      intros; apply H3; exists (pred (Rlength (cons_ORlist (cons r l1) l2)));
+        split; [ reflexivity | rewrite RList_P11; simpl in |- *; 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 as [| r l1 Hrecl1].
+  simpl in |- *; 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)) in |- *;
+          elim (RList_P3 (cons r l1) (pos_Rl (cons r l1) (Rlength l1))); 
+            intros; apply H5; exists (Rlength l1); split;
+              [ reflexivity | simpl in |- *; apply lt_n_Sn ]
+          | 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 in |- *; apply lt_n_Sn ] ] ].
 Qed.
 
 Lemma RList_P17 :
- forall (l1:Rlist) (x:R) (i:nat),
-   ordered_Rlist l1 ->
-   In x l1 ->
-   pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x.
-simple induction l1.
-intros; elim H0.
-intros; induction  i as [| i Hreci].
-simpl in |- *; elim H1; intro;
- [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2)
- | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ].
-simpl in |- *; simpl in H2; elim H1; intro.
-rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i);
- [ apply Rle_trans with (pos_Rl r0 0);
-    [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt;
-       red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
-    | 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_irrefl _ (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 0%nat; apply neq_O_lt; red in |- *; intro;
-       rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ].
+  forall (l1:Rlist) (x:R) (i:nat),
+    ordered_Rlist l1 ->
+    In x l1 ->
+    pos_Rl l1 i < x -> (i < pred (Rlength l1))%nat -> pos_Rl l1 (S i) <= x.
+Proof.
+  simple induction l1.
+  intros; elim H0.
+  intros; induction  i as [| i Hreci].
+  simpl in |- *; elim H1; intro;
+    [ simpl in H2; rewrite H4 in H2; elim (Rlt_irrefl _ H2)
+      | apply RList_P5; [ apply RList_P4 with r; assumption | assumption ] ].
+  simpl in |- *; simpl in H2; elim H1; intro.
+  rewrite H4 in H2; assert (H5 : r <= pos_Rl r0 i);
+    [ apply Rle_trans with (pos_Rl r0 0);
+      [ apply (H0 0%nat); simpl in |- *; simpl in H3; apply neq_O_lt;
+        red in |- *; intro; rewrite <- H5 in H3; elim (lt_n_O _ H3)
+        | 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_irrefl _ (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 0%nat; apply neq_O_lt; red in |- *; intro;
+            rewrite <- H5 in H3; elim (lt_n_O _ H3) ] ].
 Qed.
 
 Lemma RList_P18 :
- forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l.
-simple induction l; intros;
- [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
+  forall (l:Rlist) (f:R -> R), Rlength (app_Rlist l f) = Rlength l.
+Proof.
+  simple induction l; intros;
+    [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P19 :
- forall l:Rlist,
-   l <> nil ->  exists r : R, (exists r0 : Rlist, l = cons r r0).
-intros; induction  l as [| r l Hrecl];
- [ elim H; reflexivity | exists r; exists l; reflexivity ].
+  forall l:Rlist,
+    l <> nil ->  exists r : R, (exists r0 : Rlist, l = cons r r0).
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ elim H; reflexivity | exists r; exists l; reflexivity ].
 Qed.
 
 Lemma RList_P20 :
- forall l:Rlist,
-   (2 <= Rlength l)%nat ->
+  forall l:Rlist,
+    (2 <= Rlength l)%nat ->
     exists r : R,
-     (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). 
-intros; induction  l as [| r l Hrecl];
- [ simpl in H; elim (le_Sn_O _ H)
- | induction  l as [| r0 l Hrecl0];
-    [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H))
-    | exists r; exists r0; exists l; reflexivity ] ].
+      (exists r1 : R, (exists l' : Rlist, l = cons r (cons r1 l'))). 
+Proof.
+  intros; induction  l as [| r l Hrecl];
+    [ simpl in H; elim (le_Sn_O _ H)
+      | induction  l as [| r0 l Hrecl0];
+        [ simpl in H; elim (le_Sn_O _ (le_S_n _ _ H))
+          | exists r; exists r0; exists l; reflexivity ] ].
 Qed.
 
 Lemma RList_P21 : forall l l':Rlist, l = l' -> Rtail l = Rtail l'.
-intros; rewrite H; reflexivity.
+Proof.
+  intros; rewrite H; reflexivity.
 Qed.
 
 Lemma RList_P22 :
- forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0.
-simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ].
+  forall l1 l2:Rlist, l1 <> nil -> pos_Rl (cons_Rlist l1 l2) 0 = pos_Rl l1 0.
+Proof.
+  simple induction l1; [ intros; elim H; reflexivity | intros; reflexivity ].
 Qed.
 
 Lemma RList_P23 :
- forall l1 l2:Rlist,
-   Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
-simple induction l1;
- [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+  forall l1 l2:Rlist,
+    Rlength (cons_Rlist l1 l2) = (Rlength l1 + Rlength l2)%nat.
+Proof.
+  simple induction l1;
+    [ intro; reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P24 :
- forall l1 l2:Rlist,
-   l2 <> nil ->
-   pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) =
-   pos_Rl l2 (pred (Rlength l2)).
-simple induction l1.
-intros; reflexivity.
-intros; rewrite <- (H l2 H0); induction  l2 as [| r1 l2 Hrecl2].
-elim H0; reflexivity.
-do 2 rewrite RList_P23;
- replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with
-  (S (S (Rlength r0 + Rlength l2)));
- [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with
-    (S (Rlength r0 + Rlength l2));
-    [ reflexivity
-    | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
-       rewrite S_INR; ring ]
- | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
-    rewrite S_INR; ring ].
+  forall l1 l2:Rlist,
+    l2 <> nil ->
+    pos_Rl (cons_Rlist l1 l2) (pred (Rlength (cons_Rlist l1 l2))) =
+    pos_Rl l2 (pred (Rlength l2)).
+Proof.
+  simple induction l1.
+  intros; reflexivity.
+  intros; rewrite <- (H l2 H0); induction  l2 as [| r1 l2 Hrecl2].
+  elim H0; reflexivity.
+  do 2 rewrite RList_P23;
+    replace (Rlength (cons r r0) + Rlength (cons r1 l2))%nat with
+    (S (S (Rlength r0 + Rlength l2)));
+    [ replace (Rlength r0 + Rlength (cons r1 l2))%nat with
+      (S (Rlength r0 + Rlength l2));
+      [ reflexivity
+        | simpl in |- *; apply INR_eq; rewrite S_INR; do 2 rewrite plus_INR;
+          rewrite S_INR; ring ]
+      | simpl in |- *; apply INR_eq; do 3 rewrite S_INR; do 2 rewrite plus_INR;
+        rewrite S_INR; ring ].
 Qed.
 
 Lemma RList_P25 :
- forall l1 l2:Rlist,
-   ordered_Rlist l1 ->
-   ordered_Rlist l2 ->
-   pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 ->
-   ordered_Rlist (cons_Rlist l1 l2).
-simple induction l1.
-intros; simpl in |- *; assumption.
-simple induction r0.
-intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros;
- simpl in H3.
-induction  i as [| i Hreci].
-simpl in |- *; assumption.
-change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n;
- replace (S (pred (Rlength l2))) with (Rlength l2);
- [ assumption
- | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
-    rewrite <- H4 in H3; elim (lt_n_O _ H3) ].
-intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
-apply H0; try assumption.
-apply RList_P4 with r; assumption.
-unfold ordered_Rlist in |- *; intros; simpl in H4;
- induction  i as [| i Hreci].
-simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn.
-change
-  (pos_Rl (cons_Rlist (cons r1 r2) l2) i <=
-   pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; 
- apply (H i); simpl in |- *; apply lt_S_n; assumption.
+  forall l1 l2:Rlist,
+    ordered_Rlist l1 ->
+    ordered_Rlist l2 ->
+    pos_Rl l1 (pred (Rlength l1)) <= pos_Rl l2 0 ->
+    ordered_Rlist (cons_Rlist l1 l2).
+Proof.
+  simple induction l1.
+  intros; simpl in |- *; assumption.
+  simple induction r0.
+  intros; simpl in |- *; simpl in H2; unfold ordered_Rlist in |- *; intros;
+    simpl in H3.
+  induction  i as [| i Hreci].
+  simpl in |- *; assumption.
+  change (pos_Rl l2 i <= pos_Rl l2 (S i)) in |- *; apply (H1 i); apply lt_S_n;
+    replace (S (pred (Rlength l2))) with (Rlength l2);
+    [ assumption
+      | apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+        rewrite <- H4 in H3; elim (lt_n_O _ H3) ].
+  intros; clear H; assert (H : ordered_Rlist (cons_Rlist (cons r1 r2) l2)).
+  apply H0; try assumption.
+  apply RList_P4 with r; assumption.
+  unfold ordered_Rlist in |- *; intros; simpl in H4;
+    induction  i as [| i Hreci].
+  simpl in |- *; apply (H1 0%nat); simpl in |- *; apply lt_O_Sn.
+  change
+    (pos_Rl (cons_Rlist (cons r1 r2) l2) i <=
+      pos_Rl (cons_Rlist (cons r1 r2) l2) (S i)) in |- *; 
+    apply (H i); simpl in |- *; apply lt_S_n; assumption.
 Qed.
 
 Lemma RList_P26 :
- forall (l1 l2:Rlist) (i:nat),
-   (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i.
-simple induction l1.
-intros; elim (lt_n_O _ H).
-intros; induction  i as [| i Hreci].
-apply RList_P22; discriminate.
-apply (H l2 i); simpl in H0; apply lt_S_n; assumption.
+  forall (l1 l2:Rlist) (i:nat),
+    (i < Rlength l1)%nat -> pos_Rl (cons_Rlist l1 l2) i = pos_Rl l1 i.
+Proof.
+  simple induction l1.
+  intros; elim (lt_n_O _ H).
+  intros; induction  i as [| i Hreci].
+  apply RList_P22; discriminate.
+  apply (H l2 i); simpl in H0; apply lt_S_n; assumption.
 Qed.
 
 Lemma RList_P27 :
- forall l1 l2 l3:Rlist,
-   cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3.
-simple induction l1; intros;
- [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ].
+  forall l1 l2 l3:Rlist,
+    cons_Rlist l1 (cons_Rlist l2 l3) = cons_Rlist (cons_Rlist l1 l2) l3.
+Proof.
+  simple induction l1; intros;
+    [ reflexivity | simpl in |- *; rewrite (H l2 l3); reflexivity ].
 Qed.
 
 Lemma RList_P28 : forall l:Rlist, cons_Rlist l nil = l.
-simple induction l;
- [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
+Proof.
+  simple induction l;
+    [ reflexivity | intros; simpl in |- *; rewrite H; reflexivity ].
 Qed.
 
 Lemma RList_P29 :
- forall (l2 l1:Rlist) (i:nat),
-   (Rlength l1 <= i)%nat ->
-   (i < Rlength (cons_Rlist l1 l2))%nat ->
-   pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1).
-simple induction l2.
-intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (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 in |- *; rewrite RList_P26.
-clear l2 r0 H i H0 H1 H2; induction  l1 as [| r0 l1 Hrecl1].
-reflexivity.
-simpl in |- *; assumption.
-rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn.
-replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))).
-rewrite H3; simpl in |- *;
- replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
-apply (H (cons_Rlist l1 (cons r nil)) i).
-rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3;
- apply le_n_S; assumption.
-repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1;
- rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1));
- simpl in |- *; rewrite plus_comm; apply H1.
-rewrite RList_P23; rewrite plus_comm; reflexivity.
-change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *;
- apply minus_Sn_m; assumption.
-replace (cons r r0) with (cons_Rlist (cons r nil) r0);
- [ symmetry  in |- *; apply RList_P27 | reflexivity ].
+  forall (l2 l1:Rlist) (i:nat),
+    (Rlength l1 <= i)%nat ->
+    (i < Rlength (cons_Rlist l1 l2))%nat ->
+    pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (i - Rlength l1).
+Proof.
+  simple induction l2.
+  intros; rewrite RList_P28 in H0; elim (lt_irrefl _ (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 in |- *; rewrite RList_P26.
+  clear l2 r0 H i H0 H1 H2; induction  l1 as [| r0 l1 Hrecl1].
+  reflexivity.
+  simpl in |- *; assumption.
+  rewrite RList_P23; rewrite plus_comm; simpl in |- *; apply lt_n_Sn.
+  replace (S m - Rlength l1)%nat with (S (S m - S (Rlength l1))).
+  rewrite H3; simpl in |- *;
+    replace (S (Rlength l1)) with (Rlength (cons_Rlist l1 (cons r nil))).
+  apply (H (cons_Rlist l1 (cons r nil)) i).
+  rewrite RList_P23; rewrite plus_comm; simpl in |- *; rewrite <- H3;
+    apply le_n_S; assumption.
+  repeat rewrite RList_P23; simpl in |- *; rewrite RList_P23 in H1;
+    rewrite plus_comm in H1; simpl in H1; rewrite (plus_comm (Rlength l1));
+      simpl in |- *; rewrite plus_comm; apply H1.
+  rewrite RList_P23; rewrite plus_comm; reflexivity.
+  change (S (m - Rlength l1) = (S m - Rlength l1)%nat) in |- *;
+    apply minus_Sn_m; assumption.
+  replace (cons r r0) with (cons_Rlist (cons r nil) r0);
+  [ symmetry  in |- *; apply RList_P27 | reflexivity ].
 Qed.
diff --git a/theories/Reals/R_Ifp.v b/theories/Reals/R_Ifp.v
index 97355238..82d7bebd 100644
--- a/theories/Reals/R_Ifp.v
+++ b/theories/Reals/R_Ifp.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_Ifp.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: R_Ifp.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (**********************************************************)
 (** Complements for the reals.Integer and fractional part *)
@@ -18,7 +18,7 @@ Require Import Omega.
 Open Local Scope R_scope.
 
 (*********************************************************)
-(**      Fractional part                                 *)
+(** *    Fractional part                                 *)
 (*********************************************************)
 
 (**********)
@@ -29,517 +29,534 @@ Definition frac_part (r:R) : R := r - IZR (Int_part r).
 
 (**********)
 Lemma tech_up : forall (r:R) (z:Z), r < IZR z -> IZR z <= r + 1 -> z = up r.
-intros; generalize (archimed r); intro; elim H1; intros; clear H1;
- unfold Rgt in H2; unfold Rminus in H3;
- generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); 
- intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1;
- rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1;
- rewrite (Rplus_opp_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.
+Proof.
+  intros; generalize (archimed r); intro; elim H1; intros; clear H1;
+    unfold Rgt in H2; unfold Rminus in H3;
+      generalize (Rplus_le_compat_l r (IZR (up r) + - r) 1 H3); 
+        intro; clear H3; rewrite (Rplus_comm (IZR (up r)) (- r)) in H1;
+          rewrite <- (Rplus_assoc r (- r) (IZR (up r))) in H1;
+            rewrite (Rplus_opp_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 :
- forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r.
-intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H;
- rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1;
- cut (1 = IZR 1); auto with zarith real.
-intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1;
- rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1));
- auto with zarith real.
+  forall (r:R) (z:Z), IZR z <= r -> r < IZR (z + 1) -> (z + 1)%Z = up r.
+Proof.
+  intros; generalize (Rplus_le_compat_l 1 (IZR z) r H); intro; clear H;
+    rewrite (Rplus_comm 1 (IZR z)) in H1; rewrite (Rplus_comm 1 r) in H1;
+      cut (1 = IZR 1); auto with zarith real.
+  intro; generalize H1; pattern 1 at 1 in |- *; rewrite H; intro; clear H H1;
+    rewrite <- (plus_IZR z 1) in H2; apply (tech_up r (z + 1));
+      auto with zarith real.
 Qed.
 
 (**********)
 Lemma fp_R0 : frac_part 0 = 0.
-unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros;
- unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); 
- intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; 
- cut (up 0 = 1%Z).
-intro; rewrite H1;
- rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); 
- apply Ropp_0. 
-elim (archimed 0); intros; clear H2; unfold Rgt in H1;
- rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1);
- intro; clear H1; generalize (le_IZR_R1 (up 0) H0); 
- intro; clear H H0; omega.
+Proof.
+  unfold frac_part in |- *; unfold Int_part in |- *; elim (archimed 0); intros;
+    unfold Rminus in |- *; elim (Rplus_ne (- IZR (up 0 - 1))); 
+      intros a b; rewrite b; clear a b; rewrite <- Z_R_minus; 
+        cut (up 0 = 1%Z).
+  intro; rewrite H1;
+    rewrite (Rminus_diag_eq (IZR 1) (IZR 1) (refl_equal (IZR 1))); 
+      apply Ropp_0. 
+  elim (archimed 0); intros; clear H2; unfold Rgt in H1;
+    rewrite (Rminus_0_r (IZR (up 0))) in H0; generalize (lt_O_IZR (up 0) H1);
+      intro; clear H1; generalize (le_IZR_R1 (up 0) H0); 
+        intro; clear H H0; omega.
 Qed.
 
 (**********)
 Lemma for_base_fp : forall r:R, IZR (up r) - r > 0 /\ IZR (up r) - r <= 1.
-intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1).
-intro; elim H; intros.
-apply (Rgt_minus (IZR (up r)) r H0).
-apply archimed.
-intro; elim H; intros.
-exact H1.
-apply archimed.
+Proof.
+  intro; split; cut (IZR (up r) > r /\ IZR (up r) - r <= 1).
+  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 : forall r:R, frac_part r >= 0 /\ frac_part r < 1.
-intro; unfold frac_part in |- *; unfold Int_part in |- *; split.
+Proof.
+  intro; unfold frac_part in |- *; unfold Int_part in |- *; split.
      (*sup a O*)
-cut (r - IZR (up r) >= -1).
-rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
- rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
- fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *;
- apply Rge_minus; auto with zarith real.
-rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r);
- auto with zarith real.
+  cut (r - IZR (up r) >= -1).
+  rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+    rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+      fold (r - IZR (up r)) in |- *; fold (r - IZR (up r) - -1) in |- *;
+        apply Rge_minus; auto with zarith real.
+  rewrite <- Ropp_minus_distr; apply Ropp_le_ge_contravar; elim (for_base_fp r);
+    auto with zarith real.
     (*inf a 1*) 
-cut (r - IZR (up r) < 0).
-rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
- rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
- fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; 
- elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; 
- rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1);
- apply Rplus_lt_compat_l; auto with zarith real.
-elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr;
- apply Ropp_gt_lt_contravar; auto with zarith real.
+  cut (r - IZR (up r) < 0).
+  rewrite <- Z_R_minus; simpl in |- *; intro; unfold Rminus in |- *;
+    rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+      fold (r - IZR (up r)) in |- *; rewrite Ropp_involutive; 
+        elim (Rplus_ne 1); intros a b; pattern 1 at 2 in |- *; 
+          rewrite <- a; clear a b; rewrite (Rplus_comm (r - IZR (up r)) 1);
+            apply Rplus_lt_compat_l; auto with zarith real.
+  elim (for_base_fp r); intros; rewrite <- Ropp_0; rewrite <- Ropp_minus_distr;
+    apply Ropp_gt_lt_contravar; auto with zarith real.
 Qed.
 
 (*********************************************************)
-(**      Properties                                      *)
+(** *    Properties                                      *)
 (*********************************************************)
 
 (**********)
 Lemma base_Int_part :
- forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. 
-intro; unfold Int_part in |- *; elim (archimed r); intros.
-split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *.
-generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1;
- rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1;
- rewrite (Rplus_comm (- r) (-1)) in H1;
- rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1;
- fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1;
- apply Rminus_le; auto with zarith real.
-generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro;
- rewrite (Rplus_comm (-1) (IZR (up r))) in H1;
- generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); 
- intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2;
- fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2;
- rewrite (Rplus_comm (- r) (-1 + r)) in H2;
- rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2;
- elim (Rplus_ne (-1)); intros a b; rewrite a in H2; 
- clear a b; auto with zarith real.  
+  forall r:R, IZR (Int_part r) <= r /\ IZR (Int_part r) - r > -1. 
+Proof.
+  intro; unfold Int_part in |- *; elim (archimed r); intros.
+  split; rewrite <- (Z_R_minus (up r) 1); simpl in |- *.
+  generalize (Rle_minus (IZR (up r) - r) 1 H0); intro; unfold Rminus in H1;
+    rewrite (Rplus_assoc (IZR (up r)) (- r) (-1)) in H1;
+      rewrite (Rplus_comm (- r) (-1)) in H1;
+        rewrite <- (Rplus_assoc (IZR (up r)) (-1) (- r)) in H1;
+          fold (IZR (up r) - 1) in H1; fold (IZR (up r) - 1 - r) in H1;
+            apply Rminus_le; auto with zarith real.
+  generalize (Rplus_gt_compat_l (-1) (IZR (up r)) r H); intro;
+    rewrite (Rplus_comm (-1) (IZR (up r))) in H1;
+      generalize (Rplus_gt_compat_l (- r) (IZR (up r) + -1) (-1 + r) H1); 
+        intro; clear H H0 H1; rewrite (Rplus_comm (- r) (IZR (up r) + -1)) in H2;
+          fold (IZR (up r) - 1) in H2; fold (IZR (up r) - 1 - r) in H2;
+            rewrite (Rplus_comm (- r) (-1 + r)) in H2;
+              rewrite (Rplus_assoc (-1) r (- r)) in H2; rewrite (Rplus_opp_r r) in H2;
+                elim (Rplus_ne (-1)); intros a b; rewrite a in H2; 
+                  clear a b; auto with zarith real.  
 Qed.
 
 (**********)
 Lemma Int_part_INR : forall n:nat, Int_part (INR n) = Z_of_nat n.
-intros n; unfold Int_part in |- *.
-cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z).
-intros H'; rewrite H'; simpl in |- *; ring.
-apply sym_equal; apply tech_up; auto.
-replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)).
-repeat rewrite <- INR_IZR_INZ.
-apply lt_INR; auto.
-rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto.
-rewrite plus_IZR; simpl in |- *; auto with real.
-repeat rewrite <- INR_IZR_INZ; auto with real.
+Proof.
+  intros n; unfold Int_part in |- *.
+  cut (up (INR n) = (Z_of_nat n + Z_of_nat 1)%Z).
+  intros H'; rewrite H'; simpl in |- *; ring.
+  apply sym_equal; apply tech_up; auto.
+  replace (Z_of_nat n + Z_of_nat 1)%Z with (Z_of_nat (S n)).
+  repeat rewrite <- INR_IZR_INZ.
+  apply lt_INR; auto.
+  rewrite Zplus_comm; rewrite <- Znat.inj_plus; simpl in |- *; auto.
+  rewrite plus_IZR; simpl in |- *; auto with real.
+  repeat rewrite <- INR_IZR_INZ; auto with real.
 Qed.
 
 (**********)
 Lemma fp_nat : forall r:R, frac_part r = 0 ->  exists c : Z, r = IZR c.
-unfold frac_part in |- *; intros; split with (Int_part r);
- apply Rminus_diag_uniq; auto with zarith real.
+Proof.
+  unfold frac_part in |- *; intros; split with (Int_part r);
+    apply Rminus_diag_uniq; auto with zarith real.
 Qed.
 
 (**********)
 Lemma R0_fp_O : forall r:R, 0 <> frac_part r -> 0 <> r.
-red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro;
- auto with zarith real.
+Proof.
+  red in |- *; intros; rewrite <- H0 in H; generalize fp_R0; intro;
+    auto with zarith real.
 Qed.
 
 (**********)
 Lemma Rminus_Int_part1 :
- forall r1 r2:R,
-   frac_part r1 >= frac_part r2 ->
-   Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z.
-intros; elim (base_fp r1); elim (base_fp r2); intros;
- generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
- generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); 
- intro; clear H4; rewrite Ropp_0 in H0;
- generalize (Rge_le 0 (- frac_part r2) H0); intro; 
- clear H0; generalize (Rge_le (frac_part r1) 0 H2); 
- intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
- intro; clear H1; unfold Rgt in H2;
- generalize
-  (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
- intro; elim H1; intros; clear H1; elim (Rplus_ne 1); 
- 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 (frac_part r1 - frac_part r2) in H6;
- generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); 
- intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H;
- unfold Rminus in H6, H;
- rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H;
- rewrite (Ropp_involutive (IZR (Int_part r2))) in H;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
-   in H;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
-   in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H;
- rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
-   in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H;
- generalize
-  (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0
-     (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); 
- intro; clear H;
- rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
-     (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
-   in H0; unfold Rminus in H0; fold (r1 - r2) in H0;
- rewrite
-  (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
-     (IZR (Int_part r2) + - IZR (Int_part r1))) in H0;
- rewrite <-
-  (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
-     (- IZR (Int_part r1))) in H0;
- rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0;
- elim (Rplus_ne (- IZR (Int_part r1))); intros a b; 
- rewrite b in H0; clear a b;
- elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); 
- intros a b; rewrite a in H0; clear a b;
- rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2));
- intros a b; rewrite b in H0; clear a b;
- fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0;
- rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6;
- rewrite (Ropp_involutive (IZR (Int_part r2))) in H6;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
-   in H6;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
-   in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6;
- rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
- rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
-   in H6;
- rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
- fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6;
- generalize
-  (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
-     (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); 
- intro; clear H6;
- rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
-     (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
-   in H;
- rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H;
- elim (Rplus_ne (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 (1 = 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 (r1 - r2) (Int_part r1 - Int_part r2) H0 H); 
- intros; clear H H0; unfold Int_part at 1 in |- *; 
- omega.
+  forall r1 r2:R,
+    frac_part r1 >= frac_part r2 ->
+    Int_part (r1 - r2) = (Int_part r1 - Int_part r2)%Z.
+Proof.
+  intros; elim (base_fp r1); elim (base_fp r2); intros;
+    generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+      generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); 
+        intro; clear H4; rewrite Ropp_0 in H0;
+          generalize (Rge_le 0 (- frac_part r2) H0); intro; 
+            clear H0; generalize (Rge_le (frac_part r1) 0 H2); 
+              intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
+                intro; clear H1; unfold Rgt in H2;
+                  generalize
+                    (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
+                    intro; elim H1; intros; clear H1; elim (Rplus_ne 1); 
+                      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 (frac_part r1 - frac_part r2) in H6;
+                            generalize (Rge_le (frac_part r1 - frac_part r2) 0 H1); 
+                              intro; clear H1 H3 H4 H0 H2; unfold frac_part in H6, H;
+                                unfold Rminus in H6, H;
+                                  rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H;
+                                    rewrite (Ropp_involutive (IZR (Int_part r2))) in H;
+                                      rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+                                        in H;
+                                        rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+                                          in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H;
+                                            rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+                                              rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+                                                in H; rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+                                                  fold (r1 - r2) in H; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H;
+                                                    generalize
+                                                      (Rplus_le_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) 0
+                                                        (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H); 
+                                                      intro; clear H;
+                                                        rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
+                                                          rewrite <-
+                                                            (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+                                                              (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+                                                            in H0; unfold Rminus in H0; fold (r1 - r2) in H0;
+                                                              rewrite
+                                                                (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
+                                                                  (IZR (Int_part r2) + - IZR (Int_part r1))) in H0;
+                                                                rewrite <-
+                                                                  (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
+                                                                    (- IZR (Int_part r1))) in H0;
+                                                                  rewrite (Rplus_opp_l (IZR (Int_part r2))) in H0;
+                                                                    elim (Rplus_ne (- IZR (Int_part r1))); intros a b; 
+                                                                      rewrite b in H0; clear a b;
+                                                                        elim (Rplus_ne (IZR (Int_part r1) + - IZR (Int_part r2))); 
+                                                                          intros a b; rewrite a in H0; clear a b;
+                                                                            rewrite (Rplus_opp_r (IZR (Int_part r1))) in H0; elim (Rplus_ne (r1 - r2));
+                                                                              intros a b; rewrite b in H0; clear a b;
+                                                                                fold (IZR (Int_part r1) - IZR (Int_part r2)) in H0;
+                                                                                  rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H6;
+                                                                                    rewrite (Ropp_involutive (IZR (Int_part r2))) in H6;
+                                                                                      rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+                                                                                        in H6;
+                                                                                        rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+                                                                                          in H6; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H6;
+                                                                                            rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
+                                                                                              rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+                                                                                                in H6;
+                                                                                                rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H6;
+                                                                                                  fold (r1 - r2) in H6; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H6;
+                                                                                                    generalize
+                                                                                                      (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
+                                                                                                        (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 1 H6); 
+                                                                                                      intro; clear H6;
+                                                                                                        rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
+                                                                                                          rewrite <-
+                                                                                                            (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+                                                                                                              (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+                                                                                                            in H;
+                                                                                                            rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+                                                                                                              rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H;
+                                                                                                                elim (Rplus_ne (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 (1 = 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 (r1 - r2) (Int_part r1 - Int_part r2) H0 H); 
+        intros; clear H H0; unfold Int_part at 1 in |- *; 
+          omega.
 Qed.
 
 (**********)
 Lemma Rminus_Int_part2 :
- forall r1 r2:R,
-   frac_part r1 < frac_part r2 ->
-   Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z.
-intros; elim (base_fp r1); elim (base_fp r2); intros;
- generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
- generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); 
- intro; clear H4; rewrite Ropp_0 in H0;
- generalize (Rge_le 0 (- frac_part r2) H0); intro; 
- clear H0; generalize (Rge_le (frac_part r1) 0 H2); 
- intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
- intro; clear H1; unfold Rgt in H2;
- generalize
-  (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
- intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); 
- 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 (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_plus_distr r2 (- IZR (Int_part r2))) in H5;
- rewrite (Ropp_involutive (IZR (Int_part r2))) in H5;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
-   in H5;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
-   in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5;
- rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
- rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
-   in H5;
- rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
- fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5;
- generalize
-  (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1)
-     (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); 
- intro; clear H5;
- rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
-     (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
-   in H; unfold Rminus in H; fold (r1 - r2) in H;
- rewrite
-  (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
-     (IZR (Int_part r2) + - IZR (Int_part r1))) in H;
- rewrite <-
-  (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
-     (- IZR (Int_part r1))) in H;
- rewrite (Rplus_opp_l (IZR (Int_part r2))) in H;
- elim (Rplus_ne (- IZR (Int_part r1))); intros a b; 
- rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H;
- elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; 
- clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H;
- fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H;
- rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1;
- rewrite (Ropp_involutive (IZR (Int_part r2))) in H1;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
-   in H1;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
-   in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1;
- rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
-   in H1;
- rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1;
- generalize
-  (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
-     (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); 
- intro; clear H1;
- rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
-     (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
-   in H0;
- rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0;
- elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; 
- clear a b; rewrite <- (Rplus_opp_l 1) in H0;
- rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1)
-   in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) 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 (1 = 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)) (r1 - r2) H); 
- intro; clear H;
- generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); 
- intros; clear H0 H1; unfold Int_part at 1 in |- *; 
- omega.
+  forall r1 r2:R,
+    frac_part r1 < frac_part r2 ->
+    Int_part (r1 - r2) = (Int_part r1 - Int_part r2 - 1)%Z.
+Proof.
+  intros; elim (base_fp r1); elim (base_fp r2); intros;
+    generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+      generalize (Ropp_le_ge_contravar 0 (frac_part r2) H4); 
+        intro; clear H4; rewrite Ropp_0 in H0;
+          generalize (Rge_le 0 (- frac_part r2) H0); intro; 
+            clear H0; generalize (Rge_le (frac_part r1) 0 H2); 
+              intro; clear H2; generalize (Ropp_lt_gt_contravar (frac_part r2) 1 H1);
+                intro; clear H1; unfold Rgt in H2;
+                  generalize
+                    (sum_inequa_Rle_lt 0 (frac_part r1) 1 (-1) (- frac_part r2) 0 H0 H3 H2 H4);
+                    intro; elim H1; intros; clear H1; elim (Rplus_ne (-1)); 
+                      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 (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_plus_distr r2 (- IZR (Int_part r2))) in H5;
+                                rewrite (Ropp_involutive (IZR (Int_part r2))) in H5;
+                                  rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+                                    in H5;
+                                    rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+                                      in H5; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H5;
+                                        rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
+                                          rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+                                            in H5;
+                                            rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H5;
+                                              fold (r1 - r2) in H5; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H5;
+                                                generalize
+                                                  (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2)) (-1)
+                                                    (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) H5); 
+                                                  intro; clear H5;
+                                                    rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H;
+                                                      rewrite <-
+                                                        (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+                                                          (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+                                                        in H; unfold Rminus in H; fold (r1 - r2) in H;
+                                                          rewrite
+                                                            (Rplus_assoc (IZR (Int_part r1)) (- IZR (Int_part r2))
+                                                              (IZR (Int_part r2) + - IZR (Int_part r1))) in H;
+                                                            rewrite <-
+                                                              (Rplus_assoc (- IZR (Int_part r2)) (IZR (Int_part r2))
+                                                                (- IZR (Int_part r1))) in H;
+                                                              rewrite (Rplus_opp_l (IZR (Int_part r2))) in H;
+                                                                elim (Rplus_ne (- IZR (Int_part r1))); intros a b; 
+                                                                  rewrite b in H; clear a b; rewrite (Rplus_opp_r (IZR (Int_part r1))) in H;
+                                                                    elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H; 
+                                                                      clear a b; fold (IZR (Int_part r1) - IZR (Int_part r2)) in H;
+                                                                        fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) in H;
+                                                                          rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2))) in H1;
+                                                                            rewrite (Ropp_involutive (IZR (Int_part r2))) in H1;
+                                                                              rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)))
+                                                                                in H1;
+                                                                                rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)))
+                                                                                  in H1; rewrite (Rplus_comm (- IZR (Int_part r1)) (- r2)) in H1;
+                                                                                    rewrite (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+                                                                                      rewrite <- (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)))
+                                                                                        in H1;
+                                                                                        rewrite (Rplus_comm (- IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+                                                                                          fold (r1 - r2) in H1; fold (IZR (Int_part r2) - IZR (Int_part r1)) in H1;
+                                                                                            generalize
+                                                                                              (Rplus_lt_compat_l (IZR (Int_part r1) - IZR (Int_part r2))
+                                                                                                (r1 - r2 + (IZR (Int_part r2) - IZR (Int_part r1))) 0 H1); 
+                                                                                              intro; clear H1;
+                                                                                                rewrite (Rplus_comm (r1 - r2) (IZR (Int_part r2) - IZR (Int_part r1))) in H0;
+                                                                                                  rewrite <-
+                                                                                                    (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2))
+                                                                                                      (IZR (Int_part r2) - IZR (Int_part r1)) (r1 - r2))
+                                                                                                    in H0;
+                                                                                                    rewrite <- (Ropp_minus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+                                                                                                      rewrite (Rplus_opp_r (IZR (Int_part r1) - IZR (Int_part r2))) in H0;
+                                                                                                        elim (Rplus_ne (r1 - r2)); intros a b; rewrite b in H0; 
+                                                                                                          clear a b; rewrite <- (Rplus_opp_l 1) in H0;
+                                                                                                            rewrite <- (Rplus_assoc (IZR (Int_part r1) - IZR (Int_part r2)) (-1) 1)
+                                                                                                              in H0; fold (IZR (Int_part r1) - IZR (Int_part r2) - 1) 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 (1 = 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)) (r1 - r2) H); 
+            intro; clear H;
+              generalize (up_tech (r1 - r2) (Int_part r1 - Int_part r2 - 1) H1 H0); 
+                intros; clear H0 H1; unfold Int_part at 1 in |- *; 
+                  omega.
 Qed.
 
 (**********)
 Lemma Rminus_fp1 :
- forall r1 r2:R,
-   frac_part r1 >= frac_part r2 ->
-   frac_part (r1 - r2) = frac_part r1 - frac_part r2.
-intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H);
- intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
- unfold Rminus in |- *;
- rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2)));
- rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
- rewrite (Ropp_involutive (IZR (Int_part r2)));
- rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
- rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); 
- auto with zarith real.
+  forall r1 r2:R,
+    frac_part r1 >= frac_part r2 ->
+    frac_part (r1 - r2) = frac_part r1 - frac_part r2.
+Proof.
+  intros; unfold frac_part in |- *; generalize (Rminus_Int_part1 r1 r2 H);
+    intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1) (Int_part r2));
+      unfold Rminus in |- *;
+        rewrite (Ropp_plus_distr (IZR (Int_part r1)) (- IZR (Int_part r2)));
+          rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
+            rewrite (Ropp_involutive (IZR (Int_part r2)));
+              rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
+                rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
+                  rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
+                    rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
+                      rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); 
+                        auto with zarith real.
 Qed.
 
 (**********)
 Lemma Rminus_fp2 :
- forall r1 r2:R,
-   frac_part r1 < frac_part r2 ->
-   frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1.
-intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H);
- intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1);
- rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); 
- unfold Rminus in |- *;
- rewrite
-  (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1))
-  ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
- rewrite (Ropp_involutive (IZR 1));
- rewrite (Ropp_involutive (IZR (Int_part r2)));
- rewrite (Ropp_plus_distr (IZR (Int_part r1)));
- rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *;
- rewrite <-
-  (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1)
-  ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
- rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); 
- auto with zarith real.
+  forall r1 r2:R,
+    frac_part r1 < frac_part r2 ->
+    frac_part (r1 - r2) = frac_part r1 - frac_part r2 + 1.
+Proof.
+  intros; unfold frac_part in |- *; generalize (Rminus_Int_part2 r1 r2 H);
+    intro; rewrite H0; rewrite <- (Z_R_minus (Int_part r1 - Int_part r2) 1);
+      rewrite <- (Z_R_minus (Int_part r1) (Int_part r2)); 
+        unfold Rminus in |- *;
+          rewrite
+            (Ropp_plus_distr (IZR (Int_part r1) + - IZR (Int_part r2)) (- IZR 1))
+            ; rewrite (Ropp_plus_distr r2 (- IZR (Int_part r2)));
+              rewrite (Ropp_involutive (IZR 1));
+                rewrite (Ropp_involutive (IZR (Int_part r2)));
+                  rewrite (Ropp_plus_distr (IZR (Int_part r1)));
+                    rewrite (Ropp_involutive (IZR (Int_part r2))); simpl in |- *;
+                      rewrite <-
+                        (Rplus_assoc (r1 + - r2) (- IZR (Int_part r1) + IZR (Int_part r2)) 1)
+                        ; rewrite (Rplus_assoc r1 (- r2) (- IZR (Int_part r1) + IZR (Int_part r2)));
+                          rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (- r2 + IZR (Int_part r2)));
+                            rewrite <- (Rplus_assoc (- r2) (- IZR (Int_part r1)) (IZR (Int_part r2)));
+                              rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- r2) (IZR (Int_part r2)));
+                                rewrite (Rplus_comm (- r2) (- IZR (Int_part r1))); 
+                                  auto with zarith real.
 Qed.
 
 (**********)
 Lemma plus_Int_part1 :
- forall r1 r2:R,
-   frac_part r1 + frac_part r2 >= 1 ->
-   Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z.
-intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H;
- elim (base_fp r1); elim (base_fp r2); intros; clear H H2;
- generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); 
- intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); 
- intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2;
- generalize
-  (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); 
- intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1;
- unfold frac_part in H0, H1; unfold Rminus in H0, H1;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
-   in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
-   in H1;
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
-   in H1;
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
-   in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
-   in H0;
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0;
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
-   in H0;
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
- generalize
-  (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1
-     (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); 
- intro; clear H0;
- generalize
-  (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
-     (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); 
- intro; clear H1;
- rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
-   in H;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
-     (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
-   in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H;
- elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; 
- clear a b;
- rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
-   in H0;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
-     (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
-   in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
- elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; 
- clear a b;
- rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0;
- cut (1 = 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 (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); 
- intro; clear H H0; unfold Int_part at 1 in |- *; omega.
+  forall r1 r2:R,
+    frac_part r1 + frac_part r2 >= 1 ->
+    Int_part (r1 + r2) = (Int_part r1 + Int_part r2 + 1)%Z.
+Proof.
+  intros; generalize (Rge_le (frac_part r1 + frac_part r2) 1 H); intro; clear H;
+    elim (base_fp r1); elim (base_fp r2); intros; clear H H2;
+      generalize (Rplus_lt_compat_l (frac_part r2) (frac_part r1) 1 H3); 
+        intro; clear H3; generalize (Rplus_lt_compat_l 1 (frac_part r2) 1 H1); 
+          intro; clear H1; rewrite (Rplus_comm 1 (frac_part r2)) in H2;
+            generalize
+              (Rlt_trans (frac_part r2 + frac_part r1) (frac_part r2 + 1) 2 H H2); 
+              intro; clear H H2; rewrite (Rplus_comm (frac_part r2) (frac_part r1)) in H1;
+                unfold frac_part in H0, H1; unfold Rminus in H0, H1;
+                  rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+                    in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
+                      rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+                        in H1;
+                        rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
+                          rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+                            in H1;
+                            rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+                              rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+                                in H0; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H0;
+                                  rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+                                    in H0;
+                                    rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H0;
+                                      rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+                                        in H0;
+                                        rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H0;
+                                          generalize
+                                            (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 1
+                                              (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H0); 
+                                            intro; clear H0;
+                                              generalize
+                                                (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
+                                                  (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 2 H1); 
+                                                intro; clear H1;
+                                                  rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+                                                    in H;
+                                                    rewrite <-
+                                                      (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+                                                        (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+                                                      in H; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H;
+                                                        elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H; 
+                                                          clear a b;
+                                                            rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+                                                              in H0;
+                                                              rewrite <-
+                                                                (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+                                                                  (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+                                                                in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
+                                                                  elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H0; 
+                                                                    clear a b;
+                                                                      rewrite <- (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2)) 1 1) in H0;
+                                                                        cut (1 = 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 (r1 + r2) (Int_part r1 + Int_part r2 + 1) H H0); 
+                intro; clear H H0; unfold Int_part at 1 in |- *; omega.
 Qed.
 
 (**********)
 Lemma plus_Int_part2 :
- forall r1 r2:R,
-   frac_part r1 + frac_part r2 < 1 ->
-   Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z.
-intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3;
- generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
- generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2;
- generalize (Rplus_le_compat_l (frac_part r1) 0 (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 0 (frac_part r1) (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 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
-   in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
-   in H1;
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
-   in H1;
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
-   in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H;
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H;
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H;
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
-   in H;
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
- generalize
-  (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0
-     (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); 
- intro; clear H1;
- generalize
-  (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
-     (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); 
- intro; clear H;
- rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
-   in H1;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
-     (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
-   in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1;
- elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; 
- clear a b;
- rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
-   in H0;
- rewrite <-
-  (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
-     (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
-   in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
- elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); 
- intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2));
- intros a b; rewrite b in H0; clear a b; cut (1 = 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 (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); 
- intro; clear H0 H1; unfold Int_part at 1 in |- *; 
- omega.
+  forall r1 r2:R,
+    frac_part r1 + frac_part r2 < 1 ->
+    Int_part (r1 + r2) = (Int_part r1 + Int_part r2)%Z.
+Proof.
+  intros; elim (base_fp r1); elim (base_fp r2); intros; clear H1 H3;
+    generalize (Rge_le (frac_part r2) 0 H0); intro; clear H0;
+      generalize (Rge_le (frac_part r1) 0 H2); intro; clear H2;
+        generalize (Rplus_le_compat_l (frac_part r1) 0 (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 0 (frac_part r1) (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 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+                    in H1; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H1;
+                      rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2)
+                        in H1;
+                        rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H1;
+                          rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+                            in H1;
+                            rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H1;
+                              rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)))
+                                in H; rewrite (Rplus_comm r2 (- IZR (Int_part r2))) in H;
+                                  rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2) in H;
+                                    rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2) in H;
+                                      rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)))
+                                        in H;
+                                        rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2))) in H;
+                                          generalize
+                                            (Rplus_le_compat_l (IZR (Int_part r1) + IZR (Int_part r2)) 0
+                                              (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) H1); 
+                                            intro; clear H1;
+                                              generalize
+                                                (Rplus_lt_compat_l (IZR (Int_part r1) + IZR (Int_part r2))
+                                                  (r1 + r2 + - (IZR (Int_part r1) + IZR (Int_part r2))) 1 H); 
+                                                intro; clear H;
+                                                  rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+                                                    in H1;
+                                                    rewrite <-
+                                                      (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+                                                        (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+                                                      in H1; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H1;
+                                                        elim (Rplus_ne (r1 + r2)); intros a b; rewrite b in H1; 
+                                                          clear a b;
+                                                            rewrite (Rplus_comm (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))))
+                                                              in H0;
+                                                              rewrite <-
+                                                                (Rplus_assoc (IZR (Int_part r1) + IZR (Int_part r2))
+                                                                  (- (IZR (Int_part r1) + IZR (Int_part r2))) (r1 + r2))
+                                                                in H0; rewrite (Rplus_opp_r (IZR (Int_part r1) + IZR (Int_part r2))) in H0;
+                                                                  elim (Rplus_ne (IZR (Int_part r1) + IZR (Int_part r2))); 
+                                                                    intros a b; rewrite a in H0; clear a b; elim (Rplus_ne (r1 + r2));
+                                                                      intros a b; rewrite b in H0; clear a b; cut (1 = 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 (r1 + r2) (Int_part r1 + Int_part r2) H0 H1); 
+            intro; clear H0 H1; unfold Int_part at 1 in |- *; 
+              omega.
 Qed.
 
 (**********)
 Lemma plus_frac_part1 :
- forall r1 r2:R,
-   frac_part r1 + frac_part r2 >= 1 ->
-   frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1.
-intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro;
- rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1);
- rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *;
- unfold Rminus at 3 4 in |- *;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
- rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
- unfold Rminus in |- *;
- rewrite
-  (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1))
-  ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1);
- trivial with zarith real.
+  forall r1 r2:R,
+    frac_part r1 + frac_part r2 >= 1 ->
+    frac_part (r1 + r2) = frac_part r1 + frac_part r2 - 1.
+Proof.
+  intros; unfold frac_part in |- *; generalize (plus_Int_part1 r1 r2 H); intro;
+    rewrite H0; rewrite (plus_IZR (Int_part r1 + Int_part r2) 1);
+      rewrite (plus_IZR (Int_part r1) (Int_part r2)); simpl in |- *;
+        unfold Rminus at 3 4 in |- *;
+          rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
+            rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
+              rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
+                rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
+                  rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
+                    rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
+                      unfold Rminus in |- *;
+                        rewrite
+                          (Rplus_assoc (r1 + r2) (- (IZR (Int_part r1) + IZR (Int_part r2))) (-1))
+                          ; rewrite <- (Ropp_plus_distr (IZR (Int_part r1) + IZR (Int_part r2)) 1);
+                            trivial with zarith real.
 Qed.
 
 (**********)
 Lemma plus_frac_part2 :
- forall r1 r2:R,
-   frac_part r1 + frac_part r2 < 1 ->
-   frac_part (r1 + r2) = frac_part r1 + frac_part r2.
-intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro;
- rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2));
- unfold Rminus at 2 3 in |- *;
- rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
- rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
- rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
- rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
- rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
- rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
- unfold Rminus in |- *; trivial with zarith real.
-Qed.
\ No newline at end of file
+  forall r1 r2:R,
+    frac_part r1 + frac_part r2 < 1 ->
+    frac_part (r1 + r2) = frac_part r1 + frac_part r2.
+Proof.
+  intros; unfold frac_part in |- *; generalize (plus_Int_part2 r1 r2 H); intro;
+    rewrite H0; rewrite (plus_IZR (Int_part r1) (Int_part r2));
+      unfold Rminus at 2 3 in |- *;
+        rewrite (Rplus_assoc r1 (- IZR (Int_part r1)) (r2 + - IZR (Int_part r2)));
+          rewrite (Rplus_comm r2 (- IZR (Int_part r2)));
+            rewrite <- (Rplus_assoc (- IZR (Int_part r1)) (- IZR (Int_part r2)) r2);
+              rewrite (Rplus_comm (- IZR (Int_part r1) + - IZR (Int_part r2)) r2);
+                rewrite <- (Rplus_assoc r1 r2 (- IZR (Int_part r1) + - IZR (Int_part r2)));
+                  rewrite <- (Ropp_plus_distr (IZR (Int_part r1)) (IZR (Int_part r2)));
+                    unfold Rminus in |- *; trivial with zarith real.
+Qed.
diff --git a/theories/Reals/R_sqr.v b/theories/Reals/R_sqr.v
index d87adc24..270ea6da 100644
--- a/theories/Reals/R_sqr.v
+++ b/theories/Reals/R_sqr.v
@@ -6,325 +6,359 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqr.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: R_sqr.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rbasic_fun. Open Local Scope R_scope.
 
 (****************************************************)
-(* Rsqr : some results                              *)
+(** Rsqr : some results                             *)
 (****************************************************)
 
 Ltac ring_Rsqr := unfold Rsqr in |- *; ring.
 
 Lemma Rsqr_neg : forall x:R, Rsqr x = Rsqr (- x).
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_mult : forall x y:R, Rsqr (x * y) = Rsqr x * Rsqr y.
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_plus : forall x y:R, Rsqr (x + y) = Rsqr x + Rsqr y + 2 * x * y.
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_minus : forall x y:R, Rsqr (x - y) = Rsqr x + Rsqr y - 2 * x * y.
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_neg_minus : forall x y:R, Rsqr (x - y) = Rsqr (y - x).
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_1 : Rsqr 1 = 1.
-ring_Rsqr.
+Proof.
+  ring_Rsqr.
 Qed.
 
 Lemma Rsqr_gt_0_0 : forall x:R, 0 < Rsqr x -> x <> 0.
-intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H;
- elim (Rlt_irrefl 0 H).
+Proof.
+  intros; red in |- *; intro; rewrite H0 in H; rewrite Rsqr_0 in H;
+    elim (Rlt_irrefl 0 H).
 Qed.
 
 Lemma Rsqr_pos_lt : forall x:R, x <> 0 -> 0 < Rsqr x.
-intros; case (Rtotal_order 0 x); intro;
- [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption
- | elim H0; intro;
-    [ elim H; symmetry  in |- *; exact H1
-    | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1);
-       rewrite Ropp_0; intro; unfold Rsqr in |- *; 
-       apply Rmult_lt_0_compat; assumption ] ].
+Proof.
+  intros; case (Rtotal_order 0 x); intro;
+    [ unfold Rsqr in |- *; apply Rmult_lt_0_compat; assumption
+      | elim H0; intro;
+        [ elim H; symmetry  in |- *; exact H1
+          | rewrite Rsqr_neg; generalize (Ropp_lt_gt_contravar x 0 H1);
+            rewrite Ropp_0; intro; unfold Rsqr in |- *; 
+              apply Rmult_lt_0_compat; assumption ] ].
 Qed.
 
 Lemma Rsqr_div : forall x y:R, y <> 0 -> Rsqr (x / y) = Rsqr x / Rsqr y.
-intros; unfold Rsqr in |- *.
-unfold Rdiv in |- *.
-rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc.
-apply Rmult_eq_compat_l.
-pattern x at 2 in |- *; rewrite Rmult_comm.
-repeat rewrite Rmult_assoc.
-apply Rmult_eq_compat_l.
-reflexivity.
-assumption.
-assumption.
+Proof.
+  intros; unfold Rsqr in |- *.
+  unfold Rdiv in |- *.
+  rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc.
+  apply Rmult_eq_compat_l.
+  pattern x at 2 in |- *; rewrite Rmult_comm.
+  repeat rewrite Rmult_assoc.
+  apply Rmult_eq_compat_l.
+  reflexivity.
+  assumption.
+  assumption.
 Qed.
 
 Lemma Rsqr_eq_0 : forall x:R, Rsqr x = 0 -> x = 0.
-unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro;
- elim H0; intro; assumption.
+Proof.
+  unfold Rsqr in |- *; intros; generalize (Rmult_integral x x H); intro;
+    elim H0; intro; assumption.
 Qed.
 
 Lemma Rsqr_minus_plus : forall a b:R, (a - b) * (a + b) = Rsqr a - Rsqr b.
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_plus_minus : forall a b:R, (a + b) * (a - b) = Rsqr a - Rsqr b.
-intros; ring_Rsqr.
+Proof.
+  intros; ring_Rsqr.
 Qed.
 
 Lemma Rsqr_incr_0 :
- forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y.
-intros; case (Rle_dec x y); intro;
- [ assumption
- | cut (y < x);
-    [ intro; unfold Rsqr in H;
-       generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); 
-       intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); 
-       intro; elim (Rlt_irrefl (x * x) H4)
-    | auto with real ] ].
+  forall x y:R, Rsqr x <= Rsqr y -> 0 <= x -> 0 <= y -> x <= y.
+Proof.
+  intros; case (Rle_dec x y); intro;
+    [ assumption
+      | cut (y < x);
+        [ intro; unfold Rsqr in H;
+          generalize (Rmult_le_0_lt_compat y x y x H1 H1 H2 H2); 
+            intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H3); 
+              intro; elim (Rlt_irrefl (x * x) H4)
+          | auto with real ] ].
 Qed.
 
 Lemma Rsqr_incr_0_var : forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> x <= y.
-intros; case (Rle_dec x y); intro;
- [ assumption
- | cut (y < x);
-    [ intro; unfold Rsqr in H;
-       generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); 
-       intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); 
-       intro; elim (Rlt_irrefl (x * x) H3)
-    | auto with real ] ].
+Proof.
+  intros; case (Rle_dec x y); intro;
+    [ assumption
+      | cut (y < x);
+        [ intro; unfold Rsqr in H;
+          generalize (Rmult_le_0_lt_compat y x y x H0 H0 H1 H1); 
+            intro; generalize (Rle_lt_trans (x * x) (y * y) (x * x) H H2); 
+              intro; elim (Rlt_irrefl (x * x) H3)
+          | auto with real ] ].
 Qed.
 
 Lemma Rsqr_incr_1 :
- forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y.
-intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption.
+  forall x y:R, x <= y -> 0 <= x -> 0 <= y -> Rsqr x <= Rsqr y.
+Proof.
+  intros; unfold Rsqr in |- *; apply Rmult_le_compat; assumption.
 Qed.
 
 Lemma Rsqr_incrst_0 :
- forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y.
-intros; case (Rtotal_order x y); intro;
- [ assumption
- | elim H2; intro;
-    [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H)
-    | generalize (Rmult_le_0_lt_compat 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_irrefl (x * x) H5) ] ].
+  forall x y:R, Rsqr x < Rsqr y -> 0 <= x -> 0 <= y -> x < y.
+Proof.
+  intros; case (Rtotal_order x y); intro;
+    [ assumption
+      | elim H2; intro;
+        [ rewrite H3 in H; elim (Rlt_irrefl (Rsqr y) H)
+          | generalize (Rmult_le_0_lt_compat 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_irrefl (x * x) H5) ] ].
 Qed.
 
 Lemma Rsqr_incrst_1 :
- forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y.
-intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption.
+  forall x y:R, x < y -> 0 <= x -> 0 <= y -> Rsqr x < Rsqr y.
+Proof.
+  intros; unfold Rsqr in |- *; apply Rmult_le_0_lt_compat; assumption.
 Qed.
 
 Lemma Rsqr_neg_pos_le_0 :
- forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x.
-intros; case (Rcase_abs x); intro.
-generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
- generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H;
- generalize (Rsqr_incr_0 (- x) y H H2 H0); intro;
- rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; 
- apply Rle_ge; assumption.
-apply Rle_trans with 0;
- [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption
- | apply Rge_le; assumption ].
+  forall x y:R, Rsqr x <= Rsqr y -> 0 <= y -> - y <= x.
+Proof.
+  intros; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+    generalize (Rlt_le 0 (- x) H1); intro; rewrite (Rsqr_neg x) in H;
+      generalize (Rsqr_incr_0 (- x) y H H2 H0); intro;
+        rewrite <- (Ropp_involutive x); apply Ropp_ge_le_contravar; 
+          apply Rle_ge; assumption.
+  apply Rle_trans with 0;
+    [ rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption
+      | apply Rge_le; assumption ].
 Qed.
 
 Lemma Rsqr_neg_pos_le_1 :
- forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y.
-intros; case (Rcase_abs x); intro.
-generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
- generalize (Rlt_le 0 (- x) H2); intro;
- generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; 
- intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x);
- apply Rsqr_incr_1; assumption.
-generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption.
+  forall x y:R, - y <= x -> x <= y -> 0 <= y -> Rsqr x <= Rsqr y.
+Proof.
+  intros; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+    generalize (Rlt_le 0 (- x) H2); intro;
+      generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; 
+        intro; generalize (Rge_le y (- x) H4); intro; rewrite (Rsqr_neg x);
+          apply Rsqr_incr_1; assumption.
+  generalize (Rge_le x 0 r); intro; apply Rsqr_incr_1; assumption.
 Qed.
 
 Lemma neg_pos_Rsqr_le : forall x y:R, - y <= x -> x <= y -> Rsqr x <= Rsqr y.
-intros; case (Rcase_abs x); intro.
-generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
- generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; 
- intro; generalize (Rge_le y (- x) 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 (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro;
- apply Rsqr_incr_1; assumption.
+Proof.
+  intros; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar x 0 r); rewrite Ropp_0; intro;
+    generalize (Ropp_le_ge_contravar (- y) x H); rewrite Ropp_involutive; 
+      intro; generalize (Rge_le y (- x) 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 (Rge_le x 0 r); intro; generalize (Rle_trans 0 x y H1 H0); intro;
+    apply Rsqr_incr_1; assumption.
 Qed.
 
 Lemma Rsqr_abs : forall x:R, Rsqr x = Rsqr (Rabs x).
-intro; unfold Rabs in |- *; case (Rcase_abs x); intro;
- [ apply Rsqr_neg | reflexivity ].
+Proof.
+  intro; unfold Rabs in |- *; case (Rcase_abs x); intro;
+    [ apply Rsqr_neg | reflexivity ].
 Qed.
 
 Lemma Rsqr_le_abs_0 : forall x y:R, Rsqr x <= Rsqr y -> Rabs x <= Rabs y.
-intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs;
- [ assumption | apply Rabs_pos | apply Rabs_pos ].
+Proof.
+  intros; apply Rsqr_incr_0; repeat rewrite <- Rsqr_abs;
+    [ assumption | apply Rabs_pos | apply Rabs_pos ].
 Qed.
 
 Lemma Rsqr_le_abs_1 : forall x y:R, Rabs x <= Rabs y -> Rsqr x <= Rsqr y.
-intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
- apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
+Proof.
+  intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
+    apply (Rsqr_incr_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
 Qed.
 
 Lemma Rsqr_lt_abs_0 : forall x y:R, Rsqr x < Rsqr y -> Rabs x < Rabs y.
-intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs;
- [ assumption | apply Rabs_pos | apply Rabs_pos ].
+Proof.
+  intros; apply Rsqr_incrst_0; repeat rewrite <- Rsqr_abs;
+    [ assumption | apply Rabs_pos | apply Rabs_pos ].
 Qed.
 
 Lemma Rsqr_lt_abs_1 : forall x y:R, Rabs x < Rabs y -> Rsqr x < Rsqr y.
-intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
- apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
+Proof.
+  intros; rewrite (Rsqr_abs x); rewrite (Rsqr_abs y);
+    apply (Rsqr_incrst_1 (Rabs x) (Rabs y) H (Rabs_pos x) (Rabs_pos y)).
 Qed.
 
 Lemma Rsqr_inj : forall 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.
+Proof.
+  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 : forall x y:R, Rsqr x = Rsqr y -> Rabs x = Rabs y.
-intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros.
-rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H;
- generalize (Ropp_lt_gt_contravar y 0 r);
- generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; 
- 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 (Rge_le y 0 r); intro;
- generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; 
- intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; 
- assumption.
-rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro;
- generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; 
- intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; 
- assumption.
-generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj;
- assumption.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs x); case (Rcase_abs y); intros.
+  rewrite (Rsqr_neg x) in H; rewrite (Rsqr_neg y) in H;
+    generalize (Ropp_lt_gt_contravar y 0 r);
+      generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; 
+        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 (Rge_le y 0 r); intro;
+    generalize (Ropp_lt_gt_contravar x 0 r0); rewrite Ropp_0; 
+      intro; generalize (Rlt_le 0 (- x) H1); intro; apply Rsqr_inj; 
+        assumption.
+  rewrite (Rsqr_neg y) in H; generalize (Rge_le x 0 r0); intro;
+    generalize (Ropp_lt_gt_contravar y 0 r); rewrite Ropp_0; 
+      intro; generalize (Rlt_le 0 (- y) H1); intro; apply Rsqr_inj; 
+        assumption.
+  generalize (Rge_le x 0 r0); generalize (Rge_le y 0 r); intros; apply Rsqr_inj;
+    assumption.
 Qed.
 
 Lemma Rsqr_eq_asb_1 : forall x y:R, Rabs x = Rabs y -> Rsqr x = Rsqr y.
-intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)).
-intro; repeat rewrite <- Rsqr_abs in H0; assumption.
-rewrite H; reflexivity.
+Proof.
+  intros; cut (Rsqr (Rabs x) = Rsqr (Rabs y)).
+  intro; repeat rewrite <- Rsqr_abs in H0; assumption.
+  rewrite H; reflexivity.
 Qed.
 
 Lemma triangle_rectangle :
- forall 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) (Rle_0_sqr y) H0);
- rewrite Rplus_comm in H0;
- generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr 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 ] ].
+  forall x y z:R,
+    0 <= z -> Rsqr x + Rsqr y <= Rsqr z -> - z <= x <= z /\ - z <= y <= z.
+Proof.
+  intros;
+    generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H0);
+      rewrite Rplus_comm in H0;
+        generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr 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 :
- forall x y z:R,
-   Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z.
-intros; split;
- [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
-    intro; apply Rsqr_lt_abs_0; assumption
- | rewrite Rplus_comm in H;
-    generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
-    intro; apply Rsqr_lt_abs_0; assumption ].
+  forall x y z:R,
+    Rsqr x + Rsqr y < Rsqr z -> Rabs x < Rabs z /\ Rabs y < Rabs z.
+Proof.
+  intros; split;
+    [ generalize (plus_lt_is_lt (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
+      intro; apply Rsqr_lt_abs_0; assumption
+      | rewrite Rplus_comm in H;
+        generalize (plus_lt_is_lt (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
+          intro; apply Rsqr_lt_abs_0; assumption ].
 Qed.
 
 Lemma triangle_rectangle_le :
- forall x y z:R,
-   Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z.
-intros; split;
- [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
-    intro; apply Rsqr_le_abs_0; assumption
- | rewrite Rplus_comm in H;
-    generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
-    intro; apply Rsqr_le_abs_0; assumption ].
+  forall x y z:R,
+    Rsqr x + Rsqr y <= Rsqr z -> Rabs x <= Rabs z /\ Rabs y <= Rabs z.
+Proof.
+  intros; split;
+    [ generalize (plus_le_is_le (Rsqr x) (Rsqr y) (Rsqr z) (Rle_0_sqr y) H);
+      intro; apply Rsqr_le_abs_0; assumption
+      | rewrite Rplus_comm in H;
+        generalize (plus_le_is_le (Rsqr y) (Rsqr x) (Rsqr z) (Rle_0_sqr x) H);
+          intro; apply Rsqr_le_abs_0; assumption ].
 Qed.
 
 Lemma Rsqr_inv : forall x:R, x <> 0 -> Rsqr (/ x) = / Rsqr x.
-intros; unfold Rsqr in |- *.
-rewrite Rinv_mult_distr; try reflexivity || assumption.
+Proof.
+  intros; unfold Rsqr in |- *.
+  rewrite Rinv_mult_distr; try reflexivity || assumption.
 Qed.
 
 Lemma canonical_Rsqr :
- forall (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_plus_distr_l.
-repeat rewrite Rplus_assoc.
-apply Rplus_eq_compat_l.
-unfold Rdiv, Rminus in |- *.
-replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ].
-rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))).
-rewrite Rsqr_mult.
-repeat rewrite Rinv_mult_distr.
-repeat rewrite (Rmult_comm a).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm (/ 2)).
-rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm a).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-repeat rewrite Rplus_assoc.
-rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))).
-repeat rewrite Rplus_assoc.
-rewrite (Rmult_comm x).
-apply Rplus_eq_compat_l.
-rewrite (Rmult_comm (/ a)).
-unfold Rsqr in |- *; repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-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).
+  forall (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).
+Proof.
+  intros.
+  rewrite Rsqr_plus.
+  repeat rewrite Rmult_plus_distr_l.
+  repeat rewrite Rplus_assoc.
+  apply Rplus_eq_compat_l.
+  unfold Rdiv, Rminus in |- *.
+  replace (2 * 1 + 2 * 1) with 4; [ idtac | ring ].
+  rewrite (Rmult_plus_distr_r (4 * a * c) (- Rsqr b) (/ (4 * a))).
+  rewrite Rsqr_mult.
+  repeat rewrite Rinv_mult_distr.
+  repeat rewrite (Rmult_comm a).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (/ 2)).
+  rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm a).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  repeat rewrite Rplus_assoc.
+  rewrite (Rplus_comm (Rsqr b * (Rsqr (/ a * / 2) * a))).
+  repeat rewrite Rplus_assoc.
+  rewrite (Rmult_comm x).
+  apply Rplus_eq_compat_l.
+  rewrite (Rmult_comm (/ a)).
+  unfold Rsqr in |- *; repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  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 : forall x y:R, Rsqr x = Rsqr y -> x = y \/ x = - y.
-intros; unfold Rsqr in H;
- generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H);
- rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)).
-intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros.
-left; apply Rminus_diag_uniq; assumption.
-right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive;
- assumption.
-ring.
-Qed.
\ No newline at end of file
+Proof.
+  intros; unfold Rsqr in H;
+    generalize (Rplus_eq_compat_l (- (y * y)) (x * x) (y * y) H);
+      rewrite Rplus_opp_l; replace (- (y * y) + x * x) with ((x - y) * (x + y)).
+  intro; generalize (Rmult_integral (x - y) (x + y) H0); intro; elim H1; intros.
+  left; apply Rminus_diag_uniq; assumption.
+  right; apply Rminus_diag_uniq; unfold Rminus in |- *; rewrite Ropp_involutive;
+    assumption.
+  ring.
+Qed.
diff --git a/theories/Reals/R_sqrt.v b/theories/Reals/R_sqrt.v
index cb372840..736365a0 100644
--- a/theories/Reals/R_sqrt.v
+++ b/theories/Reals/R_sqrt.v
@@ -6,219 +6,242 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: R_sqrt.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
+(*i $Id: R_sqrt.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Rsqrt_def. Open Local Scope R_scope.
 
-(* Here is a continuous extension of Rsqrt on R *)
+(** * Continuous extension of Rsqrt on R *)
 Definition sqrt (x:R) : R :=
   match Rcase_abs x with
-  | left _ => 0
-  | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a))
+    | left _ => 0
+    | right a => Rsqrt (mknonnegreal x (Rge_le _ _ a))
   end.
 
 Lemma sqrt_positivity : forall x:R, 0 <= x -> 0 <= sqrt x.
-intros.
-unfold sqrt in |- *.
-case (Rcase_abs x); intro.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
-apply Rsqrt_positivity.
+Proof.
+  intros.
+  unfold sqrt in |- *.
+  case (Rcase_abs x); intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
+  apply Rsqrt_positivity.
 Qed.
 
 Lemma sqrt_sqrt : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
-intros.
-unfold sqrt in |- *.
-case (Rcase_abs x); intro.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
-rewrite Rsqrt_Rsqrt; reflexivity.
+Proof.
+  intros.
+  unfold sqrt in |- *.
+  case (Rcase_abs x); intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ r H)).
+  rewrite Rsqrt_Rsqrt; reflexivity.
 Qed.
 
 Lemma sqrt_0 : sqrt 0 = 0.
-apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. 
+Proof.
+  apply Rsqr_eq_0; unfold Rsqr in |- *; apply sqrt_sqrt; right; reflexivity. 
 Qed.
 
 Lemma sqrt_1 : sqrt 1 = 1.
-apply (Rsqr_inj (sqrt 1) 1);
- [ apply sqrt_positivity; left
- | left
- | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; 
- apply Rlt_0_1.
+Proof.
+  apply (Rsqr_inj (sqrt 1) 1);
+    [ apply sqrt_positivity; left
+      | left
+      | unfold Rsqr in |- *; rewrite sqrt_sqrt; [ ring | left ] ]; 
+    apply Rlt_0_1.
 Qed.
 
 Lemma sqrt_eq_0 : forall 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_0.
+Proof.
+  intros; cut (Rsqr (sqrt x) = 0).
+  intro; unfold Rsqr in H1; rewrite sqrt_sqrt in H1; assumption.
+  rewrite H0; apply Rsqr_0.
 Qed.
 
 Lemma sqrt_lem_0 : forall x y:R, 0 <= x -> 0 <= y -> sqrt x = y -> y * y = x.
-intros; rewrite <- H1; apply (sqrt_sqrt x H).
+Proof.
+  intros; rewrite <- H1; apply (sqrt_sqrt x H).
 Qed.
 
-Lemma sqtr_lem_1 : forall 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 in |- *; rewrite H1; apply (sqrt_sqrt x H) ].
+Lemma sqrt_lem_1 : forall x y:R, 0 <= x -> 0 <= y -> y * y = x -> sqrt x = y.
+Proof.
+  intros; apply Rsqr_inj;
+    [ apply (sqrt_positivity x H)
+      | assumption
+      | unfold Rsqr in |- *; rewrite H1; apply (sqrt_sqrt x H) ].
 Qed.
 
 Lemma sqrt_def : forall x:R, 0 <= x -> sqrt x * sqrt x = x.
-intros; apply (sqrt_sqrt x H).
+Proof.
+  intros; apply (sqrt_sqrt x H).
 Qed.
 
 Lemma sqrt_square : forall x:R, 0 <= x -> sqrt (x * x) = x.
-intros;
- apply
-  (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H);
- unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)).
+Proof.
+  intros;
+    apply
+      (Rsqr_inj (sqrt (Rsqr x)) x (sqrt_positivity (Rsqr x) (Rle_0_sqr x)) H);
+      unfold Rsqr in |- *; apply (sqrt_sqrt (Rsqr x) (Rle_0_sqr x)).
 Qed.
 
 Lemma sqrt_Rsqr : forall x:R, 0 <= x -> sqrt (Rsqr x) = x.
-intros; unfold Rsqr in |- *; apply sqrt_square; assumption.
+Proof.
+  intros; unfold Rsqr in |- *; apply sqrt_square; assumption.
 Qed.
 
 Lemma sqrt_Rsqr_abs : forall x:R, sqrt (Rsqr x) = Rabs x.
-intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos.
+Proof.
+  intro x; rewrite Rsqr_abs; apply sqrt_Rsqr; apply Rabs_pos.
 Qed.
 
 Lemma Rsqr_sqrt : forall x:R, 0 <= x -> Rsqr (sqrt x) = x.
-intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1).
+Proof.
+  intros x H1; unfold Rsqr in |- *; apply (sqrt_sqrt x H1).
 Qed.
 
 Lemma sqrt_mult :
- forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y.
-intros x y H1 H2;
- apply
-  (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y)
-     (sqrt_positivity (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_mult; 
- repeat rewrite Rsqr_sqrt;
- [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ].
+  forall x y:R, 0 <= x -> 0 <= y -> sqrt (x * y) = sqrt x * sqrt y.
+Proof.
+  intros x y H1 H2;
+    apply
+      (Rsqr_inj (sqrt (x * y)) (sqrt x * sqrt y)
+        (sqrt_positivity (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_mult; 
+      repeat rewrite Rsqr_sqrt;
+        [ ring | assumption | assumption | apply (Rmult_le_pos x y H1 H2) ].
 Qed.
 
 Lemma sqrt_lt_R0 : forall x:R, 0 < x -> 0 < sqrt x.
-intros x H1; apply Rsqr_incrst_0;
- [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ]
- | right; reflexivity
- | apply (sqrt_positivity x (Rlt_le 0 x H1)) ].
+Proof.
+  intros x H1; apply Rsqr_incrst_0;
+    [ rewrite Rsqr_0; rewrite Rsqr_sqrt; [ assumption | left; assumption ]
+      | right; reflexivity
+      | apply (sqrt_positivity x (Rlt_le 0 x H1)) ].
 Qed.
 
 Lemma sqrt_div :
- forall 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 (/ y));
-    [ assumption
-    | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left;
-       assumption ]
- | apply (Rmult_le_pos (sqrt x) (/ sqrt y));
-    [ apply (sqrt_positivity x H1)
-    | generalize (sqrt_lt_R0 y H2); clear H2; intro H2;
-       generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; 
-       intro H2; left; assumption ]
- | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt;
-    [ reflexivity
-    | left; assumption
-    | assumption
-    | generalize (Rinv_0_lt_compat y H2); intro H3;
-       generalize (Rlt_le 0 (/ y) H3); intro H4;
-       apply (Rmult_le_pos x (/ y) H1 H4)
-    | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4;
-       generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2;
-       elim (Rlt_irrefl 0 H2) ] ].
+  forall x y:R, 0 <= x -> 0 < y -> sqrt (x / y) = sqrt x / sqrt y.
+Proof.
+  intros x y H1 H2; apply Rsqr_inj;
+    [ apply sqrt_positivity; apply (Rmult_le_pos x (/ y));
+      [ assumption
+        | generalize (Rinv_0_lt_compat y H2); clear H2; intro H2; left;
+          assumption ]
+      | apply (Rmult_le_pos (sqrt x) (/ sqrt y));
+        [ apply (sqrt_positivity x H1)
+          | generalize (sqrt_lt_R0 y H2); clear H2; intro H2;
+            generalize (Rinv_0_lt_compat (sqrt y) H2); clear H2; 
+              intro H2; left; assumption ]
+      | rewrite Rsqr_div; repeat rewrite Rsqr_sqrt;
+        [ reflexivity
+          | left; assumption
+          | assumption
+          | generalize (Rinv_0_lt_compat y H2); intro H3;
+            generalize (Rlt_le 0 (/ y) H3); intro H4;
+              apply (Rmult_le_pos x (/ y) H1 H4)
+          | red in |- *; intro H3; generalize (Rlt_le 0 y H2); intro H4;
+            generalize (sqrt_eq_0 y H4 H3); intro H5; rewrite H5 in H2;
+              elim (Rlt_irrefl 0 H2) ] ].
 Qed.
 
 Lemma sqrt_lt_0 : forall 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.
+Proof.
+  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 : forall 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) ].
+Proof.
+  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 :
- forall 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.
+  forall x y:R, 0 <= x -> 0 <= y -> sqrt x <= sqrt y -> x <= y.
+Proof.
+  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 :
- forall 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) ].
+  forall x y:R, 0 <= x -> 0 <= y -> x <= y -> sqrt x <= sqrt y.
+Proof.
+  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 : forall 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.
+Proof.
+  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 : forall x:R, 0 <= x -> 1 < x -> sqrt x < x.
-intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2);
- intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); 
- intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *;
- rewrite <- (sqrt_def x H1);
- apply
-  (Rmult_lt_compat_l (sqrt x) 1 (sqrt x)
-     (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3).
+Proof.
+  intros x H1 H2; generalize (sqrt_lt_1 1 x (Rlt_le 0 1 Rlt_0_1) H1 H2);
+    intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); 
+      intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 2 in |- *;
+        rewrite <- (sqrt_def x H1);
+          apply
+            (Rmult_lt_compat_l (sqrt x) 1 (sqrt x)
+              (sqrt_lt_R0 x (Rlt_trans 0 1 x Rlt_0_1 H2)) H3).
 Qed.
 
 Lemma sqrt_more : forall x:R, 0 < x -> x < 1 -> x < sqrt x.
-intros x H1 H2;
- generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); 
- intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); 
- intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *;
- rewrite <- (sqrt_def x (Rlt_le 0 x H1));
- apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3).
+Proof.
+  intros x H1 H2;
+    generalize (sqrt_lt_1 x 1 (Rlt_le 0 x H1) (Rlt_le 0 1 Rlt_0_1) H2); 
+      intro H3; rewrite sqrt_1 in H3; generalize (Rmult_ne (sqrt x)); 
+        intro H4; elim H4; intros H5 H6; rewrite <- H5; pattern x at 1 in |- *;
+          rewrite <- (sqrt_def x (Rlt_le 0 x H1));
+            apply (Rmult_lt_compat_l (sqrt x) (sqrt x) 1 (sqrt_lt_R0 x H1) H3).
 Qed.
 
 Lemma sqrt_cauchy :
- forall 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_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *;
-    [ 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
+  forall a b c d:R,
+    a * c + b * d <= sqrt (Rsqr a + Rsqr b) * sqrt (Rsqr c + Rsqr d).
+Proof.
+  intros a b c d; apply Rsqr_incr_0_var;
+    [ rewrite Rsqr_mult; repeat rewrite Rsqr_sqrt; unfold Rsqr in |- *;
+      [ 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 Rplus_le_compat_l;
-             replace (a * a * d * d + b * b * c * c) with
-              (2 * a * b * c * d +
-               (a * a * d * d + b * b * c * c - 2 * a * b * c * d));
-             [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r;
-                apply Rplus_le_compat_l;
+            replace (a * a * d * d + b * b * c * c) with
+            (2 * a * b * c * d +
+              (a * a * d * d + b * b * c * c - 2 * a * b * c * d));
+            [ pattern (2 * a * b * c * d) at 1 in |- *; rewrite <- Rplus_0_r;
+              apply Rplus_le_compat_l;
                 replace (a * a * d * d + b * b * c * c - 2 * a * b * c * d)
-                 with (Rsqr (a * d - b * c));
+              with (Rsqr (a * d - b * c));
                 [ apply Rle_0_sqr | unfold Rsqr in |- *; ring ]
-             | ring ]
+              | ring ]
+            | ring ]
           | ring ]
-       | ring ]
-    | apply
-       (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d))
-    | apply
-       (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ]
- | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat;
-    apply Rle_0_sqr ].
+        | apply
+          (Rplus_le_le_0_compat (Rsqr c) (Rsqr d) (Rle_0_sqr c) (Rle_0_sqr d))
+        | apply
+          (Rplus_le_le_0_compat (Rsqr a) (Rsqr b) (Rle_0_sqr a) (Rle_0_sqr b)) ]
+      | apply Rmult_le_pos; apply sqrt_positivity; apply Rplus_le_le_0_compat;
+        apply Rle_0_sqr ].
 Qed.
 
 (************************************************************)
-(* Resolution of [a*X^2+b*X+c=0]                            *)
+(** * Resolution of [a*X^2+b*X+c=0]                         *)
 (************************************************************)
 
 Definition Delta (a:nonzeroreal) (b c:R) : R := Rsqr b - 4 * a * c.
@@ -232,168 +255,170 @@ Definition sol_x2 (a:nonzeroreal) (b c:R) : R :=
   (- b - sqrt (Delta a b c)) / (2 * a).
 
 Lemma Rsqr_sol_eq_0_1 :
- forall (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 in |- *;
- repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg;
- rewrite Rsqr_sqrt.
-rewrite Rsqr_inv.
-unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc; rewrite (Rmult_comm a).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite Rmult_plus_distr_r.
-repeat rewrite Rmult_assoc.
-pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite
- (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a))
- .
-rewrite Rmult_plus_distr_l; 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 in |- *; repeat rewrite <- Rplus_assoc.
-replace (b * b + b * b) with (2 * (b * b)).
-rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm a); rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite <- Rmult_opp_opp.
-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 in |- *;
- repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg;
- rewrite Rsqr_sqrt.
-rewrite Rsqr_inv.
-unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr;
- repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm a); repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
-rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
- pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r;
- rewrite
-  (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c)))))
-     (/ 2 * / a)).
-rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
-rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive.
-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_plus_distr_r; repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; 
- rewrite <- Rinv_l_sym.
-rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a);
- rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; 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 || apply (cond_nonzero a).
-apply prod_neq_R0; discrR || apply (cond_nonzero a).
-apply prod_neq_R0; discrR || apply (cond_nonzero a).
-assumption.
+  forall (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.
+Proof.
+  intros; elim H0; intro.
+  unfold sol_x1 in H1; unfold Delta in H1; rewrite H1; unfold Rdiv in |- *;
+    repeat rewrite Rsqr_mult; rewrite Rsqr_plus; rewrite <- Rsqr_neg;
+      rewrite Rsqr_sqrt.
+  rewrite Rsqr_inv.
+  unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc; rewrite (Rmult_comm a).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite
+    (Rmult_plus_distr_r (- b) (sqrt (b * b - 2 * (2 * (a * c)))) (/ 2 * / a))
+    .
+  rewrite Rmult_plus_distr_l; 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 in |- *; repeat rewrite <- Rplus_assoc.
+  replace (b * b + b * b) with (2 * (b * b)).
+  rewrite Rmult_plus_distr_r; repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+    rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc;
+    rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm a); rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite <- Rmult_opp_opp.
+  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 in |- *;
+    repeat rewrite Rsqr_mult; rewrite Rsqr_minus; rewrite <- Rsqr_neg;
+      rewrite Rsqr_sqrt.
+  rewrite Rsqr_inv.
+  unfold Rsqr in |- *; repeat rewrite Rinv_mult_distr;
+    repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm a); repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+    pattern 2 at 2 in |- *; rewrite (Rmult_comm 2).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r;
+    rewrite
+      (Rmult_plus_distr_r (- b) (- sqrt (b * b + - (2 * (2 * (a * c)))))
+        (/ 2 * / a)).
+  rewrite Rmult_plus_distr_l; repeat rewrite Rplus_assoc.
+  rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_involutive.
+  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_plus_distr_r; repeat rewrite Rmult_assoc;
+    rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; 
+      rewrite <- Rinv_l_sym.
+  rewrite Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite (Rmult_comm (/ 2)); repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; repeat rewrite Rmult_assoc; rewrite (Rmult_comm a);
+    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite <- Rmult_opp_opp; 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 || apply (cond_nonzero a).
+  apply prod_neq_R0; discrR || apply (cond_nonzero a).
+  apply prod_neq_R0; discrR || apply (cond_nonzero a).
+  assumption.
 Qed.
 
 Lemma Rsqr_sol_eq_0_0 :
- forall (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_comm in H0;
- generalize
-  (Rplus_opp_r_uniq ((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_eq_compat_l (/ 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 in |- *;
- generalize
-  (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
-     (sqrt (Delta a b c) / (2 * a)) H5);
- replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
-intro; rewrite H6; unfold Rdiv in |- *; ring.
-ring.
-right; unfold sol_x2 in |- *;
- generalize
-  (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
-     (- (sqrt (Delta a b c) / (2 * a))) H5);
- replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
-intro; rewrite H6; unfold Rdiv in |- *; ring.
-ring.
-rewrite Rsqr_div.
-rewrite Rsqr_sqrt.
-unfold Rdiv in |- *.
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm (/ a)).
-rewrite Rmult_assoc.
-rewrite <- Rinv_mult_distr.
-replace (2 * (2 * a) * a) with (Rsqr (2 * a)).
-reflexivity.
-ring_Rsqr.
-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  in |- *; apply Rmult_1_l.
-apply (cond_nonzero a).
-unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
-rewrite Ropp_minus_distr.
-reflexivity.
-reflexivity.
+  forall (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.
+Proof.
+  intros; rewrite (canonical_Rsqr a b c x) in H0; rewrite Rplus_comm in H0;
+    generalize
+      (Rplus_opp_r_uniq ((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_eq_compat_l (/ 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 in |- *;
+    generalize
+      (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
+        (sqrt (Delta a b c) / (2 * a)) H5);
+      replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
+  intro; rewrite H6; unfold Rdiv in |- *; ring.
+  ring.
+  right; unfold sol_x2 in |- *;
+    generalize
+      (Rplus_eq_compat_l (- (b / (2 * a))) (x + b / (2 * a))
+        (- (sqrt (Delta a b c) / (2 * a))) H5);
+      replace (- (b / (2 * a)) + (x + b / (2 * a))) with x.
+  intro; rewrite H6; unfold Rdiv in |- *; ring.
+  ring.
+  rewrite Rsqr_div.
+  rewrite Rsqr_sqrt.
+  unfold Rdiv in |- *.
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (/ a)).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  replace (2 * (2 * a) * a) with (Rsqr (2 * a)).
+  reflexivity.
+  ring_Rsqr.
+  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  in |- *; apply Rmult_1_l.
+  apply (cond_nonzero a).
+  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+  rewrite Ropp_minus_distr.
+  reflexivity.
+  reflexivity.
 Qed.
diff --git a/theories/Reals/Ranalysis.v b/theories/Reals/Ranalysis.v
index b885e4ce..d712f74b 100644
--- a/theories/Reals/Ranalysis.v
+++ b/theories/Reals/Ranalysis.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Ranalysis.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: Ranalysis.v 9319 2006-10-30 12:41:21Z barras $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -34,769 +34,768 @@ Axiom AppVar : R.
 (**********)
 Ltac intro_hyp_glob trm :=
   match constr:trm with
-  | (?X1 + ?X2)%F =>
+    | (?X1 + ?X2)%F =>
       match goal with
-      |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-      |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-      | _ => idtac
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
       end
-  | (?X1 - ?X2)%F =>
+    | (?X1 - ?X2)%F =>
       match goal with
-      |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-      |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-      | _ => idtac
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
       end
-  | (?X1 * ?X2)%F =>
+    | (?X1 * ?X2)%F =>
       match goal with
-      |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-      |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-      | _ => idtac
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
       end
-  | (?X1 / ?X2)%F =>
+    | (?X1 / ?X2)%F =>
       let aux := constr:X2 in
+        match goal with
+          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+            intro_hyp_glob X1; intro_hyp_glob X2
+          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
+            intro_hyp_glob X1; intro_hyp_glob X2
+          |  |- (derivable _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+          |  |- (continuity _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
+          | _ => idtac
+        end
+    | (comp ?X1 ?X2) =>
       match goal with
-      | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
-          intro_hyp_glob X1; intro_hyp_glob X2
-      | _:(forall x0:R, aux x0 <> 0) |- (continuity _) =>
-          intro_hyp_glob X1; intro_hyp_glob X2
-      |  |- (derivable _) =>
-          cut (forall x0:R, aux x0 <> 0);
-           [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
-      |  |- (continuity _) =>
-          cut (forall x0:R, aux x0 <> 0);
-           [ intro; intro_hyp_glob X1; intro_hyp_glob X2 | try assumption ]
-      | _ => idtac
-      end
-  | (comp ?X1 ?X2) =>
-      match goal with
-      |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
-      |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
-      | _ => idtac
+        |  |- (derivable _) => intro_hyp_glob X1; intro_hyp_glob X2
+        |  |- (continuity _) => intro_hyp_glob X1; intro_hyp_glob X2
+        | _ => idtac
       end
-  | (- ?X1)%F =>
+    | (- ?X1)%F =>
       match goal with
-      |  |- (derivable _) => intro_hyp_glob X1
-      |  |- (continuity _) => intro_hyp_glob X1
-      | _ => idtac
+        |  |- (derivable _) => intro_hyp_glob X1
+        |  |- (continuity _) => intro_hyp_glob X1
+        | _ => idtac
       end
-  | (/ ?X1)%F =>
+    | (/ ?X1)%F =>
       let aux := constr:X1 in
-      match goal with
-      | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
-          intro_hyp_glob X1
-      | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => 
-      intro_hyp_glob X1
-      |  |- (derivable _) =>
-          cut (forall x0:R, aux x0 <> 0);
-           [ intro; intro_hyp_glob X1 | try assumption ]
-      |  |- (continuity _) =>
-          cut (forall x0:R, aux x0 <> 0);
-           [ intro; intro_hyp_glob X1 | try assumption ]
-      | _ => idtac
-      end
-  | cos => idtac
-  | sin => idtac
-  | cosh => idtac
-  | sinh => idtac
-  | exp => idtac
-  | Rsqr => idtac
-  | sqrt => idtac
-  | id => idtac
-  | (fct_cte _) => idtac
-  | (pow_fct _) => idtac
-  | Rabs => idtac
-  | ?X1 =>
+        match goal with
+          | _:(forall x0:R, aux x0 <> 0) |- (derivable _) =>
+            intro_hyp_glob X1
+          | _:(forall x0:R, aux x0 <> 0) |- (continuity _) => 
+            intro_hyp_glob X1
+          |  |- (derivable _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1 | try assumption ]
+          |  |- (continuity _) =>
+            cut (forall x0:R, aux x0 <> 0);
+              [ intro; intro_hyp_glob X1 | try assumption ]
+          | _ => idtac
+        end
+    | cos => idtac
+    | sin => idtac
+    | cosh => idtac
+    | sinh => idtac
+    | exp => idtac
+    | Rsqr => idtac
+    | sqrt => idtac
+    | id => idtac
+    | (fct_cte _) => idtac
+    | (pow_fct _) => idtac
+    | Rabs => idtac
+    | ?X1 =>
       let p := constr:X1 in
-      match goal with
-      | _:(derivable p) |- _ => idtac
-      |  |- (derivable p) => idtac
-      |  |- (derivable _) =>
-          cut (True -> derivable p);
-           [ intro HYPPD; cut (derivable p);
-              [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-           | idtac ]
-      | _:(continuity p) |- _ => idtac
-      |  |- (continuity p) => idtac
-      |  |- (continuity _) =>
-          cut (True -> continuity p);
-           [ intro HYPPD; cut (continuity p);
-              [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-           | idtac ]
-      | _ => idtac
-      end
+        match goal with
+          | _:(derivable p) |- _ => idtac
+          |  |- (derivable p) => idtac
+          |  |- (derivable _) =>
+            cut (True -> derivable p);
+              [ intro HYPPD; cut (derivable p);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _:(continuity p) |- _ => idtac
+          |  |- (continuity p) => idtac
+          |  |- (continuity _) =>
+            cut (True -> continuity p);
+              [ intro HYPPD; cut (continuity p);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _ => idtac
+        end
   end.
 
 (**********)
 Ltac intro_hyp_pt trm pt :=
   match constr:trm with
-  | (?X1 + ?X2)%F =>
+    | (?X1 + ?X2)%F =>
       match goal with
-      |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (derive_pt _ _ _ = _) =>
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
           intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | _ => idtac
+        | _ => idtac
       end
-  | (?X1 - ?X2)%F =>
+    | (?X1 - ?X2)%F =>
       match goal with
-      |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (derive_pt _ _ _ = _) =>
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
           intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | _ => idtac
+        | _ => idtac
       end
-  | (?X1 * ?X2)%F =>
+    | (?X1 * ?X2)%F =>
       match goal with
-      |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (derive_pt _ _ _ = _) =>
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+        |  |- (derive_pt _ _ _ = _) =>
           intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | _ => idtac
+        | _ => idtac
       end
-  | (?X1 / ?X2)%F =>
+    | (?X1 / ?X2)%F =>
       let aux := constr:X2 in
+        match goal with
+          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+            intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
+          |  |- (derivable_pt _ _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          |  |- (continuity_pt _ _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (aux pt <> 0);
+              [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
+          | _ => idtac
+        end
+    | (comp ?X1 ?X2) =>
       match goal with
-      | _:(aux pt <> 0) |- (derivable_pt _ _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | _:(aux pt <> 0) |- (continuity_pt _ _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
-          intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt
-      |  |- (derivable_pt _ _) =>
-          cut (aux pt <> 0);
-           [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-      |  |- (continuity_pt _ _) =>
-          cut (aux pt <> 0);
-           [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-      |  |- (derive_pt _ _ _ = _) =>
-          cut (aux pt <> 0);
-           [ intro; intro_hyp_pt X1 pt; intro_hyp_pt X2 pt | try assumption ]
-      | _ => idtac
-      end
-  | (comp ?X1 ?X2) =>
-      match goal with
-      |  |- (derivable_pt _ _) =>
+        |  |- (derivable_pt _ _) =>
           let pt_f1 := eval cbv beta in (X2 pt) in
-          (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-      |  |- (continuity_pt _ _) =>
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        |  |- (continuity_pt _ _) =>
           let pt_f1 := eval cbv beta in (X2 pt) in
-          (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-      |  |- (derive_pt _ _ _ = _) =>
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        |  |- (derive_pt _ _ _ = _) =>
           let pt_f1 := eval cbv beta in (X2 pt) in
-          (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
-      | _ => idtac
+            (intro_hyp_pt X1 pt_f1; intro_hyp_pt X2 pt)
+        | _ => idtac
       end
-  | (- ?X1)%F =>
+    | (- ?X1)%F =>
       match goal with
-      |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt
-      |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt
-      |  |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt
-      | _ => idtac
+        |  |- (derivable_pt _ _) => intro_hyp_pt X1 pt
+        |  |- (continuity_pt _ _) => intro_hyp_pt X1 pt
+        |  |- (derive_pt _ _ _ = _) => intro_hyp_pt X1 pt
+        | _ => idtac
       end
-  | (/ ?X1)%F =>
+    | (/ ?X1)%F =>
       let aux := constr:X1 in
+        match goal with
+          | _:(aux pt <> 0) |- (derivable_pt _ _) =>
+            intro_hyp_pt X1 pt
+          | _:(aux pt <> 0) |- (continuity_pt _ _) =>
+            intro_hyp_pt X1 pt
+          | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
+            intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
+            generalize (id pt); intro; intro_hyp_pt X1 pt
+          |  |- (derivable_pt _ _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          |  |- (continuity_pt _ _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
+          | _ => idtac
+        end
+    | cos => idtac
+    | sin => idtac
+    | cosh => idtac
+    | sinh => idtac
+    | exp => idtac
+    | Rsqr => idtac
+    | id => idtac
+    | (fct_cte _) => idtac
+    | (pow_fct _) => idtac
+    | sqrt =>
       match goal with
-      | _:(aux pt <> 0) |- (derivable_pt _ _) =>
-          intro_hyp_pt X1 pt
-      | _:(aux pt <> 0) |- (continuity_pt _ _) =>
-          intro_hyp_pt X1 pt
-      | _:(aux pt <> 0) |- (derive_pt _ _ _ = _) =>
-          intro_hyp_pt X1 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (derivable_pt _ _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (continuity_pt _ _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt
-      | id:(forall x0:R, aux x0 <> 0) |- (derive_pt _ _ _ = _) =>
-          generalize (id pt); intro; intro_hyp_pt X1 pt
-      |  |- (derivable_pt _ _) =>
-          cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-      |  |- (continuity_pt _ _) =>
-          cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-      |  |- (derive_pt _ _ _ = _) =>
-          cut (aux pt <> 0); [ intro; intro_hyp_pt X1 pt | try assumption ]
-      | _ => idtac
-      end
-  | cos => idtac
-  | sin => idtac
-  | cosh => idtac
-  | sinh => idtac
-  | exp => idtac
-  | Rsqr => idtac
-  | id => idtac
-  | (fct_cte _) => idtac
-  | (pow_fct _) => idtac
-  | sqrt =>
-      match goal with
-      |  |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ]
-      |  |- (continuity_pt _ _) =>
+        |  |- (derivable_pt _ _) => cut (0 < pt); [ intro | try assumption ]
+        |  |- (continuity_pt _ _) =>
           cut (0 <= pt); [ intro | try assumption ]
-      |  |- (derive_pt _ _ _ = _) =>
+        |  |- (derive_pt _ _ _ = _) =>
           cut (0 < pt); [ intro | try assumption ]
-      | _ => idtac
+        | _ => idtac
       end
-  | Rabs =>
+    | Rabs =>
       match goal with
-      |  |- (derivable_pt _ _) =>
+        |  |- (derivable_pt _ _) =>
           cut (pt <> 0); [ intro | try assumption ]
-      | _ => idtac
+        | _ => idtac
       end
-  | ?X1 =>
+    | ?X1 =>
       let p := constr:X1 in
-      match goal with
-      | _:(derivable_pt p pt) |- _ => idtac
-      |  |- (derivable_pt p pt) => idtac
-      |  |- (derivable_pt _ _) =>
-          cut (True -> derivable_pt p pt);
-           [ intro HYPPD; cut (derivable_pt p pt);
-              [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-           | idtac ]
-      | _:(continuity_pt p pt) |- _ => idtac
-      |  |- (continuity_pt p pt) => idtac
-      |  |- (continuity_pt _ _) =>
-          cut (True -> continuity_pt p pt);
-           [ intro HYPPD; cut (continuity_pt p pt);
-              [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-           | idtac ]
-      |  |- (derive_pt _ _ _ = _) =>
-          cut (True -> derivable_pt p pt);
-           [ intro HYPPD; cut (derivable_pt p pt);
-              [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
-           | idtac ]
-      | _ => idtac
-      end
+        match goal with
+          | _:(derivable_pt p pt) |- _ => idtac
+          |  |- (derivable_pt p pt) => idtac
+          |  |- (derivable_pt _ _) =>
+            cut (True -> derivable_pt p pt);
+              [ intro HYPPD; cut (derivable_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _:(continuity_pt p pt) |- _ => idtac
+          |  |- (continuity_pt p pt) => idtac
+          |  |- (continuity_pt _ _) =>
+            cut (True -> continuity_pt p pt);
+              [ intro HYPPD; cut (continuity_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          |  |- (derive_pt _ _ _ = _) =>
+            cut (True -> derivable_pt p pt);
+              [ intro HYPPD; cut (derivable_pt p pt);
+                [ intro; clear HYPPD | apply HYPPD; clear HYPPD; trivial ]
+                | idtac ]
+          | _ => idtac
+        end
   end.
- 
+
 (**********)
 Ltac is_diff_pt :=
   match goal with
-  |  |- (derivable_pt Rsqr _) =>
+    |  |- (derivable_pt Rsqr _) =>
       
   (* fonctions de base *)
-  apply derivable_pt_Rsqr
-  |  |- (derivable_pt id ?X1) => apply (derivable_pt_id X1)
-  |  |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const
-  |  |- (derivable_pt sin _) => apply derivable_pt_sin
-  |  |- (derivable_pt cos _) => apply derivable_pt_cos
-  |  |- (derivable_pt sinh _) => apply derivable_pt_sinh
-  |  |- (derivable_pt cosh _) => apply derivable_pt_cosh
-  |  |- (derivable_pt exp _) => apply derivable_pt_exp
-  |  |- (derivable_pt (pow_fct _) _) =>
+      apply derivable_pt_Rsqr
+    |  |- (derivable_pt id ?X1) => apply (derivable_pt_id X1)
+    |  |- (derivable_pt (fct_cte _) _) => apply derivable_pt_const
+    |  |- (derivable_pt sin _) => apply derivable_pt_sin
+    |  |- (derivable_pt cos _) => apply derivable_pt_cos
+    |  |- (derivable_pt sinh _) => apply derivable_pt_sinh
+    |  |- (derivable_pt cosh _) => apply derivable_pt_cosh
+    |  |- (derivable_pt exp _) => apply derivable_pt_exp
+    |  |- (derivable_pt (pow_fct _) _) =>
       unfold pow_fct in |- *; apply derivable_pt_pow
-  |  |- (derivable_pt sqrt ?X1) =>
+    |  |- (derivable_pt sqrt ?X1) =>
       apply (derivable_pt_sqrt X1);
-       assumption ||
-         unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-          comp, id, fct_cte, pow_fct in |- *
-  |  |- (derivable_pt Rabs ?X1) =>
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
+    |  |- (derivable_pt Rabs ?X1) =>
       apply (Rderivable_pt_abs X1);
-       assumption ||
-         unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-          comp, id, fct_cte, pow_fct in |- *
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
         (* regles de differentiabilite *)
         (* PLUS *)
-  |  |- (derivable_pt (?X1 + ?X2) ?X3) =>
+    |  |- (derivable_pt (?X1 + ?X2) ?X3) =>
       apply (derivable_pt_plus X1 X2 X3); is_diff_pt
        (* MOINS *)
-  |  |- (derivable_pt (?X1 - ?X2) ?X3) =>
+    |  |- (derivable_pt (?X1 - ?X2) ?X3) =>
       apply (derivable_pt_minus X1 X2 X3); is_diff_pt
        (* OPPOSE *)
-  |  |- (derivable_pt (- ?X1) ?X2) =>
+    |  |- (derivable_pt (- ?X1) ?X2) =>
       apply (derivable_pt_opp X1 X2);
-       is_diff_pt
+        is_diff_pt
        (* MULTIPLICATION PAR UN SCALAIRE *)
-  |  |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+    |  |- (derivable_pt (mult_real_fct ?X1 ?X2) ?X3) =>
       apply (derivable_pt_scal X2 X1 X3); is_diff_pt
        (* MULTIPLICATION *)
-  |  |- (derivable_pt (?X1 * ?X2) ?X3) =>
+    |  |- (derivable_pt (?X1 * ?X2) ?X3) =>
       apply (derivable_pt_mult X1 X2 X3); is_diff_pt
        (* DIVISION *)
-  |  |- (derivable_pt (?X1 / ?X2) ?X3) =>
+    |  |- (derivable_pt (?X1 / ?X2) ?X3) =>
       apply (derivable_pt_div X1 X2 X3);
-       [ is_diff_pt
-       | is_diff_pt
-       | try
-          assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-             comp, pow_fct, id, fct_cte in |- * ]
-  |  |- (derivable_pt (/ ?X1) ?X2) =>
+        [ is_diff_pt
+          | is_diff_pt
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                comp, pow_fct, id, fct_cte in |- * ]
+    |  |- (derivable_pt (/ ?X1) ?X2) =>
       
        (* INVERSION *)
-       apply (derivable_pt_inv X1 X2);
-       [ assumption ||
-           unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+      apply (derivable_pt_inv X1 X2);
+        [ assumption ||
+          unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
             comp, pow_fct, id, fct_cte in |- *
-       | is_diff_pt ]
-  |  |- (derivable_pt (comp ?X1 ?X2) ?X3) =>
+          | is_diff_pt ]
+    |  |- (derivable_pt (comp ?X1 ?X2) ?X3) =>
       
        (* COMPOSITION *)
-       apply (derivable_pt_comp X2 X1 X3); is_diff_pt
-  | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
+      apply (derivable_pt_comp X2 X1 X3); is_diff_pt
+    | _:(derivable_pt ?X1 ?X2) |- (derivable_pt ?X1 ?X2) =>
       assumption
-  | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
+    | _:(derivable ?X1) |- (derivable_pt ?X1 ?X2) =>
       cut (derivable X1); [ intro HypDDPT; apply HypDDPT | assumption ]
-  |  |- (True -> derivable_pt _ _) =>
+    |  |- (True -> derivable_pt _ _) =>
       intro HypTruE; clear HypTruE; is_diff_pt
-  | _ =>
+    | _ =>
       try
-       unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-        fct_cte, comp, pow_fct in |- *
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
   end.
 
 (**********)
 Ltac is_diff_glob :=
   match goal with
-  |  |- (derivable Rsqr) => 
+    |  |- (derivable Rsqr) => 
   (* fonctions de base *)
-  apply derivable_Rsqr
-  |  |- (derivable id) => apply derivable_id
-  |  |- (derivable (fct_cte _)) => apply derivable_const
-  |  |- (derivable sin) => apply derivable_sin
-  |  |- (derivable cos) => apply derivable_cos
-  |  |- (derivable cosh) => apply derivable_cosh
-  |  |- (derivable sinh) => apply derivable_sinh
-  |  |- (derivable exp) => apply derivable_exp
-  |  |- (derivable (pow_fct _)) =>
+      apply derivable_Rsqr
+    |  |- (derivable id) => apply derivable_id
+    |  |- (derivable (fct_cte _)) => apply derivable_const
+    |  |- (derivable sin) => apply derivable_sin
+    |  |- (derivable cos) => apply derivable_cos
+    |  |- (derivable cosh) => apply derivable_cosh
+    |  |- (derivable sinh) => apply derivable_sinh
+    |  |- (derivable exp) => apply derivable_exp
+    |  |- (derivable (pow_fct _)) =>
       unfold pow_fct in |- *;
-       apply derivable_pow
+        apply derivable_pow
         (* regles de differentiabilite *)
         (* PLUS *)
-  |  |- (derivable (?X1 + ?X2)) =>
+    |  |- (derivable (?X1 + ?X2)) =>
       apply (derivable_plus X1 X2); is_diff_glob
        (* MOINS *)
-  |  |- (derivable (?X1 - ?X2)) =>
+    |  |- (derivable (?X1 - ?X2)) =>
       apply (derivable_minus X1 X2); is_diff_glob
        (* OPPOSE *)
-  |  |- (derivable (- ?X1)) =>
+    |  |- (derivable (- ?X1)) =>
       apply (derivable_opp X1);
-       is_diff_glob
+        is_diff_glob
        (* MULTIPLICATION PAR UN SCALAIRE *)
-  |  |- (derivable (mult_real_fct ?X1 ?X2)) =>
+    |  |- (derivable (mult_real_fct ?X1 ?X2)) =>
       apply (derivable_scal X2 X1); is_diff_glob
        (* MULTIPLICATION *)
-  |  |- (derivable (?X1 * ?X2)) =>
+    |  |- (derivable (?X1 * ?X2)) =>
       apply (derivable_mult X1 X2); is_diff_glob
        (* DIVISION *)
-  |  |- (derivable (?X1 / ?X2)) =>
+    |  |- (derivable (?X1 / ?X2)) =>
       apply (derivable_div X1 X2);
-       [ is_diff_glob
-       | is_diff_glob
-       | try
-          assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-             id, fct_cte, comp, pow_fct in |- * ]
-  |  |- (derivable (/ ?X1)) =>
+        [ is_diff_glob
+          | is_diff_glob
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                id, fct_cte, comp, pow_fct in |- * ]
+    |  |- (derivable (/ ?X1)) =>
       
        (* INVERSION *)
-       apply (derivable_inv X1);
-       [ try
+      apply (derivable_inv X1);
+        [ try
           assumption ||
             unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-             id, fct_cte, comp, pow_fct in |- *
-       | is_diff_glob ]
-  |  |- (derivable (comp sqrt _)) =>
+              id, fct_cte, comp, pow_fct in |- *
+          | is_diff_glob ]
+    |  |- (derivable (comp sqrt _)) =>
       
        (* COMPOSITION *)
-       unfold derivable in |- *; intro; try is_diff_pt
-  |  |- (derivable (comp Rabs _)) =>
       unfold derivable in |- *; intro; try is_diff_pt
-  |  |- (derivable (comp ?X1 ?X2)) =>
+    |  |- (derivable (comp Rabs _)) =>
+      unfold derivable in |- *; intro; try is_diff_pt
+    |  |- (derivable (comp ?X1 ?X2)) =>
       apply (derivable_comp X2 X1); is_diff_glob
-  | _:(derivable ?X1) |- (derivable ?X1) => assumption
-  |  |- (True -> derivable _) =>
+    | _:(derivable ?X1) |- (derivable ?X1) => assumption
+    |  |- (True -> derivable _) =>
       intro HypTruE; clear HypTruE; is_diff_glob
-  | _ =>
+    | _ =>
       try
-       unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-        fct_cte, comp, pow_fct in |- *
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
   end.
 
 (**********)
 Ltac is_cont_pt :=
   match goal with
-  |  |- (continuity_pt Rsqr _) =>
+    |  |- (continuity_pt Rsqr _) =>
       
        (* fonctions de base *)
-       apply derivable_continuous_pt; apply derivable_pt_Rsqr
-  |  |- (continuity_pt id ?X1) =>
+      apply derivable_continuous_pt; apply derivable_pt_Rsqr
+    |  |- (continuity_pt id ?X1) =>
       apply derivable_continuous_pt; apply (derivable_pt_id X1)
-  |  |- (continuity_pt (fct_cte _) _) =>
+    |  |- (continuity_pt (fct_cte _) _) =>
       apply derivable_continuous_pt; apply derivable_pt_const
-  |  |- (continuity_pt sin _) =>
+    |  |- (continuity_pt sin _) =>
       apply derivable_continuous_pt; apply derivable_pt_sin
-  |  |- (continuity_pt cos _) =>
+    |  |- (continuity_pt cos _) =>
       apply derivable_continuous_pt; apply derivable_pt_cos
-  |  |- (continuity_pt sinh _) =>
+    |  |- (continuity_pt sinh _) =>
       apply derivable_continuous_pt; apply derivable_pt_sinh
-  |  |- (continuity_pt cosh _) =>
+    |  |- (continuity_pt cosh _) =>
       apply derivable_continuous_pt; apply derivable_pt_cosh
-  |  |- (continuity_pt exp _) =>
+    |  |- (continuity_pt exp _) =>
       apply derivable_continuous_pt; apply derivable_pt_exp
-  |  |- (continuity_pt (pow_fct _) _) =>
+    |  |- (continuity_pt (pow_fct _) _) =>
       unfold pow_fct in |- *; apply derivable_continuous_pt;
-       apply derivable_pt_pow
-  |  |- (continuity_pt sqrt ?X1) =>
+        apply derivable_pt_pow
+    |  |- (continuity_pt sqrt ?X1) =>
       apply continuity_pt_sqrt;
-       assumption ||
-         unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
-          comp, id, fct_cte, pow_fct in |- *
-  |  |- (continuity_pt Rabs ?X1) =>
+        assumption ||
+          unfold plus_fct, minus_fct, opp_fct, mult_fct, div_fct, inv_fct,
+            comp, id, fct_cte, pow_fct in |- *
+    |  |- (continuity_pt Rabs ?X1) =>
       apply (Rcontinuity_abs X1)
        (* regles de differentiabilite *)
        (* PLUS *)
-  |  |- (continuity_pt (?X1 + ?X2) ?X3) =>
+    |  |- (continuity_pt (?X1 + ?X2) ?X3) =>
       apply (continuity_pt_plus X1 X2 X3); is_cont_pt
        (* MOINS *)
-  |  |- (continuity_pt (?X1 - ?X2) ?X3) =>
+    |  |- (continuity_pt (?X1 - ?X2) ?X3) =>
       apply (continuity_pt_minus X1 X2 X3); is_cont_pt
        (* OPPOSE *)
-  |  |- (continuity_pt (- ?X1) ?X2) =>
+    |  |- (continuity_pt (- ?X1) ?X2) =>
       apply (continuity_pt_opp X1 X2);
-       is_cont_pt
+        is_cont_pt
        (* MULTIPLICATION PAR UN SCALAIRE *)
-  |  |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) =>
+    |  |- (continuity_pt (mult_real_fct ?X1 ?X2) ?X3) =>
       apply (continuity_pt_scal X2 X1 X3); is_cont_pt
        (* MULTIPLICATION *)
-  |  |- (continuity_pt (?X1 * ?X2) ?X3) =>
+    |  |- (continuity_pt (?X1 * ?X2) ?X3) =>
       apply (continuity_pt_mult X1 X2 X3); is_cont_pt
        (* DIVISION *)
-  |  |- (continuity_pt (?X1 / ?X2) ?X3) =>
+    |  |- (continuity_pt (?X1 / ?X2) ?X3) =>
       apply (continuity_pt_div X1 X2 X3);
-       [ is_cont_pt
-       | is_cont_pt
-       | try
-          assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-             comp, id, fct_cte, pow_fct in |- * ]
-  |  |- (continuity_pt (/ ?X1) ?X2) =>
+        [ is_cont_pt
+          | is_cont_pt
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                comp, id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity_pt (/ ?X1) ?X2) =>
       
        (* INVERSION *)
-       apply (continuity_pt_inv X1 X2);
-       [ is_cont_pt
-       | assumption ||
-           unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-            comp, id, fct_cte, pow_fct in |- * ]
-  |  |- (continuity_pt (comp ?X1 ?X2) ?X3) =>
+      apply (continuity_pt_inv X1 X2);
+        [ is_cont_pt
+          | assumption ||
+            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+              comp, id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity_pt (comp ?X1 ?X2) ?X3) =>
       
        (* COMPOSITION *)
-       apply (continuity_pt_comp X2 X1 X3); is_cont_pt
-  | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+      apply (continuity_pt_comp X2 X1 X3); is_cont_pt
+    | _:(continuity_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
       assumption
-  | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
+    | _:(continuity ?X1) |- (continuity_pt ?X1 ?X2) =>
       cut (continuity X1); [ intro HypDDPT; apply HypDDPT | assumption ]
-  | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
+    | _:(derivable_pt ?X1 ?X2) |- (continuity_pt ?X1 ?X2) =>
       apply derivable_continuous_pt; assumption
-  | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
+    | _:(derivable ?X1) |- (continuity_pt ?X1 ?X2) =>
       cut (continuity X1);
-       [ intro HypDDPT; apply HypDDPT
-       | apply derivable_continuous; assumption ]
-  |  |- (True -> continuity_pt _ _) =>
+        [ intro HypDDPT; apply HypDDPT
+          | apply derivable_continuous; assumption ]
+    |  |- (True -> continuity_pt _ _) =>
       intro HypTruE; clear HypTruE; is_cont_pt
-  | _ =>
+    | _ =>
       try
-       unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-        fct_cte, comp, pow_fct in |- *
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
   end.
 
 (**********)
 Ltac is_cont_glob :=
   match goal with
-  |  |- (continuity Rsqr) =>
+    |  |- (continuity Rsqr) =>
       
        (* fonctions de base *)
-       apply derivable_continuous; apply derivable_Rsqr
-  |  |- (continuity id) => apply derivable_continuous; apply derivable_id
-  |  |- (continuity (fct_cte _)) =>
+      apply derivable_continuous; apply derivable_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 _)) =>
+    |  |- (continuity sin) => apply derivable_continuous; apply derivable_sin
+    |  |- (continuity cos) => apply derivable_continuous; apply derivable_cos
+    |  |- (continuity exp) => apply derivable_continuous; apply derivable_exp
+    |  |- (continuity (pow_fct _)) =>
       unfold pow_fct in |- *; apply derivable_continuous; apply derivable_pow
-  |  |- (continuity sinh) =>
+    |  |- (continuity sinh) =>
       apply derivable_continuous; apply derivable_sinh
-  |  |- (continuity cosh) =>
+    |  |- (continuity cosh) =>
       apply derivable_continuous; apply derivable_cosh
-  |  |- (continuity Rabs) =>
+    |  |- (continuity Rabs) =>
       apply Rcontinuity_abs
        (* regles de continuite *)
        (* PLUS *)
-  |  |- (continuity (?X1 + ?X2)) =>
+    |  |- (continuity (?X1 + ?X2)) =>
       apply (continuity_plus X1 X2);
-       try is_cont_glob || assumption
+        try is_cont_glob || assumption
             (* MOINS *)
-  |  |- (continuity (?X1 - ?X2)) =>
+    |  |- (continuity (?X1 - ?X2)) =>
       apply (continuity_minus X1 X2);
-       try is_cont_glob || assumption
+        try is_cont_glob || assumption
             (* OPPOSE *)
-  |  |- (continuity (- ?X1)) =>
+    |  |- (continuity (- ?X1)) =>
       apply (continuity_opp X1); try is_cont_glob || assumption
                                       (* INVERSE *)
-  |  |- (continuity (/ ?X1)) =>
+    |  |- (continuity (/ ?X1)) =>
       apply (continuity_inv X1);
-       try is_cont_glob || assumption
+        try is_cont_glob || assumption
             (* MULTIPLICATION PAR UN SCALAIRE *)
-  |  |- (continuity (mult_real_fct ?X1 ?X2)) =>
+    |  |- (continuity (mult_real_fct ?X1 ?X2)) =>
       apply (continuity_scal X2 X1);
-       try is_cont_glob || assumption
+        try is_cont_glob || assumption
             (* MULTIPLICATION *)
-  |  |- (continuity (?X1 * ?X2)) =>
+    |  |- (continuity (?X1 * ?X2)) =>
       apply (continuity_mult X1 X2);
-       try is_cont_glob || assumption
+        try is_cont_glob || assumption
             (* DIVISION *)
-  |  |- (continuity (?X1 / ?X2)) =>
+    |  |- (continuity (?X1 / ?X2)) =>
       apply (continuity_div X1 X2);
-       [ try is_cont_glob || assumption
-       | try is_cont_glob || assumption
-       | try
-          assumption ||
-            unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
-             id, fct_cte, pow_fct in |- * ]
-  |  |- (continuity (comp sqrt _)) =>
+        [ try is_cont_glob || assumption
+          | try is_cont_glob || assumption
+          | try
+            assumption ||
+              unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct,
+                id, fct_cte, pow_fct in |- * ]
+    |  |- (continuity (comp sqrt _)) =>
       
        (* COMPOSITION *)
-       unfold continuity_pt in |- *; intro; try is_cont_pt
-  |  |- (continuity (comp ?X1 ?X2)) =>
+      unfold continuity_pt in |- *; intro; try is_cont_pt
+    |  |- (continuity (comp ?X1 ?X2)) =>
       apply (continuity_comp X2 X1); try is_cont_glob || assumption
-  | _:(continuity ?X1) |- (continuity ?X1) => assumption
-  |  |- (True -> continuity _) =>
+    | _:(continuity ?X1) |- (continuity ?X1) => assumption
+    |  |- (True -> continuity _) =>
       intro HypTruE; clear HypTruE; is_cont_glob
-  | _:(derivable ?X1) |- (continuity ?X1) =>
+    | _:(derivable ?X1) |- (continuity ?X1) =>
       apply derivable_continuous; assumption
-  | _ =>
+    | _ =>
       try
-       unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
-        fct_cte, comp, pow_fct in |- *
+        unfold plus_fct, mult_fct, div_fct, minus_fct, opp_fct, inv_fct, id,
+          fct_cte, comp, pow_fct in |- *
   end.
 
 (**********)
 Ltac rew_term trm :=
   match constr:trm with
-  | (?X1 + ?X2) =>
+    | (?X1 + ?X2) =>
       let p1 := rew_term X1 with p2 := rew_term X2 in
-      match constr:p1 with
-      | (fct_cte ?X3) =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(fct_cte (X3 + X4))
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 + X4))
+              | _ => constr:(p1 + p2)%F
+            end
           | _ => constr:(p1 + p2)%F
-          end
-      | _ => constr:(p1 + p2)%F
-      end
-  | (?X1 - ?X2) =>
+        end
+    | (?X1 - ?X2) =>
       let p1 := rew_term X1 with p2 := rew_term X2 in
-      match constr:p1 with
-      | (fct_cte ?X3) =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(fct_cte (X3 - X4))
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 - X4))
+              | _ => constr:(p1 - p2)%F
+            end
           | _ => constr:(p1 - p2)%F
-          end
-      | _ => constr:(p1 - p2)%F
-      end
-  | (?X1 / ?X2) =>
+        end
+    | (?X1 / ?X2) =>
       let p1 := rew_term X1 with p2 := rew_term X2 in
-      match constr:p1 with
-      | (fct_cte ?X3) =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
-          | _ => constr:(p1 / p2)%F
-          end
-      | _ =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
-          | _ => constr:(p1 / p2)%F
-          end
-      end
-  | (?X1 * / ?X2) =>
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+              | _ => constr:(p1 / p2)%F
+            end
+          | _ =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+              | _ => constr:(p1 / p2)%F
+            end
+        end
+    | (?X1 * / ?X2) =>
       let p1 := rew_term X1 with p2 := rew_term X2 in
-      match constr:p1 with
-      | (fct_cte ?X3) =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
-          | _ => constr:(p1 / p2)%F
-          end
-      | _ =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
-          | _ => constr:(p1 / p2)%F
-          end
-      end
-  | (?X1 * ?X2) =>
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 / X4))
+              | _ => constr:(p1 / p2)%F
+            end
+          | _ =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(p1 * fct_cte (/ X4))%F
+              | _ => constr:(p1 / p2)%F
+            end
+        end
+    | (?X1 * ?X2) =>
       let p1 := rew_term X1 with p2 := rew_term X2 in
-      match constr:p1 with
-      | (fct_cte ?X3) =>
-          match constr:p2 with
-          | (fct_cte ?X4) => constr:(fct_cte (X3 * X4))
+        match constr:p1 with
+          | (fct_cte ?X3) =>
+            match constr:p2 with
+              | (fct_cte ?X4) => constr:(fct_cte (X3 * X4))
+              | _ => constr:(p1 * p2)%F
+            end
           | _ => constr:(p1 * p2)%F
-          end
-      | _ => constr:(p1 * p2)%F
-      end
-  | (- ?X1) =>
+        end
+    | (- ?X1) =>
       let p := rew_term X1 in
-      match constr:p with
-      | (fct_cte ?X2) => constr:(fct_cte (- X2))
-      | _ => constr:(- p)%F
-      end
-  | (/ ?X1) =>
+        match constr:p with
+          | (fct_cte ?X2) => constr:(fct_cte (- X2))
+          | _ => constr:(- p)%F
+        end
+    | (/ ?X1) =>
       let p := rew_term X1 in
-      match constr:p with
-      | (fct_cte ?X2) => constr:(fct_cte (/ X2))
-      | _ => constr:(/ p)%F
-      end
-  | (?X1 AppVar) => constr:X1
-  | (?X1 ?X2) =>
+        match constr:p with
+          | (fct_cte ?X2) => constr:(fct_cte (/ X2))
+          | _ => constr:(/ p)%F
+        end
+    | (?X1 AppVar) => constr:X1
+    | (?X1 ?X2) =>
       let p := rew_term X2 in
-      match constr:p with
-      | (fct_cte ?X3) => constr:(fct_cte (X1 X3))
-      | _ => constr:(comp X1 p)
-      end
-  | AppVar => constr:id
-  | (AppVar ^ ?X1) => constr:(pow_fct X1)
-  | (?X1 ^ ?X2) =>
+        match constr:p with
+          | (fct_cte ?X3) => constr:(fct_cte (X1 X3))
+          | _ => constr:(comp X1 p)
+        end
+    | AppVar => constr:id
+    | (AppVar ^ ?X1) => constr:(pow_fct X1)
+    | (?X1 ^ ?X2) =>
       let p := rew_term X1 in
-      match constr:p with
-      | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3))
-      | _ => constr:(comp (pow_fct X2) p)
-      end
-  | ?X1 => constr:(fct_cte X1)
+        match constr:p with
+          | (fct_cte ?X3) => constr:(fct_cte (pow_fct X2 X3))
+          | _ => constr:(comp (pow_fct X2) p)
+        end
+    | ?X1 => constr:(fct_cte X1)
   end.
 
 (**********)
 Ltac deriv_proof trm pt :=
   match constr:trm with
-  | (?X1 + ?X2)%F =>
+    | (?X1 + ?X2)%F =>
       let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-      constr:(derivable_pt_plus X1 X2 pt p1 p2)
-  | (?X1 - ?X2)%F =>
+        constr:(derivable_pt_plus X1 X2 pt p1 p2)
+    | (?X1 - ?X2)%F =>
       let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-      constr:(derivable_pt_minus X1 X2 pt p1 p2)
-  | (?X1 * ?X2)%F =>
+        constr:(derivable_pt_minus X1 X2 pt p1 p2)
+    | (?X1 * ?X2)%F =>
       let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-      constr:(derivable_pt_mult X1 X2 pt p1 p2)
-  | (?X1 / ?X2)%F =>
+        constr:(derivable_pt_mult X1 X2 pt p1 p2)
+    | (?X1 / ?X2)%F =>
       match goal with
-      | id:(?X2 pt <> 0) |- _ =>
+        | id:(?X2 pt <> 0) |- _ =>
           let p1 := deriv_proof X1 pt with p2 := deriv_proof X2 pt in
-          constr:(derivable_pt_div X1 X2 pt p1 p2 id)
-      | _ => constr:False
+            constr:(derivable_pt_div X1 X2 pt p1 p2 id)
+        | _ => constr:False
       end
-  | (/ ?X1)%F =>
+    | (/ ?X1)%F =>
       match goal with
-      | id:(?X1 pt <> 0) |- _ =>
+        | id:(?X1 pt <> 0) |- _ =>
           let p1 := deriv_proof X1 pt in
-          constr:(derivable_pt_inv X1 pt p1 id)
-      | _ => constr:False
+            constr:(derivable_pt_inv X1 pt p1 id)
+        | _ => constr:False
       end
-  | (comp ?X1 ?X2) =>
+    | (comp ?X1 ?X2) =>
       let pt_f1 := eval cbv beta in (X2 pt) in
-      let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in
-      constr:(derivable_pt_comp X2 X1 pt p2 p1)
-  | (- ?X1)%F =>
+        let p1 := deriv_proof X1 pt_f1 with p2 := deriv_proof X2 pt in
+          constr:(derivable_pt_comp X2 X1 pt p2 p1)
+    | (- ?X1)%F =>
       let p1 := deriv_proof X1 pt in
-      constr:(derivable_pt_opp X1 pt p1)
-  | sin => constr:(derivable_pt_sin pt)
-  | cos => constr:(derivable_pt_cos pt)
-  | sinh => constr:(derivable_pt_sinh pt)
-  | cosh => constr:(derivable_pt_cosh pt)
-  | exp => constr:(derivable_pt_exp pt)
-  | id => constr:(derivable_pt_id pt)
-  | Rsqr => constr:(derivable_pt_Rsqr pt)
-  | sqrt =>
+        constr:(derivable_pt_opp X1 pt p1)
+    | sin => constr:(derivable_pt_sin pt)
+    | cos => constr:(derivable_pt_cos pt)
+    | sinh => constr:(derivable_pt_sinh pt)
+    | cosh => constr:(derivable_pt_cosh pt)
+    | exp => constr:(derivable_pt_exp pt)
+    | id => constr:(derivable_pt_id pt)
+    | Rsqr => constr:(derivable_pt_Rsqr pt)
+    | sqrt =>
       match goal with
-      | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id)
-      | _ => constr:False
+        | id:(0 < pt) |- _ => constr:(derivable_pt_sqrt pt id)
+        | _ => constr:False
       end
-  | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt)
-  | ?X1 =>
+    | (fct_cte ?X1) => constr:(derivable_pt_const X1 pt)
+    | ?X1 =>
       let aux := constr:X1 in
-      match goal with
-      | id:(derivable_pt aux pt) |- _ => constr:id
-      | id:(derivable aux) |- _ => constr:(id pt)
-      | _ => constr:False
-      end
+        match goal with
+          | id:(derivable_pt aux pt) |- _ => constr:id
+          | id:(derivable aux) |- _ => constr:(id pt)
+          | _ => constr:False
+        end
   end.
 
 (**********)
 Ltac simplify_derive trm pt :=
   match constr:trm with
-  | (?X1 + ?X2)%F =>
+    | (?X1 + ?X2)%F =>
       try rewrite derive_pt_plus; simplify_derive X1 pt;
-       simplify_derive X2 pt
-  | (?X1 - ?X2)%F =>
+        simplify_derive X2 pt
+    | (?X1 - ?X2)%F =>
       try rewrite derive_pt_minus; simplify_derive X1 pt;
-       simplify_derive X2 pt
-  | (?X1 * ?X2)%F =>
+        simplify_derive X2 pt
+    | (?X1 * ?X2)%F =>
       try rewrite derive_pt_mult; simplify_derive X1 pt;
-       simplify_derive X2 pt
-  | (?X1 / ?X2)%F =>
+        simplify_derive X2 pt
+    | (?X1 / ?X2)%F =>
       try rewrite derive_pt_div; simplify_derive X1 pt; simplify_derive X2 pt
-  | (comp ?X1 ?X2) =>
+    | (comp ?X1 ?X2) =>
       let pt_f1 := eval cbv beta in (X2 pt) in
-      (try rewrite derive_pt_comp; simplify_derive X1 pt_f1;
-        simplify_derive X2 pt)
-  | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt
-  | (/ ?X1)%F =>
+        (try rewrite derive_pt_comp; simplify_derive X1 pt_f1;
+          simplify_derive X2 pt)
+    | (- ?X1)%F => try rewrite derive_pt_opp; simplify_derive X1 pt
+    | (/ ?X1)%F =>
       try rewrite derive_pt_inv; simplify_derive X1 pt
-  | (fct_cte ?X1) => try rewrite derive_pt_const
-  | id => try rewrite derive_pt_id
-  | sin => try rewrite derive_pt_sin
-  | cos => try rewrite derive_pt_cos
-  | sinh => try rewrite derive_pt_sinh
-  | cosh => try rewrite derive_pt_cosh
-  | exp => try rewrite derive_pt_exp
-  | Rsqr => try rewrite derive_pt_Rsqr
-  | sqrt => try rewrite derive_pt_sqrt
-  | ?X1 =>
+    | (fct_cte ?X1) => try rewrite derive_pt_const
+    | id => try rewrite derive_pt_id
+    | sin => try rewrite derive_pt_sin
+    | cos => try rewrite derive_pt_cos
+    | sinh => try rewrite derive_pt_sinh
+    | cosh => try rewrite derive_pt_cosh
+    | exp => try rewrite derive_pt_exp
+    | Rsqr => try rewrite derive_pt_Rsqr
+    | sqrt => try rewrite derive_pt_sqrt
+    | ?X1 =>
       let aux := constr:X1 in
-      match goal with
-      | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ =>
-          try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2);
-           [ rewrite id | apply pr_nu ]
-      | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ =>
-          try replace (derive_pt aux pt H) with (derive_pt aux pt X2);
-           [ rewrite id | apply pr_nu ]
-      | _ => idtac
-      end
-  | _ => idtac
+        match goal with
+          | id:(derive_pt aux pt ?X2 = _),H:(derivable aux) |- _ =>
+            try replace (derive_pt aux pt (H pt)) with (derive_pt aux pt X2);
+              [ rewrite id | apply pr_nu ]
+          | id:(derive_pt aux pt ?X2 = _),H:(derivable_pt aux pt) |- _ =>
+            try replace (derive_pt aux pt H) with (derive_pt aux pt X2);
+              [ rewrite id | apply pr_nu ]
+          | _ => idtac
+        end
+    | _ => idtac
   end.
 
 (**********)
 Ltac reg :=
   match goal with
-  |  |- (derivable_pt ?X1 ?X2) =>
+    |  |- (derivable_pt ?X1 ?X2) =>
       let trm := eval cbv beta in (X1 AppVar) in
-      let aux := rew_term trm in
-      (intro_hyp_pt aux X2;
-        try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt)
-  |  |- (derivable ?X1) =>
+        let aux := rew_term trm in
+          (intro_hyp_pt aux X2;
+            try (change (derivable_pt aux X2) in |- *; is_diff_pt) || is_diff_pt)
+    |  |- (derivable ?X1) =>
       let trm := eval cbv beta in (X1 AppVar) in
-      let aux := rew_term trm in
-      (intro_hyp_glob aux;
-        try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob)
-  |  |- (continuity ?X1) =>
+        let aux := rew_term trm in
+          (intro_hyp_glob aux;
+            try (change (derivable aux) in |- *; is_diff_glob) || is_diff_glob)
+    |  |- (continuity ?X1) =>
       let trm := eval cbv beta in (X1 AppVar) in
-      let aux := rew_term trm in
-      (intro_hyp_glob aux;
-        try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob)
-  |  |- (continuity_pt ?X1 ?X2) =>
+        let aux := rew_term trm in
+          (intro_hyp_glob aux;
+            try (change (continuity aux) in |- *; is_cont_glob) || is_cont_glob)
+    |  |- (continuity_pt ?X1 ?X2) =>
       let trm := eval cbv beta in (X1 AppVar) in
-      let aux := rew_term trm in
-      (intro_hyp_pt aux X2;
-        try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt)
-  |  |- (derive_pt ?X1 ?X2 ?X3 = ?X4) =>
+        let aux := rew_term trm in
+          (intro_hyp_pt aux X2;
+            try (change (continuity_pt aux X2) in |- *; is_cont_pt) || is_cont_pt)
+    |  |- (derive_pt ?X1 ?X2 ?X3 = ?X4) =>
       let trm := eval cbv beta in (X1 AppVar) in
       let aux := rew_term trm in
-      (intro_hyp_pt aux X2;
-        let aux2 := deriv_proof aux X2 in
-        (try
-          (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2);
-            [ simplify_derive aux X2;
-               try
-                unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte,
-                 inv_fct, opp_fct in |- *; try ring
-            | try apply pr_nu ]) || is_diff_pt))
-  end.
\ No newline at end of file
+      intro_hyp_pt aux X2;
+      (let aux2 := deriv_proof aux X2 in
+       try
+         (replace (derive_pt X1 X2 X3) with (derive_pt aux X2 aux2);
+           [ simplify_derive aux X2;
+             try unfold plus_fct, minus_fct, mult_fct, div_fct, id, fct_cte,
+                        inv_fct, opp_fct in |- *; ring || ring_simplify
+           | try apply pr_nu ]) || is_diff_pt)
+  end.
diff --git a/theories/Reals/Ranalysis1.v b/theories/Reals/Ranalysis1.v
index 0148d0a2..93a66e70 100644
--- a/theories/Reals/Ranalysis1.v
+++ b/theories/Reals/Ranalysis1.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis1.v 9042 2006-07-11 22:06:48Z herbelin $ i*)
+(*i $Id: Ranalysis1.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -15,7 +15,7 @@ Require Export Rderiv. Open Local Scope R_scope.
 Implicit Type f : R -> R.
 
 (****************************************************)
-(**           Basic operations on functions         *)
+(** *         Basic operations on functions         *)
 (****************************************************)
 Definition plus_fct f1 f2 (x:R) : R := f1 x + f2 x.
 Definition opp_fct f (x:R) : R := - f x.
@@ -52,14 +52,14 @@ Definition fct_cte (a x:R) : R := a.
 Definition id (x:R) := x.
 
 (****************************************************)
-(**            Variations of functions              *)
+(** *          Variations of functions              *)
 (****************************************************)
 Definition increasing f : Prop := forall x y:R, x <= y -> f x <= f y.
 Definition decreasing f : Prop := forall x y:R, x <= y -> f y <= f x.
 Definition strict_increasing f : Prop := forall x y:R, x < y -> f x < f y.
 Definition strict_decreasing f : Prop := forall x y:R, x < y -> f y < f x.
 Definition constant f : Prop := forall x y:R, f x = f y.
-  
+
 (**********) 
 Definition no_cond (x:R) : Prop := True.
 
@@ -68,7 +68,7 @@ Definition constant_D_eq f (D:R -> Prop) (c:R) : Prop :=
   forall x:R, D x -> f x = c.
 
 (***************************************************)
-(**      Definition of continuity as a limit       *)
+(** *    Definition of continuity as a limit       *)
 (***************************************************)
 
 (**********)
@@ -80,173 +80,192 @@ Arguments Scope continuity [Rfun_scope].
 
 (**********)
 Lemma continuity_pt_plus :
- forall f1 f2 (x0:R),
-   continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0.
-unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros;
- apply limit_plus; assumption.
+  forall f1 f2 (x0:R),
+    continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 + f2) x0.
+Proof.
+  unfold continuity_pt, plus_fct in |- *; unfold continue_in in |- *; intros;
+    apply limit_plus; assumption.
 Qed.
 
 Lemma continuity_pt_opp :
- forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0.
-unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros;
- apply limit_Ropp; assumption.
+  forall f (x0:R), continuity_pt f x0 -> continuity_pt (- f) x0.
+Proof.
+  unfold continuity_pt, opp_fct in |- *; unfold continue_in in |- *; intros;
+    apply limit_Ropp; assumption.
 Qed.
- 
+
 Lemma continuity_pt_minus :
- forall f1 f2 (x0:R),
-   continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0.
-unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros;
- apply limit_minus; assumption.
+  forall f1 f2 (x0:R),
+    continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 - f2) x0.
+Proof.
+  unfold continuity_pt, minus_fct in |- *; unfold continue_in in |- *; intros;
+    apply limit_minus; assumption.
 Qed.
 
 Lemma continuity_pt_mult :
- forall f1 f2 (x0:R),
-   continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0.
-unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros;
- apply limit_mul; assumption.
+  forall f1 f2 (x0:R),
+    continuity_pt f1 x0 -> continuity_pt f2 x0 -> continuity_pt (f1 * f2) x0.
+Proof.
+  unfold continuity_pt, mult_fct in |- *; unfold continue_in in |- *; intros;
+    apply limit_mul; assumption.
 Qed.
 
 Lemma continuity_pt_const : forall f (x0:R), constant f -> continuity_pt f x0.
-unfold constant, continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- intros; exists 1; split;
- [ apply Rlt_0_1
- | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *;
-    rewrite R_dist_eq; assumption ].
+Proof.
+  unfold constant, continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      intros; exists 1; split;
+        [ apply Rlt_0_1
+          | intros; generalize (H x x0); intro; rewrite H2; simpl in |- *;
+            rewrite R_dist_eq; assumption ].
 Qed.
 
 Lemma continuity_pt_scal :
- forall f (a x0:R),
-   continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0.
-unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *;
- intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0).
-unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split.
-apply Rlt_0_1.
-intros; rewrite R_dist_eq; assumption.
-assumption.
+  forall f (a x0:R),
+    continuity_pt f x0 -> continuity_pt (mult_real_fct a f) x0.
+Proof.
+  unfold continuity_pt, mult_real_fct in |- *; unfold continue_in in |- *;
+    intros; apply (limit_mul (fun x:R => a) f (D_x no_cond x0) a (f x0) x0).
+  unfold limit1_in in |- *; unfold limit_in in |- *; intros; exists 1; split.
+  apply Rlt_0_1.
+  intros; rewrite R_dist_eq; assumption.
+  assumption.
 Qed.
 
 Lemma continuity_pt_inv :
- forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0.
-intros.
-replace (/ f)%F with (fun x:R => / f x).
-unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
- apply limit_inv; assumption.
-unfold inv_fct in |- *; reflexivity.
-Qed.
- 
+  forall f (x0:R), continuity_pt f x0 -> f x0 <> 0 -> continuity_pt (/ f) x0.
+Proof.
+  intros.
+  replace (/ f)%F with (fun x:R => / f x).
+  unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
+    apply limit_inv; assumption.
+  unfold inv_fct in |- *; reflexivity.
+Qed.
+
 Lemma div_eq_inv : forall f1 f2, (f1 / f2)%F = (f1 * / f2)%F.
-intros; reflexivity.
+Proof.
+  intros; reflexivity.
 Qed.
- 
+
 Lemma continuity_pt_div :
- forall f1 f2 (x0:R),
-   continuity_pt f1 x0 ->
-   continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0.
-intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult;
- [ assumption | apply continuity_pt_inv; assumption ].
+  forall f1 f2 (x0:R),
+    continuity_pt f1 x0 ->
+    continuity_pt f2 x0 -> f2 x0 <> 0 -> continuity_pt (f1 / f2) x0.
+Proof.
+  intros; rewrite (div_eq_inv f1 f2); apply continuity_pt_mult;
+    [ assumption | apply continuity_pt_inv; assumption ].
 Qed.
 
 Lemma continuity_pt_comp :
- forall f1 f2 (x:R),
-   continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x.
-unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
- unfold comp in |- *.
-cut
- (limit1_in (fun x0:R => f2 (f1 x0))
-    (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) (
-    f2 (f1 x)) x ->
-  limit1_in (fun 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 in |- *; unfold limit_in in |- *; unfold dist in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-assert (H3 := H1 eps H2).
-elim H3; intros.
-exists x0.
-split.
-elim H4; intros; assumption.
-intros; case (Req_dec (f1 x) (f1 x1)); intro.
-rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- assumption.
-elim H4; intros; apply H8.
-split.
-unfold Dgf, D_x, no_cond in |- *.
-split.
-split.
-trivial.
-elim H5; unfold D_x, no_cond in |- *; intros.
-elim H9; intros; assumption.
-split.
-trivial.
-assumption.
-elim H5; intros; assumption.
+  forall f1 f2 (x:R),
+    continuity_pt f1 x -> continuity_pt f2 (f1 x) -> continuity_pt (f2 o f1) x.
+Proof.
+  unfold continuity_pt in |- *; unfold continue_in in |- *; intros;
+    unfold comp in |- *.
+  cut
+    (limit1_in (fun x0:R => f2 (f1 x0))
+      (Dgf (D_x no_cond x) (D_x no_cond (f1 x)) f1) (
+        f2 (f1 x)) x ->
+      limit1_in (fun 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 in |- *; unfold limit_in in |- *; unfold dist in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  assert (H3 := H1 eps H2).
+  elim H3; intros.
+  exists x0.
+  split.
+  elim H4; intros; assumption.
+  intros; case (Req_dec (f1 x) (f1 x1)); intro.
+  rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    assumption.
+  elim H4; intros; apply H8.
+  split.
+  unfold Dgf, D_x, no_cond in |- *.
+  split.
+  split.
+  trivial.
+  elim H5; unfold D_x, no_cond in |- *; intros.
+  elim H9; intros; assumption.
+  split.
+  trivial.
+  assumption.
+  elim H5; intros; assumption.
 Qed.
 
 (**********) 
 Lemma continuity_plus :
- forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2).
-unfold continuity in |- *; intros;
- apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
+  forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 + f2).
+Proof.
+  unfold continuity in |- *; intros;
+    apply (continuity_pt_plus f1 f2 x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_opp : forall f, continuity f -> continuity (- f).
-unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)).
+Proof.
+  unfold continuity in |- *; intros; apply (continuity_pt_opp f x (H x)).
 Qed.
 
 Lemma continuity_minus :
- forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2).
-unfold continuity in |- *; intros;
- apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
+  forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 - f2).
+Proof.
+  unfold continuity in |- *; intros;
+    apply (continuity_pt_minus f1 f2 x (H x) (H0 x)).
 Qed.
- 
+
 Lemma continuity_mult :
- forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2).
-unfold continuity in |- *; intros;
- apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
+  forall f1 f2, continuity f1 -> continuity f2 -> continuity (f1 * f2).
+Proof.
+  unfold continuity in |- *; intros;
+    apply (continuity_pt_mult f1 f2 x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_const : forall f, constant f -> continuity f.
-unfold continuity in |- *; intros; apply (continuity_pt_const f x H).
+Proof.
+  unfold continuity in |- *; intros; apply (continuity_pt_const f x H).
 Qed.
 
 Lemma continuity_scal :
- forall f (a:R), continuity f -> continuity (mult_real_fct a f).
-unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)).
+  forall f (a:R), continuity f -> continuity (mult_real_fct a f).
+Proof.
+  unfold continuity in |- *; intros; apply (continuity_pt_scal f a x (H x)).
 Qed.
-  
+
 Lemma continuity_inv :
- forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f).
-unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)).
+  forall f, continuity f -> (forall x:R, f x <> 0) -> continuity (/ f).
+Proof.
+  unfold continuity in |- *; intros; apply (continuity_pt_inv f x (H x) (H0 x)).
 Qed.
 
 Lemma continuity_div :
- forall f1 f2,
-   continuity f1 ->
-   continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2).
-unfold continuity in |- *; intros;
- apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
+  forall f1 f2,
+    continuity f1 ->
+    continuity f2 -> (forall x:R, f2 x <> 0) -> continuity (f1 / f2).
+Proof.
+  unfold continuity in |- *; intros;
+    apply (continuity_pt_div f1 f2 x (H x) (H0 x) (H1 x)).
 Qed.
- 
+
 Lemma continuity_comp :
- forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1).
-unfold continuity in |- *; intros.
-apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
+  forall f1 f2, continuity f1 -> continuity f2 -> continuity (f2 o f1).
+Proof.
+  unfold continuity in |- *; intros.
+  apply (continuity_pt_comp f1 f2 x (H x) (H0 (f1 x))).
 Qed.
 
 
 (*****************************************************)
-(**  Derivative's definition using Landau's kernel   *)
+(** * Derivative's definition using Landau's kernel  *)
 (*****************************************************)
 
 Definition derivable_pt_lim f (x l:R) : Prop :=
   forall eps:R,
     0 < eps ->
-     exists delta : posreal,
+    exists delta : posreal,
       (forall h:R,
-         h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps).
+        h <> 0 -> Rabs h < delta -> Rabs ((f (x + h) - f x) / h - l) < eps).
 
 Definition derivable_pt_abs f (x l:R) : Prop := derivable_pt_lim f x l.
 
@@ -265,1225 +284,1279 @@ Arguments Scope derive [Rfun_scope _].
 
 Definition antiderivative f (g:R -> R) (a b:R) : Prop :=
   (forall x:R,
-     a <= x <= b ->  exists pr : derivable_pt g x, f x = derive_pt g x pr) /\
+    a <= x <= b ->  exists pr : derivable_pt g x, f x = derive_pt g x pr) /\
   a <= b.
-(************************************)
-(** Class of differential functions *)
-(************************************)
+(**************************************)
+(** * 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)}.
+    cond_D1 : derivable d2;
+    cond_D2 : derivable (derive d2 cond_D1)}.
 
 (**********)
 Lemma uniqueness_step1 :
- forall f (x l1 l2:R),
-   limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 ->
-   limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 ->
-   l1 = l2.
-intros;
- apply
-  (single_limit (fun h:R => (f (x + h) - f x) / h) (
-     fun h:R => h <> 0) l1 l2 0); try assumption.
-unfold adhDa in |- *; intros; exists (alp / 2).
-split.
-unfold Rdiv in |- *; apply prod_neq_R0.
-red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
-apply Rinv_neq_0_compat; discrR.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult.
-replace (Rabs (/ 2)) with (/ 2).
-replace (Rabs alp) with alp.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
- [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double;
- pattern alp at 1 in |- *; replace alp with (alp + 0); 
- [ idtac | ring ]; apply Rplus_lt_compat_l; assumption.
-symmetry  in |- *; apply Rabs_right; left; assumption.
-symmetry  in |- *; apply Rabs_right; left; change (0 < / 2) in |- *;
- apply Rinv_0_lt_compat; prove_sup0. 
+  forall f (x l1 l2:R),
+    limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l1 0 ->
+    limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l2 0 ->
+    l1 = l2.
+Proof.
+  intros;
+    apply
+      (single_limit (fun h:R => (f (x + h) - f x) / h) (
+        fun h:R => h <> 0) l1 l2 0); try assumption.
+  unfold adhDa in |- *; intros; exists (alp / 2).
+  split.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+  apply Rinv_neq_0_compat; discrR.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite Rabs_mult.
+  replace (Rabs (/ 2)) with (/ 2).
+  replace (Rabs alp) with alp.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite (Rmult_comm 2); rewrite Rmult_assoc; rewrite <- Rinv_l_sym;
+    [ idtac | discrR ]; rewrite Rmult_1_r; rewrite double;
+      pattern alp at 1 in |- *; replace alp with (alp + 0); 
+        [ idtac | ring ]; apply Rplus_lt_compat_l; assumption.
+  symmetry  in |- *; apply Rabs_right; left; assumption.
+  symmetry  in |- *; apply Rabs_right; left; change (0 < / 2) in |- *;
+    apply Rinv_0_lt_compat; prove_sup0. 
 Qed.
 
 Lemma uniqueness_step2 :
- forall f (x l:R),
-   derivable_pt_lim f x l ->
-   limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0.
-unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *;
- unfold limit_in in |- *; intros.
-assert (H1 := H eps H0).
-elim H1; intros.
-exists (pos x0).
-split.
-apply (cond_pos x0).
-simpl in |- *; unfold R_dist in |- *; intros.
-elim H3; intros.
-apply H2;
- [ assumption
- | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5;
-    assumption ].
+  forall f (x l:R),
+    derivable_pt_lim f x l ->
+    limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0.
+Proof. 
+  unfold derivable_pt_lim in |- *; intros; unfold limit1_in in |- *;
+    unfold limit_in in |- *; intros.
+  assert (H1 := H eps H0).
+  elim H1; intros.
+  exists (pos x0).
+  split.
+  apply (cond_pos x0).
+  simpl in |- *; unfold R_dist in |- *; intros.
+  elim H3; intros.
+  apply H2;
+    [ assumption
+      | unfold Rminus in H5; rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5;
+        assumption ].
 Qed.
 
 Lemma uniqueness_step3 :
- forall f (x l:R),
-   limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 ->
-   derivable_pt_lim f x l.
-unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *;
- unfold dist in |- *; simpl in |- *; intros.
-elim (H eps H0).
-intros; elim H1; intros.
-exists (mkposreal x0 H2).
-simpl in |- *; intros; unfold R_dist in H3; apply (H3 h).
-split;
- [ assumption
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ].
+  forall f (x l:R),
+    limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 ->
+    derivable_pt_lim f x l.
+Proof.
+  unfold limit1_in, derivable_pt_lim in |- *; unfold limit_in in |- *;
+    unfold dist in |- *; simpl in |- *; intros.
+  elim (H eps H0).
+  intros; elim H1; intros.
+  exists (mkposreal x0 H2).
+  simpl in |- *; intros; unfold R_dist in H3; apply (H3 h).
+  split;
+    [ assumption
+      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; assumption ].
 Qed.
 
 Lemma uniqueness_limite :
- forall f (x l1 l2:R),
-   derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2.
-intros.
-assert (H1 := uniqueness_step2 _ _ _ H).
-assert (H2 := uniqueness_step2 _ _ _ H0).
-assert (H3 := uniqueness_step1 _ _ _ _ H1 H2).
-assumption.
+  forall f (x l1 l2:R),
+    derivable_pt_lim f x l1 -> derivable_pt_lim f x l2 -> l1 = l2.
+Proof.
+  intros.
+  assert (H1 := uniqueness_step2 _ _ _ H).
+  assert (H2 := uniqueness_step2 _ _ _ H0).
+  assert (H3 := uniqueness_step1 _ _ _ _ H1 H2).
+  assumption.
 Qed.
 
 Lemma derive_pt_eq :
- forall f (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 := uniqueness_limite _ _ _ _ H H1).
-unfold derive_pt in |- *; unfold derivable_pt_abs in |- *.
-symmetry  in |- *; assumption.
+  forall f (x l:R) (pr:derivable_pt f x),
+    derive_pt f x pr = l <-> derivable_pt_lim f x l.
+Proof.
+  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 := uniqueness_limite _ _ _ _ H H1).
+  unfold derive_pt in |- *; unfold derivable_pt_abs in |- *.
+  symmetry  in |- *; assumption.
 Qed.
 
 (**********)
 Lemma derive_pt_eq_0 :
- forall f (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).
+  forall f (x l:R) (pr:derivable_pt f x),
+    derivable_pt_lim f x l -> derive_pt f x pr = l.
+Proof.
+  intros; elim (derive_pt_eq f x l pr); intros.
+  apply (H1 H).
 Qed.
 
 (**********)
 Lemma derive_pt_eq_1 :
- forall f (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).
+  forall f (x l:R) (pr:derivable_pt f x),
+    derive_pt f x pr = l -> derivable_pt_lim f x l.
+Proof.
+  intros; elim (derive_pt_eq f x l pr); intros.
+  apply (H0 H).
 Qed.
 
 
-(********************************************************************)
-(** Equivalence of this definition with the one using limit concept *)
-(********************************************************************)
+(**********************************************************************)
+(** * Equivalence of this definition with the one using limit concept *)
+(**********************************************************************)
 Lemma derive_pt_D_in :
- forall 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 in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-apply derive_pt_eq_0. 
-unfold derivable_pt_lim in |- *.
-intros; elim (H eps H0); intros alpha H1; elim H1; intros;
- exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); 
- intro; cut (x + h - x = h);
- [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
-    [ intro; generalize (H6 H8); rewrite H7; intro; assumption
-    | split;
-       [ unfold D_x in |- *; split;
-          [ unfold no_cond in |- *; trivial
-          | apply Rminus_not_eq_right; rewrite H7; assumption ]
-       | rewrite H7; assumption ] ]
- | ring ].
-intro.
-assert (H0 := derive_pt_eq_1 f x (df x) pr H).
-unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
- unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
- 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.
+  forall 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.
+Proof.
+  intros; split.
+  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  apply derive_pt_eq_0. 
+  unfold derivable_pt_lim in |- *.
+  intros; elim (H eps H0); intros alpha H1; elim H1; intros;
+    exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); 
+      intro; cut (x + h - x = h);
+        [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
+          [ intro; generalize (H6 H8); rewrite H7; intro; assumption
+            | split;
+              [ unfold D_x in |- *; split;
+                [ unfold no_cond in |- *; trivial
+                  | apply Rminus_not_eq_right; rewrite H7; assumption ]
+                | rewrite H7; assumption ] ]
+          | ring ].
+  intro.
+  assert (H0 := derive_pt_eq_1 f x (df x) pr H).
+  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+    unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
+      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 :
- forall 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 in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-unfold derivable_pt_lim in |- *.
-intros; elim (H eps H0); intros alpha H1; elim H1; intros;
- exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); 
- intro; cut (x + h - x = h);
- [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
-    [ intro; generalize (H6 H8); rewrite H7; intro; assumption
-    | split;
-       [ unfold D_x in |- *; split;
-          [ unfold no_cond in |- *; trivial
-          | apply Rminus_not_eq_right; rewrite H7; assumption ]
-       | rewrite H7; assumption ] ]
- | ring ].
-intro.
-unfold derivable_pt_lim in H.
-unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
- unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
- 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.
+  forall f (df:R -> R) (x:R),
+    D_in f df no_cond x <-> derivable_pt_lim f x (df x).
+Proof.
+  intros; split.
+  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  unfold derivable_pt_lim in |- *.
+  intros; elim (H eps H0); intros alpha H1; elim H1; intros;
+    exists (mkposreal alpha H2); intros; generalize (H3 (x + h)); 
+      intro; cut (x + h - x = h);
+        [ intro; cut (D_x no_cond x (x + h) /\ Rabs (x + h - x) < alpha);
+          [ intro; generalize (H6 H8); rewrite H7; intro; assumption
+            | split;
+              [ unfold D_x in |- *; split;
+                [ unfold no_cond in |- *; trivial
+                  | apply Rminus_not_eq_right; rewrite H7; assumption ]
+                | rewrite H7; assumption ] ]
+          | ring ].
+  intro.
+  unfold derivable_pt_lim in H.
+  unfold D_in in |- *; unfold limit1_in in |- *; unfold limit_in in |- *;
+    unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
+      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   *)
+(** * derivability -> continuity   *)
 (***********************************)
 (**********)
 Lemma derivable_derive :
- forall f (x:R) (pr:derivable_pt f x),  exists l : R, derive_pt f x pr = l.
-intros; exists (projT1 pr).
-unfold derive_pt in |- *; reflexivity.
+  forall f (x:R) (pr:derivable_pt f x),  exists l : R, derive_pt f x pr = l.
+Proof.
+  intros; exists (projT1 pr).
+  unfold derive_pt in |- *; reflexivity.
 Qed.
 
 Theorem derivable_continuous_pt :
- forall f (x:R), derivable_pt f x -> continuity_pt f x.
-intros f x X.
-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 in |- *.
-apply (cont_deriv f (fct_cte l) no_cond x H5).
-unfold fct_cte in |- *; reflexivity.
+  forall f (x:R), derivable_pt f x -> continuity_pt f x.
+Proof.
+  intros f x X.
+  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 in |- *.
+  apply (cont_deriv f (fct_cte l) no_cond x H5).
+  unfold fct_cte in |- *; reflexivity.
 Qed.
 
 Theorem derivable_continuous : forall f, derivable f -> continuity f.
-unfold derivable, continuity in |- *; intros f X x.
-apply (derivable_continuous_pt f x (X x)).
+Proof.
+  unfold derivable, continuity in |- *; intros f X x.
+  apply (derivable_continuous_pt f x (X x)).
 Qed.
 
 (****************************************************************)
-(**                      Main rules                             *)
+(** *                    Main rules                             *)
 (****************************************************************)
 
 Lemma derivable_pt_lim_plus :
- forall f1 f2 (x l1 l2:R),
-   derivable_pt_lim f1 x l1 ->
-   derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2).
-intros.
-apply uniqueness_step3.
-assert (H1 := uniqueness_step2 _ _ _ H).
-assert (H2 := uniqueness_step2 _ _ _ H0).
-unfold plus_fct in |- *.
-cut
- (forall 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 (fun h':R => (f1 (x + h') - f1 x) / h')
-    (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
-unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-elim (H4 eps H5); intros.
-exists x0.
-elim H6; intros.
-split.
-assumption.
-intros; rewrite H3; apply H8; assumption.
-intro; unfold Rdiv in |- *; ring.
+  forall f1 f2 (x l1 l2:R),
+    derivable_pt_lim f1 x l1 ->
+    derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 + f2) x (l1 + l2).
+  intros.
+  apply uniqueness_step3.
+  assert (H1 := uniqueness_step2 _ _ _ H).
+  assert (H2 := uniqueness_step2 _ _ _ H0).
+  unfold plus_fct in |- *.
+  cut
+    (forall 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 (fun h':R => (f1 (x + h') - f1 x) / h')
+      (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
+  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  elim (H4 eps H5); intros.
+  exists x0.
+  elim H6; intros.
+  split.
+  assumption.
+  intros; rewrite H3; apply H8; assumption.
+  intro; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma derivable_pt_lim_opp :
- forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l).
-intros.
-apply uniqueness_step3.
-assert (H1 := uniqueness_step2 _ _ _ H).
-unfold opp_fct in |- *.
-cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)).
-intro.
-generalize
- (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1).
-unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-elim (H2 eps H3); intros.
-exists x0.
-elim H4; intros.
-split.
-assumption.
-intros; rewrite H0; apply H6; assumption.
-intro; unfold Rdiv in |- *; ring.
+  forall f (x l:R), derivable_pt_lim f x l -> derivable_pt_lim (- f) x (- l).
+Proof. 
+  intros.
+  apply uniqueness_step3.
+  assert (H1 := uniqueness_step2 _ _ _ H).
+  unfold opp_fct in |- *.
+  cut (forall h:R, (- f (x + h) - - f x) / h = - ((f (x + h) - f x) / h)).
+  intro.
+  generalize
+    (limit_Ropp (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) l 0 H1).
+  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  elim (H2 eps H3); intros.
+  exists x0.
+  elim H4; intros.
+  split.
+  assumption.
+  intros; rewrite H0; apply H6; assumption.
+  intro; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma derivable_pt_lim_minus :
- forall f1 f2 (x l1 l2:R),
-   derivable_pt_lim f1 x l1 ->
-   derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2).
-intros.
-apply uniqueness_step3.
-assert (H1 := uniqueness_step2 _ _ _ H).
-assert (H2 := uniqueness_step2 _ _ _ H0).
-unfold minus_fct in |- *.
-cut
- (forall 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 (fun h':R => (f1 (x + h') - f1 x) / h')
-    (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
-unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
- simpl in |- *; unfold R_dist in |- *; intros.
-elim (H4 eps H5); intros.
-exists x0.
-elim H6; intros.
-split.
-assumption.
-intros; rewrite <- H3; apply H8; assumption.
-intro; unfold Rdiv in |- *; ring.
+  forall f1 f2 (x l1 l2:R),
+    derivable_pt_lim f1 x l1 ->
+    derivable_pt_lim f2 x l2 -> derivable_pt_lim (f1 - f2) x (l1 - l2).
+Proof.
+  intros.
+  apply uniqueness_step3.
+  assert (H1 := uniqueness_step2 _ _ _ H).
+  assert (H2 := uniqueness_step2 _ _ _ H0).
+  unfold minus_fct in |- *.
+  cut
+    (forall 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 (fun h':R => (f1 (x + h') - f1 x) / h')
+      (fun h':R => (f2 (x + h') - f2 x) / h') (fun h:R => h <> 0) l1 l2 0 H1 H2).
+  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+    simpl in |- *; unfold R_dist in |- *; intros.
+  elim (H4 eps H5); intros.
+  exists x0.
+  elim H6; intros.
+  split.
+  assumption.
+  intros; rewrite <- H3; apply H8; assumption.
+  intro; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma derivable_pt_lim_mult :
- forall f1 f2 (x l1 l2:R),
-   derivable_pt_lim f1 x l1 ->
-   derivable_pt_lim f2 x l2 ->
-   derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2).
-intros.
-assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
-elim H1; intros.
-assert (H4 := H3 H).
-assert (H5 := derivable_pt_lim_D_in f2 (fun 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 (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x).
-elim H1; intros.
-clear H1 H3.
-apply H2.
-unfold mult_fct in |- *.
-apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption.
+  forall f1 f2 (x l1 l2:R),
+    derivable_pt_lim f1 x l1 ->
+    derivable_pt_lim f2 x l2 ->
+    derivable_pt_lim (f1 * f2) x (l1 * f2 x + f1 x * l2).
+Proof.
+  intros.
+  assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
+  elim H1; intros.
+  assert (H4 := H3 H).
+  assert (H5 := derivable_pt_lim_D_in f2 (fun 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 (f1 * f2)%F (fun y:R => l1 * f2 x + f1 x * l2) x).
+  elim H1; intros.
+  clear H1 H3.
+  apply H2.
+  unfold mult_fct in |- *.
+  apply (Dmult no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x); assumption.
 Qed.
 
 Lemma derivable_pt_lim_const : forall a x:R, derivable_pt_lim (fct_cte a) x 0.
-intros; unfold fct_cte, derivable_pt_lim in |- *.
-intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *;
- rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l;
- rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+Proof.
+  intros; unfold fct_cte, derivable_pt_lim in |- *.
+  intros; exists (mkposreal 1 Rlt_0_1); intros; unfold Rminus in |- *;
+    rewrite Rplus_opp_r; unfold Rdiv in |- *; rewrite Rmult_0_l;
+      rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
 Qed.
 
 Lemma derivable_pt_lim_scal :
- forall f (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 (fct_cte a * f)%F.
-replace (a * l) with (0 * f x + a * l); [ idtac | ring ].
-apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption.
-unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity.
+  forall f (a x l:R),
+    derivable_pt_lim f x l -> derivable_pt_lim (mult_real_fct a f) x (a * l).
+Proof.
+  intros.
+  assert (H0 := derivable_pt_lim_const a x).
+  replace (mult_real_fct a f) with (fct_cte a * f)%F.
+  replace (a * l) with (0 * f x + a * l); [ idtac | ring ].
+  apply (derivable_pt_lim_mult (fct_cte a) f x 0 l); assumption.
+  unfold mult_real_fct, mult_fct, fct_cte in |- *; reflexivity.
 Qed.
 
 Lemma derivable_pt_lim_id : forall x:R, derivable_pt_lim id x 1.
-intro; unfold derivable_pt_lim in |- *.
-intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2;
- unfold id in |- *; replace ((x + h - x) / h - 1) with 0.
-rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h).
-apply Rabs_pos.
-assumption.
-unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x);
- rewrite Rplus_assoc.
-rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *;
- rewrite <- Rinv_r_sym.
-symmetry  in |- *; apply Rplus_opp_r.
-assumption.
+Proof.
+  intro; unfold derivable_pt_lim in |- *.
+  intros eps Heps; exists (mkposreal eps Heps); intros h H1 H2;
+    unfold id in |- *; replace ((x + h - x) / h - 1) with 0.
+  rewrite Rabs_R0; apply Rle_lt_trans with (Rabs h).
+  apply Rabs_pos.
+  assumption.
+  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite (Rplus_comm x);
+    rewrite Rplus_assoc.
+  rewrite Rplus_opp_l; rewrite Rplus_0_r; unfold Rdiv in |- *;
+    rewrite <- Rinv_r_sym.
+  symmetry  in |- *; apply Rplus_opp_r.
+  assumption.
 Qed.
 
 Lemma derivable_pt_lim_Rsqr : forall x:R, derivable_pt_lim Rsqr x (2 * x).
-intro; unfold derivable_pt_lim in |- *.
-unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps);
- intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h.
-assumption.
-replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h);
- [ idtac | ring ].
-unfold Rdiv in |- *; rewrite Rmult_plus_distr_r.
-repeat rewrite Rmult_assoc.
-repeat rewrite <- Rinv_r_sym; [ idtac | assumption ].
-ring.
+Proof.
+  intro; unfold derivable_pt_lim in |- *.
+  unfold Rsqr in |- *; intros eps Heps; exists (mkposreal eps Heps);
+    intros h H1 H2; replace (((x + h) * (x + h) - x * x) / h - 2 * x) with h.
+  assumption.
+  replace ((x + h) * (x + h) - x * x) with (2 * x * h + h * h);
+  [ idtac | ring ].
+  unfold Rdiv in |- *; rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  repeat rewrite <- Rinv_r_sym; [ idtac | assumption ].
+  ring.
 Qed.
 
 Lemma derivable_pt_lim_comp :
- forall f1 f2 (x l1 l2:R),
-   derivable_pt_lim f1 x l1 ->
-   derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1).
-intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
-elim H1; intros.
-assert (H4 := H3 H).
-assert (H5 := derivable_pt_lim_D_in f2 (fun 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 (f2 o f1)%F (fun y:R => l2 * l1) x).
-elim H1; intros.
-clear H1 H3; apply H2.
-unfold comp in |- *;
- cut
-  (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1)
-     (Dgf no_cond no_cond f1) x ->
-   D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x).
-intro; apply H1.
-rewrite Rmult_comm;
- apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x);
- assumption.
-unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; unfold dist in |- *; simpl in |- *;
- unfold R_dist in |- *; intros.
-elim (H1 eps H3); intros.
-exists x0; intros; split.
-elim H5; intros; assumption.
-intros; elim H5; intros; apply H9; split.
-unfold D_x in |- *; split.
-split; trivial.
-elim H6; intros; unfold D_x in H10; elim H10; intros; assumption.
-elim H6; intros; assumption.
+  forall f1 f2 (x l1 l2:R),
+    derivable_pt_lim f1 x l1 ->
+    derivable_pt_lim f2 (f1 x) l2 -> derivable_pt_lim (f2 o f1) x (l2 * l1).
+Proof.
+  intros; assert (H1 := derivable_pt_lim_D_in f1 (fun y:R => l1) x).
+  elim H1; intros.
+  assert (H4 := H3 H).
+  assert (H5 := derivable_pt_lim_D_in f2 (fun 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 (f2 o f1)%F (fun y:R => l2 * l1) x).
+  elim H1; intros.
+  clear H1 H3; apply H2.
+  unfold comp in |- *;
+    cut
+      (D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1)
+        (Dgf no_cond no_cond f1) x ->
+        D_in (fun x0:R => f2 (f1 x0)) (fun y:R => l2 * l1) no_cond x).
+  intro; apply H1.
+  rewrite Rmult_comm;
+    apply (Dcomp no_cond no_cond (fun y:R => l1) (fun y:R => l2) f1 f2 x);
+      assumption.
+  unfold Dgf, D_in, no_cond in |- *; unfold limit1_in in |- *;
+    unfold limit_in in |- *; unfold dist in |- *; simpl in |- *;
+      unfold R_dist in |- *; intros.
+  elim (H1 eps H3); intros.
+  exists x0; intros; split.
+  elim H5; intros; assumption.
+  intros; elim H5; intros; apply H9; split.
+  unfold D_x in |- *; split.
+  split; trivial.
+  elim H6; intros; unfold D_x in H10; elim H10; intros; assumption.
+  elim H6; intros; assumption.
 Qed.
 
 Lemma derivable_pt_plus :
- forall f1 f2 (x:R),
-   derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x.
-unfold derivable_pt in |- *; intros f1 f2 x X X0.
-elim X; intros.
-elim X0; intros.
-apply existT with (x0 + x1).
-apply derivable_pt_lim_plus; assumption.
+  forall f1 f2 (x:R),
+    derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 + f2) x.
+Proof.
+  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  elim X; intros.
+  elim X0; intros.
+  apply existT with (x0 + x1).
+  apply derivable_pt_lim_plus; assumption.
 Qed.
 
 Lemma derivable_pt_opp :
- forall f (x:R), derivable_pt f x -> derivable_pt (- f) x.
-unfold derivable_pt in |- *; intros f x X.
-elim X; intros.
-apply existT with (- x0).
-apply derivable_pt_lim_opp; assumption.
+  forall f (x:R), derivable_pt f x -> derivable_pt (- f) x.
+Proof.
+  unfold derivable_pt in |- *; intros f x X.
+  elim X; intros.
+  apply existT with (- x0).
+  apply derivable_pt_lim_opp; assumption.
 Qed.
 
 Lemma derivable_pt_minus :
- forall f1 f2 (x:R),
-   derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x.
-unfold derivable_pt in |- *; intros f1 f2 x X X0.
-elim X; intros.
-elim X0; intros.
-apply existT with (x0 - x1).
-apply derivable_pt_lim_minus; assumption.
+  forall f1 f2 (x:R),
+    derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 - f2) x.
+Proof.
+  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  elim X; intros.
+  elim X0; intros.
+  apply existT with (x0 - x1).
+  apply derivable_pt_lim_minus; assumption.
 Qed.
 
 Lemma derivable_pt_mult :
- forall f1 f2 (x:R),
-   derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x.
-unfold derivable_pt in |- *; intros f1 f2 x X X0.
-elim X; intros.
-elim X0; intros.
-apply existT with (x0 * f2 x + f1 x * x1).
-apply derivable_pt_lim_mult; assumption.
+  forall f1 f2 (x:R),
+    derivable_pt f1 x -> derivable_pt f2 x -> derivable_pt (f1 * f2) x.
+Proof.
+  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  elim X; intros.
+  elim X0; intros.
+  apply existT with (x0 * f2 x + f1 x * x1).
+  apply derivable_pt_lim_mult; assumption.
 Qed.
 
 Lemma derivable_pt_const : forall a x:R, derivable_pt (fct_cte a) x.
-intros; unfold derivable_pt in |- *.
-apply existT with 0.
-apply derivable_pt_lim_const.
+Proof.
+  intros; unfold derivable_pt in |- *.
+  apply existT with 0.
+  apply derivable_pt_lim_const.
 Qed.
 
 Lemma derivable_pt_scal :
- forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x.
-unfold derivable_pt in |- *; intros f1 a x X.
-elim X; intros.
-apply existT with (a * x0).
-apply derivable_pt_lim_scal; assumption.
+  forall f (a x:R), derivable_pt f x -> derivable_pt (mult_real_fct a f) x.
+Proof.
+  unfold derivable_pt in |- *; intros f1 a x X.
+  elim X; intros.
+  apply existT with (a * x0).
+  apply derivable_pt_lim_scal; assumption.
 Qed.
 
 Lemma derivable_pt_id : forall x:R, derivable_pt id x.
-unfold derivable_pt in |- *; intro.
-exists 1.
-apply derivable_pt_lim_id.
+Proof.
+  unfold derivable_pt in |- *; intro.
+  exists 1.
+  apply derivable_pt_lim_id.
 Qed.
 
 Lemma derivable_pt_Rsqr : forall x:R, derivable_pt Rsqr x.
-unfold derivable_pt in |- *; intro; apply existT with (2 * x).
-apply derivable_pt_lim_Rsqr.
+Proof.
+  unfold derivable_pt in |- *; intro; apply existT with (2 * x).
+  apply derivable_pt_lim_Rsqr.
 Qed.
 
 Lemma derivable_pt_comp :
- forall f1 f2 (x:R),
-   derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x.
-unfold derivable_pt in |- *; intros f1 f2 x X X0.
-elim X; intros.
-elim X0; intros.
-apply existT with (x1 * x0).
-apply derivable_pt_lim_comp; assumption.
+  forall f1 f2 (x:R),
+    derivable_pt f1 x -> derivable_pt f2 (f1 x) -> derivable_pt (f2 o f1) x.
+Proof.
+  unfold derivable_pt in |- *; intros f1 f2 x X X0.
+  elim X; intros.
+  elim X0; intros.
+  apply existT with (x1 * x0).
+  apply derivable_pt_lim_comp; assumption.
 Qed.
 
 Lemma derivable_plus :
- forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2).
-unfold derivable in |- *; intros f1 f2 X X0 x.
-apply (derivable_pt_plus _ _ x (X _) (X0 _)).
+  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 + f2).
+Proof.
+  unfold derivable in |- *; intros f1 f2 X X0 x.
+  apply (derivable_pt_plus _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_opp : forall f, derivable f -> derivable (- f).
-unfold derivable in |- *; intros f X x.
-apply (derivable_pt_opp _ x (X _)).
+Proof.
+  unfold derivable in |- *; intros f X x.
+  apply (derivable_pt_opp _ x (X _)).
 Qed.
 
 Lemma derivable_minus :
- forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2).
-unfold derivable in |- *; intros f1 f2 X X0 x.
-apply (derivable_pt_minus _ _ x (X _) (X0 _)).
+  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 - f2).
+Proof.
+  unfold derivable in |- *; intros f1 f2 X X0 x.
+  apply (derivable_pt_minus _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_mult :
- forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2).
-unfold derivable in |- *; intros f1 f2 X X0 x.
-apply (derivable_pt_mult _ _ x (X _) (X0 _)).
+  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f1 * f2).
+Proof.
+  unfold derivable in |- *; intros f1 f2 X X0 x.
+  apply (derivable_pt_mult _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derivable_const : forall a:R, derivable (fct_cte a).
-unfold derivable in |- *; intros.
-apply derivable_pt_const.
+Proof.
+  unfold derivable in |- *; intros.
+  apply derivable_pt_const.
 Qed.
 
 Lemma derivable_scal :
- forall f (a:R), derivable f -> derivable (mult_real_fct a f).
-unfold derivable in |- *; intros f a X x.
-apply (derivable_pt_scal _ a x (X _)).
+  forall f (a:R), derivable f -> derivable (mult_real_fct a f).
+Proof.
+  unfold derivable in |- *; intros f a X x.
+  apply (derivable_pt_scal _ a x (X _)).
 Qed.
 
 Lemma derivable_id : derivable id.
-unfold derivable in |- *; intro; apply derivable_pt_id.
+Proof.
+  unfold derivable in |- *; intro; apply derivable_pt_id.
 Qed.
 
 Lemma derivable_Rsqr : derivable Rsqr.
-unfold derivable in |- *; intro; apply derivable_pt_Rsqr.
+Proof.
+  unfold derivable in |- *; intro; apply derivable_pt_Rsqr.
 Qed.
 
 Lemma derivable_comp :
- forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1).
-unfold derivable in |- *; intros f1 f2 X X0 x.
-apply (derivable_pt_comp _ _ x (X _) (X0 _)).
+  forall f1 f2, derivable f1 -> derivable f2 -> derivable (f2 o f1).
+Proof.
+  unfold derivable in |- *; intros f1 f2 X X0 x.
+  apply (derivable_pt_comp _ _ x (X _) (X0 _)).
 Qed.
 
 Lemma derive_pt_plus :
- forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
-   derive_pt (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 (f1 + f2)%F 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.
+  forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+    derive_pt (f1 + f2) x (derivable_pt_plus _ _ _ pr1 pr2) =
+    derive_pt f1 x pr1 + derive_pt f2 x pr2.
+Proof.
+  intros.
+  assert (H := derivable_derive f1 x pr1).
+  assert (H0 := derivable_derive f2 x pr2).
+  assert
+    (H1 := derivable_derive (f1 + f2)%F 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 :
- forall f (x:R) (pr1:derivable_pt f x),
-   derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1.
-intros.
-assert (H := derivable_derive f x pr1).
-assert (H0 := derivable_derive (- f)%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.
+  forall f (x:R) (pr1:derivable_pt f x),
+    derive_pt (- f) x (derivable_pt_opp _ _ pr1) = - derive_pt f x pr1.
+Proof.
+  intros.
+  assert (H := derivable_derive f x pr1).
+  assert (H0 := derivable_derive (- f)%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 :
- forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
-   derive_pt (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 (f1 - f2)%F 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.
+  forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+    derive_pt (f1 - f2) x (derivable_pt_minus _ _ _ pr1 pr2) =
+    derive_pt f1 x pr1 - derive_pt f2 x pr2.
+Proof.
+  intros.
+  assert (H := derivable_derive f1 x pr1).
+  assert (H0 := derivable_derive f2 x pr2).
+  assert
+    (H1 := derivable_derive (f1 - f2)%F 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 :
- forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
-   derive_pt (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 (f1 * f2)%F 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.
+  forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 x),
+    derive_pt (f1 * f2) x (derivable_pt_mult _ _ _ pr1 pr2) =
+    derive_pt f1 x pr1 * f2 x + f1 x * derive_pt f2 x pr2.
+Proof.
+  intros.
+  assert (H := derivable_derive f1 x pr1).
+  assert (H0 := derivable_derive f2 x pr2).
+  assert
+    (H1 := derivable_derive (f1 * f2)%F 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 :
- forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0.
-intros.
-apply derive_pt_eq_0.
-apply derivable_pt_lim_const.
+  forall a x:R, derive_pt (fct_cte a) x (derivable_pt_const a x) = 0.
+Proof.
+  intros.
+  apply derive_pt_eq_0.
+  apply derivable_pt_lim_const.
 Qed.
 
 Lemma derive_pt_scal :
- forall f (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.
+  forall f (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.
+Proof.
+  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 : forall x:R, derive_pt id x (derivable_pt_id _) = 1.
-intros.
-apply derive_pt_eq_0.
-apply derivable_pt_lim_id.
+Proof.
+  intros.
+  apply derive_pt_eq_0.
+  apply derivable_pt_lim_id.
 Qed.
 
 Lemma derive_pt_Rsqr :
- forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x.
-intros.
-apply derive_pt_eq_0.
-apply derivable_pt_lim_Rsqr.
+  forall x:R, derive_pt Rsqr x (derivable_pt_Rsqr _) = 2 * x.
+Proof.
+  intros.
+  apply derive_pt_eq_0.
+  apply derivable_pt_lim_Rsqr.
 Qed.
 
 Lemma derive_pt_comp :
- forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)),
-   derive_pt (f2 o 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 (f2 o f1)%F 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.
+  forall f1 f2 (x:R) (pr1:derivable_pt f1 x) (pr2:derivable_pt f2 (f1 x)),
+    derive_pt (f2 o f1) x (derivable_pt_comp _ _ _ pr1 pr2) =
+    derive_pt f2 (f1 x) pr2 * derive_pt f1 x pr1.
+Proof.
+  intros.
+  assert (H := derivable_derive f1 x pr1).
+  assert (H0 := derivable_derive f2 (f1 x) pr2).
+  assert
+    (H1 := derivable_derive (f2 o f1)%F 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) (y:R) : R := y ^ n.
 
 Lemma derivable_pt_lim_pow_pos :
- forall (x:R) (n:nat),
-   (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
-intros.
-induction  n as [| n Hrecn].
-elim (lt_irrefl _ H).
-cut (n = 0%nat \/ (0 < n)%nat).
-intro; elim H0; intro.
-rewrite H1; simpl in |- *.
-replace (fun y:R => y * 1) with (id * fct_cte 1)%F.
-replace (1 * 1) with (1 * fct_cte 1 x + id x * 0).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_id.
-apply derivable_pt_lim_const.
-unfold fct_cte, id in |- *; ring.
-reflexivity.
-replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n).
-replace (pred (S n)) with n; [ idtac | reflexivity ].
-replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F.
-set (f := fun y:R => y ^ n).
-replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_id.
-unfold f in |- *; apply Hrecn; assumption.
-unfold f in |- *.
-pattern n at 1 5 in |- *; replace n with (S (pred n)).
-unfold id in |- *; rewrite S_INR; simpl in |- *.
-ring.
-symmetry  in |- *; apply S_pred with 0%nat; assumption.
-unfold mult_fct, id in |- *; reflexivity.
-reflexivity.
-inversion H.
-left; reflexivity.
-right.
-apply lt_le_trans with 1%nat.
-apply lt_O_Sn.
-assumption.
+  forall (x:R) (n:nat),
+    (0 < n)%nat -> derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  elim (lt_irrefl _ H).
+  cut (n = 0%nat \/ (0 < n)%nat).
+  intro; elim H0; intro.
+  rewrite H1; simpl in |- *.
+  replace (fun y:R => y * 1) with (id * fct_cte 1)%F.
+  replace (1 * 1) with (1 * fct_cte 1 x + id x * 0).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_id.
+  apply derivable_pt_lim_const.
+  unfold fct_cte, id in |- *; ring.
+  reflexivity.
+  replace (fun y:R => y ^ S n) with (fun y:R => y * y ^ n).
+  replace (pred (S n)) with n; [ idtac | reflexivity ].
+  replace (fun y:R => y * y ^ n) with (id * (fun y:R => y ^ n))%F.
+  set (f := fun y:R => y ^ n).
+  replace (INR (S n) * x ^ n) with (1 * f x + id x * (INR n * x ^ pred n)).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_id.
+  unfold f in |- *; apply Hrecn; assumption.
+  unfold f in |- *.
+  pattern n at 1 5 in |- *; replace n with (S (pred n)).
+  unfold id in |- *; rewrite S_INR; simpl in |- *.
+  ring.
+  symmetry  in |- *; apply S_pred with 0%nat; assumption.
+  unfold mult_fct, id in |- *; reflexivity.
+  reflexivity.
+  inversion H.
+  left; reflexivity.
+  right.
+  apply lt_le_trans with 1%nat.
+  apply lt_O_Sn.
+  assumption.
 Qed.
 
 Lemma derivable_pt_lim_pow :
- forall (x:R) (n:nat),
-   derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *.
-rewrite Rmult_0_l.
-replace (fun _:R => 1) with (fct_cte 1);
- [ apply derivable_pt_lim_const | reflexivity ].
-apply derivable_pt_lim_pow_pos.
-apply lt_O_Sn.
+  forall (x:R) (n:nat),
+    derivable_pt_lim (fun y:R => y ^ n) x (INR n * x ^ pred n).
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *.
+  rewrite Rmult_0_l.
+  replace (fun _:R => 1) with (fct_cte 1);
+  [ apply derivable_pt_lim_const | reflexivity ].
+  apply derivable_pt_lim_pow_pos.
+  apply lt_O_Sn.
 Qed.
 
 Lemma derivable_pt_pow :
- forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x.
-intros; unfold derivable_pt in |- *.
-apply existT with (INR n * x ^ pred n).
-apply derivable_pt_lim_pow.
+  forall (n:nat) (x:R), derivable_pt (fun y:R => y ^ n) x.
+Proof.
+  intros; unfold derivable_pt in |- *.
+  apply existT with (INR n * x ^ pred n).
+  apply derivable_pt_lim_pow.
 Qed.
 
 Lemma derivable_pow : forall n:nat, derivable (fun y:R => y ^ n).
-intro; unfold derivable in |- *; intro; apply derivable_pt_pow.
+Proof.
+  intro; unfold derivable in |- *; intro; apply derivable_pt_pow.
 Qed.
 
 Lemma derive_pt_pow :
- forall (n:nat) (x:R),
-   derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n.
-intros; apply derive_pt_eq_0.
-apply derivable_pt_lim_pow.
+  forall (n:nat) (x:R),
+    derive_pt (fun y:R => y ^ n) x (derivable_pt_pow n x) = INR n * x ^ pred n.
+Proof.
+  intros; apply derive_pt_eq_0.
+  apply derivable_pt_lim_pow.
 Qed.
 
 Lemma pr_nu :
- forall f (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 in |- *.
-apply (uniqueness_limite f x x0 x1 p p0).
+  forall f (x:R) (pr1 pr2:derivable_pt f x),
+    derive_pt f x pr1 = derive_pt f x pr2. 
+Proof.
+  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 in |- *.
+  apply (uniqueness_limite f x x0 x1 p p0).
 Qed.
 
 
 (************************************************************)
-(**             Local extremum's condition                  *)
+(** *           Local extremum's condition                  *)
 (************************************************************)
 
 Theorem deriv_maximum :
- forall f (a b c:R) (pr:derivable_pt f c),
-   a < c ->
-   c < b ->
-   (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0.
-intros; case (Rtotal_order 0 (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 in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H5 (l / 2) H6); intros delta H7.
-cut (0 < (b - c) / 2).
-intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0).
-intro; cut (Rabs (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
-  (Rabs
-     ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
-      Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2).
-unfold Rabs in |- *;
- case
-  (Rcase_abs
-     ((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
-  (Rplus_lt_compat_l (- l)
-     (l +
-      -
+  forall f (a b c:R) (pr:derivable_pt f c),
+    a < c ->
+    c < b ->
+    (forall x:R, a < x -> x < b -> f x <= f c) -> derive_pt f c pr = 0.
+Proof.
+  intros; case (Rtotal_order 0 (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 in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H5 (l / 2) H6); intros delta H7.
+  cut (0 < (b - c) / 2).
+  intro; cut (Rmin (delta / 2) ((b - c) / 2) <> 0).
+  intro; cut (Rabs (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
+      (Rabs
+        ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+          Rmin (delta / 2) ((b + - c) / 2) + - l) < l / 2).
+  unfold Rabs in |- *;
+    case
+    (Rcase_abs
       ((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_opp_l; 
- rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)).
-intro;
- generalize
-  (Ropp_lt_gt_contravar
-     (-
+        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
+      (Rplus_lt_compat_l (- 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_opp_l; 
+        rewrite Rplus_0_l; replace (- l + l / 2) with (- (l / 2)).
+  intro;
+    generalize
+      (Ropp_lt_gt_contravar
+        (-
+          ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
+            Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20);
+      repeat rewrite Ropp_involutive; 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_irrefl 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 l at 2 in |- *; rewrite double_var.
+  ring.
+  ring.
+  intro.
+  assert
+    (H20 :=
+      Rge_le
       ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
-       Rmin (delta / 2) ((b + - c) / 2))) (- (l / 2)) H20);
- repeat rewrite Ropp_involutive; 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_irrefl 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 l at 2 in |- *; rewrite double_var.
-ring.
-ring.
-intro.
-assert
- (H20 :=
-  Rge_le
+        Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). 
+  assumption.
+  rewrite <- Ropp_0;
+    replace
     ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
-     Rmin (delta / 2) ((b + - c) / 2) + - l) 0 r).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H20 H18)). 
-assumption.
-rewrite <- Ropp_0;
- replace
-  ((f (c + Rmin (delta / 2) ((b + - c) / 2)) + - f c) /
-   Rmin (delta / 2) ((b + - c) / 2) + - l) with
+      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 Ropp_gt_lt_contravar;
+    change
+      (0 <
+        l +
+        -
+        ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
+          Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat;
+      [ assumption
+        | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ].
+  unfold Rminus; ring.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+  replace
+  ((f (c + Rmin (delta / 2) ((b - c) / 2)) - f c) /
+    Rmin (delta / 2) ((b - c) / 2)) with
   (-
-   (l +
-    -
-    ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
-     Rmin (delta / 2) ((b + - c) / 2)))).
-apply Ropp_gt_lt_contravar;
- change
-   (0 <
-    l +
-    -
-    ((f (c + Rmin (delta / 2) ((b + - c) / 2)) - f c) /
-     Rmin (delta / 2) ((b + - c) / 2))) in |- *; apply Rplus_lt_le_0_compat;
- [ assumption
- | rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge; assumption ].
-ring.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; 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_0; apply Ropp_ge_le_contravar; apply Rle_ge;
- unfold Rdiv in |- *; apply Rmult_le_pos;
- [ generalize
-    (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2)))
-       (f (c + Rmin (delta * / 2) ((b - c) * / 2))) (
-       f c) H15); rewrite Rplus_opp_r; intro; assumption
- | left; apply Rinv_0_lt_compat; assumption ].
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))).
-apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)).
-repeat rewrite <- Rmult_assoc.
-rewrite <- Rinv_r_sym.
-repeat rewrite Rmult_1_l.
-ring.
-red in |- *; intro.
-unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
-red in |- *; intro.
-unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
-assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)).
-assert
- (H15 :=
-  Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14).
-apply Rle_lt_trans with (c + (b - c) / 2).
-assumption.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-replace (2 * (c + (b - c) / 2)) with (c + b).
-replace (2 * b) with (b + b).
-apply Rplus_lt_compat_r; assumption.
-ring.
-unfold Rdiv in |- *; rewrite Rmult_plus_distr_l.
-repeat rewrite (Rmult_comm 2).
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-ring.
-discrR.
-apply Rlt_trans with c.
-assumption.
-pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l;
- assumption.
-cut (0 < delta / 2).
-intro;
- apply
-  (Rmin_stable_in_posreal (mkposreal (delta / 2) H12)
-     (mkposreal ((b - c) / 2) H8)).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
-intro.
-cut (0 < delta / 2).
-intro.
-generalize
- (Rmin_stable_in_posreal (mkposreal (delta / 2) H10)
-    (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro;
- elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-intro; apply Rle_lt_trans with (delta / 2).
-apply Rmin_l.
-unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l.
-replace (2 * delta) with (delta + delta). 
-pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
- apply Rplus_lt_compat_l.
-rewrite Rplus_0_r; apply (cond_pos delta).
-symmetry  in |- *; apply double.
-discrR.
-cut (0 < delta / 2).
-intro;
- generalize
-  (Rmin_stable_in_posreal (mkposreal (delta / 2) H9)
-     (mkposreal ((b - c) / 2) H8)); simpl in |- *; 
- intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro;
- assumption.
-apply Rinv_0_lt_compat; prove_sup0.
-elim H2; intro.
-symmetry  in |- *; assumption.
-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 (Rabs (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
-  (Rabs
-     ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
-      Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < 
-   - (l / 2)).
-unfold Rabs in |- *;
- case
-  (Rcase_abs
-     ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
-      Rmax (- (delta / 2)) ((a + - c) / 2) + - l)).
-intro;
- elim
-  (Rlt_irrefl 0
-     (Rlt_trans 0
+    ((f c - f (c + Rmin (delta / 2) ((b - c) / 2))) /
+      Rmin (delta / 2) ((b - c) / 2))).
+  rewrite <- Ropp_0; apply Ropp_ge_le_contravar; apply Rle_ge;
+    unfold Rdiv in |- *; apply Rmult_le_pos;
+      [ generalize
+        (Rplus_le_compat_r (- f (c + Rmin (delta * / 2) ((b - c) * / 2)))
+          (f (c + Rmin (delta * / 2) ((b - c) * / 2))) (
+            f c) H15); rewrite Rplus_opp_r; intro; assumption
+        | left; apply Rinv_0_lt_compat; assumption ].
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  repeat rewrite <- (Rmult_comm (/ Rmin (delta * / 2) ((b - c) * / 2))).
+  apply Rmult_eq_reg_l with (Rmin (delta * / 2) ((b - c) * / 2)).
+  repeat rewrite <- Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  repeat rewrite Rmult_1_l.
+  ring.
+  red in |- *; intro.
+  unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
+  red in |- *; intro.
+  unfold Rdiv in H12; rewrite H16 in H12; elim (Rlt_irrefl 0 H12).
+  assert (H14 := Rmin_r (delta / 2) ((b - c) / 2)).
+  assert
+    (H15 :=
+      Rplus_le_compat_l c (Rmin (delta / 2) ((b - c) / 2)) ((b - c) / 2) H14).
+  apply Rle_lt_trans with (c + (b - c) / 2).
+  assumption.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  replace (2 * (c + (b - c) / 2)) with (c + b).
+  replace (2 * b) with (b + b).
+  apply Rplus_lt_compat_r; assumption.
+  ring.
+  unfold Rdiv in |- *; rewrite Rmult_plus_distr_l.
+  repeat rewrite (Rmult_comm 2).
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  ring.
+  discrR.
+  apply Rlt_trans with c.
+  assumption.
+  pattern c at 1 in |- *; rewrite <- (Rplus_0_r c); apply Rplus_lt_compat_l;
+    assumption.
+  cut (0 < delta / 2).
+  intro;
+    apply
+      (Rmin_stable_in_posreal (mkposreal (delta / 2) H12)
+        (mkposreal ((b - c) / 2) H8)).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  unfold Rabs in |- *; case (Rcase_abs (Rmin (delta / 2) ((b - c) / 2))).
+  intro.
+  cut (0 < delta / 2).
+  intro.
+  generalize
+    (Rmin_stable_in_posreal (mkposreal (delta / 2) H10)
+      (mkposreal ((b - c) / 2) H8)); simpl in |- *; intro;
+    elim (Rlt_irrefl 0 (Rlt_trans 0 (Rmin (delta / 2) ((b - c) / 2)) 0 H11 r)).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  intro; apply Rle_lt_trans with (delta / 2).
+  apply Rmin_l.
+  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l.
+  replace (2 * delta) with (delta + delta). 
+  pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+    apply Rplus_lt_compat_l.
+  rewrite Rplus_0_r; apply (cond_pos delta).
+  symmetry  in |- *; apply double.
+  discrR.
+  cut (0 < delta / 2).
+  intro;
+    generalize
+      (Rmin_stable_in_posreal (mkposreal (delta / 2) H9)
+        (mkposreal ((b - c) / 2) H8)); simpl in |- *; 
+      intro; red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  generalize (Rplus_lt_compat_r (- c) c b H0); rewrite Rplus_opp_r; intro;
+    assumption.
+  apply Rinv_0_lt_compat; prove_sup0.
+  elim H2; intro.
+  symmetry  in |- *; assumption.
+  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 (Rabs (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
+      (Rabs
+        ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+          Rmax (- (delta / 2)) ((a + - c) / 2) + - l) < 
+        - (l / 2)).
+  unfold Rabs in |- *;
+    case
+    (Rcase_abs
+      ((f (c + Rmax (- (delta / 2)) ((a + - c) / 2)) + - f c) /
+        Rmax (- (delta / 2)) ((a + - c) / 2) + - l)).
+  intro;
+    elim
+      (Rlt_irrefl 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
+      (Rplus_lt_compat_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_opp_l;
+      rewrite Rplus_0_r; 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) 0 H19 r)).
-intros;
- generalize
-  (Rplus_lt_compat_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_opp_l;
- rewrite Rplus_0_r; 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_irrefl 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_involutive (l / 2)); rewrite <- Ropp_0;
- apply Ropp_lt_gt_contravar; assumption.
-pattern l at 3 in |- *; rewrite double_var.
-ring.
-assumption.
-apply Rplus_le_lt_0_compat; assumption.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
-unfold Rdiv in |- *;
- 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
- (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)))
-    (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) (
-    f c) H16); rewrite Rplus_opp_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 Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar;
- assumption.
-unfold Rdiv in |- *.
-rewrite <- Ropp_inv_permute.
-rewrite Rmult_opp_opp.
-reflexivity.
-unfold Rdiv in H11; assumption.
-generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10);
- rewrite Rplus_0_r; intro; apply Rlt_trans with c; 
- assumption.
-generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro;
- generalize
-  (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14);
- intro; apply Rlt_le_trans with (c + (a - c) / 2).
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-replace (2 * (c + (a - c) / 2)) with (a + c).
-rewrite double.
-apply Rplus_lt_compat_l; assumption.
-ring.
-rewrite <- Rplus_assoc.
-rewrite <- double_var.
-ring.
-assumption.
-unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
-intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
- generalize
-  (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2))
-     H12); rewrite Ropp_involutive; intro;
- generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13);
- intro; apply Rle_lt_trans with (delta / 2).
-assumption.
-apply Rmult_lt_reg_l with 2. 
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite double.
-pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
- apply Rplus_lt_compat_l; rewrite Rplus_0_r; 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 in |- *; 
- intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); 
- intro;
- elim
-  (Rlt_irrefl 0
-     (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)).
-rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
- apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
-assumption.
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse. 
-rewrite (Ropp_minus_distr a c).
-reflexivity.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat;
- [ apply (cond_pos delta)
- | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
-red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
-cut ((a - c) / 2 < 0).
-intro; cut (- (delta / 2) < 0).
-intro;
- apply
-  (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11)
-     (mknegreal ((a - c) / 2) H10)).
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat;
- [ apply (cond_pos delta)
- | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
-rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
- apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
-assumption.
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse. 
-rewrite (Ropp_minus_distr a c).
-reflexivity.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro;
-    assumption
- | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
-replace (- (l / 2)) with (- l / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
-assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ].
-unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse.
+          Rmax (- (delta / 2)) ((a + - c) / 2)) (l / 2) 0 H22 H21); 
+      intro;
+        elim
+          (Rlt_irrefl 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_involutive (l / 2)); rewrite <- Ropp_0;
+    apply Ropp_lt_gt_contravar; assumption.
+  pattern l at 3 in |- *; rewrite double_var.
+  ring.
+  assumption.
+  apply Rplus_le_lt_0_compat; assumption.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+  unfold Rdiv in |- *;
+    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
+    (Rplus_le_compat_l (- f (c + Rmax (- (delta * / 2)) ((a - c) * / 2)))
+      (f (c + Rmax (- (delta * / 2)) ((a - c) * / 2))) (
+        f c) H16); rewrite Rplus_opp_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 Rinv_0_lt_compat; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar;
+    assumption.
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_inv_permute.
+  rewrite Rmult_opp_opp.
+  reflexivity.
+  unfold Rdiv in H11; assumption.
+  generalize (Rplus_lt_compat_l c (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H10);
+    rewrite Rplus_0_r; intro; apply Rlt_trans with c; 
+      assumption.
+  generalize (RmaxLess2 (- (delta / 2)) ((a - c) / 2)); intro;
+    generalize
+      (Rplus_le_compat_l c ((a - c) / 2) (Rmax (- (delta / 2)) ((a - c) / 2)) H14);
+      intro; apply Rlt_le_trans with (c + (a - c) / 2).
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  replace (2 * (c + (a - c) / 2)) with (a + c).
+  rewrite double.
+  apply Rplus_lt_compat_l; assumption.
+  field; discrR.
+  assumption.
+  unfold Rabs in |- *; case (Rcase_abs (Rmax (- (delta / 2)) ((a - c) / 2))).
+  intro; generalize (RmaxLess1 (- (delta / 2)) ((a - c) / 2)); intro;
+    generalize
+      (Ropp_le_ge_contravar (- (delta / 2)) (Rmax (- (delta / 2)) ((a - c) / 2))
+        H12); rewrite Ropp_involutive; intro;
+      generalize (Rge_le (delta / 2) (- Rmax (- (delta / 2)) ((a - c) / 2)) H13);
+        intro; apply Rle_lt_trans with (delta / 2).
+  assumption.
+  apply Rmult_lt_reg_l with 2. 
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite double.
+  pattern delta at 2 in |- *; rewrite <- (Rplus_0_r delta);
+    apply Rplus_lt_compat_l; rewrite Rplus_0_r; 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 in |- *; 
+      intro; generalize (Rge_le (Rmax (- (delta / 2)) ((a - c) / 2)) 0 r); 
+        intro;
+          elim
+            (Rlt_irrefl 0
+              (Rle_lt_trans 0 (Rmax (- (delta / 2)) ((a - c) / 2)) 0 H15 H14)).
+  rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
+    apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
+  assumption.
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse. 
+  rewrite (Ropp_minus_distr a c).
+  reflexivity.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+    apply Rmult_lt_0_compat;
+      [ apply (cond_pos delta)
+        | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+  red in |- *; intro; rewrite H11 in H10; elim (Rlt_irrefl 0 H10).
+  cut ((a - c) / 2 < 0).
+  intro; cut (- (delta / 2) < 0).
+  intro;
+    apply
+      (Rmax_stable_in_negreal (mknegreal (- (delta / 2)) H11)
+        (mknegreal ((a - c) / 2) H10)).
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; unfold Rdiv in |- *;
+    apply Rmult_lt_0_compat;
+      [ apply (cond_pos delta)
+        | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+  rewrite <- Ropp_0; rewrite <- (Ropp_involutive ((a - c) / 2));
+    apply Ropp_lt_gt_contravar; replace (- ((a - c) / 2)) with ((c - a) / 2).
+  assumption.
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse. 
+  rewrite (Ropp_minus_distr a c).
+  reflexivity.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ generalize (Rplus_lt_compat_r (- a) a c H); rewrite Rplus_opp_r; intro;
+      assumption
+      | assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ] ].
+  replace (- (l / 2)) with (- l / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+  assert (Hyp : 0 < 2); [ prove_sup0 | apply (Rinv_0_lt_compat 2 Hyp) ].
+  unfold Rdiv in |- *; apply Ropp_mult_distr_l_reverse.
 Qed.
 
 Theorem deriv_minimum :
- forall f (a b c:R) (pr:derivable_pt f c),
-   a < c ->
-   c < b ->
-   (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0.
-intros.
-rewrite <- (Ropp_involutive (derive_pt f c pr)).
-apply Ropp_eq_0_compat.
-rewrite <- (derive_pt_opp f c pr).
-cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c).
-intro.
-apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2).
-intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge.
-apply (H1 x H2 H3).
-Qed.
- 
+  forall f (a b c:R) (pr:derivable_pt f c),
+    a < c ->
+    c < b ->
+    (forall x:R, a < x -> x < b -> f c <= f x) -> derive_pt f c pr = 0.
+Proof.
+  intros.
+  rewrite <- (Ropp_involutive (derive_pt f c pr)).
+  apply Ropp_eq_0_compat.
+  rewrite <- (derive_pt_opp f c pr).
+  cut (forall x:R, a < x -> x < b -> (- f)%F x <= (- f)%F c).
+  intro.
+  apply (deriv_maximum (- f)%F a b c (derivable_pt_opp _ _ pr) H H0 H2).
+  intros; unfold opp_fct in |- *; apply Ropp_ge_le_contravar; apply Rle_ge.
+  apply (H1 x H2 H3).
+Qed.
+
 Theorem deriv_constant2 :
- forall f (a b c:R) (pr:derivable_pt f c),
-   a < c ->
-   c < b -> (forall 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).
+  forall f (a b c:R) (pr:derivable_pt f c),
+    a < c ->
+    c < b -> (forall x:R, a < x -> x < b -> f x = f c) -> derive_pt f c pr = 0.
+Proof.
+  intros.
+  eapply deriv_maximum with a b; try assumption.
+  intros; right; apply (H1 x H2 H3).
 Qed.
 
 (**********)
 Lemma nonneg_derivative_0 :
- forall f (pr:derivable f),
-   increasing f -> forall 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 (Rtotal_order 0 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 /\ Rabs (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 Rabs in |- *;
- case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
-intro;
- elim
-  (Rlt_irrefl 0
-     (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)).
-intros;
- generalize
-  (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l)
-     (- (l / 2)) H13); unfold Rminus in |- *;
- replace (- (l / 2) + l) with (l / 2).
-rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 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_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)).
-rewrite <- Ropp_0 in H5;
- generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5);
- repeat rewrite Ropp_involutive; intro; assumption.
-pattern l at 3 in |- *; rewrite double_var.
-ring.
-unfold Rminus in |- *; apply Rplus_le_le_0_compat.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-cut (x <= x + delta * / 2).
-intro; generalize (H x (x + delta * / 2) H12); intro;
- generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13);
- rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
- left; assumption.
-left; apply Rinv_0_lt_compat; assumption.
-left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-cut (x <= x + delta * / 2).
-intro; generalize (H x (x + delta * / 2) H9); intro;
- generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12);
- rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
-pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
- left; assumption. 
-left; apply Rinv_0_lt_compat; assumption.
-split.
-unfold Rdiv in |- *; apply prod_neq_R0.
-generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7;
- elim (Rlt_irrefl 0 H7).
-apply Rinv_neq_0_compat; discrR.
-split.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-replace (Rabs (delta / 2)) with (delta / 2).
-unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite (Rmult_comm 2).
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
-rewrite Rmult_1_r.
-rewrite double.
-pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r.
-apply Rplus_lt_compat_l; apply (cond_pos delta).
-symmetry  in |- *; apply Rabs_right.
-left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat;
- [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
-unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse;
- apply Rmult_lt_0_compat.
-apply Rplus_lt_reg_r with l.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
-apply Rinv_0_lt_compat; prove_sup0.
+  forall f (pr:derivable f),
+    increasing f -> forall x:R, 0 <= derive_pt f x (pr x).
+Proof.
+  intros; unfold increasing in H.
+  assert (H0 := derivable_derive f x (pr x)).
+  elim H0; intros l H1.
+  rewrite H1; case (Rtotal_order 0 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 /\ Rabs (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 Rabs in |- *;
+    case (Rcase_abs ((f (x + delta / 2) - f x) / (delta / 2) - l)).
+  intro;
+    elim
+      (Rlt_irrefl 0
+        (Rle_lt_trans 0 ((f (x + delta / 2) - f x) / (delta / 2) - l) 0 H12 r)).
+  intros;
+    generalize
+      (Rplus_lt_compat_r l ((f (x + delta / 2) - f x) / (delta / 2) - l)
+        (- (l / 2)) H13); unfold Rminus in |- *;
+      replace (- (l / 2) + l) with (l / 2).
+  rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 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_irrefl 0 (Rlt_trans 0 (l / 2) 0 H15 H16)).
+  rewrite <- Ropp_0 in H5;
+    generalize (Ropp_lt_gt_contravar (-0) (- (l / 2)) H5);
+      repeat rewrite Ropp_involutive; intro; assumption.
+  pattern l at 3 in |- *; rewrite double_var.
+  ring.
+  unfold Rminus in |- *; apply Rplus_le_le_0_compat.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  cut (x <= x + delta * / 2).
+  intro; generalize (H x (x + delta * / 2) H12); intro;
+    generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H13);
+      rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+    left; assumption.
+  left; apply Rinv_0_lt_compat; assumption.
+  left; rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; assumption.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  cut (x <= x + delta * / 2).
+  intro; generalize (H x (x + delta * / 2) H9); intro;
+    generalize (Rplus_le_compat_l (- f x) (f x) (f (x + delta * / 2)) H12);
+      rewrite Rplus_opp_l; rewrite Rplus_comm; intro; assumption.
+  pattern x at 1 in |- *; rewrite <- (Rplus_0_r x); apply Rplus_le_compat_l;
+    left; assumption. 
+  left; apply Rinv_0_lt_compat; assumption.
+  split.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  generalize (cond_pos delta); intro; red in |- *; intro H9; rewrite H9 in H7;
+    elim (Rlt_irrefl 0 H7).
+  apply Rinv_neq_0_compat; discrR.
+  split.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  replace (Rabs (delta / 2)) with (delta / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite (Rmult_comm 2).
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+  rewrite Rmult_1_r.
+  rewrite double.
+  pattern (pos delta) at 1 in |- *; rewrite <- Rplus_0_r.
+  apply Rplus_lt_compat_l; apply (cond_pos delta).
+  symmetry  in |- *; apply Rabs_right.
+  left; change (0 < delta / 2) in |- *; unfold Rdiv in |- *;
+    apply Rmult_lt_0_compat;
+      [ apply (cond_pos delta) | apply Rinv_0_lt_compat; prove_sup0 ].
+  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+    apply Rmult_lt_0_compat.
+  apply Rplus_lt_reg_r with l.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rplus_0_r; assumption.
+  apply Rinv_0_lt_compat; prove_sup0.
 Qed.
diff --git a/theories/Reals/Ranalysis2.v b/theories/Reals/Ranalysis2.v
index 0627e22c..fb89da67 100644
--- a/theories/Reals/Ranalysis2.v
+++ b/theories/Reals/Ranalysis2.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis2.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Ranalysis2.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -14,437 +14,450 @@ Require Import Ranalysis1. Open Local Scope R_scope.
 
 (**********)
 Lemma formule :
- forall (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 in |- *.
-repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
- repeat rewrite Rinv_mult_distr; try assumption.
-replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x));
- [ 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 || ring.
-apply prod_neq_R0; assumption.
+  forall (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).
+Proof.
+  intros; unfold Rdiv, Rminus, Rsqr in |- *.
+  repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+    repeat rewrite Rinv_mult_distr; try assumption.
+  replace (l1 * f2 x * (/ f2 x * / f2 x)) with (l1 * / f2 x * (f2 x * / f2 x));
+  [ 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 || ring.
+  apply prod_neq_R0; assumption.
 Qed.
 
 Lemma Rmin_pos : forall x y:R, 0 < x -> 0 < y -> 0 < Rmin x y.
-intros; unfold Rmin in |- *.
-case (Rle_dec x y); intro; assumption.
+Proof.
+  intros; unfold Rmin in |- *.
+  case (Rle_dec x y); intro; assumption.
 Qed.
 
 Lemma maj_term1 :
- forall (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 ->
-   (forall h:R,
+  forall (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 ->
+    (forall h:R,
       h <> 0 ->
       Rabs h < alp_f1d ->
       Rabs ((f1 (x + h) - f1 x) / h - l1) < Rabs (eps * f2 x / 8)) ->
-   (forall a:R,
+    (forall a:R,
       Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
-   h <> 0 ->
-   Rabs h < alp_f1d ->
-   Rabs h < Rmin eps_f2 alp_f2 ->
-   Rabs (/ 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 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)).
-rewrite Rabs_mult.
-apply Rmult_le_compat_r.
-apply Rabs_pos.
-rewrite Rabs_Rinv; [ left; exact H7 | assumption ].
-apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)).
-apply Rmult_lt_compat_l.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
-exact H8.
-right; unfold Rdiv in |- *.
-repeat rewrite Rabs_mult.
-rewrite Rabs_Rinv; discrR.
-replace (Rabs 8) with 8.
-replace 8 with 8; [ idtac | ring ].
-rewrite Rinv_mult_distr; [ idtac | discrR | discrR ].
-replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with
- (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x)));
- [ idtac | ring ].
-replace (Rabs eps) with eps.
-repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
-ring.
-symmetry  in |- *; apply Rabs_right; left; assumption.
-symmetry  in |- *; apply Rabs_right; left; prove_sup.
+    h <> 0 ->
+    Rabs h < alp_f1d ->
+    Rabs h < Rmin eps_f2 alp_f2 ->
+    Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) < eps / 4.
+Proof.
+  intros.
+  assert (H7 := H3 h H6).
+  assert (H8 := H2 h H4 H5).
+  apply Rle_lt_trans with
+    (2 / Rabs (f2 x) * Rabs ((f1 (x + h) - f1 x) / h - l1)).
+  rewrite Rabs_mult.
+  apply Rmult_le_compat_r.
+  apply Rabs_pos.
+  rewrite Rabs_Rinv; [ left; exact H7 | assumption ].
+  apply Rlt_le_trans with (2 / Rabs (f2 x) * Rabs (eps * f2 x / 8)).
+  apply Rmult_lt_compat_l.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ prove_sup0 | apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption ].
+  exact H8.
+  right; unfold Rdiv in |- *.
+  repeat rewrite Rabs_mult.
+  rewrite Rabs_Rinv; discrR.
+  replace (Rabs 8) with 8.
+  replace 8 with 8; [ idtac | ring ].
+  rewrite Rinv_mult_distr; [ idtac | discrR | discrR ].
+  replace (2 * / Rabs (f2 x) * (Rabs eps * Rabs (f2 x) * (/ 2 * / 4))) with
+  (Rabs eps * / 4 * (2 * / 2) * (Rabs (f2 x) * / Rabs (f2 x)));
+  [ idtac | ring ].
+  replace (Rabs eps) with eps.
+  repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+  ring.
+  symmetry  in |- *; apply Rabs_right; left; assumption.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup.
 Qed.
 
 Lemma maj_term2 :
- forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) 
-   (f2:R -> R),
-   0 < eps ->
-   f2 x <> 0 ->
-   f2 (x + h) <> 0 ->
-   (forall a:R,
+  forall (x h eps l1 alp_f2 alp_f2t2:R) (eps_f2:posreal) 
+    (f2:R -> R),
+    0 < eps ->
+    f2 x <> 0 ->
+    f2 (x + h) <> 0 ->
+    (forall a:R,
       Rabs a < alp_f2t2 ->
       Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))) ->
-   (forall a:R,
+    (forall a:R,
       Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
-   h <> 0 ->
-   Rabs h < alp_f2t2 ->
-   Rabs h < Rmin eps_f2 alp_f2 ->
-   l1 <> 0 -> Rabs (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
- (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
-rewrite Rabs_mult; apply Rmult_le_compat_l.
-apply Rabs_pos.
-rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr.
-left; apply H9.
-apply Rlt_le_trans with
- (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
-apply Rmult_lt_compat_r.
-apply Rabs_pos_lt.
-unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
- try assumption || discrR.
-red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
-apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR.
-unfold Rdiv in |- *.
-repeat rewrite Rinv_mult_distr; try assumption.
-repeat rewrite Rabs_mult.
-replace (Rabs 2) with 2.
-rewrite (Rmult_comm 2).
-replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
- (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); 
- [ idtac | ring ].
-repeat apply Rmult_lt_compat_l.
-apply Rabs_pos_lt; assumption.
-apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
-repeat rewrite Rabs_Rinv; try assumption.
-rewrite <- (Rmult_comm 2).
-unfold Rdiv in H8; exact H8.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-right.
-unfold Rsqr, Rdiv in |- *.
-do 1 rewrite Rinv_mult_distr; try assumption || discrR.
-do 1 rewrite Rinv_mult_distr; try assumption || discrR.
-repeat rewrite Rabs_mult.
-repeat rewrite Rabs_Rinv; try assumption || discrR.
-replace (Rabs eps) with eps.
-replace (Rabs 8) with 8.
-replace (Rabs 2) with 2.
-replace 8 with (4 * 2); [ idtac | ring ].
-rewrite Rinv_mult_distr; discrR.
-replace
- (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) *
-  (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with
- (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) *
-  (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
-repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR.
-ring.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-symmetry  in |- *; apply Rabs_right; left; prove_sup.
-symmetry  in |- *; apply Rabs_right; left; assumption.
+    h <> 0 ->
+    Rabs h < alp_f2t2 ->
+    Rabs h < Rmin eps_f2 alp_f2 ->
+    l1 <> 0 -> Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) < eps / 4.
+Proof.
+  intros.
+  assert (H8 := H3 h H6).
+  assert (H9 := H2 h H5).
+  apply Rle_lt_trans with
+    (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+  rewrite Rabs_mult; apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  rewrite <- (Rabs_Ropp (f2 x - f2 (x + h))); rewrite Ropp_minus_distr.
+  left; apply H9.
+  apply Rlt_le_trans with
+    (Rabs (2 * (l1 / (f2 x * f2 x))) * Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+  apply Rmult_lt_compat_r.
+  apply Rabs_pos_lt.
+  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+    try assumption || discrR.
+  red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  apply Rinv_neq_0_compat; apply prod_neq_R0; try assumption || discrR.
+  unfold Rdiv in |- *.
+  repeat rewrite Rinv_mult_distr; try assumption.
+  repeat rewrite Rabs_mult.
+  replace (Rabs 2) with 2.
+  rewrite (Rmult_comm 2).
+  replace (Rabs l1 * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
+  (Rabs l1 * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); 
+  [ idtac | ring ].
+  repeat apply Rmult_lt_compat_l.
+  apply Rabs_pos_lt; assumption.
+  apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
+  repeat rewrite Rabs_Rinv; try assumption.
+  rewrite <- (Rmult_comm 2).
+  unfold Rdiv in H8; exact H8.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  right.
+  unfold Rsqr, Rdiv in |- *.
+  do 1 rewrite Rinv_mult_distr; try assumption || discrR.
+  do 1 rewrite Rinv_mult_distr; try assumption || discrR.
+  repeat rewrite Rabs_mult.
+  repeat rewrite Rabs_Rinv; try assumption || discrR.
+  replace (Rabs eps) with eps.
+  replace (Rabs 8) with 8.
+  replace (Rabs 2) with 2.
+  replace 8 with (4 * 2); [ idtac | ring ].
+  rewrite Rinv_mult_distr; discrR.
+  replace
+  (2 * (Rabs l1 * (/ Rabs (f2 x) * / Rabs (f2 x))) *
+    (eps * (Rabs (f2 x) * Rabs (f2 x)) * (/ 4 * / 2 * / Rabs l1))) with
+  (eps * / 4 * (Rabs l1 * / Rabs l1) * (Rabs (f2 x) * / Rabs (f2 x)) *
+    (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
+  repeat rewrite <- Rinv_r_sym; try (apply Rabs_no_R0; assumption) || discrR.
+  ring.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup.
+  symmetry  in |- *; apply Rabs_right; left; assumption.
 Qed.
 
 Lemma maj_term3 :
- forall (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 ->
-   (forall h:R,
+  forall (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 ->
+    (forall h:R,
       h <> 0 ->
       Rabs h < alp_f2d ->
       Rabs ((f2 (x + h) - f2 x) / h - l2) <
       Rabs (Rsqr (f2 x) * eps / (8 * f1 x))) ->
-   (forall a:R,
+    (forall a:R,
       Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
-   h <> 0 ->
-   Rabs h < alp_f2d ->
-   Rabs h < Rmin eps_f2 alp_f2 ->
-   f1 x <> 0 ->
-   Rabs (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
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
-rewrite Rabs_mult.
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-left; apply H8.
-apply Rlt_le_trans with
- (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
-apply Rmult_lt_compat_r.
-apply Rabs_pos_lt.
-unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
- try assumption.
-red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
-apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption.
-unfold Rdiv in |- *.
-repeat rewrite Rinv_mult_distr; try assumption.
-repeat rewrite Rabs_mult.
-replace (Rabs 2) with 2.
-rewrite (Rmult_comm 2).
-replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
- (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); 
- [ idtac | ring ].
-repeat apply Rmult_lt_compat_l.
-apply Rabs_pos_lt; assumption.
-apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
-repeat rewrite Rabs_Rinv; assumption || idtac.
-rewrite <- (Rmult_comm 2).
-unfold Rdiv in H9; exact H9.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-right.
-unfold Rsqr, Rdiv in |- *.
-rewrite Rinv_mult_distr; try assumption || discrR.
-rewrite Rinv_mult_distr; try assumption || discrR.
-repeat rewrite Rabs_mult.
-repeat rewrite Rabs_Rinv; try assumption || discrR.
-replace (Rabs eps) with eps.
-replace (Rabs 8) with 8.
-replace (Rabs 2) with 2.
-replace 8 with (4 * 2); [ idtac | ring ].
-rewrite Rinv_mult_distr; discrR.
-replace
- (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) *
-  (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with
- (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
-  (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ].
-repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
-ring.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-symmetry  in |- *; apply Rabs_right; left; prove_sup.
-symmetry  in |- *; apply Rabs_right; left; assumption.
+    h <> 0 ->
+    Rabs h < alp_f2d ->
+    Rabs h < Rmin eps_f2 alp_f2 ->
+    f1 x <> 0 ->
+    Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) <
+    eps / 4.
+Proof.
+  intros.
+  assert (H8 := H2 h H4 H5).
+  assert (H9 := H3 h H6).
+  apply Rle_lt_trans with
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
+  rewrite Rabs_mult.
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  left; apply H8.
+  apply Rlt_le_trans with
+    (Rabs (2 * (f1 x / (f2 x * f2 x))) * Rabs (Rsqr (f2 x) * eps / (8 * f1 x))).
+  apply Rmult_lt_compat_r.
+  apply Rabs_pos_lt.
+  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+    try assumption.
+  red in |- *; intro H10; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  apply Rinv_neq_0_compat; apply prod_neq_R0; discrR || assumption.
+  unfold Rdiv in |- *.
+  repeat rewrite Rinv_mult_distr; try assumption.
+  repeat rewrite Rabs_mult.
+  replace (Rabs 2) with 2.
+  rewrite (Rmult_comm 2).
+  replace (Rabs (f1 x) * (Rabs (/ f2 x) * Rabs (/ f2 x)) * 2) with
+  (Rabs (f1 x) * (Rabs (/ f2 x) * (Rabs (/ f2 x) * 2))); 
+  [ idtac | ring ].
+  repeat apply Rmult_lt_compat_l.
+  apply Rabs_pos_lt; assumption.
+  apply Rabs_pos_lt; apply Rinv_neq_0_compat; assumption.
+  repeat rewrite Rabs_Rinv; assumption || idtac.
+  rewrite <- (Rmult_comm 2).
+  unfold Rdiv in H9; exact H9.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  right.
+  unfold Rsqr, Rdiv in |- *.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  repeat rewrite Rabs_mult.
+  repeat rewrite Rabs_Rinv; try assumption || discrR.
+  replace (Rabs eps) with eps.
+  replace (Rabs 8) with 8.
+  replace (Rabs 2) with 2.
+  replace 8 with (4 * 2); [ idtac | ring ].
+  rewrite Rinv_mult_distr; discrR.
+  replace
+  (2 * (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x))) *
+    (Rabs (f2 x) * Rabs (f2 x) * eps * (/ 4 * / 2 * / Rabs (f1 x)))) with
+  (eps * / 4 * (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
+    (Rabs (f1 x) * / Rabs (f1 x)) * (2 * / 2)); [ idtac | ring ].
+  repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+  ring.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup.
+  symmetry  in |- *; apply Rabs_right; left; assumption.
 Qed.
 
 Lemma maj_term4 :
- forall (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 ->
-   (forall a:R,
+  forall (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 ->
+    (forall a:R,
       Rabs a < alp_f2c ->
       Rabs (f2 (x + a) - f2 x) <
       Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) ->
-   (forall a:R,
+    (forall a:R,
       Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)) ->
-   h <> 0 ->
-   Rabs h < alp_f2c ->
-   Rabs h < Rmin eps_f2 alp_f2 ->
-   f1 x <> 0 ->
-   l2 <> 0 ->
-   Rabs (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
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) *
-  Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
-rewrite Rabs_mult.
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-left; apply H9.
-apply Rlt_le_trans with
- (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) *
-  Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
-apply Rmult_lt_compat_r.
-apply Rabs_pos_lt.
-unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
- assumption || idtac.
-red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H).
-apply Rinv_neq_0_compat; apply prod_neq_R0.
-apply prod_neq_R0.
-discrR.
-assumption.
-assumption.
-unfold Rdiv in |- *.
-repeat rewrite Rinv_mult_distr;
- try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption).
-repeat rewrite Rabs_mult.
-replace (Rabs 2) with 2.
-replace
- (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with
- (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2))));
- [ idtac | ring ].
-replace
- (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with
- (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))));
- [ idtac | ring ].
-repeat apply Rmult_lt_compat_l.
-apply Rabs_pos_lt; assumption.
-apply Rabs_pos_lt; assumption.
-apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *;
- apply prod_neq_R0; assumption.
-repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ].
-rewrite <- (Rmult_comm 2).
-unfold Rdiv in H10; exact H10.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-right; unfold Rsqr, Rdiv in |- *.
-rewrite Rinv_mult_distr; try assumption || discrR.
-rewrite Rinv_mult_distr; try assumption || discrR.
-rewrite Rinv_mult_distr; try assumption || discrR.
-rewrite Rinv_mult_distr; try assumption || discrR.
-repeat rewrite Rabs_mult.
-repeat rewrite Rabs_Rinv; try assumption || discrR.
-replace (Rabs eps) with eps.
-replace (Rabs 8) with 8.
-replace (Rabs 2) with 2.
-replace 8 with (4 * 2); [ idtac | ring ].
-rewrite Rinv_mult_distr; discrR.
-replace
- (2 * Rabs l2 *
-  (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) *
-  (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps *
-   (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with
- (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) *
-  (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
-  (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
-repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
-ring.
-symmetry  in |- *; apply Rabs_right; left; prove_sup0.
-symmetry  in |- *; apply Rabs_right; left; prove_sup.
-symmetry  in |- *; apply Rabs_right; left; assumption.
-apply prod_neq_R0; assumption || discrR.
-apply prod_neq_R0; assumption.
+    h <> 0 ->
+    Rabs h < alp_f2c ->
+    Rabs h < Rmin eps_f2 alp_f2 ->
+    f1 x <> 0 ->
+    l2 <> 0 ->
+    Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x)) <
+    eps / 4.
+Proof.
+  intros.
+  assert (H9 := H2 h H5).
+  assert (H10 := H3 h H6).
+  apply Rle_lt_trans with
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) *
+      Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+  rewrite Rabs_mult.
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  left; apply H9.
+  apply Rlt_le_trans with
+    (Rabs (2 * l2 * (f1 x / (Rsqr (f2 x) * f2 x))) *
+      Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+  apply Rmult_lt_compat_r.
+  apply Rabs_pos_lt.
+  unfold Rdiv in |- *; unfold Rsqr in |- *; repeat apply prod_neq_R0;
+    assumption || idtac.
+  red in |- *; intro H11; rewrite H11 in H; elim (Rlt_irrefl _ H).
+  apply Rinv_neq_0_compat; apply prod_neq_R0.
+  apply prod_neq_R0.
+  discrR.
+  assumption.
+  assumption.
+  unfold Rdiv in |- *.
+  repeat rewrite Rinv_mult_distr;
+    try assumption || (unfold Rsqr in |- *; apply prod_neq_R0; assumption).
+  repeat rewrite Rabs_mult.
+  replace (Rabs 2) with 2.
+  replace
+  (2 * Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 x)))) with
+  (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * (Rabs (/ f2 x) * 2))));
+  [ idtac | ring ].
+  replace
+  (Rabs l2 * Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))) with
+  (Rabs l2 * (Rabs (f1 x) * (Rabs (/ Rsqr (f2 x)) * Rabs (/ f2 (x + h)))));
+  [ idtac | ring ].
+  repeat apply Rmult_lt_compat_l.
+  apply Rabs_pos_lt; assumption.
+  apply Rabs_pos_lt; assumption.
+  apply Rabs_pos_lt; apply Rinv_neq_0_compat; unfold Rsqr in |- *;
+    apply prod_neq_R0; assumption.
+  repeat rewrite Rabs_Rinv; [ idtac | assumption | assumption ].
+  rewrite <- (Rmult_comm 2).
+  unfold Rdiv in H10; exact H10.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  right; unfold Rsqr, Rdiv in |- *.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  rewrite Rinv_mult_distr; try assumption || discrR.
+  repeat rewrite Rabs_mult.
+  repeat rewrite Rabs_Rinv; try assumption || discrR.
+  replace (Rabs eps) with eps.
+  replace (Rabs 8) with 8.
+  replace (Rabs 2) with 2.
+  replace 8 with (4 * 2); [ idtac | ring ].
+  rewrite Rinv_mult_distr; discrR.
+  replace
+  (2 * Rabs l2 *
+    (Rabs (f1 x) * (/ Rabs (f2 x) * / Rabs (f2 x) * / Rabs (f2 x))) *
+    (Rabs (f2 x) * Rabs (f2 x) * Rabs (f2 x) * eps *
+      (/ 4 * / 2 * / Rabs (f1 x) * / Rabs l2))) with
+  (eps * / 4 * (Rabs l2 * / Rabs l2) * (Rabs (f1 x) * / Rabs (f1 x)) *
+    (Rabs (f2 x) * / Rabs (f2 x)) * (Rabs (f2 x) * / Rabs (f2 x)) *
+    (Rabs (f2 x) * / Rabs (f2 x)) * (2 * / 2)); [ idtac | ring ].
+  repeat rewrite <- Rinv_r_sym; try discrR || (apply Rabs_no_R0; assumption).
+  ring.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup0.
+  symmetry  in |- *; apply Rabs_right; left; prove_sup.
+  symmetry  in |- *; apply Rabs_right; left; assumption.
+  apply prod_neq_R0; assumption || discrR.
+  apply prod_neq_R0; assumption.
 Qed.
 
 Lemma D_x_no_cond : forall x a:R, a <> 0 -> D_x no_cond x (x + a).
-intros.
-unfold D_x, no_cond in |- *.
-split.
-trivial.
-apply Rminus_not_eq.
-unfold Rminus in |- *.
-rewrite Ropp_plus_distr.
-rewrite <- Rplus_assoc.
-rewrite Rplus_opp_r.
-rewrite Rplus_0_l.
-apply Ropp_neq_0_compat; assumption.
+Proof.
+  intros.
+  unfold D_x, no_cond in |- *.
+  split.
+  trivial.
+  apply Rminus_not_eq.
+  unfold Rminus in |- *.
+  rewrite Ropp_plus_distr.
+  rewrite <- Rplus_assoc.
+  rewrite Rplus_opp_r.
+  rewrite Rplus_0_l.
+  apply Ropp_neq_0_compat; assumption.
 Qed.
 
 Lemma Rabs_4 :
- forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d.
-intros.
-apply Rle_trans with (Rabs (a + b) + Rabs (c + d)).
-replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ].
-apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)).
-apply Rplus_le_compat_r.
-apply Rabs_triang.
-repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
-apply Rabs_triang.
+  forall a b c d:R, Rabs (a + b + c + d) <= Rabs a + Rabs b + Rabs c + Rabs d.
+Proof.
+  intros.
+  apply Rle_trans with (Rabs (a + b) + Rabs (c + d)).
+  replace (a + b + c + d) with (a + b + (c + d)); [ apply Rabs_triang | ring ].
+  apply Rle_trans with (Rabs a + Rabs b + Rabs (c + d)).
+  apply Rplus_le_compat_r.
+  apply Rabs_triang.
+  repeat rewrite Rplus_assoc; repeat apply Rplus_le_compat_l.
+  apply Rabs_triang.
 Qed.
 
 Lemma Rlt_4 :
- forall 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 Rplus_lt_compat_r; assumption.
-repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l.
-apply Rlt_trans with (d + e + g).
-rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption.
-rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g).
-apply Rplus_lt_compat_r; assumption.
-apply Rplus_lt_compat_l; assumption.
+  forall 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.
+Proof.
+  intros; apply Rlt_trans with (b + c + e + g).
+  repeat apply Rplus_lt_compat_r; assumption.
+  repeat rewrite Rplus_assoc; apply Rplus_lt_compat_l.
+  apply Rlt_trans with (d + e + g).
+  rewrite Rplus_assoc; apply Rplus_lt_compat_r; assumption.
+  rewrite Rplus_assoc; apply Rplus_lt_compat_l; apply Rlt_trans with (f + g).
+  apply Rplus_lt_compat_r; assumption.
+  apply Rplus_lt_compat_l; assumption.
 Qed.
 
 Lemma Rmin_2 : forall a b c:R, a < b -> a < c -> a < Rmin b c.
-intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption.
+Proof.
+  intros; unfold Rmin in |- *; case (Rle_dec b c); intro; assumption.
 Qed.
 
 Lemma quadruple : forall x:R, 4 * x = x + x + x + x.
-intro; ring.
+Proof.
+  intro; ring.
 Qed.
 
 Lemma quadruple_var : forall x:R, x = x / 4 + x / 4 + x / 4 + x / 4.
-intro; rewrite <- quadruple.
-unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR.
-reflexivity.
+Proof.
+  intro; rewrite <- quadruple.
+  unfold Rdiv in |- *; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m; discrR.
+  reflexivity.
 Qed.
 
 (**********)
 Lemma continuous_neq_0 :
- forall (f:R -> R) (x0:R),
-   continuity_pt f x0 ->
-   f x0 <> 0 ->
+  forall (f:R -> R) (x0:R),
+    continuity_pt f x0 ->
+    f x0 <> 0 ->
     exists eps : posreal, (forall h:R, Rabs 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 (Rabs (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) < Rabs (f x0 / 2)).
-unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
- replace (x0 + h - x0) with h.
-intros; assert (H7 := H6 H4).
-red in |- *; intro.
-rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7;
- rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7;
- pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7.
-cut (0 < Rabs (f x0)).
-intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7).
-cut (Rabs (/ 2) = / 2).
-assert (Hyp : 0 < 2).
-prove_sup0.
-intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10);
- rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; 
- [ idtac | discrR ].
-cut (IZR 1 < IZR 2).
-unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro;
- elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
-apply IZR_lt; omega.
-unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro.
-assert (Hyp : 0 < 2).
-prove_sup0.
-assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11;
- rewrite <- Rinv_r_sym in H11; [ idtac | discrR ].
-elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)).
-reflexivity.
-apply (Rabs_pos_lt _ H0).
-ring.
-assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro.
-intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *;
- unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply Rabs_pos_lt.
-unfold Rdiv in |- *; apply prod_neq_R0;
- [ assumption | apply Rinv_neq_0_compat; discrR ].
-intro; apply H5.
-split.
-unfold D_x, no_cond in |- *.
-split; trivial || assumption.
-assumption.
-change (0 < Rabs (f x0 / 2)) in |- *.
-apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0.
-assumption.
-apply Rinv_neq_0_compat; discrR.
-Qed.
\ No newline at end of file
+Proof.
+  intros; unfold continuity_pt in H; unfold continue_in in H;
+    unfold limit1_in in H; unfold limit_in in H; elim (H (Rabs (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) < Rabs (f x0 / 2)).
+  unfold dist in |- *; simpl in |- *; unfold R_dist in |- *;
+    replace (x0 + h - x0) with h.
+  intros; assert (H7 := H6 H4).
+  red in |- *; intro.
+  rewrite H8 in H7; unfold Rminus in H7; rewrite Rplus_0_l in H7;
+    rewrite Rabs_Ropp in H7; unfold Rdiv in H7; rewrite Rabs_mult in H7;
+      pattern (Rabs (f x0)) at 1 in H7; rewrite <- Rmult_1_r in H7.
+  cut (0 < Rabs (f x0)).
+  intro; assert (H10 := Rmult_lt_reg_l _ _ _ H9 H7).
+  cut (Rabs (/ 2) = / 2).
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  intro; rewrite H11 in H10; assert (H12 := Rmult_lt_compat_l 2 _ _ Hyp H10);
+    rewrite Rmult_1_r in H12; rewrite <- Rinv_r_sym in H12; 
+      [ idtac | discrR ].
+  cut (IZR 1 < IZR 2).
+  unfold IZR in |- *; unfold INR, nat_of_P in |- *; simpl in |- *; intro;
+    elim (Rlt_irrefl 1 (Rlt_trans _ _ _ H13 H12)).
+  apply IZR_lt; omega.
+  unfold Rabs in |- *; case (Rcase_abs (/ 2)); intro.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  assert (H11 := Rmult_lt_compat_l 2 _ _ Hyp r); rewrite Rmult_0_r in H11;
+    rewrite <- Rinv_r_sym in H11; [ idtac | discrR ].
+  elim (Rlt_irrefl 0 (Rlt_trans _ _ _ Rlt_0_1 H11)).
+  reflexivity.
+  apply (Rabs_pos_lt _ H0).
+  ring.
+  assert (H6 := Req_dec x0 (x0 + h)); elim H6; intro.
+  intro; rewrite <- H7; unfold dist, R_met in |- *; unfold R_dist in |- *;
+    unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+      apply Rabs_pos_lt.
+  unfold Rdiv in |- *; apply prod_neq_R0;
+    [ assumption | apply Rinv_neq_0_compat; discrR ].
+  intro; apply H5.
+  split.
+  unfold D_x, no_cond in |- *.
+  split; trivial || assumption.
+  assumption.
+  change (0 < Rabs (f x0 / 2)) in |- *.
+  apply Rabs_pos_lt; unfold Rdiv in |- *; apply prod_neq_R0.
+  assumption.
+  apply Rinv_neq_0_compat; discrR.
+Qed.
diff --git a/theories/Reals/Ranalysis3.v b/theories/Reals/Ranalysis3.v
index 663ccb07..f50aa2ad 100644
--- a/theories/Reals/Ranalysis3.v
+++ b/theories/Reals/Ranalysis3.v
@@ -6,788 +6,792 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis3.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+(*i $Id: Ranalysis3.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
 Require Import Ranalysis1.
 Require Import Ranalysis2. Open Local Scope R_scope.
 
-(* Division *)
+(** Division *)
 Theorem derivable_pt_lim_div :
- forall (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 (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)).
-intros f1 f2 x l1 l2 H H0 H1.
-cut (derivable_pt f2 x);
- [ intro X | unfold derivable_pt in |- *; apply 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 in |- *.
-assert (H3 := derivable_continuous_pt _ _ X).
-unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3;
- unfold limit_in in H3; unfold dist in H3.
-simpl in H3; unfold R_dist in H3.
-elim (H3 (Rabs (f2 x) / 2));
- [ idtac
- | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *;
-    apply Rmult_lt_0_compat;
-    [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-clear H3; intros alp_f2 H3.
-cut
- (forall x0:R,
-    Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2).
-intro H4.
-cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)).
-intro H5.
-cut
- (forall a:R,
-    Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)).
-intro Maj.
-unfold derivable_pt_lim in |- *; intros.
-elim (H (Rabs (eps * f2 x / 8)));
- [ idtac
- | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *;
-    apply Rabs_pos_lt; repeat apply prod_neq_R0;
-    [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
-    | assumption
-    | apply Rinv_neq_0_compat; discrR ] ].
-intros alp_f1d H7.
-case (Req_dec (f1 x) 0); intro.
-case (Req_dec l1 0); intro.
+  forall (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 (f1 / f2) x ((l1 * f2 x - l2 * f1 x) / Rsqr (f2 x)).
+Proof.
+  intros f1 f2 x l1 l2 H H0 H1.
+  cut (derivable_pt f2 x);
+    [ intro X | unfold derivable_pt in |- *; apply 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 in |- *.
+  assert (H3 := derivable_continuous_pt _ _ X).
+  unfold continuity_pt in H3; unfold continue_in in H3; unfold limit1_in in H3;
+    unfold limit_in in H3; unfold dist in H3.
+  simpl in H3; unfold R_dist in H3.
+  elim (H3 (Rabs (f2 x) / 2));
+    [ idtac
+      | unfold Rdiv in |- *; change (0 < Rabs (f2 x) * / 2) in |- *;
+        apply Rmult_lt_0_compat;
+          [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  clear H3; intros alp_f2 H3.
+  cut
+    (forall x0:R,
+      Rabs (x0 - x) < alp_f2 -> Rabs (f2 x0 - f2 x) < Rabs (f2 x) / 2).
+  intro H4.
+  cut (forall a:R, Rabs (a - x) < alp_f2 -> Rabs (f2 x) / 2 < Rabs (f2 a)).
+  intro H5.
+  cut
+    (forall a:R,
+      Rabs a < Rmin eps_f2 alp_f2 -> / Rabs (f2 (x + a)) < 2 / Rabs (f2 x)).
+  intro Maj.
+  unfold derivable_pt_lim in |- *; intros.
+  elim (H (Rabs (eps * f2 x / 8)));
+    [ idtac
+      | unfold Rdiv in |- *; change (0 < Rabs (eps * f2 x * / 8)) in |- *;
+        apply Rabs_pos_lt; repeat apply prod_neq_R0;
+          [ red in |- *; intro H7; rewrite H7 in H6; elim (Rlt_irrefl _ H6)
+            | assumption
+            | apply Rinv_neq_0_compat; discrR ] ].
+  intros alp_f1d H7.
+  case (Req_dec (f1 x) 0); intro.
+  case (Req_dec l1 0); 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 in |- *; 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
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite H8.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite H8.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite H9.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2);
- try assumption || apply H2.
-apply H14.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
+  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 in |- *; 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
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite H8.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite H8.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite H9.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2);
+    try assumption || apply H2.
+  apply H14.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; 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 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
-clear H10; intros alp_f2t2 H10.
-cut
- (forall a:R,
-    Rabs a < alp_f2t2 ->
-    Rabs (f2 (x + a) - f2 x) < Rabs (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 in |- *.
-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
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite H8.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite H8.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-rewrite <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
-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_dec a 0); intro.
-rewrite H14; rewrite Rplus_0_r.
-unfold Rminus in |- *; rewrite Rplus_opp_r.
-rewrite Rabs_R0.
-apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc.
-repeat apply prod_neq_R0; try assumption.
-red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
-apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption.
-apply H13.
-split.
-apply D_x_no_cond; assumption.
-replace (x + a - x) with a; [ assumption | ring ].
-change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
-apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
- repeat apply prod_neq_R0.
-red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
-assumption. 
-assumption.
-apply Rinv_neq_0_compat; repeat apply prod_neq_R0;
- [ discrR | discrR | discrR | assumption ].
+  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 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
+  clear H10; intros alp_f2t2 H10.
+  cut
+    (forall a:R,
+      Rabs a < alp_f2t2 ->
+      Rabs (f2 (x + a) - f2 x) < Rabs (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 in |- *.
+  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
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite H8.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite H8.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_term2 x h eps l1 alp_f2 alp_f2t2 eps_f2 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  rewrite <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; apply quadruple_var.
+  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_dec a 0); intro.
+  rewrite H14; rewrite Rplus_0_r.
+  unfold Rminus in |- *; rewrite Rplus_opp_r.
+  rewrite Rabs_R0.
+  apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc.
+  repeat apply prod_neq_R0; try assumption.
+  red in |- *; intro; rewrite H15 in H6; elim (Rlt_irrefl _ H6).
+  apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption.
+  apply H13.
+  split.
+  apply D_x_no_cond; assumption.
+  replace (x + a - x) with a; [ assumption | ring ].
+  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
+  apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+    repeat apply prod_neq_R0.
+  red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6).
+  assumption. 
+  assumption.
+  apply Rinv_neq_0_compat; repeat apply prod_neq_R0;
+    [ discrR | discrR | discrR | assumption ].
 (***********************************)
 (*              Cas n° 3           *)
 (*     (f1 x)<>0  l1=0  l2=0       *)
 (***********************************)
-case (Req_dec l1 0); intro.
-case (Req_dec l2 0); intro.
-elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
- [ idtac
- | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
-    repeat apply prod_neq_R0;
-    [ assumption
-    | assumption
-    | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
-    | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ].
-intros alp_f2d H12.
-cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
-intro.
-exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
-simpl in |- *.
-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
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite H10.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_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 in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac.
-apply H2; assumption.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
-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).
+  case (Req_dec l1 0); intro.
+  case (Req_dec l2 0); intro.
+  elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
+    [ idtac
+      | apply Rabs_pos_lt; unfold Rdiv, Rsqr in |- *; repeat rewrite Rmult_assoc;
+        repeat apply prod_neq_R0;
+          [ assumption
+            | assumption
+            | red in |- *; intro; rewrite H11 in H6; elim (Rlt_irrefl _ H6)
+            | apply Rinv_neq_0_compat; repeat apply prod_neq_R0; discrR || assumption ] ].
+  intros alp_f2d H12.
+  cut (0 < Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)).
+  intro.
+  exists (mkposreal (Rmin (Rmin eps_f2 alp_f2) (Rmin alp_f1d alp_f2d)) H11).
+  simpl in |- *.
+  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
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite H10.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_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 in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); assumption || idtac.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; apply quadruple_var.
+  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 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
- [ idtac
- | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *;
-    repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0;
-    try assumption || 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 (Rabs (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 in |- *; 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
- (forall a:R,
-    Rabs a < alp_f2c ->
-    Rabs (f2 (x + a) - f2 x) <
-    Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
-intro.
-rewrite formule; try assumption.
-apply Rle_lt_trans with
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite <- Rabs_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 <- Rabs_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 in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
-apply H2; assumption.
-intros.
-case (Req_dec a 0); intro.
-rewrite H17; rewrite Rplus_0_r.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0.
-apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *.
-repeat rewrite Rinv_mult_distr; try assumption.
-repeat apply prod_neq_R0; try assumption.
-red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). 
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; assumption.
-apply Rinv_neq_0_compat; assumption.
-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 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *.
-apply Rabs_pos_lt.
-unfold Rsqr, Rdiv in |- *.
-repeat rewrite Rinv_mult_distr; try assumption || discrR.
-repeat apply prod_neq_R0; try assumption.
-red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). 
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; assumption.
-apply Rinv_neq_0_compat; assumption.
-apply prod_neq_R0; [ discrR | assumption ].
-red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). 
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; discrR.
-apply Rinv_neq_0_compat; assumption.
+  elim (H0 (Rabs (Rsqr (f2 x) * eps / (8 * f1 x))));
+    [ idtac
+      | apply Rabs_pos_lt; unfold Rsqr, Rdiv in |- *;
+        repeat rewrite Rinv_mult_distr; repeat apply prod_neq_R0;
+          try assumption || 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 (Rabs (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 in |- *; 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
+    (forall a:R,
+      Rabs a < alp_f2c ->
+      Rabs (f2 (x + a) - f2 x) <
+      Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+  intro.
+  rewrite formule; try assumption.
+  apply Rle_lt_trans with
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite <- Rabs_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 <- Rabs_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 in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; apply quadruple_var.
+  apply H2; assumption.
+  intros.
+  case (Req_dec a 0); intro.
+  rewrite H17; rewrite Rplus_0_r.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0.
+  apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *.
+  repeat rewrite Rinv_mult_distr; try assumption.
+  repeat apply prod_neq_R0; try assumption.
+  red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6). 
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; assumption.
+  apply Rinv_neq_0_compat; assumption.
+  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 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *.
+  apply Rabs_pos_lt.
+  unfold Rsqr, Rdiv in |- *.
+  repeat rewrite Rinv_mult_distr; try assumption || discrR.
+  repeat apply prod_neq_R0; try assumption.
+  red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6). 
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; assumption.
+  apply Rinv_neq_0_compat; assumption.
+  apply prod_neq_R0; [ discrR | assumption ].
+  red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6). 
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rinv_neq_0_compat; assumption.
 (***********************************)
 (*              Cas n° 5           *)
 (*    (f1 x)<>0  l1<>0  l2=0       *)
 (***********************************)
-case (Req_dec l2 0); 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 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
-clear H11; intros alp_f2t2 H11.
-elim (H0 (Rabs (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 in |- *.
-intros.
-cut
- (forall a:R,
-    Rabs a < alp_f2t2 ->
-    Rabs (f2 (x + a) - f2 x) < Rabs (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
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite H10.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
-rewrite Rabs_R0; rewrite Rmult_0_l.
-apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
-rewrite <- Rabs_mult.
-apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-rewrite <- Rabs_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 <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
-apply H2; assumption.
-intros.
-case (Req_dec a 0); intro.
-rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0.
-apply Rabs_pos_lt.
-unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
-unfold Rsqr in |- *.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
-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 Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
-change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
-apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
+  case (Req_dec l2 0); 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 (Rabs (eps * Rsqr (f2 x) / (8 * l1)))).
+  clear H11; intros alp_f2t2 H11.
+  elim (H0 (Rabs (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 in |- *.
+  intros.
+  cut
+    (forall a:R,
+      Rabs a < alp_f2t2 ->
+      Rabs (f2 (x + a) - f2 x) < Rabs (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
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite H10.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_r || rewrite Rmult_0_l.
+  rewrite Rabs_R0; rewrite Rmult_0_l.
+  apply Rmult_lt_0_compat; [ assumption | apply Rinv_0_lt_compat; prove_sup ].
+  rewrite <- Rabs_mult.
+  apply (maj_term3 x h eps l2 alp_f2 eps_f2 alp_f2d f1 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  rewrite <- Rabs_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 <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; apply quadruple_var.
+  apply H2; assumption.
+  intros.
+  case (Req_dec a 0); intro.
+  rewrite H17; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0.
+  apply Rabs_pos_lt.
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  unfold Rsqr in |- *.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H18; rewrite H18 in H6; elim (Rlt_irrefl _ H6)).
+  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 Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
+  change (0 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *.
+  apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H12; rewrite H12 in H6; elim (Rlt_irrefl _ H6)).
 (***********************************)
 (*              Cas n° 6           *)
 (*    (f1 x)<>0  l1<>0  l2<>0      *)
 (***********************************)
-elim (H0 (Rabs (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 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))).
-intros alp_f2c H13.
-elim (H12 (Rabs (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 in |- *.
-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
- (forall a:R,
-    Rabs a < alp_f2t2 ->
-    Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
-cut
- (forall a:R,
-    Rabs a < alp_f2c ->
-    Rabs (f2 (x + a) - f2 x) <
-    Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
-intros.
-rewrite formule; try assumption.
-apply Rle_lt_trans with
- (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
-  Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
-  Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
-  Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
-unfold Rminus in |- *.
-rewrite <-
- (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
- .
-apply Rabs_4.
-repeat rewrite Rabs_mult.
-apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
-cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
-cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
-cut
- (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
-  eps / 4).
-cut
- (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
-  eps / 4).
-intros.
-apply Rlt_4; assumption.
-rewrite <- Rabs_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 <- Rabs_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 <- Rabs_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 <- Rabs_mult.
-apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
-apply H2; assumption.
-apply Rmin_2; assumption.
-right; symmetry  in |- *; apply quadruple_var.
-apply H2; assumption.
-intros.
-case (Req_dec a 0); intro.
-rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
-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_dec a 0); intro.
-rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
-discrR.
-assumption.
-elim H14; intros.
-apply H20.
-split.
-unfold D_x, no_cond in |- *; 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 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
-change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *;
- apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
-apply prod_neq_R0; [ discrR | assumption ].
-apply prod_neq_R0; [ discrR | assumption ].
-assumption.
-apply Rabs_pos_lt.
-unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr;
- [ idtac | discrR | assumption ].
-repeat apply prod_neq_R0;
- assumption ||
-   (apply Rinv_neq_0_compat; assumption) ||
-     (apply Rinv_neq_0_compat; discrR) ||
-       (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
-intros.
-unfold Rdiv in |- *.
-apply Rmult_lt_reg_l with (Rabs (f2 (x + a))).
-apply Rabs_pos_lt; apply H2.
-apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
-assumption.
-apply Rmin_l.
-rewrite <- Rinv_r_sym.
-apply Rmult_lt_reg_l with (Rabs (f2 x)).
-apply Rabs_pos_lt; assumption.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm (Rabs (f2 x))).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-apply Rmult_lt_reg_l with (/ 2).
-apply Rinv_0_lt_compat; prove_sup0.
-repeat rewrite (Rmult_comm (/ 2)).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r.
-unfold Rdiv in H5; apply H5.
-replace (x + a - x) with a.
-assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption.
-ring.
-discrR.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; apply H2.
-assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption.
-intros.
-assert (H6 := H4 a H5).
-rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6.
-rewrite Ropp_minus_distr in H6.
-assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6).
-apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2).
-rewrite Rplus_assoc.
-rewrite <- double_var.
-do 2 rewrite (Rplus_comm (- Rabs (f2 a))).
-rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-unfold Rminus in H7; assumption.
-intros.
-case (Req_dec x x0); intro.
-rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim H3; intros.
-apply H7.
-split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-assumption.
-assumption.
+  elim (H0 (Rabs (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 (Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2)))).
+  intros alp_f2c H13.
+  elim (H12 (Rabs (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 in |- *.
+  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
+    (forall a:R,
+      Rabs a < alp_f2t2 ->
+      Rabs (f2 (x + a) - f2 x) < Rabs (eps * Rsqr (f2 x) / (8 * l1))).
+  cut
+    (forall a:R,
+      Rabs a < alp_f2c ->
+      Rabs (f2 (x + a) - f2 x) <
+      Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))).
+  intros.
+  rewrite formule; try assumption.
+  apply Rle_lt_trans with
+    (Rabs (/ f2 (x + h) * ((f1 (x + h) - f1 x) / h - l1)) +
+      Rabs (l1 / (f2 x * f2 (x + h)) * (f2 x - f2 (x + h))) +
+      Rabs (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) - f2 x) / h - l2)) +
+      Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h)) * (f2 (x + h) - f2 x))).
+  unfold Rminus in |- *.
+  rewrite <-
+    (Rabs_Ropp (f1 x / (f2 x * f2 (x + h)) * ((f2 (x + h) + - f2 x) / h + - l2)))
+    .
+  apply Rabs_4.
+  repeat rewrite Rabs_mult.
+  apply Rlt_le_trans with (eps / 4 + eps / 4 + eps / 4 + eps / 4).
+  cut (Rabs (/ f2 (x + h)) * Rabs ((f1 (x + h) - f1 x) / h - l1) < eps / 4).
+  cut (Rabs (l1 / (f2 x * f2 (x + h))) * Rabs (f2 x - f2 (x + h)) < eps / 4).
+  cut
+    (Rabs (f1 x / (f2 x * f2 (x + h))) * Rabs ((f2 (x + h) - f2 x) / h - l2) <
+      eps / 4).
+  cut
+    (Rabs (l2 * f1 x / (Rsqr (f2 x) * f2 (x + h))) * Rabs (f2 (x + h) - f2 x) <
+      eps / 4).
+  intros.
+  apply Rlt_4; assumption.
+  rewrite <- Rabs_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 <- Rabs_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 <- Rabs_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 <- Rabs_mult.
+  apply (maj_term1 x h eps l1 alp_f2 eps_f2 alp_f1d f1 f2); try assumption.
+  apply H2; assumption.
+  apply Rmin_2; assumption.
+  right; symmetry  in |- *; apply quadruple_var.
+  apply H2; assumption.
+  intros.
+  case (Req_dec a 0); intro.
+  rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+  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_dec a 0); intro.
+  rewrite H18; rewrite Rplus_0_r; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H28; rewrite H28 in H6; elim (Rlt_irrefl _ H6)).
+  discrR.
+  assumption.
+  elim H14; intros.
+  apply H20.
+  split.
+  unfold D_x, no_cond in |- *; 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 < Rabs (eps * Rsqr (f2 x) / (8 * l1))) in |- *; apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr; try discrR || assumption.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H14; rewrite H14 in H6; elim (Rlt_irrefl _ H6)).
+  change (0 < Rabs (Rsqr (f2 x) * f2 x * eps / (8 * f1 x * l2))) in |- *;
+    apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr.
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H13; rewrite H13 in H6; elim (Rlt_irrefl _ H6)).
+  apply prod_neq_R0; [ discrR | assumption ].
+  apply prod_neq_R0; [ discrR | assumption ].
+  assumption.
+  apply Rabs_pos_lt.
+  unfold Rdiv, Rsqr in |- *; rewrite Rinv_mult_distr;
+    [ idtac | discrR | assumption ].
+  repeat apply prod_neq_R0;
+    assumption ||
+      (apply Rinv_neq_0_compat; assumption) ||
+        (apply Rinv_neq_0_compat; discrR) ||
+          (red in |- *; intro H11; rewrite H11 in H6; elim (Rlt_irrefl _ H6)).
+  intros.
+  unfold Rdiv in |- *.
+  apply Rmult_lt_reg_l with (Rabs (f2 (x + a))).
+  apply Rabs_pos_lt; apply H2.
+  apply Rlt_le_trans with (Rmin eps_f2 alp_f2).
+  assumption.
+  apply Rmin_l.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (Rabs (f2 x)).
+  apply Rabs_pos_lt; assumption.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (Rabs (f2 x))).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  apply Rmult_lt_reg_l with (/ 2).
+  apply Rinv_0_lt_compat; prove_sup0.
+  repeat rewrite (Rmult_comm (/ 2)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r.
+  unfold Rdiv in H5; apply H5.
+  replace (x + a - x) with a.
+  assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_r _ _)); assumption.
+  ring.
+  discrR.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; apply H2.
+  assert (H7 := Rlt_le_trans _ _ _ H6 (Rmin_l _ _)); assumption.
+  intros.
+  assert (H6 := H4 a H5).
+  rewrite <- (Rabs_Ropp (f2 a - f2 x)) in H6.
+  rewrite Ropp_minus_distr in H6.
+  assert (H7 := Rle_lt_trans _ _ _ (Rabs_triang_inv _ _) H6).
+  apply Rplus_lt_reg_r with (- Rabs (f2 a) + Rabs (f2 x) / 2).
+  rewrite Rplus_assoc.
+  rewrite <- double_var.
+  do 2 rewrite (Rplus_comm (- Rabs (f2 a))).
+  rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+  unfold Rminus in H7; assumption.
+  intros.
+  case (Req_dec x x0); intro.
+  rewrite <- H5; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      [ apply Rabs_pos_lt; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim H3; intros.
+  apply H7.
+  split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  assumption.
+  assumption.
 Qed.
 
 Lemma derivable_pt_div :
- forall (f1 f2:R -> R) (x:R),
-   derivable_pt f1 x ->
-   derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x.
-unfold derivable_pt in |- *.
-intros f1 f2 x X X0 H.
-elim X; intros.
-elim X0; intros.
-apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)).
-apply derivable_pt_lim_div; assumption.
+  forall (f1 f2:R -> R) (x:R),
+    derivable_pt f1 x ->
+    derivable_pt f2 x -> f2 x <> 0 -> derivable_pt (f1 / f2) x.
+Proof.
+  unfold derivable_pt in |- *.
+  intros f1 f2 x X X0 H.
+  elim X; intros.
+  elim X0; intros.
+  apply existT with ((x0 * f2 x - x1 * f1 x) / Rsqr (f2 x)).
+  apply derivable_pt_lim_div; assumption.
 Qed.
 
 Lemma derivable_div :
- forall f1 f2:R -> R,
-   derivable f1 ->
-   derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2).
-unfold derivable in |- *; intros f1 f2 X X0 H x.
-apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
+  forall f1 f2:R -> R,
+    derivable f1 ->
+    derivable f2 -> (forall x:R, f2 x <> 0) -> derivable (f1 / f2).
+Proof.
+  unfold derivable in |- *; intros f1 f2 X X0 H x.
+  apply (derivable_pt_div _ _ _ (X x) (X0 x) (H x)).
 Qed.
 
 Lemma derive_pt_div :
- forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) 
-   (pr2:derivable_pt f2 x) (na:f2 x <> 0),
-   derive_pt (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 (f1 / f2)%F 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.
+  forall (f1 f2:R -> R) (x:R) (pr1:derivable_pt f1 x) 
+    (pr2:derivable_pt f2 x) (na:f2 x <> 0),
+    derive_pt (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).
+Proof.
+  intros.
+  assert (H := derivable_derive f1 x pr1).
+  assert (H0 := derivable_derive f2 x pr2).
+  assert
+    (H1 := derivable_derive (f1 / f2)%F 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/theories/Reals/Ranalysis4.v b/theories/Reals/Ranalysis4.v
index 40bb2429..205c06b4 100644
--- a/theories/Reals/Ranalysis4.v
+++ b/theories/Reals/Ranalysis4.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Ranalysis4.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+(*i $Id: Ranalysis4.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -18,367 +18,392 @@ Require Import Exp_prop. Open Local Scope R_scope.
 
 (**********)
 Lemma derivable_pt_inv :
- forall (f:R -> R) (x:R),
-   f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x.
-intros f x H X; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x).
-intro X0; apply X0.
-apply derivable_pt_div.
-apply derivable_pt_const.
-assumption.
-assumption.
-unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros;
- unfold derivable_pt in |- *; apply existT with x0;
- unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
- unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; 
- intros; elim (p eps H0); intros; exists x1; intros; 
- unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x));
- rewrite <- (Rmult_1_l (/ f (x + h))).
-apply H1; assumption.
+  forall (f:R -> R) (x:R),
+    f x <> 0 -> derivable_pt f x -> derivable_pt (/ f) x.
+Proof.
+  intros f x H X; cut (derivable_pt (fct_cte 1 / f) x -> derivable_pt (/ f) x).
+  intro X0; apply X0.
+  apply derivable_pt_div.
+  apply derivable_pt_const.
+  assumption.
+  assumption.
+  unfold div_fct, inv_fct, fct_cte in |- *; intro X0; elim X0; intros;
+    unfold derivable_pt in |- *; apply existT with x0;
+      unfold derivable_pt_abs in |- *; unfold derivable_pt_lim in |- *;
+        unfold derivable_pt_abs in p; unfold derivable_pt_lim in p; 
+          intros; elim (p eps H0); intros; exists x1; intros; 
+            unfold Rdiv in H1; unfold Rdiv in |- *; rewrite <- (Rmult_1_l (/ f x));
+              rewrite <- (Rmult_1_l (/ f (x + h))).
+  apply H1; assumption.
 Qed.
 
 (**********)
 Lemma pr_nu_var :
- forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
-   f = g -> derive_pt f x pr1 = derive_pt g x pr2.
-unfold derivable_pt, derive_pt in |- *; intros.
-elim pr1; intros.
-elim pr2; intros.
-simpl in |- *.
-rewrite H in p.
-apply uniqueness_limite with g x; assumption.
+  forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
+    f = g -> derive_pt f x pr1 = derive_pt g x pr2.
+Proof.
+  unfold derivable_pt, derive_pt in |- *; intros.
+  elim pr1; intros.
+  elim pr2; intros.
+  simpl in |- *.
+  rewrite H in p.
+  apply uniqueness_limite with g x; assumption.
 Qed.
 
 (**********)
 Lemma pr_nu_var2 :
- forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
-   (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
-unfold derivable_pt, derive_pt in |- *; intros.
-elim pr1; intros.
-elim pr2; intros.
-simpl in |- *.
-assert (H0 := uniqueness_step2 _ _ _ p). 
-assert (H1 := uniqueness_step2 _ _ _ p0). 
-cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0).
-intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). 
-assumption.
-unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
- simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1;
- unfold 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.
+  forall (f g:R -> R) (x:R) (pr1:derivable_pt f x) (pr2:derivable_pt g x),
+    (forall h:R, f h = g h) -> derive_pt f x pr1 = derive_pt g x pr2.
+Proof.
+  unfold derivable_pt, derive_pt in |- *; intros.
+  elim pr1; intros.
+  elim pr2; intros.
+  simpl in |- *.
+  assert (H0 := uniqueness_step2 _ _ _ p). 
+  assert (H1 := uniqueness_step2 _ _ _ p0). 
+  cut (limit1_in (fun h:R => (f (x + h) - f x) / h) (fun h:R => h <> 0) x1 0).
+  intro; assert (H3 := uniqueness_step1 _ _ _ _ H0 H2). 
+  assumption.
+  unfold limit1_in in |- *; unfold limit_in in |- *; unfold dist in |- *;
+    simpl in |- *; unfold R_dist in |- *; unfold limit1_in in H1;
+      unfold 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 :
- forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f).
-intros f H X.
-unfold derivable in |- *; intro x.
-apply derivable_pt_inv.
-apply (H x).
-apply (X x).
+  forall f:R -> R, (forall x:R, f x <> 0) -> derivable f -> derivable (/ f).
+Proof.
+  intros f H X.
+  unfold derivable in |- *; intro x.
+  apply derivable_pt_inv.
+  apply (H x).
+  apply (X x).
 Qed.
 
 Lemma derive_pt_inv :
- forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0),
-   derive_pt (/ f) x (derivable_pt_inv f x na pr) =
-   - derive_pt f x pr / Rsqr (f x).
-intros;
- replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with
-  (derive_pt (fct_cte 1 / f) x
-     (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)).
-rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *;
- rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *;
- rewrite Rplus_0_l; reflexivity.
-apply pr_nu_var2.
-intro; unfold div_fct, fct_cte, inv_fct in |- *.
-unfold Rdiv in |- *; ring.
+  forall (f:R -> R) (x:R) (pr:derivable_pt f x) (na:f x <> 0),
+    derive_pt (/ f) x (derivable_pt_inv f x na pr) =
+    - derive_pt f x pr / Rsqr (f x).
+Proof.
+  intros;
+    replace (derive_pt (/ f) x (derivable_pt_inv f x na pr)) with
+    (derive_pt (fct_cte 1 / f) x
+      (derivable_pt_div (fct_cte 1) f x (derivable_pt_const 1 x) pr na)).
+  rewrite derive_pt_div; rewrite derive_pt_const; unfold fct_cte in |- *;
+    rewrite Rmult_0_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+      rewrite Rplus_0_l; reflexivity.
+  apply pr_nu_var2.
+  intro; unfold div_fct, fct_cte, inv_fct in |- *.
+  unfold Rdiv in |- *; ring.
 Qed.
 
-(* Rabsolu *)
+(** Rabsolu *)
 Lemma Rabs_derive_1 : forall x:R, 0 < x -> derivable_pt_lim Rabs x 1.
-intros.
-unfold derivable_pt_lim in |- *; intros.
-exists (mkposreal x H); intros.
-rewrite (Rabs_right x).
-rewrite (Rabs_right (x + h)).
-rewrite Rplus_comm.
-unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r.
-rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
-rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0.
-apply H1.
-apply Rle_ge.
-case (Rcase_abs h); intro.
-rewrite (Rabs_left h r) in H2.
-left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r;
- rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; 
- apply H2.
-apply Rplus_le_le_0_compat.
-left; apply H.
-apply Rge_le; apply r.
-left; apply H.
+Proof.
+  intros.
+  unfold derivable_pt_lim in |- *; intros.
+  exists (mkposreal x H); intros.
+  rewrite (Rabs_right x).
+  rewrite (Rabs_right (x + h)).
+  rewrite Rplus_comm.
+  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_r.
+  rewrite Rplus_0_r; unfold Rdiv in |- *; rewrite <- Rinv_r_sym.
+  rewrite Rplus_opp_r; rewrite Rabs_R0; apply H0.
+  apply H1.
+  apply Rle_ge.
+  case (Rcase_abs h); intro.
+  rewrite (Rabs_left h r) in H2.
+  left; rewrite Rplus_comm; apply Rplus_lt_reg_r with (- h); rewrite Rplus_0_r;
+    rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l; 
+      apply H2.
+  apply Rplus_le_le_0_compat.
+  left; apply H.
+  apply Rge_le; apply r.
+  left; apply H.
 Qed.
 
 Lemma Rabs_derive_2 : forall x:R, x < 0 -> derivable_pt_lim Rabs x (-1).
-intros.
-unfold derivable_pt_lim in |- *; intros.
-cut (0 < - x).
-intro; exists (mkposreal (- x) H1); intros.
-rewrite (Rabs_left x).
-rewrite (Rabs_left (x + h)).
-rewrite Rplus_comm.
-rewrite Ropp_plus_distr.
-unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc;
- rewrite Rplus_opp_l.
-rewrite Rplus_0_r; unfold Rdiv in |- *.
-rewrite Ropp_mult_distr_l_reverse.
-rewrite <- Rinv_r_sym.
-rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
-apply H2.
-case (Rcase_abs h); intro.
-apply Ropp_lt_cancel.
-rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat.
-apply H1.
-apply Ropp_0_gt_lt_contravar; apply r.
-rewrite (Rabs_right h r) in H3.
-apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc;
- rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3.
-apply H.
-apply Ropp_0_gt_lt_contravar; apply H.
+Proof.
+  intros.
+  unfold derivable_pt_lim in |- *; intros.
+  cut (0 < - x).
+  intro; exists (mkposreal (- x) H1); intros.
+  rewrite (Rabs_left x).
+  rewrite (Rabs_left (x + h)).
+  rewrite Rplus_comm.
+  rewrite Ropp_plus_distr.
+  unfold Rminus in |- *; rewrite Ropp_involutive; rewrite Rplus_assoc;
+    rewrite Rplus_opp_l.
+  rewrite Rplus_0_r; unfold Rdiv in |- *.
+  rewrite Ropp_mult_distr_l_reverse.
+  rewrite <- Rinv_r_sym.
+  rewrite Ropp_involutive; rewrite Rplus_opp_l; rewrite Rabs_R0; apply H0.
+  apply H2.
+  case (Rcase_abs h); intro.
+  apply Ropp_lt_cancel.
+  rewrite Ropp_0; rewrite Ropp_plus_distr; apply Rplus_lt_0_compat.
+  apply H1.
+  apply Ropp_0_gt_lt_contravar; apply r.
+  rewrite (Rabs_right h r) in H3.
+  apply Rplus_lt_reg_r with (- x); rewrite Rplus_0_r; rewrite <- Rplus_assoc;
+    rewrite Rplus_opp_l; rewrite Rplus_0_l; apply H3.
+  apply H.
+  apply Ropp_0_gt_lt_contravar; apply H.
 Qed.
 
-(* Rabsolu is derivable for all x <> 0 *)
+(** Rabsolu is derivable for all x <> 0 *)
 Lemma Rderivable_pt_abs : forall x:R, x <> 0 -> derivable_pt Rabs x.
-intros.
-case (total_order_T x 0); intro.
-elim s; intro.
-unfold derivable_pt in |- *; apply existT with (-1).
-apply (Rabs_derive_2 x a).
-elim H; exact b.
-unfold derivable_pt in |- *; apply existT with 1.
-apply (Rabs_derive_1 x r).
+Proof.
+  intros.
+  case (total_order_T x 0); intro.
+  elim s; intro.
+  unfold derivable_pt in |- *; apply existT with (-1).
+  apply (Rabs_derive_2 x a).
+  elim H; exact b.
+  unfold derivable_pt in |- *; apply existT with 1.
+  apply (Rabs_derive_1 x r).
 Qed.
 
-(* Rabsolu is continuous for all x *)
+(** Rabsolu is continuous for all x *)
 Lemma Rcontinuity_abs : continuity Rabs.
-unfold continuity in |- *; intro.
-case (Req_dec x 0); intro.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros; exists eps; 
- split.
-apply H0.
-intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; 
- intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3;
- rewrite Rplus_0_r in H3; apply H3.
-apply derivable_continuous_pt; apply (Rderivable_pt_abs x H).
+Proof.
+  unfold continuity in |- *; intro.
+  case (Req_dec x 0); intro.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros; exists eps; 
+        split.
+  apply H0.
+  intros; rewrite H; rewrite Rabs_R0; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_Rabsolu; elim H1; 
+      intros; rewrite H in H3; unfold Rminus in H3; rewrite Ropp_0 in H3;
+        rewrite Rplus_0_r in H3; apply H3.
+  apply derivable_continuous_pt; apply (Rderivable_pt_abs x H).
 Qed.
 
-(* Finite sums : Sum a_k x^k *)
+(** Finite sums : Sum a_k x^k *)
 Lemma continuity_finite_sum :
- forall (An:nat -> R) (N:nat),
-   continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
-intros; unfold continuity in |- *; intro.
-induction  N as [| N HrecN].
-simpl in |- *.
-apply continuity_pt_const.
-unfold constant in |- *; intros; reflexivity.
-replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
- ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
-  (fun y:R => (An (S N) * y ^ S N)%R))%F.
-apply continuity_pt_plus.
-apply HrecN.
-replace (fun y:R => An (S N) * y ^ S N) with
- (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
-apply continuity_pt_scal.
-apply derivable_continuous_pt.
-apply derivable_pt_pow.
-reflexivity.
-reflexivity.
+  forall (An:nat -> R) (N:nat),
+    continuity (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
+Proof.
+  intros; unfold continuity in |- *; intro.
+  induction  N as [| N HrecN].
+  simpl in |- *.
+  apply continuity_pt_const.
+  unfold constant in |- *; intros; reflexivity.
+  replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
+  ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
+    (fun y:R => (An (S N) * y ^ S N)%R))%F.
+  apply continuity_pt_plus.
+  apply HrecN.
+  replace (fun y:R => An (S N) * y ^ S N) with
+  (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
+  apply continuity_pt_scal.
+  apply derivable_continuous_pt.
+  apply derivable_pt_pow.
+  reflexivity.
+  reflexivity.
 Qed.
 
 Lemma derivable_pt_lim_fs :
- forall (An:nat -> R) (x:R) (N:nat),
-   (0 < N)%nat ->
-   derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
-     (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)).
-intros; induction  N as [| N HrecN].
-elim (lt_irrefl _ H).
-cut (N = 0%nat \/ (0 < N)%nat).
-intro; elim H0; intro.
-rewrite H1.
-simpl in |- *.
-replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with
- (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F.
-replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)).
-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 in |- *; ring.
-reflexivity.
-replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
- ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
-  (fun y:R => (An (S N) * y ^ S N)%R))%F.
-replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N)))
- with
- (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) +
-  An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))).
-apply derivable_pt_lim_plus.
-apply HrecN.
-assumption.
-replace (fun y:R => An (S N) * y ^ S N) with
- (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
-apply derivable_pt_lim_scal.
-replace (pred (S N)) with N; [ idtac | reflexivity ].
-pattern N at 3 in |- *; replace N with (pred (S N)).
-apply derivable_pt_lim_pow.
-reflexivity.
-reflexivity.
-cut (pred (S N) = S (pred N)).
-intro; rewrite H2.
-rewrite tech5.
-apply Rplus_eq_compat_l.
-rewrite <- H2.
-replace (pred (S N)) with N; [ idtac | reflexivity ].
-ring.
-simpl in |- *.
-apply S_pred with 0%nat; assumption.
-unfold plus_fct in |- *.
-simpl in |- *; reflexivity.
-inversion H.
-left; reflexivity.
-right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
+  forall (An:nat -> R) (x:R) (N:nat),
+    (0 < N)%nat ->
+    derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
+    (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)).
+Proof.
+  intros; induction  N as [| N HrecN].
+  elim (lt_irrefl _ H).
+  cut (N = 0%nat \/ (0 < N)%nat).
+  intro; elim H0; intro.
+  rewrite H1.
+  simpl in |- *.
+  replace (fun y:R => An 0%nat * 1 + An 1%nat * (y * 1)) with
+  (fct_cte (An 0%nat * 1) + mult_real_fct (An 1%nat) (id * fct_cte 1))%F.
+  replace (1 * An 1%nat * 1) with (0 + An 1%nat * (1 * fct_cte 1 x + id x * 0)).
+  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 in |- *; ring.
+  reflexivity.
+  replace (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) (S N)) with
+  ((fun y:R => sum_f_R0 (fun k:nat => (An k * y ^ k)%R) N) +
+    (fun y:R => (An (S N) * y ^ S N)%R))%F.
+  replace (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N)))
+    with
+      (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N) +
+        An (S N) * (INR (S (pred (S N))) * x ^ pred (S N))).
+  apply derivable_pt_lim_plus.
+  apply HrecN.
+  assumption.
+  replace (fun y:R => An (S N) * y ^ S N) with
+  (mult_real_fct (An (S N)) (fun y:R => y ^ S N)).
+  apply derivable_pt_lim_scal.
+  replace (pred (S N)) with N; [ idtac | reflexivity ].
+  pattern N at 3 in |- *; replace N with (pred (S N)).
+  apply derivable_pt_lim_pow.
+  reflexivity.
+  reflexivity.
+  cut (pred (S N) = S (pred N)).
+  intro; rewrite H2.
+  rewrite tech5.
+  apply Rplus_eq_compat_l.
+  rewrite <- H2.
+  replace (pred (S N)) with N; [ idtac | reflexivity ].
+  ring.
+  simpl in |- *.
+  apply S_pred with 0%nat; assumption.
+  unfold plus_fct in |- *.
+  simpl in |- *; reflexivity.
+  inversion H.
+  left; reflexivity.
+  right; apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
 Qed.
 
 Lemma derivable_pt_lim_finite_sum :
- forall (An:nat -> R) (x:R) (N:nat),
-   derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
-     match N with
-     | O => 0
-     | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)
-     end.
-intros.
-induction  N as [| N HrecN].
-simpl in |- *.
-rewrite Rmult_1_r.
-replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat));
- [ apply derivable_pt_lim_const | reflexivity ].
-apply derivable_pt_lim_fs; apply lt_O_Sn.
+  forall (An:nat -> R) (x:R) (N:nat),
+    derivable_pt_lim (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x
+    match N with
+      | O => 0
+      | _ => sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred N)
+    end.
+Proof.
+  intros.
+  induction  N as [| N HrecN].
+  simpl in |- *.
+  rewrite Rmult_1_r.
+  replace (fun _:R => An 0%nat) with (fct_cte (An 0%nat));
+  [ apply derivable_pt_lim_const | reflexivity ].
+  apply derivable_pt_lim_fs; apply lt_O_Sn.
 Qed.
 
 Lemma derivable_pt_finite_sum :
- forall (An:nat -> R) (N:nat) (x:R),
-   derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x.
-intros.
-unfold derivable_pt in |- *.
-assert (H := derivable_pt_lim_finite_sum An x N).
-induction  N as [| N HrecN].
-apply existT with 0; apply H.
-apply existT with
- (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); 
- apply H.
+  forall (An:nat -> R) (N:nat) (x:R),
+    derivable_pt (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N) x.
+Proof.
+  intros.
+  unfold derivable_pt in |- *.
+  assert (H := derivable_pt_lim_finite_sum An x N).
+  induction  N as [| N HrecN].
+  apply existT with 0; apply H.
+  apply existT with
+    (sum_f_R0 (fun k:nat => INR (S k) * An (S k) * x ^ k) (pred (S N))); 
+    apply H.
 Qed.
 
 Lemma derivable_finite_sum :
- forall (An:nat -> R) (N:nat),
-   derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
-intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum.
+  forall (An:nat -> R) (N:nat),
+    derivable (fun y:R => sum_f_R0 (fun k:nat => An k * y ^ k) N).
+Proof.
+  intros; unfold derivable in |- *; intro; apply derivable_pt_finite_sum.
 Qed.
 
-(* Regularity of hyperbolic functions *)
+(** Regularity of hyperbolic functions *)
 Lemma derivable_pt_lim_cosh : forall x:R, derivable_pt_lim cosh x (sinh x).
-intro.
-unfold cosh, sinh in |- *; unfold Rdiv in |- *.
-replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with
- ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
-replace ((exp x - exp (- x)) * / 2) with
- ((exp x + exp (- x) * -1) * fct_cte (/ 2) x +
-  (exp + comp exp (- id))%F 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 in |- *; ring.
+Proof.
+  intro.
+  unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+  replace (fun x0:R => (exp x0 + exp (- x0)) * / 2) with
+  ((exp + comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
+  replace ((exp x - exp (- x)) * / 2) with
+  ((exp x + exp (- x) * -1) * fct_cte (/ 2) x +
+    (exp + comp exp (- id))%F 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 in |- *; ring.
 Qed.
 
 Lemma derivable_pt_lim_sinh : forall x:R, derivable_pt_lim sinh x (cosh x).
-intro.
-unfold cosh, sinh in |- *; unfold Rdiv in |- *.
-replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with
- ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
-replace ((exp x + exp (- x)) * / 2) with
- ((exp x - exp (- x) * -1) * fct_cte (/ 2) x +
-  (exp - comp exp (- id))%F 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 in |- *; ring.
+Proof.
+  intro.
+  unfold cosh, sinh in |- *; unfold Rdiv in |- *.
+  replace (fun x0:R => (exp x0 - exp (- x0)) * / 2) with
+  ((exp - comp exp (- id)) * fct_cte (/ 2))%F; [ idtac | reflexivity ].
+  replace ((exp x + exp (- x)) * / 2) with
+  ((exp x - exp (- x) * -1) * fct_cte (/ 2) x +
+    (exp - comp exp (- id))%F 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 in |- *; ring.
 Qed.
 
 Lemma derivable_pt_exp : forall x:R, derivable_pt exp x.
-intro.
-unfold derivable_pt in |- *.
-apply existT with (exp x).
-apply derivable_pt_lim_exp.
+Proof.
+  intro.
+  unfold derivable_pt in |- *.
+  apply existT with (exp x).
+  apply derivable_pt_lim_exp.
 Qed.
 
 Lemma derivable_pt_cosh : forall x:R, derivable_pt cosh x.
-intro.
-unfold derivable_pt in |- *.
-apply existT with (sinh x).
-apply derivable_pt_lim_cosh.
+Proof.
+  intro.
+  unfold derivable_pt in |- *.
+  apply existT with (sinh x).
+  apply derivable_pt_lim_cosh.
 Qed.
 
 Lemma derivable_pt_sinh : forall x:R, derivable_pt sinh x.
-intro.
-unfold derivable_pt in |- *.
-apply existT with (cosh x).
-apply derivable_pt_lim_sinh.
+Proof.
+  intro.
+  unfold derivable_pt in |- *.
+  apply existT with (cosh x).
+  apply derivable_pt_lim_sinh.
 Qed.
 
 Lemma derivable_exp : derivable exp.
-unfold derivable in |- *; apply derivable_pt_exp.
+Proof.
+  unfold derivable in |- *; apply derivable_pt_exp.
 Qed.
 
 Lemma derivable_cosh : derivable cosh.
-unfold derivable in |- *; apply derivable_pt_cosh.
+Proof.
+  unfold derivable in |- *; apply derivable_pt_cosh.
 Qed.
 
 Lemma derivable_sinh : derivable sinh.
-unfold derivable in |- *; apply derivable_pt_sinh.
+Proof.
+  unfold derivable in |- *; apply derivable_pt_sinh.
 Qed.
 
 Lemma derive_pt_exp :
- forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x.
-intro; apply derive_pt_eq_0.
-apply derivable_pt_lim_exp.
+  forall x:R, derive_pt exp x (derivable_pt_exp x) = exp x.
+Proof.
+  intro; apply derive_pt_eq_0.
+  apply derivable_pt_lim_exp.
 Qed.
 
 Lemma derive_pt_cosh :
- forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x.
-intro; apply derive_pt_eq_0.
-apply derivable_pt_lim_cosh.
+  forall x:R, derive_pt cosh x (derivable_pt_cosh x) = sinh x.
+Proof.
+  intro; apply derive_pt_eq_0.
+  apply derivable_pt_lim_cosh.
 Qed.
 
 Lemma derive_pt_sinh :
- forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x.
-intro; apply derive_pt_eq_0.
-apply derivable_pt_lim_sinh.
+  forall x:R, derive_pt sinh x (derivable_pt_sinh x) = cosh x.
+Proof.
+  intro; apply derive_pt_eq_0.
+  apply derivable_pt_lim_sinh.
 Qed.
diff --git a/theories/Reals/Raxioms.v b/theories/Reals/Raxioms.v
index 61902568..aaea59f4 100644
--- a/theories/Reals/Raxioms.v
+++ b/theories/Reals/Raxioms.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Raxioms.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
+(*i $Id: Raxioms.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (*********************************************************)
 (**    Axiomatisation of the classical reals             *)
@@ -17,11 +17,11 @@ Require Export Rdefinitions.
 Open Local Scope R_scope.
 
 (*********************************************************)
-(*               Field axioms                            *)
+(** *            Field axioms                            *)
 (*********************************************************)
 
 (*********************************************************)
-(**      Addition                                        *)
+(** **   Addition                                        *)
 (*********************************************************)
 
 (**********)
@@ -41,7 +41,7 @@ Axiom Rplus_0_l : forall r:R, 0 + r = r.
 Hint Resolve Rplus_0_l: real.
 
 (***********************************************************)       
-(**       Multiplication                                   *)
+(** **    Multiplication                                   *)
 (***********************************************************)
 
 (**********)
@@ -65,7 +65,7 @@ Axiom R1_neq_R0 : 1 <> 0.
 Hint Resolve R1_neq_R0: real.
 
 (*********************************************************)
-(**      Distributivity                                  *)
+(** **   Distributivity                                  *)
 (*********************************************************)
 
 (**********)
@@ -74,17 +74,17 @@ Axiom
 Hint Resolve Rmult_plus_distr_l: real v62.
 
 (*********************************************************)
-(**      Order axioms                                    *)
+(** *    Order axioms                                    *)
 (*********************************************************)
 (*********************************************************)
-(**      Total Order                                     *)
+(** **   Total Order                                     *)
 (*********************************************************)
 
 (**********)
 Axiom total_order_T : forall r1 r2:R, {r1 < r2} + {r1 = r2} + {r1 > r2}.
 
 (*********************************************************)
-(**      Lower                                           *)
+(** **   Lower                                           *)
 (*********************************************************)
 
 (**********)
@@ -103,7 +103,7 @@ Axiom
 Hint Resolve Rlt_asym Rplus_lt_compat_l Rmult_lt_compat_l: real.
 
 (**********************************************************) 
-(**      Injection from N to R                            *)
+(** *    Injection from N to R                            *)
 (**********************************************************)
 
 (**********)
@@ -117,7 +117,7 @@ Arguments Scope INR [nat_scope].
 
 
 (**********************************************************) 
-(**      Injection from [Z] to [R]                        *)
+(** *    Injection from [Z] to [R]                        *)
 (**********************************************************)
 
 (**********)
@@ -130,14 +130,14 @@ Definition IZR (z:Z) : R :=
 Arguments Scope IZR [Z_scope].
 
 (**********************************************************)
-(**      [R] Archimedian                                  *)
+(** *    [R] Archimedian                                  *)
 (**********************************************************)
 
 (**********)
 Axiom archimed : forall r:R, IZR (up r) > r /\ IZR (up r) - r <= 1.
 
 (**********************************************************)
-(**      [R] Complete                                     *)
+(** *    [R] Complete                                     *)
 (**********************************************************)
 
 (**********)
diff --git a/theories/Reals/Rbase.v b/theories/Reals/Rbase.v
index 5bfb692a..5bee0f82 100644
--- a/theories/Reals/Rbase.v
+++ b/theories/Reals/Rbase.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rbase.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rbase.v 9178 2006-09-26 11:18:22Z barras $ i*)
 
 Require Export Rdefinitions.
 Require Export Raxioms.
 Require Export RIneq.
-Require Export DiscrR.
\ No newline at end of file
+Require Export DiscrR.
diff --git a/theories/Reals/Rbasic_fun.v b/theories/Reals/Rbasic_fun.v
index 0d1b06e2..98bd607b 100644
--- a/theories/Reals/Rbasic_fun.v
+++ b/theories/Reals/Rbasic_fun.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rbasic_fun.v 8838 2006-05-22 09:26:36Z herbelin $ i*)
+(*i $Id: Rbasic_fun.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (*********************************************************)
 (**          Complements for the real numbers            *)
@@ -20,453 +20,489 @@ Require Import Fourier. Open Local Scope R_scope.
 Implicit Type r : R.
 
 (*******************************)
-(**          Rmin              *)
+(** *        Rmin              *)
 (*******************************)
 
 (*********)
 Definition Rmin (x y:R) : R :=
   match Rle_dec x y with
-  | left _ => x
-  | right _ => y
+    | left _ => x
+    | right _ => y
   end.
 
 (*********)
 Lemma Rmin_Rgt_l : forall r1 r2 r, Rmin r1 r2 > r -> r1 > r /\ r2 > r.
-intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros.
-split.
-assumption.
-unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
-split.
-generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H).
-assumption.
+Proof.
+  intros r1 r2 r; unfold Rmin in |- *; case (Rle_dec r1 r2); intros.
+  split.
+  assumption.
+  unfold Rgt in |- *; unfold Rgt in H; exact (Rlt_le_trans r r1 r2 H r0).
+  split.
+  generalize (Rnot_le_lt r1 r2 n); intro; exact (Rgt_trans r1 r2 r H0 H).
+  assumption.
 Qed.
 
 (*********)
 Lemma Rmin_Rgt_r : forall r1 r2 r, r1 > r /\ r2 > r -> Rmin r1 r2 > r.
-intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
- assumption.
+Proof.
+  intros; unfold Rmin in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+    assumption.
 Qed.
 
 (*********)
 Lemma Rmin_Rgt : forall r1 r2 r, Rmin r1 r2 > r <-> r1 > r /\ r2 > r.
-intros; split.
-exact (Rmin_Rgt_l r1 r2 r).
-exact (Rmin_Rgt_r r1 r2 r).
+Proof.
+  intros; split.
+  exact (Rmin_Rgt_l r1 r2 r).
+  exact (Rmin_Rgt_r r1 r2 r).
 Qed.
 
 (*********)
 Lemma Rmin_l : forall x y:R, Rmin x y <= x.
-intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
- [ right; reflexivity | auto with real ].
+Proof.
+  intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+    [ right; reflexivity | auto with real ].
 Qed.
- 
+
 (*********)
 Lemma Rmin_r : forall x y:R, Rmin x y <= y.
-intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
- [ assumption | auto with real ].
+Proof.
+  intros; unfold Rmin in |- *; case (Rle_dec x y); intro H1;
+    [ assumption | auto with real ].
 Qed.
 
 (*********)
 Lemma Rmin_comm : forall a b:R, Rmin a b = Rmin b a.
-intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros;
- try reflexivity || (apply Rle_antisym; assumption || auto with real).
+Proof.
+  intros; unfold Rmin in |- *; case (Rle_dec a b); case (Rle_dec b a); intros;
+    try reflexivity || (apply Rle_antisym; assumption || auto with real).
 Qed.
 
 (*********)
 Lemma Rmin_stable_in_posreal : forall x y:posreal, 0 < Rmin x y.
-intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ].
+Proof.
+  intros; apply Rmin_Rgt_r; split; [ apply (cond_pos x) | apply (cond_pos y) ].
 Qed.
 
 (*******************************)
-(**          Rmax              *)
+(** *        Rmax              *)
 (*******************************)
 
 (*********)
 Definition Rmax (x y:R) : R :=
   match Rle_dec x y with
-  | left _ => y
-  | right _ => x
+    | left _ => y
+    | right _ => x
   end.
 
 (*********)
 Lemma Rmax_Rle : forall r1 r2 r, r <= Rmax r1 r2 <-> r <= r1 \/ r <= r2.
-intros; split.
-unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto.
-intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
- auto.
-apply (Rle_trans r r1 r2); auto.
-generalize (Rnot_le_lt r1 r2 n); clear n; intro; unfold Rgt in H0;
- apply (Rlt_le r r1 (Rle_lt_trans r r2 r1 H H0)).
+Proof.
+  intros; split.
+  unfold Rmax in |- *; case (Rle_dec r1 r2); intros; auto.
+  intro; unfold Rmax in |- *; case (Rle_dec r1 r2); elim H; clear H; intros;
+    auto.
+  apply (Rle_trans r r1 r2); auto.
+  generalize (Rnot_le_lt 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 : forall r1 r2, r1 <= Rmax r1 r2.
-intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
+Proof.
+  intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
 Qed.
- 
+
 Lemma RmaxLess2 : forall r1 r2, r2 <= Rmax r1 r2.
-intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
+Proof.
+  intros r1 r2; unfold Rmax in |- *; case (Rle_dec r1 r2); auto with real.
 Qed.
- 
+
 Lemma Rmax_comm : forall p q:R, Rmax p q = Rmax q p.
-intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto;
- intros H1 H2; apply Rle_antisym; auto with real.
+Proof.
+  intros p q; unfold Rmax in |- *; case (Rle_dec p q); case (Rle_dec q p); auto;
+    intros H1 H2; apply Rle_antisym; auto with real.
 Qed.
 
 Notation RmaxSym := Rmax_comm (only parsing).
 
 Lemma RmaxRmult :
- forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q.
-intros p q r H; unfold Rmax in |- *.
-case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
-case H; intros E1.
-case H1; auto with real.
-rewrite <- E1; repeat rewrite Rmult_0_l; auto.
-case H; intros E1.
-case H2; auto with real.
-apply Rmult_le_reg_l with (r := r); auto.
-rewrite <- E1; repeat rewrite Rmult_0_l; auto.
+  forall (p q:R) r, 0 <= r -> Rmax (r * p) (r * q) = r * Rmax p q.
+Proof.
+  intros p q r H; unfold Rmax in |- *.
+  case (Rle_dec p q); case (Rle_dec (r * p) (r * q)); auto; intros H1 H2; auto.
+  case H; intros E1.
+  case H1; auto with real.
+  rewrite <- E1; repeat rewrite Rmult_0_l; auto.
+  case H; intros E1.
+  case H2; auto with real.
+  apply Rmult_le_reg_l with (r := r); auto.
+  rewrite <- E1; repeat rewrite Rmult_0_l; auto.
 Qed.
 
 Lemma Rmax_stable_in_negreal : forall x y:negreal, Rmax x y < 0.
-intros; unfold Rmax in |- *; case (Rle_dec x y); intro;
- [ apply (cond_neg y) | apply (cond_neg x) ].
+Proof.
+  intros; unfold Rmax in |- *; case (Rle_dec x y); intro;
+    [ apply (cond_neg y) | apply (cond_neg x) ].
 Qed.
 
 (*******************************)
-(**          Rabsolu           *)
+(** *        Rabsolu           *)
 (*******************************)
 
 (*********)
 Lemma Rcase_abs : forall r, {r < 0} + {r >= 0}. 
-intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X.
-right; apply (Rle_ge 0 r a).
-left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b).
+Proof.
+  intro; generalize (Rle_dec 0 r); intro X; elim X; intro; clear X.
+  right; apply (Rle_ge 0 r a).
+  left; fold (0 > r) in |- *; apply (Rnot_le_lt 0 r b).
 Qed.
 
 (*********)
 Definition Rabs r : R :=
   match Rcase_abs r with
-  | left _ => - r
-  | right _ => r
+    | left _ => - r
+    | right _ => r
   end.
 
 (*********)
 Lemma Rabs_R0 : Rabs 0 = 0.
-unfold Rabs in |- *; case (Rcase_abs 0); auto; intro.
-generalize (Rlt_irrefl 0); intro; elimtype False; auto.
+Proof.
+  unfold Rabs in |- *; case (Rcase_abs 0); auto; intro.
+  generalize (Rlt_irrefl 0); intro; elimtype False; auto.
 Qed.
 
 Lemma Rabs_R1 : Rabs 1 = 1.
+Proof.
 unfold Rabs in |- *; case (Rcase_abs 1); auto with real.
 intros H; absurd (1 < 0); auto with real.
 Qed.
 
 (*********)
 Lemma Rabs_no_R0 : forall r, r <> 0 -> Rabs r <> 0.
-intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto.
-apply Ropp_neq_0_compat; auto.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs r); intro; auto.
+  apply Ropp_neq_0_compat; auto.
 Qed.
 
 (*********)
 Lemma Rabs_left : forall r, r < 0 -> Rabs r = - r.
-intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro;
- absurd (r >= 0).
-exact (Rlt_not_ge r 0 H).
-assumption.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs r); trivial; intro;
+    absurd (r >= 0).
+  exact (Rlt_not_ge r 0 H).
+  assumption.
 Qed.
 
 (*********)
 Lemma Rabs_right : forall r, r >= 0 -> Rabs r = r.
-intros; unfold Rabs in |- *; case (Rcase_abs r); intro.
-absurd (r >= 0).
-exact (Rlt_not_ge r 0 r0).
-assumption.
-trivial.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs r); intro.
+  absurd (r >= 0).
+  exact (Rlt_not_ge r 0 r0).
+  assumption.
+  trivial.
 Qed.
 
 Lemma Rabs_left1 : forall a:R, a <= 0 -> Rabs a = - a.
-intros a H; case H; intros H1.
-apply Rabs_left; auto.
-rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
+Proof.
+  intros a H; case H; intros H1.
+  apply Rabs_left; auto.
+  rewrite H1; simpl in |- *; rewrite Rabs_right; auto with real.
 Qed.
 
 (*********)
 Lemma Rabs_pos : forall x:R, 0 <= Rabs x.
-intros; unfold Rabs in |- *; case (Rcase_abs x); intro.
-generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H;
- rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption.
-apply Rge_le; assumption.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar x 0 r); intro; unfold Rgt in H;
+    rewrite Ropp_0 in H; unfold Rle in |- *; left; assumption.
+  apply Rge_le; assumption.
 Qed.
 
 Lemma RRle_abs : forall x:R, x <= Rabs x.
-intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier.
+Proof.
+  intro; unfold Rabs in |- *; case (Rcase_abs x); intros; fourier.
 Qed.
 
 (*********)
 Lemma Rabs_pos_eq : forall x:R, 0 <= x -> Rabs x = x.
-intros; unfold Rabs in |- *; case (Rcase_abs x); intro;
- [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ].
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs x); intro;
+    [ generalize (Rgt_not_le 0 x r); intro; elimtype False; auto | trivial ].
 Qed.
 
 (*********)
 Lemma Rabs_Rabsolu : forall x:R, Rabs (Rabs x) = Rabs x.
-intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)).
+Proof.
+  intro; apply (Rabs_pos_eq (Rabs x) (Rabs_pos x)).
 Qed.
 
 (*********)
 Lemma Rabs_pos_lt : forall x:R, x <> 0 -> 0 < Rabs x.
-intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro;
- auto.
-elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *;
- case (Rcase_abs x); intros; auto.
-clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0);
- rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); 
- trivial.
+Proof.
+  intros; generalize (Rabs_pos x); intro; unfold Rle in H0; elim H0; intro;
+    auto.
+  elimtype False; clear H0; elim H; clear H; generalize H1; unfold Rabs in |- *;
+    case (Rcase_abs x); intros; auto.
+  clear r H1; generalize (Rplus_eq_compat_l x 0 (- x) H0);
+    rewrite (let (H1, H2) := Rplus_ne x in H1); rewrite (Rplus_opp_r x); 
+      trivial.
 Qed.
 
 (*********)
 Lemma Rabs_minus_sym : forall x y:R, Rabs (x - y) = Rabs (y - x).
-intros; unfold Rabs in |- *; case (Rcase_abs (x - y));
- case (Rcase_abs (y - x)); intros.
- generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros;
-  generalize (Rlt_asym x y H); intro; elimtype False; 
-  auto.
-rewrite (Ropp_minus_distr x y); trivial.
-rewrite (Ropp_minus_distr y x); trivial.
-unfold Rge in r, r0; elim r; elim r0; intros; clear r r0.
-generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y);
- intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); 
- intro; elimtype False; auto.
-rewrite (Rminus_diag_uniq x y H); trivial.
-rewrite (Rminus_diag_uniq y x H0); trivial.
-rewrite (Rminus_diag_uniq y x H0); trivial.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs (x - y));
+    case (Rcase_abs (y - x)); intros.
+  generalize (Rminus_lt y x r); generalize (Rminus_lt x y r0); intros;
+    generalize (Rlt_asym x y H); intro; elimtype False; 
+      auto.
+  rewrite (Ropp_minus_distr x y); trivial.
+  rewrite (Ropp_minus_distr y x); trivial.
+  unfold Rge in r, r0; elim r; elim r0; intros; clear r r0.
+  generalize (Ropp_lt_gt_0_contravar (x - y) H); rewrite (Ropp_minus_distr x y);
+    intro; unfold Rgt in H0; generalize (Rlt_asym 0 (y - x) H0); 
+      intro; elimtype False; auto.
+  rewrite (Rminus_diag_uniq x y H); trivial.
+  rewrite (Rminus_diag_uniq y x H0); trivial.
+  rewrite (Rminus_diag_uniq y x H0); trivial.
 Qed.
 
 (*********)
 Lemma Rabs_mult : forall x y:R, Rabs (x * y) = Rabs x * Rabs y.
-intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x);
- case (Rcase_abs y); intros; auto.
-generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro;
- rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); 
- intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; 
- auto.
-rewrite (Ropp_mult_distr_l_reverse x y); trivial. 
-rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x);
- rewrite (Rmult_comm x y); trivial.
-unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0.
-generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1;
- generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; 
- auto.
-rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0);
- intro; elimtype False; auto.
-rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
- intro; elimtype False; auto.
-rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
- intro; elimtype False; auto.
-rewrite (Rmult_opp_opp x y); trivial.
-unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H.
-generalize (Rmult_lt_compat_l y x 0 H0 r0); intro;
- rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1;
- generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; 
- auto.
-generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0));
- generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); 
- intros; generalize (Rmult_integral x y H); intro; 
- elim H3; intro; elimtype False; auto.  
-rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H;
- generalize (Rlt_irrefl 0); intro; elimtype False; 
- auto.
-rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial.
-unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros;
- unfold Rgt in H0, H.
-generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1;
- generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; 
- auto.
-generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r));
- generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); 
- intros; generalize (Rmult_integral x y H); intro; 
- elim H3; intro; elimtype False; auto.  
-rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H;
- generalize (Rlt_irrefl 0); intro; elimtype False; 
- auto.
-rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial.
+Proof.
+  intros; unfold Rabs in |- *; case (Rcase_abs (x * y)); case (Rcase_abs x);
+    case (Rcase_abs y); intros; auto.
+  generalize (Rmult_lt_gt_compat_neg_l y x 0 r r0); intro;
+    rewrite (Rmult_0_r y) in H; generalize (Rlt_asym (x * y) 0 r1); 
+      intro; unfold Rgt in H; elimtype False; rewrite (Rmult_comm y x) in H; 
+        auto.
+  rewrite (Ropp_mult_distr_l_reverse x y); trivial. 
+  rewrite (Rmult_comm x (- y)); rewrite (Ropp_mult_distr_l_reverse y x);
+    rewrite (Rmult_comm x y); trivial.
+  unfold Rge in r, r0; elim r; elim r0; clear r r0; intros; unfold Rgt in H, H0.
+  generalize (Rmult_lt_compat_l x 0 y H H0); intro; rewrite (Rmult_0_r x) in H1;
+    generalize (Rlt_asym (x * y) 0 r1); intro; elimtype False; 
+      auto.
+  rewrite H in r1; rewrite (Rmult_0_l y) in r1; generalize (Rlt_irrefl 0);
+    intro; elimtype False; auto.
+  rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
+    intro; elimtype False; auto.
+  rewrite H0 in r1; rewrite (Rmult_0_r x) in r1; generalize (Rlt_irrefl 0);
+    intro; elimtype False; auto.
+  rewrite (Rmult_opp_opp x y); trivial.
+  unfold Rge in r, r1; elim r; elim r1; clear r r1; intros; unfold Rgt in H0, H.
+  generalize (Rmult_lt_compat_l y x 0 H0 r0); intro;
+    rewrite (Rmult_0_r y) in H1; rewrite (Rmult_comm y x) in H1;
+      generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; 
+        auto.
+  generalize (Rlt_dichotomy_converse x 0 (or_introl (x > 0) r0));
+    generalize (Rlt_dichotomy_converse y 0 (or_intror (y < 0) H0)); 
+      intros; generalize (Rmult_integral x y H); intro; 
+        elim H3; intro; elimtype False; auto.  
+  rewrite H0 in H; rewrite (Rmult_0_r x) in H; unfold Rgt in H;
+    generalize (Rlt_irrefl 0); intro; elimtype False; 
+      auto.
+  rewrite H0; rewrite (Rmult_0_r x); rewrite (Rmult_0_r (- x)); trivial.
+  unfold Rge in r0, r1; elim r0; elim r1; clear r0 r1; intros;
+    unfold Rgt in H0, H.
+  generalize (Rmult_lt_compat_l x y 0 H0 r); intro; rewrite (Rmult_0_r x) in H1;
+    generalize (Rlt_asym (x * y) 0 H1); intro; elimtype False; 
+      auto.
+  generalize (Rlt_dichotomy_converse y 0 (or_introl (y > 0) r));
+    generalize (Rlt_dichotomy_converse 0 x (or_introl (0 > x) H0)); 
+      intros; generalize (Rmult_integral x y H); intro; 
+        elim H3; intro; elimtype False; auto.  
+  rewrite H0 in H; rewrite (Rmult_0_l y) in H; unfold Rgt in H;
+    generalize (Rlt_irrefl 0); intro; elimtype False; 
+      auto.
+  rewrite H0; rewrite (Rmult_0_l y); rewrite (Rmult_0_l (- y)); trivial.
 Qed.
 
 (*********)
 Lemma Rabs_Rinv : forall r, r <> 0 -> Rabs (/ r) = / Rabs r.
-intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
- intros.
-apply Ropp_inv_permute; auto.
-generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros.
-unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False;
- auto.
-generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro;
- elimtype False; auto.
-unfold Rge in r1; elim r1; clear r1; intro.
-unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0));
- intro; elimtype False; auto.
-elimtype False; auto.
+Proof.
+  intro; unfold Rabs in |- *; case (Rcase_abs r); case (Rcase_abs (/ r)); auto;
+    intros.
+  apply Ropp_inv_permute; auto.
+  generalize (Rinv_lt_0_compat r r1); intro; unfold Rge in r0; elim r0; intros.
+  unfold Rgt in H1; generalize (Rlt_asym 0 (/ r) H1); intro; elimtype False;
+    auto.
+  generalize (Rlt_dichotomy_converse (/ r) 0 (or_introl (/ r > 0) H0)); intro;
+    elimtype False; auto.
+  unfold Rge in r1; elim r1; clear r1; intro.
+  unfold Rgt in H0; generalize (Rlt_asym 0 (/ r) (Rinv_0_lt_compat r H0));
+    intro; elimtype False; auto.
+  elimtype False; auto.
 Qed. 
 
 Lemma Rabs_Ropp : forall x:R, Rabs (- x) = Rabs x.
-intro; cut (- x = -1 * x).
-intros; rewrite H.
-rewrite Rabs_mult.
-cut (Rabs (-1) = 1).
-intros; rewrite H0.
-ring.
-unfold Rabs in |- *; case (Rcase_abs (-1)).
-intro; ring.
-intro H0; generalize (Rge_le (-1) 0 H0); intros.
-generalize (Ropp_le_ge_contravar 0 (-1) H1).
-rewrite Ropp_involutive; rewrite Ropp_0.
-intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2);
- intro; elimtype False; auto.  
-ring.
+Proof.
+  intro; cut (- x = -1 * x).
+  intros; rewrite H.
+  rewrite Rabs_mult.
+  cut (Rabs (-1) = 1).
+  intros; rewrite H0.
+  ring.
+  unfold Rabs in |- *; case (Rcase_abs (-1)).
+  intro; ring.
+  intro H0; generalize (Rge_le (-1) 0 H0); intros.
+  generalize (Ropp_le_ge_contravar 0 (-1) H1).
+  rewrite Ropp_involutive; rewrite Ropp_0.
+  intro; generalize (Rgt_not_le 1 0 Rlt_0_1); intro; generalize (Rge_le 0 1 H2);
+    intro; elimtype False; auto.  
+  ring.
 Qed.
 
 (*********)
 Lemma Rabs_triang : forall a b:R, Rabs (a + b) <= Rabs a + Rabs b.
-intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a);
- case (Rcase_abs b); intros.
-apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b);
- reflexivity.
+Proof.
+  intros a b; unfold Rabs in |- *; case (Rcase_abs (a + b)); case (Rcase_abs a);
+    case (Rcase_abs b); intros.
+  apply (Req_le (- (a + b)) (- a + - b)); rewrite (Ropp_plus_distr a b);
+    reflexivity.
 (**)
-rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b);
- unfold Rle in |- *; unfold Rge in r; elim r; intro.
-left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro;
- elim (Rplus_ne (- b)); intros v w; rewrite v in H0; 
- clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H).
-right; rewrite H; apply Ropp_0.
+  rewrite (Ropp_plus_distr a b); apply (Rplus_le_compat_l (- a) (- b) b);
+    unfold Rle in |- *; unfold Rge in r; elim r; intro.
+  left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- b) 0 b H); intro;
+    elim (Rplus_ne (- b)); intros v w; rewrite v in H0; 
+      clear v w; rewrite (Rplus_opp_l b) in H0; apply (Rlt_trans (- b) 0 b H0 H).
+  right; rewrite H; apply Ropp_0.
 (**)
-rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b));
- rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a);
- unfold Rle in |- *; unfold Rge in r0; elim r0; intro.
-left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro;
- elim (Rplus_ne (- a)); intros v w; rewrite v in H0; 
- clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H).
-right; rewrite H; apply Ropp_0.
+  rewrite (Ropp_plus_distr a b); rewrite (Rplus_comm (- a) (- b));
+    rewrite (Rplus_comm a (- b)); apply (Rplus_le_compat_l (- b) (- a) a);
+      unfold Rle in |- *; unfold Rge in r0; elim r0; intro.
+  left; unfold Rgt in H; generalize (Rplus_lt_compat_l (- a) 0 a H); intro;
+    elim (Rplus_ne (- a)); intros v w; rewrite v in H0; 
+      clear v w; rewrite (Rplus_opp_l a) in H0; apply (Rlt_trans (- a) 0 a H0 H).
+  right; rewrite H; apply Ropp_0.
 (**)
-elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro;
- elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
- generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; 
- unfold Rge in H0; elim H0; intro; clear H0.
-unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto.
-absurd (a + b = 0); auto.
-apply (Rlt_dichotomy_converse (a + b) 0); left; assumption.
+  elimtype False; generalize (Rplus_ge_compat_l a b 0 r); intro;
+    elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
+      generalize (Rge_trans (a + b) a 0 H r0); intro; clear H; 
+        unfold Rge in H0; elim H0; intro; clear H0.
+  unfold Rgt in H; generalize (Rlt_asym (a + b) 0 r1); intro; auto.
+  absurd (a + b = 0); auto.
+  apply (Rlt_dichotomy_converse (a + b) 0); left; assumption.
 (**)
-elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro;
- elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
- generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; 
- unfold Rge in r1; elim r1; clear r1; intro.
-unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro;
- apply (Rlt_irrefl (a + b)); assumption.
-rewrite H in H0; apply (Rlt_irrefl 0); assumption.
+  elimtype False; generalize (Rplus_lt_compat_l a b 0 r); intro;
+    elim (Rplus_ne a); intros v w; rewrite v in H; clear v w;
+      generalize (Rlt_trans (a + b) a 0 H r0); intro; clear H; 
+        unfold Rge in r1; elim r1; clear r1; intro.
+  unfold Rgt in H; generalize (Rlt_trans (a + b) 0 (a + b) H0 H); intro;
+    apply (Rlt_irrefl (a + b)); assumption.
+  rewrite H in H0; apply (Rlt_irrefl 0); assumption.
 (**)
-rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b);
- apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a));
- unfold Rminus in |- *; rewrite (Ropp_involutive a);
- generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; 
- intro; elim (Rplus_ne a); intros v w; rewrite v in H; 
- clear v w; generalize (Rlt_trans (a + a) a 0 H r0); 
- intro; apply (Rlt_le (a + a) 0 H0).
+  rewrite (Rplus_comm a b); rewrite (Rplus_comm (- a) b);
+    apply (Rplus_le_compat_l b a (- a)); apply (Rminus_le a (- a));
+      unfold Rminus in |- *; rewrite (Ropp_involutive a);
+        generalize (Rplus_lt_compat_l a a 0 r0); clear r r1; 
+          intro; elim (Rplus_ne a); intros v w; rewrite v in H; 
+            clear v w; generalize (Rlt_trans (a + a) a 0 H r0); 
+              intro; apply (Rlt_le (a + a) 0 H0).
 (**)
-apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b));
- unfold Rminus in |- *; rewrite (Ropp_involutive b);
- generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; 
- intro; elim (Rplus_ne b); intros v w; rewrite v in H; 
- clear v w; generalize (Rlt_trans (b + b) b 0 H r); 
- intro; apply (Rlt_le (b + b) 0 H0).
+  apply (Rplus_le_compat_l a b (- b)); apply (Rminus_le b (- b));
+    unfold Rminus in |- *; rewrite (Ropp_involutive b);
+      generalize (Rplus_lt_compat_l b b 0 r); clear r0 r1; 
+        intro; elim (Rplus_ne b); intros v w; rewrite v in H; 
+          clear v w; generalize (Rlt_trans (b + b) b 0 H r); 
+            intro; apply (Rlt_le (b + b) 0 H0).
 (**)
-unfold Rle in |- *; right; reflexivity.
+  unfold Rle in |- *; right; reflexivity.
 Qed.
 
 (*********)
 Lemma Rabs_triang_inv : forall a b:R, Rabs a - Rabs b <= Rabs (a - b).
-intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b)));
- unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b));
- rewrite (Rplus_comm (Rabs b) (Rabs a));
- rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b));
- rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a)));
- replace (Rabs a) with (Rabs (a + 0)).
- rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b));
-  rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)).
- exact (Rabs_triang b (a + - b)).
- rewrite (proj1 (Rplus_ne a)); trivial.
+Proof.
+  intros; apply (Rplus_le_reg_l (Rabs b) (Rabs a - Rabs b) (Rabs (a - b)));
+    unfold Rminus in |- *; rewrite <- (Rplus_assoc (Rabs b) (Rabs a) (- Rabs b));
+      rewrite (Rplus_comm (Rabs b) (Rabs a));
+        rewrite (Rplus_assoc (Rabs a) (Rabs b) (- Rabs b));
+          rewrite (Rplus_opp_r (Rabs b)); rewrite (proj1 (Rplus_ne (Rabs a)));
+            replace (Rabs a) with (Rabs (a + 0)).
+  rewrite <- (Rplus_opp_r b); rewrite <- (Rplus_assoc a b (- b));
+    rewrite (Rplus_comm a b); rewrite (Rplus_assoc b a (- b)).
+  exact (Rabs_triang b (a + - b)).
+  rewrite (proj1 (Rplus_ne a)); trivial.
 Qed.
 
 (* ||a|-|b||<=|a-b| *)
 Lemma Rabs_triang_inv2 : forall a b:R, Rabs (Rabs a - Rabs b) <= Rabs (a - b). 
-cut
- (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). 
-intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]].
-rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b));
- do 2 rewrite Ropp_minus_distr. 
-apply H; left; assumption. 
-rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply Rabs_pos. 
-apply H; left; assumption. 
-intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). 
-apply Rabs_triang_inv. 
-rewrite (Rabs_right (Rabs a - Rabs b));
- [ reflexivity
- | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r;
-    replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); 
-    [ assumption | ring ] ]. 
+Proof.
+  cut
+    (forall a b:R, Rabs b <= Rabs a -> Rabs (Rabs a - Rabs b) <= Rabs (a - b)). 
+  intros; destruct (Rtotal_order (Rabs a) (Rabs b)) as [Hlt| [Heq| Hgt]].
+  rewrite <- (Rabs_Ropp (Rabs a - Rabs b)); rewrite <- (Rabs_Ropp (a - b));
+    do 2 rewrite Ropp_minus_distr. 
+  apply H; left; assumption. 
+  rewrite Heq; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply Rabs_pos. 
+  apply H; left; assumption. 
+  intros; replace (Rabs (Rabs a - Rabs b)) with (Rabs a - Rabs b). 
+  apply Rabs_triang_inv. 
+  rewrite (Rabs_right (Rabs a - Rabs b));
+    [ reflexivity
+      | apply Rle_ge; apply Rplus_le_reg_l with (Rabs b); rewrite Rplus_0_r;
+        replace (Rabs b + (Rabs a - Rabs b)) with (Rabs a); 
+        [ assumption | ring ] ]. 
 Qed. 
 
 (*********)
 Lemma Rabs_def1 : forall x a:R, x < a -> - a < x -> Rabs x < a.
-unfold Rabs in |- *; intros; case (Rcase_abs x); intro.
-generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *;
- rewrite Ropp_involutive; intro; assumption.
-assumption.
+Proof.
+  unfold Rabs in |- *; intros; case (Rcase_abs x); intro.
+  generalize (Ropp_lt_gt_contravar (- a) x H0); unfold Rgt in |- *;
+    rewrite Ropp_involutive; intro; assumption.
+  assumption.
 Qed.
 
 (*********)
 Lemma Rabs_def2 : forall x a:R, Rabs x < a -> x < a /\ - a < x.
-unfold Rabs in |- *; intro x; case (Rcase_abs x); intros.
-generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro;
- generalize (Rlt_trans 0 (- x) a H0 H); intro; split. 
-apply (Rlt_trans x 0 a r H1).
-generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x);
- unfold Rgt in |- *; trivial.
-fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro;
- generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *;
- generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; 
- intro; split; assumption.
+Proof.
+  unfold Rabs in |- *; intro x; case (Rcase_abs x); intros.
+  generalize (Ropp_gt_lt_0_contravar x r); unfold Rgt in |- *; intro;
+    generalize (Rlt_trans 0 (- x) a H0 H); intro; split. 
+  apply (Rlt_trans x 0 a r H1).
+  generalize (Ropp_lt_gt_contravar (- x) a H); rewrite (Ropp_involutive x);
+    unfold Rgt in |- *; trivial.
+  fold (a > x) in H; generalize (Rgt_ge_trans a x 0 H r); intro;
+    generalize (Ropp_lt_gt_0_contravar a H0); intro; fold (0 > - a) in |- *;
+      generalize (Rge_gt_trans x 0 (- a) r H1); unfold Rgt in |- *; 
+        intro; split; assumption.
 Qed.
 
 Lemma RmaxAbs :
- forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r).
-intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
-repeat rewrite Rabs_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 (Rabs_left p); auto.
-case (Rle_or_lt 0 q); intros H'2.
-repeat rewrite Rabs_right; auto with real.
-apply Rle_trans with r; auto.
-apply RmaxLess2; auto.
-apply Rge_trans with q; auto with real.
-rewrite (Rabs_left q); auto.
-case (Rle_or_lt 0 r); intros H'3.
-repeat rewrite Rabs_right; auto with real.
-apply Rle_trans with (- p); auto with real.
-apply RmaxLess1; auto.
-rewrite (Rabs_left r); auto.
-apply Rle_trans with (- p); auto with real.
-apply RmaxLess1; auto.
+  forall (p q:R) r, p <= q -> q <= r -> Rabs q <= Rmax (Rabs p) (Rabs r).
+Proof.
+  intros p q r H' H'0; case (Rle_or_lt 0 p); intros H'1.
+  repeat rewrite Rabs_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 (Rabs_left p); auto.
+  case (Rle_or_lt 0 q); intros H'2.
+  repeat rewrite Rabs_right; auto with real.
+  apply Rle_trans with r; auto.
+  apply RmaxLess2; auto.
+  apply Rge_trans with q; auto with real.
+  rewrite (Rabs_left q); auto.
+  case (Rle_or_lt 0 r); intros H'3.
+  repeat rewrite Rabs_right; auto with real.
+  apply Rle_trans with (- p); auto with real.
+  apply RmaxLess1; auto.
+  rewrite (Rabs_left r); auto.
+  apply Rle_trans with (- p); auto with real.
+  apply RmaxLess1; auto.
 Qed.
 
 Lemma Rabs_Zabs : forall z:Z, Rabs (IZR z) = IZR (Zabs z).
-intros z; case z; simpl in |- *; auto with real.
-apply Rabs_right; auto with real.
-intros p0; apply Rabs_right; auto with real zarith.
-intros p0; rewrite Rabs_Ropp.
-apply Rabs_right; auto with real zarith.
+Proof.
+  intros z; case z; simpl in |- *; auto with real.
+  apply Rabs_right; auto with real.
+  intros p0; apply Rabs_right; auto with real zarith.
+  intros p0; rewrite Rabs_Ropp.
+  apply Rabs_right; auto with real zarith.
 Qed.
  
diff --git a/theories/Reals/Rcomplete.v b/theories/Reals/Rcomplete.v
index 2f11a404..16e12d7f 100644
--- a/theories/Reals/Rcomplete.v
+++ b/theories/Reals/Rcomplete.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rcomplete.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: Rcomplete.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -24,175 +24,176 @@ Open Local Scope R_scope.
 (****************************************************)
 
 Theorem R_complete :
- forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l).
-intros.
-set (Vn := sequence_minorant Un (cauchy_min Un H)).
-set (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 existT with x.
-rewrite <- H2 in p0.
-unfold Un_cv in |- *.
-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 in |- *.
-apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)).
-replace (Un n - x) with (Un n - Vn n + (Vn n - x));
- [ apply Rabs_triang | ring ].
-apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)).
-do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
-apply Rplus_le_compat_l.
-repeat rewrite Rabs_right.
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n));
- apply Rplus_le_compat_l.
-assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-fold Vn Wn in H8.
-elim (H8 n); intros.
-assumption.
-apply Rle_ge.
-unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
-rewrite Rplus_0_r.
-replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ].
-assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-fold Vn Wn in H8.
-elim (H8 n); intros.
-apply Rle_trans with (Un n); assumption.
-apply Rle_ge.
-unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
-rewrite Rplus_0_r.
-replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ].
-assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
-fold Vn Wn in H8.
-elim (H8 n); intros.
-assumption.
-apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)).
-do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
-apply Rplus_le_compat_l.
-replace (Wn n - Vn n) with (Wn n - x + (x - Vn n));
- [ apply Rabs_triang | ring ].
-apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3).
-repeat apply Rplus_lt_compat.
-unfold R_dist in H5.
-apply H5.
-unfold ge in |- *; apply le_trans with (max x1 x2).
-apply le_max_l.
-assumption.
-rewrite <- Rabs_Ropp.
-replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
-unfold R_dist in H6.
-apply H6.
-unfold ge in |- *; apply le_trans with (max x1 x2).
-apply le_max_r.
-assumption.
-unfold R_dist in H6.
-apply H6.
-unfold ge in |- *; apply le_trans with (max x1 x2).
-apply le_max_r.
-assumption.
-right.
-pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
-ring.
-unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_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.
-set (N := max (max N1 N2) N3).
-apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)).
-replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ].
-apply Rle_lt_trans with
- (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)).
-rewrite Rplus_assoc.
-apply Rplus_le_compat_l.
-replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0));
- [ apply Rabs_triang | ring ].
-replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5).
-repeat apply Rplus_lt_compat.
-rewrite <- Rabs_Ropp.
-replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ].
-unfold ge, N in |- *.
-apply le_trans with (max N1 N2); apply le_max_l.
-unfold Wn, Vn in |- *.
-unfold sequence_majorant, sequence_minorant in |- *.
-assert
- (H7 :=
-  approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
-assert
- (H8 :=
-  approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
-cut
- (Wn N =
-  majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
-cut
- (Vn N =
-  minorant (fun k:nat => Un (N + k)%nat) (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
- (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)).
-replace (Wn N - Vn N) with
- (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N));
- [ apply Rabs_triang | ring ].
-apply Rle_lt_trans with
- (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) +
-  Rabs (Un (N + k1)%nat - Vn N)).
-rewrite Rplus_assoc.
-apply Rplus_le_compat_l.
-replace (Un (N + k2)%nat - Vn N) with
- (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N));
- [ apply Rabs_triang | ring ].
-replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5);
- [ repeat apply Rplus_lt_compat | ring ].
-assumption.
-apply H6.
-unfold ge in |- *.
-apply le_trans with N.
-unfold N in |- *; apply le_max_r.
-apply le_plus_l.
-unfold ge in |- *.
-apply le_trans with N.
-unfold N in |- *; apply le_max_r.
-apply le_plus_l.
-rewrite <- Rabs_Ropp.
-replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat);
- [ assumption | ring ].
-reflexivity.
-reflexivity.
-apply H5.
-unfold ge in |- *; apply le_trans with (max N1 N2).
-apply le_max_r.
-unfold N in |- *; apply le_max_l.
-pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)).
-ring.
-unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-discrR.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat.
-prove_sup0; try apply lt_O_Sn.
-Qed.
\ No newline at end of file
+  forall Un:nat -> R, Cauchy_crit Un -> sigT (fun l:R => Un_cv Un l).
+Proof.
+  intros.
+  set (Vn := sequence_minorant Un (cauchy_min Un H)).
+  set (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 existT with x.
+  rewrite <- H2 in p0.
+  unfold Un_cv in |- *.
+  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 in |- *.
+  apply Rle_lt_trans with (Rabs (Un n - Vn n) + Rabs (Vn n - x)).
+  replace (Un n - x) with (Un n - Vn n + (Vn n - x));
+  [ apply Rabs_triang | ring ].
+  apply Rle_lt_trans with (Rabs (Wn n - Vn n) + Rabs (Vn n - x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
+  apply Rplus_le_compat_l.
+  repeat rewrite Rabs_right.
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- Vn n));
+    apply Rplus_le_compat_l.
+  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+  fold Vn Wn in H8.
+  elim (H8 n); intros.
+  assumption.
+  apply Rle_ge.
+  unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+  rewrite Rplus_0_r.
+  replace (Vn n + (Wn n + - Vn n)) with (Wn n); [ idtac | ring ].
+  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+  fold Vn Wn in H8.
+  elim (H8 n); intros.
+  apply Rle_trans with (Un n); assumption.
+  apply Rle_ge.
+  unfold Rminus in |- *; apply Rplus_le_reg_l with (Vn n).
+  rewrite Rplus_0_r.
+  replace (Vn n + (Un n + - Vn n)) with (Un n); [ idtac | ring ].
+  assert (H8 := Vn_Un_Wn_order Un (cauchy_maj Un H) (cauchy_min Un H)).
+  fold Vn Wn in H8.
+  elim (H8 n); intros.
+  assumption.
+  apply Rle_lt_trans with (Rabs (Wn n - x) + Rabs (x - Vn n) + Rabs (Vn n - x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (Vn n - x))).
+  apply Rplus_le_compat_l.
+  replace (Wn n - Vn n) with (Wn n - x + (x - Vn n));
+  [ apply Rabs_triang | ring ].
+  apply Rlt_le_trans with (eps / 3 + eps / 3 + eps / 3).
+  repeat apply Rplus_lt_compat.
+  unfold R_dist in H5.
+  apply H5.
+  unfold ge in |- *; apply le_trans with (max x1 x2).
+  apply le_max_l.
+  assumption.
+  rewrite <- Rabs_Ropp.
+  replace (- (x - Vn n)) with (Vn n - x); [ idtac | ring ].
+  unfold R_dist in H6.
+  apply H6.
+  unfold ge in |- *; apply le_trans with (max x1 x2).
+  apply le_max_r.
+  assumption.
+  unfold R_dist in H6.
+  apply H6.
+  unfold ge in |- *; apply le_trans with (max x1 x2).
+  apply le_max_r.
+  assumption.
+  right.
+  pattern eps at 4 in |- *; replace eps with (3 * (eps / 3)).
+  ring.
+  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m; discrR.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_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.
+  set (N := max (max N1 N2) N3).
+  apply Rle_lt_trans with (Rabs (x - Wn N) + Rabs (Wn N - x0)).
+  replace (x - x0) with (x - Wn N + (Wn N - x0)); [ apply Rabs_triang | ring ].
+  apply Rle_lt_trans with
+    (Rabs (x - Wn N) + Rabs (Wn N - Vn N) + Rabs (Vn N - x0)).
+  rewrite Rplus_assoc.
+  apply Rplus_le_compat_l.
+  replace (Wn N - x0) with (Wn N - Vn N + (Vn N - x0));
+  [ apply Rabs_triang | ring ].
+  replace eps with (eps / 5 + 3 * (eps / 5) + eps / 5).
+  repeat apply Rplus_lt_compat.
+  rewrite <- Rabs_Ropp.
+  replace (- (x - Wn N)) with (Wn N - x); [ apply H4 | ring ].
+  unfold ge, N in |- *.
+  apply le_trans with (max N1 N2); apply le_max_l.
+  unfold Wn, Vn in |- *.
+  unfold sequence_majorant, sequence_minorant in |- *.
+  assert
+    (H7 :=
+      approx_maj (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
+  assert
+    (H8 :=
+      approx_min (fun k:nat => Un (N + k)%nat) (min_ss Un N (cauchy_min Un H))).
+  cut
+    (Wn N =
+      majorant (fun k:nat => Un (N + k)%nat) (maj_ss Un N (cauchy_maj Un H))).
+  cut
+    (Vn N =
+      minorant (fun k:nat => Un (N + k)%nat) (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
+    (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Vn N)).
+  replace (Wn N - Vn N) with
+  (Wn N - Un (N + k2)%nat + (Un (N + k2)%nat - Vn N));
+  [ apply Rabs_triang | ring ].
+  apply Rle_lt_trans with
+    (Rabs (Wn N - Un (N + k2)%nat) + Rabs (Un (N + k2)%nat - Un (N + k1)%nat) +
+      Rabs (Un (N + k1)%nat - Vn N)).
+  rewrite Rplus_assoc.
+  apply Rplus_le_compat_l.
+  replace (Un (N + k2)%nat - Vn N) with
+  (Un (N + k2)%nat - Un (N + k1)%nat + (Un (N + k1)%nat - Vn N));
+  [ apply Rabs_triang | ring ].
+  replace (3 * (eps / 5)) with (eps / 5 + eps / 5 + eps / 5);
+  [ repeat apply Rplus_lt_compat | ring ].
+  assumption.
+  apply H6.
+  unfold ge in |- *.
+  apply le_trans with N.
+  unfold N in |- *; apply le_max_r.
+  apply le_plus_l.
+  unfold ge in |- *.
+  apply le_trans with N.
+  unfold N in |- *; apply le_max_r.
+  apply le_plus_l.
+  rewrite <- Rabs_Ropp.
+  replace (- (Un (N + k1)%nat - Vn N)) with (Vn N - Un (N + k1)%nat);
+  [ assumption | ring ].
+  reflexivity.
+  reflexivity.
+  apply H5.
+  unfold ge in |- *; apply le_trans with (max N1 N2).
+  apply le_max_r.
+  unfold N in |- *; apply le_max_l.
+  pattern eps at 4 in |- *; replace eps with (5 * (eps / 5)).
+  ring.
+  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  discrR.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat.
+  prove_sup0; try apply lt_O_Sn.
+Qed.
diff --git a/theories/Reals/Rdefinitions.v b/theories/Reals/Rdefinitions.v
index 62aec6bc..f9ba589e 100644
--- a/theories/Reals/Rdefinitions.v
+++ b/theories/Reals/Rdefinitions.v
@@ -5,12 +5,11 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Rdefinitions.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rdefinitions.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 
 (*********************************************************)
 (**          Definitions for the axiomatization          *)
-(*                                                       *)
 (*********************************************************)
 
 Require Export ZArith_base.
@@ -66,4 +65,4 @@ Infix ">" := Rgt : R_scope.
 Notation "x <= y <= z" := ((x <= y)%R /\ (y <= z)%R) : R_scope.
 Notation "x <= y < z" := ((x <= y)%R /\ (y < z)%R) : R_scope.
 Notation "x < y < z" := ((x < y)%R /\ (y < z)%R) : R_scope.
-Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope.
\ No newline at end of file
+Notation "x < y <= z" := ((x < y)%R /\ (y <= z)%R) : R_scope.
diff --git a/theories/Reals/Rderiv.v b/theories/Reals/Rderiv.v
index 42663de6..e2fd2efe 100644
--- a/theories/Reals/Rderiv.v
+++ b/theories/Reals/Rderiv.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rderiv.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rderiv.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (*********************************************************)
 (**     Definition of the derivative,continuity          *)
@@ -34,398 +34,409 @@ Definition D_in (f d:R -> R) (D:R -> Prop) (x0:R) : Prop :=
 
 (*********)
 Lemma cont_deriv :
- forall (f d:R -> R) (D:R -> Prop) (x0:R),
-   D_in f d D x0 -> continue_in f D x0.
-unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; 
- intros; elim (H eps H0); clear H; intros; elim H; 
- clear H; intros; elim (Req_dec (d x0) 0); intro.
-split with (Rmin 1 x); split.
-elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)).
-intros; elim H3; clear H3; intros;
- generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1);
- unfold Rgt in |- *; intro; elim (H5 H4); clear H5; 
- intros; generalize (H1 x1 (conj H3 H6)); clear H1; 
- intro; unfold D_x in H3; elim H3; intros.
-rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1;
- cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)).
-intro; unfold R_dist in H5;
- generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5);
- rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0));
- assumption.
-rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1;
- rewrite Rabs_mult in H1; cut (x1 - x0 <> 0).
-intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1;
- generalize
-  (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0))
-     eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10;
- rewrite Rmult_assoc in H10; rewrite Rinv_l in H10.
-rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption.
-apply Rabs_no_R0; auto.
-apply Rminus_eq_contra; auto.
+  forall (f d:R -> R) (D:R -> Prop) (x0:R),
+    D_in f d D x0 -> continue_in f D x0.
+Proof.
+  unfold continue_in in |- *; unfold D_in in |- *; unfold limit1_in in |- *;
+    unfold limit_in in |- *; unfold Rdiv in |- *; simpl in |- *; 
+      intros; elim (H eps H0); clear H; intros; elim H; 
+        clear H; intros; elim (Req_dec (d x0) 0); intro.
+  split with (Rmin 1 x); split.
+  elim (Rmin_Rgt 1 x 0); intros a b; apply (b (conj Rlt_0_1 H)).
+  intros; elim H3; clear H3; intros;
+    generalize (let (H1, H2) := Rmin_Rgt 1 x (R_dist x1 x0) in H1);
+      unfold Rgt in |- *; intro; elim (H5 H4); clear H5; 
+        intros; generalize (H1 x1 (conj H3 H6)); clear H1; 
+          intro; unfold D_x in H3; elim H3; intros.
+  rewrite H2 in H1; unfold R_dist in |- *; unfold R_dist in H1;
+    cut (Rabs (f x1 - f x0) < eps * Rabs (x1 - x0)).
+  intro; unfold R_dist in H5;
+    generalize (Rmult_lt_compat_l eps (Rabs (x1 - x0)) 1 H0 H5);
+      rewrite Rmult_1_r; intro; apply Rlt_trans with (r2 := eps * Rabs (x1 - x0));
+        assumption.
+  rewrite (Rminus_0_r ((f x1 - f x0) * / (x1 - x0))) in H1;
+    rewrite Rabs_mult in H1; cut (x1 - x0 <> 0).
+  intro; rewrite (Rabs_Rinv (x1 - x0) H9) in H1;
+    generalize
+      (Rmult_lt_compat_l (Rabs (x1 - x0)) (Rabs (f x1 - f x0) * / Rabs (x1 - x0))
+        eps (Rabs_pos_lt (x1 - x0) H9) H1); intro; rewrite Rmult_comm in H10;
+      rewrite Rmult_assoc in H10; rewrite Rinv_l in H10.
+  rewrite Rmult_1_r in H10; rewrite Rmult_comm; assumption.
+  apply Rabs_no_R0; auto.
+  apply Rminus_eq_contra; auto.
 (**)
- split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split.
-cut (Rmin (/ 2) x > 0).
-cut (eps * / Rabs (2 * d x0) > 0).
-intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0);
- intros a b; apply (b (conj H4 H3)).
-apply Rmult_gt_0_compat; auto.
-unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt;
- apply Rmult_integral_contrapositive; split.
-discrR.
-assumption.
-elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2).
-intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4;
- apply (b (conj H4 H)).
-fourier.
-intros; elim H3; clear H3; intros;
- generalize
-  (let (H1, H2) :=
-       Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in
-   H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; 
- intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1);
- unfold Rgt in |- *; intro; elim (H7 H5); clear H7; 
- intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); 
- clear H1; intro; unfold D_x in H3; elim H3; intros;
- generalize (sym_not_eq H5); clear H5; intro H5;
- generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1;
- pattern (d x0) at 1 in |- *;
- rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2);
- rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *;
- unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
- rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0));
- rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0)));
- rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0)));
- rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0));
- rewrite <-
-  (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0))
-  ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0));
- clear H1; intro;
- generalize
-  (Rmult_lt_compat_l (Rabs (x1 - x0))
-     (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps
-     (Rabs_pos_lt (x1 - x0) H9) H1);
- rewrite <-
-  (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0)))
-     (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)));
- rewrite (Rabs_Rinv (x1 - x0) H9);
- rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9));
- rewrite
-  (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2)
-  ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); 
- intro; rewrite (Rmult_comm (x1 - x0) (- d x0));
- rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0));
- fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *;
- rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; 
- intro;
- generalize
-  (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0)))
-     (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1);
- clear H1; intro;
- generalize
-  (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0)))
-     (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (
-     Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *;
- rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0))));
- rewrite <-
-  (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0)))
-     (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0))));
- rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); 
- clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps).
-intro;
- apply
-  (Rlt_trans (Rabs (f x1 - f x0))
-     (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). 
-clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro;
- unfold Rgt in H0;
- generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); 
- clear H7; intro;
- generalize
-  (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) (
-     eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro;
- rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5;
- rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5;
- rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0).
-intro; fold (Rabs (d x0) > 0) in H1;
- rewrite
-  (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6
-     (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
-   in H5;
- rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5;
- rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5;
- rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5;
- rewrite
-  (Rinv_l (Rabs (d x0))
-     (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
-   in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5;
- cut (Rabs 2 = 2).
-intro; rewrite H7 in H5;
- generalize
-  (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2)
-     (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; 
- rewrite eps2 in H10; assumption.
-unfold Rabs in |- *; case (Rcase_abs 2); auto.
- intro; cut (0 < 2).
-intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto.
-fourier.
-apply Rabs_no_R0.
-discrR.
+  split with (Rmin (Rmin (/ 2) x) (eps * / Rabs (2 * d x0))); split.
+  cut (Rmin (/ 2) x > 0).
+  cut (eps * / Rabs (2 * d x0) > 0).
+  intros; elim (Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) 0);
+    intros a b; apply (b (conj H4 H3)).
+  apply Rmult_gt_0_compat; auto.
+  unfold Rgt in |- *; apply Rinv_0_lt_compat; apply Rabs_pos_lt;
+    apply Rmult_integral_contrapositive; split.
+  discrR.
+  assumption.
+  elim (Rmin_Rgt (/ 2) x 0); intros a b; cut (0 < 2).
+  intro; generalize (Rinv_0_lt_compat 2 H3); intro; fold (/ 2 > 0) in H4;
+    apply (b (conj H4 H)).
+  fourier.
+  intros; elim H3; clear H3; intros;
+    generalize
+      (let (H1, H2) :=
+        Rmin_Rgt (Rmin (/ 2) x) (eps * / Rabs (2 * d x0)) (R_dist x1 x0) in
+        H1); unfold Rgt in |- *; intro; elim (H5 H4); clear H5; 
+      intros; generalize (let (H1, H2) := Rmin_Rgt (/ 2) x (R_dist x1 x0) in H1);
+        unfold Rgt in |- *; intro; elim (H7 H5); clear H7; 
+          intros; clear H4 H5; generalize (H1 x1 (conj H3 H8)); 
+            clear H1; intro; unfold D_x in H3; elim H3; intros;
+              generalize (sym_not_eq H5); clear H5; intro H5;
+                generalize (Rminus_eq_contra x1 x0 H5); intro; generalize H1;
+                  pattern (d x0) at 1 in |- *;
+                    rewrite <- (let (H1, H2) := Rmult_ne (d x0) in H2);
+                      rewrite <- (Rinv_l (x1 - x0) H9); unfold R_dist in |- *;
+                        unfold Rminus at 1 in |- *; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0)));
+                          rewrite (Rmult_comm (/ (x1 - x0) * (x1 - x0)) (d x0));
+                            rewrite <- (Ropp_mult_distr_l_reverse (d x0) (/ (x1 - x0) * (x1 - x0)));
+                              rewrite (Rmult_comm (- d x0) (/ (x1 - x0) * (x1 - x0)));
+                                rewrite (Rmult_assoc (/ (x1 - x0)) (x1 - x0) (- d x0));
+                                  rewrite <-
+                                    (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) ((x1 - x0) * - d x0))
+                                    ; rewrite (Rabs_mult (/ (x1 - x0)) (f x1 - f x0 + (x1 - x0) * - d x0));
+                                      clear H1; intro;
+                                        generalize
+                                          (Rmult_lt_compat_l (Rabs (x1 - x0))
+                                            (Rabs (/ (x1 - x0)) * Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) eps
+                                            (Rabs_pos_lt (x1 - x0) H9) H1);
+                                          rewrite <-
+                                            (Rmult_assoc (Rabs (x1 - x0)) (Rabs (/ (x1 - x0)))
+                                              (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)));
+                                            rewrite (Rabs_Rinv (x1 - x0) H9);
+                                              rewrite (Rinv_r (Rabs (x1 - x0)) (Rabs_no_R0 (x1 - x0) H9));
+                                                rewrite
+                                                  (let (H1, H2) := Rmult_ne (Rabs (f x1 - f x0 + (x1 - x0) * - d x0)) in H2)
+                                                  ; generalize (Rabs_triang_inv (f x1 - f x0) ((x1 - x0) * d x0)); 
+                                                    intro; rewrite (Rmult_comm (x1 - x0) (- d x0));
+                                                      rewrite (Ropp_mult_distr_l_reverse (d x0) (x1 - x0));
+                                                        fold (f x1 - f x0 - d x0 * (x1 - x0)) in |- *;
+                                                          rewrite (Rmult_comm (x1 - x0) (d x0)) in H10; clear H1; 
+                                                            intro;
+                                                              generalize
+                                                                (Rle_lt_trans (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0)))
+                                                                  (Rabs (f x1 - f x0 - d x0 * (x1 - x0))) (Rabs (x1 - x0) * eps) H10 H1);
+                                                                clear H1; intro;
+                                                                  generalize
+                                                                    (Rplus_lt_compat_l (Rabs (d x0 * (x1 - x0)))
+                                                                      (Rabs (f x1 - f x0) - Rabs (d x0 * (x1 - x0))) (
+                                                                        Rabs (x1 - x0) * eps) H1); unfold Rminus at 2 in |- *;
+                                                                    rewrite (Rplus_comm (Rabs (f x1 - f x0)) (- Rabs (d x0 * (x1 - x0))));
+                                                                      rewrite <-
+                                                                        (Rplus_assoc (Rabs (d x0 * (x1 - x0))) (- Rabs (d x0 * (x1 - x0)))
+                                                                          (Rabs (f x1 - f x0))); rewrite (Rplus_opp_r (Rabs (d x0 * (x1 - x0))));
+                                                                        rewrite (let (H1, H2) := Rplus_ne (Rabs (f x1 - f x0)) in H2); 
+                                                                          clear H1; intro; cut (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps < eps).
+  intro;
+    apply
+      (Rlt_trans (Rabs (f x1 - f x0))
+        (Rabs (d x0 * (x1 - x0)) + Rabs (x1 - x0) * eps) eps H1 H11). 
+  clear H1 H5 H3 H10; generalize (Rabs_pos_lt (d x0) H2); intro;
+    unfold Rgt in H0;
+      generalize (Rmult_lt_compat_l eps (R_dist x1 x0) (/ 2) H0 H7); 
+        clear H7; intro;
+          generalize
+            (Rmult_lt_compat_l (Rabs (d x0)) (R_dist x1 x0) (
+              eps * / Rabs (2 * d x0)) H1 H6); clear H6; intro;
+            rewrite (Rmult_comm eps (R_dist x1 x0)) in H3; unfold R_dist in H3, H5;
+              rewrite <- (Rabs_mult (d x0) (x1 - x0)) in H5;
+                rewrite (Rabs_mult 2 (d x0)) in H5; cut (Rabs 2 <> 0).
+  intro; fold (Rabs (d x0) > 0) in H1;
+    rewrite
+      (Rinv_mult_distr (Rabs 2) (Rabs (d x0)) H6
+        (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
+      in H5;
+      rewrite (Rmult_comm (Rabs (d x0)) (eps * (/ Rabs 2 * / Rabs (d x0)))) in H5;
+        rewrite <- (Rmult_assoc eps (/ Rabs 2) (/ Rabs (d x0))) in H5;
+          rewrite (Rmult_assoc (eps * / Rabs 2) (/ Rabs (d x0)) (Rabs (d x0))) in H5;
+            rewrite
+              (Rinv_l (Rabs (d x0))
+                (Rlt_dichotomy_converse (Rabs (d x0)) 0 (or_intror (Rabs (d x0) < 0) H1)))
+              in H5; rewrite (let (H1, H2) := Rmult_ne (eps * / Rabs 2) in H1) in H5;
+                cut (Rabs 2 = 2).
+  intro; rewrite H7 in H5;
+    generalize
+      (Rplus_lt_compat (Rabs (d x0 * (x1 - x0))) (eps * / 2)
+        (Rabs (x1 - x0) * eps) (eps * / 2) H5 H3); intro; 
+      rewrite eps2 in H10; assumption.
+  unfold Rabs in |- *; case (Rcase_abs 2); auto.
+  intro; cut (0 < 2).
+  intro; generalize (Rlt_asym 0 2 H7); intro; elimtype False; auto.
+  fourier.
+  apply Rabs_no_R0.
+  discrR.
 Qed.
 
 
 (*********)
 Lemma Dconst :
- forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0.
-unfold D_in in |- *; intros; unfold limit1_in in |- *;
- unfold limit_in in |- *; unfold Rdiv in |- *; intros; 
- simpl in |- *; split with eps; split; auto.
-intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l;
- unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0));
- unfold Rabs in |- *; case (Rcase_abs 0); intro.
-absurd (0 < 0); auto.
-red in |- *; intro; apply (Rlt_irrefl 0 H1).
-unfold Rgt in H0; assumption.
+  forall (D:R -> Prop) (y x0:R), D_in (fun x:R => y) (fun x:R => 0) D x0.
+Proof.
+  unfold D_in in |- *; intros; unfold limit1_in in |- *;
+    unfold limit_in in |- *; unfold Rdiv in |- *; intros; 
+      simpl in |- *; split with eps; split; auto.
+  intros; rewrite (Rminus_diag_eq y y (refl_equal y)); rewrite Rmult_0_l;
+    unfold R_dist in |- *; rewrite (Rminus_diag_eq 0 0 (refl_equal 0));
+      unfold Rabs in |- *; case (Rcase_abs 0); intro.
+  absurd (0 < 0); auto.
+  red in |- *; intro; apply (Rlt_irrefl 0 H1).
+  unfold Rgt in H0; assumption.
 Qed.
 
 (*********)
 Lemma Dx :
- forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0.
-unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *;
- unfold limit_in in |- *; intros; simpl in |- *; split with eps; 
- split; auto.
-intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros;
- rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3)));
- unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1));
- unfold Rabs in |- *; case (Rcase_abs 0); intro.
-absurd (0 < 0); auto.
-red in |- *; intro; apply (Rlt_irrefl 0 r).
-unfold Rgt in H; assumption.
+  forall (D:R -> Prop) (x0:R), D_in (fun x:R => x) (fun x:R => 1) D x0.
+Proof.
+  unfold D_in in |- *; unfold Rdiv in |- *; intros; unfold limit1_in in |- *;
+    unfold limit_in in |- *; intros; simpl in |- *; split with eps; 
+      split; auto.
+  intros; elim H0; clear H0; intros; unfold D_x in H0; elim H0; intros;
+    rewrite (Rinv_r (x - x0) (Rminus_eq_contra x x0 (sym_not_eq H3)));
+      unfold R_dist in |- *; rewrite (Rminus_diag_eq 1 1 (refl_equal 1));
+        unfold Rabs in |- *; case (Rcase_abs 0); intro.
+  absurd (0 < 0); auto.
+  red in |- *; intro; apply (Rlt_irrefl 0 r).
+  unfold Rgt in H; assumption.
 Qed. 
 
 (*********)
 Lemma Dadd :
- forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
-   D_in f df D x0 ->
-   D_in g dg D x0 ->
-   D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0.
-unfold D_in in |- *; intros;
- generalize
-  (limit_plus (fun x:R => (f x - f x0) * / (x - x0))
-     (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) (
-     df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); 
- clear H; intros; elim H; clear H; intros; split with x; 
- split; auto; intros; generalize (H1 x1 H2); clear H1; 
- intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
- rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
- rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0))
-   in H1;
- rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1;
- cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)).
-intro; rewrite H3 in H1; assumption.
-ring.
+  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+    D_in f df D x0 ->
+    D_in g dg D x0 ->
+    D_in (fun x:R => f x + g x) (fun x:R => df x + dg x) D x0.
+Proof.
+  unfold D_in in |- *; intros;
+    generalize
+      (limit_plus (fun x:R => (f x - f x0) * / (x - x0))
+        (fun x:R => (g x - g x0) * / (x - x0)) (D_x D x0) (
+          df x0) (dg x0) x0 H H0); clear H H0; unfold limit1_in in |- *;
+      unfold limit_in in |- *; simpl in |- *; intros; elim (H eps H0); 
+        clear H; intros; elim H; clear H; intros; split with x; 
+          split; auto; intros; generalize (H1 x1 H2); clear H1; 
+            intro; rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
+              rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
+                rewrite <- (Rmult_plus_distr_l (/ (x1 - x0)) (f x1 - f x0) (g x1 - g x0))
+                  in H1;
+                  rewrite (Rmult_comm (/ (x1 - x0)) (f x1 - f x0 + (g x1 - g x0))) in H1;
+                    cut (f x1 - f x0 + (g x1 - g x0) = f x1 + g x1 - (f x0 + g x0)).
+  intro; rewrite H3 in H1; assumption.
+  ring.
 Qed.
 
 (*********)
 Lemma Dmult :
- forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
-   D_in f df D x0 ->
-   D_in g dg D x0 ->
-   D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0.
-intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0;
- generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; 
- intro;
- generalize
-  (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) (
-     fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); 
- intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0).
-intro;
- generalize
-  (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
-     fun _: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 (fun x:R => (f x - f x0) * / (x - x0) * g x0)
-     (fun x:R => (g x - g x0) * / (x - x0) * f x) (
-     D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); 
- clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; 
- simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; intros; elim (H eps H0); clear H; intros; 
- elim H; clear H; intros; split with x; split; auto; 
- intros; generalize (H1 x1 H2); clear H1; intro;
- rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
- rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
- rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1;
- rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1;
- rewrite <-
-  (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0)
-     ((g x1 - g x0) * f x1)) in H1;
- rewrite
-  (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1))
-   in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1;
- cut
-  ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0).
-intro; rewrite H3 in H1; assumption.
-ring.
-unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
- split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0));
- intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; 
- assumption.
+  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+    D_in f df D x0 ->
+    D_in g dg D x0 ->
+    D_in (fun x:R => f x * g x) (fun x:R => df x * g x + f x * dg x) D x0.
+Proof.
+  intros; unfold D_in in |- *; generalize H H0; intros; unfold D_in in H, H0;
+    generalize (cont_deriv f df D x0 H1); unfold continue_in in |- *; 
+      intro;
+        generalize
+          (limit_mul (fun x:R => (g x - g x0) * / (x - x0)) (
+            fun x:R => f x) (D_x D x0) (dg x0) (f x0) x0 H0 H3); 
+          intro; cut (limit1_in (fun x:R => g x0) (D_x D x0) (g x0) x0).
+  intro;
+    generalize
+      (limit_mul (fun x:R => (f x - f x0) * / (x - x0)) (
+        fun _: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 (fun x:R => (f x - f x0) * / (x - x0) * g x0)
+            (fun x:R => (g x - g x0) * / (x - x0) * f x) (
+              D_x D x0) (df x0 * g x0) (dg x0 * f x0) x0 H H4); 
+          clear H4 H; intro; unfold limit1_in in H; unfold limit_in in H; 
+            simpl in H; unfold limit1_in in |- *; unfold limit_in in |- *; 
+              simpl in |- *; intros; elim (H eps H0); clear H; intros; 
+                elim H; clear H; intros; split with x; split; auto; 
+                  intros; generalize (H1 x1 H2); clear H1; intro;
+                    rewrite (Rmult_comm (f x1 - f x0) (/ (x1 - x0))) in H1;
+                      rewrite (Rmult_comm (g x1 - g x0) (/ (x1 - x0))) in H1;
+                        rewrite (Rmult_assoc (/ (x1 - x0)) (f x1 - f x0) (g x0)) in H1;
+                          rewrite (Rmult_assoc (/ (x1 - x0)) (g x1 - g x0) (f x1)) in H1;
+                            rewrite <-
+                              (Rmult_plus_distr_l (/ (x1 - x0)) ((f x1 - f x0) * g x0)
+                                ((g x1 - g x0) * f x1)) in H1;
+                              rewrite
+                                (Rmult_comm (/ (x1 - x0)) ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1))
+                                in H1; rewrite (Rmult_comm (dg x0) (f x0)) in H1;
+                                  cut
+                                    ((f x1 - f x0) * g x0 + (g x1 - g x0) * f x1 = f x1 * g x1 - f x0 * g x0).
+  intro; rewrite H3 in H1; assumption.
+  ring.
+  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+    split with eps; split; auto; intros; elim (R_dist_refl (g x0) (g x0));
+      intros a b; rewrite (b (refl_equal (g x0))); unfold Rgt in H; 
+        assumption.
 Qed.
 
 (*********)
 Lemma Dmult_const :
- forall (D:R -> Prop) (f df:R -> R) (x0 a:R),
-   D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0.
-intros;
- generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H);
- unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0;
- rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; 
- assumption.
+  forall (D:R -> Prop) (f df:R -> R) (x0 a:R),
+    D_in f df D x0 -> D_in (fun x:R => a * f x) (fun x:R => a * df x) D x0.
+Proof.
+  intros;
+    generalize (Dmult D (fun _:R => 0) df (fun _:R => a) f x0 (Dconst D a x0) H);
+      unfold D_in in |- *; intros; rewrite (Rmult_0_l (f x0)) in H0;
+        rewrite (let (H1, H2) := Rplus_ne (a * df x0) in H2) in H0; 
+          assumption.
 Qed.
 
 (*********)
 Lemma Dopp :
- forall (D:R -> Prop) (f df:R -> R) (x0:R),
-   D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0.
-intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- intros; generalize (H0 eps H1); clear H0; intro; elim H0; 
- clear H0; intros; elim H0; clear H0; simpl in |- *; 
- intros; split with x; split; auto.
-intros; generalize (H2 x1 H3); clear H2; intro;
- rewrite Ropp_mult_distr_l_reverse in H2;
- rewrite Ropp_mult_distr_l_reverse in H2;
- rewrite Ropp_mult_distr_l_reverse 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.
+  forall (D:R -> Prop) (f df:R -> R) (x0:R),
+    D_in f df D x0 -> D_in (fun x:R => - f x) (fun x:R => - df x) D x0.
+Proof.
+  intros; generalize (Dmult_const D f df x0 (-1) H); unfold D_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      intros; generalize (H0 eps H1); clear H0; intro; elim H0; 
+        clear H0; intros; elim H0; clear H0; simpl in |- *; 
+          intros; split with x; split; auto.
+  intros; generalize (H2 x1 H3); clear H2; intro;
+    rewrite Ropp_mult_distr_l_reverse in H2;
+      rewrite Ropp_mult_distr_l_reverse in H2;
+        rewrite Ropp_mult_distr_l_reverse 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 :
- forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
-   D_in f df D x0 ->
-   D_in g dg D x0 ->
-   D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0.
-unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro;
- apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); 
- assumption. 
+  forall (D:R -> Prop) (df dg f g:R -> R) (x0:R),
+    D_in f df D x0 ->
+    D_in g dg D x0 ->
+    D_in (fun x:R => f x - g x) (fun x:R => df x - dg x) D x0.
+Proof.
+  unfold Rminus in |- *; intros; generalize (Dopp D g dg x0 H0); intro;
+    apply (Dadd D df (fun x:R => - dg x) f (fun x:R => - g x) x0); 
+      assumption. 
 Qed.
 
 (*********)
 Lemma Dx_pow_n :
- forall (n:nat) (D:R -> Prop) (x0:R),
-   D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0.
-simple induction n; intros.
-simpl in |- *; rewrite Rmult_0_l; apply Dconst.
-intros; cut (n0 = (S n0 - 1)%nat);
- [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ].
-generalize
- (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) (
-    fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) (
-    H D x0)); unfold D_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); 
- 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 (x0 ^ n0) in H2) in H2;
- rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2;
- rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2;
- rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2;
- rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat));
- intro cond.
-rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *;
- cut (1 + x0 * 1 * 0 = 1 * 1);
- [ intro A; rewrite A in H2; assumption | ring ].
-cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ];
- rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2;
- rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption.
+  forall (n:nat) (D:R -> Prop) (x0:R),
+    D_in (fun x:R => x ^ n) (fun x:R => INR n * x ^ (n - 1)) D x0.
+Proof.
+  simple induction n; intros.
+  simpl in |- *; rewrite Rmult_0_l; apply Dconst.
+  intros; cut (n0 = (S n0 - 1)%nat);
+    [ intro a; rewrite <- a; clear a | simpl in |- *; apply minus_n_O ].
+  generalize
+    (Dmult D (fun _:R => 1) (fun x:R => INR n0 * x ^ (n0 - 1)) (
+      fun x:R => x) (fun x:R => x ^ n0) x0 (Dx D x0) (
+        H D x0)); unfold D_in in |- *; unfold limit1_in in |- *;
+    unfold limit_in in |- *; simpl in |- *; intros; elim (H0 eps H1); 
+      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 (x0 ^ n0) in H2) in H2;
+      rewrite (tech_pow_Rmult x1 n0) in H2; rewrite (tech_pow_Rmult x0 n0) in H2;
+        rewrite (Rmult_comm (INR n0) (x0 ^ (n0 - 1))) in H2;
+          rewrite <- (Rmult_assoc x0 (x0 ^ (n0 - 1)) (INR n0)) in H2;
+            rewrite (tech_pow_Rmult x0 (n0 - 1)) in H2; elim (classic (n0 = 0%nat));
+              intro cond.
+  rewrite cond in H2; rewrite cond; simpl in H2; simpl in |- *;
+    cut (1 + x0 * 1 * 0 = 1 * 1);
+      [ intro A; rewrite A in H2; assumption | ring ].
+  cut (n0 <> 0%nat -> S (n0 - 1) = n0); [ intro | omega ];
+    rewrite (H3 cond) in H2; rewrite (Rmult_comm (x0 ^ n0) (INR n0)) in H2;
+      rewrite (tech_pow_Rplus x0 n0 n0) in H2; assumption.
 Qed.
 
 (*********)
 Lemma Dcomp :
- forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R),
-   D_in f df Df x0 ->
-   D_in g dg Dg (f x0) ->
-   D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0.
-intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *;
- unfold Rdiv in |- *; intros;
- generalize
-  (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) (
-     D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); 
- 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 (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0))
-     (fun x:R => (f x - f x0) * / (x - x0))
-     (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) (
-     df x0) x0 H3); intro;
- cut
-  (limit1_in (fun x:R => (f x - f x0) * / (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 (fun x:R => (f x - f x0) * / (x - x0)) (
-     fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1
-     (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); 
- intro; unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
- 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 0); intros a b; apply (b (conj 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 (conj H11 H14) H5)); intro;
- rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16;
- rewrite (Rmult_0_l (/ (x2 - x0))) in H16;
- rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12;
- rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0))));
- rewrite (Rmult_0_l (/ (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) /\ 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 (g (f x2) - g (f x0)) (/ (f x2 - f x0))
-     ((f x2 - f x0) * / (x2 - x0))) in H15;
- rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0)))
-   in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15;
- rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15;
- rewrite (Rmult_comm (df x0) (dg (f x0))); assumption.
-clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *;
- simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; 
- 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 H4 H5)).
+  forall (Df Dg:R -> Prop) (df dg f g:R -> R) (x0:R),
+    D_in f df Df x0 ->
+    D_in g dg Dg (f x0) ->
+    D_in (fun x:R => g (f x)) (fun x:R => df x * dg (f x)) (Dgf Df Dg f) x0.
+Proof.
+  intros Df Dg df dg f g x0 H H0; generalize H H0; unfold D_in in |- *;
+    unfold Rdiv in |- *; intros;
+      generalize
+        (limit_comp f (fun x:R => (g x - g (f x0)) * / (x - f x0)) (
+          D_x Df x0) (D_x Dg (f x0)) (f x0) (dg (f x0)) x0); 
+        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 (fun x:R => (g (f x) - g (f x0)) * / (f x - f x0))
+                  (fun x:R => (f x - f x0) * / (x - x0))
+                  (Dgf (D_x Df x0) (D_x Dg (f x0)) f) (dg (f x0)) (
+                    df x0) x0 H3); intro;
+                cut
+                  (limit1_in (fun x:R => (f x - f x0) * / (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 (fun x:R => (f x - f x0) * / (x - x0)) (
+        fun x:R => dg (f x0)) (D_x Df x0) (df x0) (dg (f x0)) x0 H1
+      (limit_free (fun x:R => dg (f x0)) (D_x Df x0) x0 x0)); 
+      intro; unfold limit1_in in |- *; unfold limit_in in |- *; 
+        simpl in |- *; unfold limit1_in in H5, H7; unfold limit_in in H5, H7;
+          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 0); intros a b; apply (b (conj 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 (conj H11 H14) H5)); intro;
+      rewrite (Rminus_diag_eq (f x2) (f x0) H12) in H16;
+        rewrite (Rmult_0_l (/ (x2 - x0))) in H16;
+          rewrite (Rmult_0_l (dg (f x0))) in H16; rewrite H12;
+            rewrite (Rminus_diag_eq (g (f x0)) (g (f x0)) (refl_equal (g (f x0))));
+              rewrite (Rmult_0_l (/ (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) /\ 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 (g (f x2) - g (f x0)) (/ (f x2 - f x0))
+              ((f x2 - f x0) * / (x2 - x0))) in H15;
+            rewrite <- (Rmult_assoc (/ (f x2 - f x0)) (f x2 - f x0) (/ (x2 - x0)))
+              in H15; rewrite (Rinv_l (f x2 - f x0) H16) in H15;
+                rewrite (let (H1, H2) := Rmult_ne (/ (x2 - x0)) in H2) in H15;
+                  rewrite (Rmult_comm (df x0) (dg (f x0))); assumption.
+  clear H5 H3 H4 H2; unfold limit1_in in |- *; unfold limit_in in |- *;
+    simpl in |- *; unfold limit1_in in H1; unfold limit_in in H1; 
+      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 H4 H5)).
 Qed.   
 
 (*********)
 Lemma D_pow_n :
- forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R),
-   D_in expr dexpr D x0 ->
-   D_in (fun x:R => expr x ^ n)
-     (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) (
-     Dgf D D expr) x0.
-intros n D x0 expr dexpr H;
- generalize
-  (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr (
-     fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); 
- intro; unfold D_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0;
- 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 * expr x0 ^ (n - 1)) =
-  INR n * expr x0 ^ (n - 1) * dexpr x0);
- [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ].
+  forall (n:nat) (D:R -> Prop) (x0:R) (expr dexpr:R -> R),
+    D_in expr dexpr D x0 ->
+    D_in (fun x:R => expr x ^ n)
+    (fun x:R => INR n * expr x ^ (n - 1) * dexpr x) (
+      Dgf D D expr) x0.
+Proof.
+  intros n D x0 expr dexpr H;
+    generalize
+      (Dcomp D D dexpr (fun x:R => INR n * x ^ (n - 1)) expr (
+        fun x:R => x ^ n) x0 H (Dx_pow_n n D (expr x0))); 
+      intro; unfold D_in in |- *; unfold limit1_in in |- *;
+        unfold limit_in in |- *; simpl in |- *; intros; unfold D_in in H0;
+          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 * expr x0 ^ (n - 1)) =
+      INR n * expr x0 ^ (n - 1) * dexpr x0);
+    [ intro Rew; rewrite <- Rew; exact (H2 x1 H3) | ring ].
 Qed.
diff --git a/theories/Reals/Reals.v b/theories/Reals/Reals.v
index c9cd189d..906f4977 100644
--- a/theories/Reals/Reals.v
+++ b/theories/Reals/Reals.v
@@ -6,9 +6,9 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Reals.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Reals.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
-(* The library REALS is divided in 6 parts :
+(** The library REALS is divided in 6 parts :
    - Rbase: basic lemmas on R
             equalities and inequalities
             Ring and Field are instantiated on R
diff --git a/theories/Reals/Rfunctions.v b/theories/Reals/Rfunctions.v
index 0ab93229..c727623c 100644
--- a/theories/Reals/Rfunctions.v
+++ b/theories/Reals/Rfunctions.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rfunctions.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
+(*i $Id: Rfunctions.v 9302 2006-10-27 21:21:17Z barras $ 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*)
@@ -15,6 +15,8 @@
 (**          Definition of the sum functions            *)
 (*                                                      *)
 (********************************************************)
+Require Export LegacyArithRing. (* for ring_nat... *)
+Require Export ArithRing.
 
 Require Import Rbase.
 Require Export R_Ifp.
@@ -29,498 +31,496 @@ Open Local Scope nat_scope.
 Open Local Scope R_scope.
 
 (*******************************)
-(**  Lemmas about factorial    *)
+(** * Lemmas about factorial   *)
 (*******************************)
 (*********)
 Lemma INR_fact_neq_0 : forall n:nat, INR (fact n) <> 0.
 Proof.
-intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
- assumption.
+  intro; red in |- *; intro; apply (not_O_INR (fact n) (fact_neq_0 n));
+    assumption.
 Qed.    
 
 (*********)
 Lemma fact_simpl : forall n:nat, fact (S n) = (S n * fact n)%nat.
 Proof.
-intro; reflexivity.
+  intro; reflexivity.
 Qed. 
 
 (*********)
 Lemma simpl_fact :
- forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n).
+  forall n:nat, / INR (fact (S n)) * / / INR (fact n) = / INR (S n).
 Proof.
-intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n));
- unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *;
- rewrite (mult_INR (S n) (fact n));
- rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))).
-rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n)));
- rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
- apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1).
-apply not_O_INR; auto.
-apply INR_fact_neq_0.
+  intro; rewrite (Rinv_involutive (INR (fact n)) (INR_fact_neq_0 n));
+    unfold fact at 1 in |- *; cbv beta iota in |- *; fold fact in |- *;
+      rewrite (mult_INR (S n) (fact n));
+        rewrite (Rinv_mult_distr (INR (S n)) (INR (fact n))).
+  rewrite (Rmult_assoc (/ INR (S n)) (/ INR (fact n)) (INR (fact n)));
+    rewrite (Rinv_l (INR (fact n)) (INR_fact_neq_0 n));
+      apply (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1).
+  apply not_O_INR; auto.
+  apply INR_fact_neq_0.
 Qed.
 
 (*******************************)
-(*          Power              *)
+(** *       Power              *)
 (*******************************)
 (*********)
 Boxed Fixpoint pow (r:R) (n:nat) {struct n} : R :=
   match n with
-  | O => 1
-  | S n => r * pow r n
+    | O => 1
+    | S n => r * pow r n
   end.
 
 Infix "^" := pow : R_scope.
 
 Lemma pow_O : forall x:R, x ^ 0 = 1.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
- 
+
 Lemma pow_1 : forall x:R, x ^ 1 = x.
 Proof.
-simpl in |- *; auto with real.
+  simpl in |- *; auto with real.
 Qed.
- 
+
 Lemma pow_add : forall (x:R) (n m:nat), x ^ (n + m) = x ^ n * x ^ m.
 Proof.
-intros x n; elim n; simpl in |- *; auto with real.
-intros n0 H' m; rewrite H'; auto with real.
+  intros x n; elim n; simpl in |- *; auto with real.
+  intros n0 H' m; rewrite H'; auto with real.
 Qed.
 
 Lemma pow_nonzero : forall (x:R) (n:nat), x <> 0 -> x ^ n <> 0.
 Proof.
-intro; simple induction n; simpl in |- *.
-intro; red in |- *; intro; apply R1_neq_R0; assumption.
-intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1).
-intro; auto.
-apply H; assumption.
+  intro; simple induction n; simpl in |- *.
+  intro; red in |- *; intro; apply R1_neq_R0; assumption.
+  intros; red in |- *; intro; elim (Rmult_integral x (x ^ n0) H1).
+  intro; auto.
+  apply H; assumption.
 Qed.
 
 Hint Resolve pow_O pow_1 pow_add pow_nonzero: real.
- 
+
 Lemma pow_RN_plus :
- forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m.
+  forall (x:R) (n m:nat), x <> 0 -> x ^ n = x ^ (n + m) * / x ^ m.
 Proof.
-intros x n; elim n; simpl in |- *; auto with real.
-intros n0 H' m H'0.
-rewrite Rmult_assoc; rewrite <- H'; auto.
+  intros x n; elim n; simpl in |- *; auto with real.
+  intros n0 H' m H'0.
+  rewrite Rmult_assoc; rewrite <- H'; auto.
 Qed.
 
 Lemma pow_lt : forall (x:R) (n:nat), 0 < x -> 0 < x ^ n.
 Proof.
-intros x n; elim n; simpl in |- *; auto with real.
-intros n0 H' H'0; replace 0 with (x * 0); auto with real.
+  intros x n; elim n; simpl in |- *; auto with real.
+  intros n0 H' H'0; replace 0 with (x * 0); auto with real.
 Qed.
 Hint Resolve pow_lt: real.
 
 Lemma Rlt_pow_R1 : forall (x:R) (n:nat), 1 < x -> (0 < n)%nat -> 1 < x ^ n.
 Proof.
-intros x n; elim n; simpl in |- *; auto with real.
-intros H' H'0; elimtype False; omega.
-intros n0; case n0.
-simpl in |- *; rewrite Rmult_1_r; auto.
-intros n1 H' H'0 H'1.
-replace 1 with (1 * 1); auto with real.
-apply Rlt_trans with (r2 := x * 1); auto with real.
-apply Rmult_lt_compat_l; auto with real.
-apply Rlt_trans with (r2 := 1); auto with real.
-apply H'; auto with arith.
+  intros x n; elim n; simpl in |- *; auto with real.
+  intros H' H'0; elimtype False; omega.
+  intros n0; case n0.
+  simpl in |- *; rewrite Rmult_1_r; auto.
+  intros n1 H' H'0 H'1.
+  replace 1 with (1 * 1); auto with real.
+  apply Rlt_trans with (r2 := x * 1); auto with real.
+  apply Rmult_lt_compat_l; auto with real.
+  apply Rlt_trans with (r2 := 1); auto with real.
+  apply H'; auto with arith.
 Qed.
 Hint Resolve Rlt_pow_R1: real.
 
 Lemma Rlt_pow : forall (x:R) (n m:nat), 1 < x -> (n < m)%nat -> x ^ n < x ^ m.
 Proof.
-intros x n m H' H'0; replace m with (m - n + n)%nat.
-rewrite pow_add.
-pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n);
- auto with real.
-apply Rminus_lt.
-repeat rewrite (fun y:R => Rmult_comm y (x ^ n));
- rewrite <- Rmult_minus_distr_l.
-replace 0 with (x ^ n * 0); auto with real.
-apply Rmult_lt_compat_l; auto with real.
-apply pow_lt; auto with real.
-apply Rlt_trans with (r2 := 1); auto with real.
-apply Rlt_minus; auto with real.
-apply Rlt_pow_R1; auto with arith.
-apply plus_lt_reg_l with (p := n); auto with arith.
-rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
-rewrite plus_comm; auto with arith.
+  intros x n m H' H'0; replace m with (m - n + n)%nat.
+  rewrite pow_add.
+  pattern (x ^ n) at 1 in |- *; replace (x ^ n) with (1 * x ^ n);
+    auto with real.
+  apply Rminus_lt.
+  repeat rewrite (fun y:R => Rmult_comm y (x ^ n));
+    rewrite <- Rmult_minus_distr_l.
+  replace 0 with (x ^ n * 0); auto with real.
+  apply Rmult_lt_compat_l; auto with real.
+  apply pow_lt; auto with real.
+  apply Rlt_trans with (r2 := 1); auto with real.
+  apply Rlt_minus; auto with real.
+  apply Rlt_pow_R1; auto with arith.
+  apply plus_lt_reg_l with (p := n); auto with arith.
+  rewrite le_plus_minus_r; auto with arith; rewrite <- plus_n_O; auto.
+  rewrite plus_comm; auto with arith.
 Qed.
 Hint Resolve Rlt_pow: real.
 
 (*********)
 Lemma tech_pow_Rmult : forall (x:R) (n:nat), x * x ^ n = x ^ S n.
 Proof.
-simple induction n; simpl in |- *; trivial.
+  simple induction n; simpl in |- *; trivial.
 Qed.
 
 (*********)
 Lemma tech_pow_Rplus :
- forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a.
+  forall (x:R) (a n:nat), x ^ a + INR n * x ^ a = INR (S n) * x ^ a.
 Proof.
-intros; pattern (x ^ a) at 1 in |- *;
- rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1);
- rewrite (Rmult_comm (INR n) (x ^ a));
- rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n));
- rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); 
- apply Rmult_comm.
+  intros; pattern (x ^ a) at 1 in |- *;
+    rewrite <- (let (H1, H2) := Rmult_ne (x ^ a) in H1);
+      rewrite (Rmult_comm (INR n) (x ^ a));
+        rewrite <- (Rmult_plus_distr_l (x ^ a) 1 (INR n));
+          rewrite (Rplus_comm 1 (INR n)); rewrite <- (S_INR n); 
+            apply Rmult_comm.
 Qed.
 
 Lemma poly : forall (n:nat) (x:R), 0 < x -> 1 + INR n * x <= (1 + x) ^ n.
 Proof.
-intros; elim n.
-simpl in |- *; cut (1 + 0 * x = 1).
-intro; rewrite H0; unfold Rle in |- *; right; reflexivity.
-ring.
-intros; unfold pow in |- *; fold pow in |- *;
- apply
-  (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x))
-     ((1 + x) * (1 + x) ^ n0)).
-cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)).
-intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *;
- rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1);
- apply Rplus_le_compat_l; elim n0; intros.
-simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto.
-unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *;
- intro; fold (Rsqr x) in |- *;
- apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1)));
- fold (x > 0) in H;
- apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))).
-rewrite (S_INR n0); ring.
-unfold Rle in H0; elim H0; intro. 
-unfold Rle in |- *; left; apply Rmult_lt_compat_l.
-rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)).
-assumption.
-rewrite H1; unfold Rle in |- *; right; trivial.
+  intros; elim n.
+  simpl in |- *; cut (1 + 0 * x = 1).
+  intro; rewrite H0; unfold Rle in |- *; right; reflexivity.
+  ring.
+  intros; unfold pow in |- *; fold pow in |- *;
+    apply
+      (Rle_trans (1 + INR (S n0) * x) ((1 + x) * (1 + INR n0 * x))
+        ((1 + x) * (1 + x) ^ n0)).
+  cut ((1 + x) * (1 + INR n0 * x) = 1 + INR (S n0) * x + INR n0 * (x * x)).
+  intro; rewrite H1; pattern (1 + INR (S n0) * x) at 1 in |- *;
+    rewrite <- (let (H1, H2) := Rplus_ne (1 + INR (S n0) * x) in H1);
+      apply Rplus_le_compat_l; elim n0; intros.
+  simpl in |- *; rewrite Rmult_0_l; unfold Rle in |- *; right; auto.
+  unfold Rle in |- *; left; generalize Rmult_gt_0_compat; unfold Rgt in |- *;
+    intro; fold (Rsqr x) in |- *;
+      apply (H3 (INR (S n1)) (Rsqr x) (lt_INR_0 (S n1) (lt_O_Sn n1)));
+        fold (x > 0) in H;
+          apply (Rlt_0_sqr x (Rlt_dichotomy_converse x 0 (or_intror (x < 0) H))).
+  rewrite (S_INR n0); ring.
+  unfold Rle in H0; elim H0; intro. 
+  unfold Rle in |- *; left; apply Rmult_lt_compat_l.
+  rewrite Rplus_comm; apply (Rle_lt_0_plus_1 x (Rlt_le 0 x H)).
+  assumption.
+  rewrite H1; unfold Rle in |- *; right; trivial.
 Qed.
 
 Lemma Power_monotonic :
- forall (x:R) (m n:nat),
-   Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n).
-Proof.
-intros x m n H; induction  n as [| n Hrecn]; intros; inversion H0.
-unfold Rle in |- *; right; reflexivity.
-unfold Rle in |- *; right; reflexivity.
-apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))).
-apply Hrecn; assumption.
-simpl in |- *; rewrite Rabs_mult.
-pattern (Rabs (x ^ n)) at 1 in |- *.
-rewrite <- Rmult_1_r.
-rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))).
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-unfold Rgt in H.
-apply Rlt_le; assumption.
+  forall (x:R) (m n:nat),
+    Rabs x > 1 -> (m <= n)%nat -> Rabs (x ^ m) <= Rabs (x ^ n).
+Proof.
+  intros x m n H; induction  n as [| n Hrecn]; intros; inversion H0.
+  unfold Rle in |- *; right; reflexivity.
+  unfold Rle in |- *; right; reflexivity.
+  apply (Rle_trans (Rabs (x ^ m)) (Rabs (x ^ n)) (Rabs (x ^ S n))).
+  apply Hrecn; assumption.
+  simpl in |- *; rewrite Rabs_mult.
+  pattern (Rabs (x ^ n)) at 1 in |- *.
+  rewrite <- Rmult_1_r.
+  rewrite (Rmult_comm (Rabs x) (Rabs (x ^ n))).
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  unfold Rgt in H.
+  apply Rlt_le; assumption.
 Qed.
 
 Lemma RPow_abs : forall (x:R) (n:nat), Rabs x ^ n = Rabs (x ^ n).
 Proof.
-intro; simple induction n; simpl in |- *.
-apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
-intros; rewrite H; apply sym_eq; apply Rabs_mult.
+  intro; simple induction n; simpl in |- *.
+  apply sym_eq; apply Rabs_pos_eq; apply Rlt_le; apply Rlt_0_1.
+  intros; rewrite H; apply sym_eq; apply Rabs_mult.
 Qed.
 
 
 Lemma Pow_x_infinity :
- forall x:R,
-   Rabs x > 1 ->
-   forall b:R,
+  forall x:R,
+    Rabs x > 1 ->
+    forall b:R,
       exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) >= b).
 Proof.
-intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1;
- cut (exists N : nat, INR N >= b * / (Rabs x - 1)).
-intro; elim H1; clear H1; intros; exists x0; intros;
- apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b).
-apply Rle_ge; apply Power_monotonic; assumption.
-rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)).
-intro; rewrite H3;
- apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b).
-apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus;
- assumption.
-apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b).
-apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1)));
- pattern (INR x0 * (Rabs x - 1)) at 1 in |- *;
- rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1);
- apply Rplus_lt_compat_l; apply Rlt_0_1.
-cut (b = b * / (Rabs x - 1) * (Rabs x - 1)).
-intros; rewrite H4; apply Rmult_ge_compat_r.
-apply Rge_minus; unfold Rge in |- *; left; assumption.
-assumption.
-rewrite Rmult_assoc; rewrite Rinv_l.
-ring.
-apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption.
-ring.
-cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z).
-intros; elim H1; intro.
-elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0;
- apply
-  (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
-rewrite INR_IZR_INZ; apply IZR_ge; omega.
-unfold Rge in |- *; left; assumption.
-exists 0%nat;
- apply
-  (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
-rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega.
-unfold Rge in |- *; left; assumption.
-omega.
+  intros; elim (archimed (b * / (Rabs x - 1))); intros; clear H1;
+    cut (exists N : nat, INR N >= b * / (Rabs x - 1)).
+  intro; elim H1; clear H1; intros; exists x0; intros;
+    apply (Rge_trans (Rabs (x ^ n)) (Rabs (x ^ x0)) b).
+  apply Rle_ge; apply Power_monotonic; assumption.
+  rewrite <- RPow_abs; cut (Rabs x = 1 + (Rabs x - 1)).
+  intro; rewrite H3;
+    apply (Rge_trans ((1 + (Rabs x - 1)) ^ x0) (1 + INR x0 * (Rabs x - 1)) b).
+  apply Rle_ge; apply poly; fold (Rabs x - 1 > 0) in |- *; apply Rgt_minus;
+    assumption.
+  apply (Rge_trans (1 + INR x0 * (Rabs x - 1)) (INR x0 * (Rabs x - 1)) b).
+  apply Rle_ge; apply Rlt_le; rewrite (Rplus_comm 1 (INR x0 * (Rabs x - 1)));
+    pattern (INR x0 * (Rabs x - 1)) at 1 in |- *;
+      rewrite <- (let (H1, H2) := Rplus_ne (INR x0 * (Rabs x - 1)) in H1);
+        apply Rplus_lt_compat_l; apply Rlt_0_1.
+  cut (b = b * / (Rabs x - 1) * (Rabs x - 1)).
+  intros; rewrite H4; apply Rmult_ge_compat_r.
+  apply Rge_minus; unfold Rge in |- *; left; assumption.
+  assumption.
+  rewrite Rmult_assoc; rewrite Rinv_l.
+  ring.
+  apply Rlt_dichotomy_converse; right; apply Rgt_minus; assumption.
+  ring.
+  cut ((0 <= up (b * / (Rabs x - 1)))%Z \/ (up (b * / (Rabs x - 1)) <= 0)%Z).
+  intros; elim H1; intro.
+  elim (IZN (up (b * / (Rabs x - 1))) H2); intros; exists x0;
+    apply
+      (Rge_trans (INR x0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
+  rewrite INR_IZR_INZ; apply IZR_ge; omega.
+  unfold Rge in |- *; left; assumption.
+  exists 0%nat;
+    apply
+      (Rge_trans (INR 0) (IZR (up (b * / (Rabs x - 1)))) (b * / (Rabs x - 1))).
+  rewrite INR_IZR_INZ; apply IZR_ge; simpl in |- *; omega.
+  unfold Rge in |- *; left; assumption.
+  omega.
 Qed.
 
 Lemma pow_ne_zero : forall n:nat, n <> 0%nat -> 0 ^ n = 0.
 Proof.
-simple induction n.
-simpl in |- *; auto.
-intros; elim H; reflexivity.
-intros; simpl in |- *; apply Rmult_0_l.
+  simple induction n.
+  simpl in |- *; auto.
+  intros; elim H; reflexivity.
+  intros; simpl in |- *; apply Rmult_0_l.
 Qed.
 
 Lemma Rinv_pow : forall (x:R) (n:nat), x <> 0 -> / x ^ n = (/ x) ^ n.
 Proof.
-intros; elim n; simpl in |- *.
-apply Rinv_1.
-intro m; intro; rewrite Rinv_mult_distr.
-rewrite H0; reflexivity; assumption.
-assumption.
-apply pow_nonzero; assumption.
+  intros; elim n; simpl in |- *.
+  apply Rinv_1.
+  intro m; intro; rewrite Rinv_mult_distr.
+  rewrite H0; reflexivity; assumption.
+  assumption.
+  apply pow_nonzero; assumption.
 Qed.
 
 Lemma pow_lt_1_zero :
- forall x:R,
-   Rabs x < 1 ->
-   forall y:R,
-     0 < y ->
+  forall x:R,
+    Rabs x < 1 ->
+    forall y:R,
+      0 < y ->
       exists N : nat, (forall n:nat, (n >= N)%nat -> Rabs (x ^ n) < y).
 Proof.
-intros; elim (Req_dec x 0); intro. 
-exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero.
-rewrite Rabs_R0; assumption.
-inversion GE; auto.
-cut (Rabs (/ x) > 1).
-intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N.
-exists N; intros; rewrite <- (Rinv_involutive y).
-rewrite <- (Rinv_involutive (Rabs (x ^ n))).
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat.
-assumption.
-apply Rinv_0_lt_compat.
-apply Rabs_pos_lt.
-apply pow_nonzero.
-assumption.
-rewrite <- Rabs_Rinv.
-rewrite Rinv_pow.
-apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))).
-pattern (/ y) at 1 in |- *.
-rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1).
-apply Rplus_lt_compat_l.
-apply Rlt_0_1.
-apply Rge_le.
-apply H3.
-assumption.
-assumption.
-apply pow_nonzero.
-assumption.
-apply Rabs_no_R0.
-apply pow_nonzero.
-assumption.
-apply Rlt_dichotomy_converse.
-right; unfold Rgt in |- *; assumption.
-rewrite <- (Rinv_involutive 1).
-rewrite Rabs_Rinv.
-unfold Rgt in |- *; apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat.
-apply Rabs_pos_lt.
-assumption.
-rewrite Rinv_1; apply Rlt_0_1.
-rewrite Rinv_1; assumption.
-assumption.
-red in |- *; intro; apply R1_neq_R0; assumption.
+  intros; elim (Req_dec x 0); intro. 
+  exists 1%nat; rewrite H1; intros n GE; rewrite pow_ne_zero.
+  rewrite Rabs_R0; assumption.
+  inversion GE; auto.
+  cut (Rabs (/ x) > 1).
+  intros; elim (Pow_x_infinity (/ x) H2 (/ y + 1)); intros N.
+  exists N; intros; rewrite <- (Rinv_involutive y).
+  rewrite <- (Rinv_involutive (Rabs (x ^ n))).
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat.
+  apply Rinv_0_lt_compat.
+  assumption.
+  apply Rinv_0_lt_compat.
+  apply Rabs_pos_lt.
+  apply pow_nonzero.
+  assumption.
+  rewrite <- Rabs_Rinv.
+  rewrite Rinv_pow.
+  apply (Rlt_le_trans (/ y) (/ y + 1) (Rabs ((/ x) ^ n))).
+  pattern (/ y) at 1 in |- *.
+  rewrite <- (let (H1, H2) := Rplus_ne (/ y) in H1).
+  apply Rplus_lt_compat_l.
+  apply Rlt_0_1.
+  apply Rge_le.
+  apply H3.
+  assumption.
+  assumption.
+  apply pow_nonzero.
+  assumption.
+  apply Rabs_no_R0.
+  apply pow_nonzero.
+  assumption.
+  apply Rlt_dichotomy_converse.
+  right; unfold Rgt in |- *; assumption.
+  rewrite <- (Rinv_involutive 1).
+  rewrite Rabs_Rinv.
+  unfold Rgt in |- *; apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt.
+  assumption.
+  rewrite Rinv_1; apply Rlt_0_1.
+  rewrite Rinv_1; assumption.
+  assumption.
+  red in |- *; intro; apply R1_neq_R0; assumption.
 Qed.
 
 Lemma pow_R1 : forall (r:R) (n:nat), r ^ n = 1 -> Rabs r = 1 \/ n = 0%nat.
 Proof.
-intros r n H'.
-case (Req_dec (Rabs r) 1); auto; intros H'1.
-case (Rdichotomy _ _ H'1); intros H'2.
-generalize H'; case n; auto.
-intros n0 H'0.
-cut (r <> 0); [ intros Eq1 | idtac ].
-cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
-absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto.
-replace (Rabs (/ r) ^ S n0) with 1.
-simpl in |- *; apply Rlt_irrefl; auto.
-rewrite Rabs_Rinv; auto.
-rewrite <- Rinv_pow; auto.
-rewrite RPow_abs; auto.
-rewrite H'0; rewrite Rabs_right; auto with real.
-apply Rle_ge; auto with real.
-apply Rlt_pow; auto with arith.
-rewrite Rabs_Rinv; auto.
-apply Rmult_lt_reg_l with (r := Rabs r).
-case (Rabs_pos r); auto.
-intros H'3; case Eq2; auto.
-rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
-red in |- *; intro; absurd (r ^ S n0 = 1); auto.
-simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
-generalize H'; case n; auto.
-intros n0 H'0.
-cut (r <> 0); [ intros Eq1 | auto with real ].
-cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
-absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith.
-repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
-red in |- *; intro; absurd (r ^ S n0 = 1); auto.
-simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+  intros r n H'.
+  case (Req_dec (Rabs r) 1); auto; intros H'1.
+  case (Rdichotomy _ _ H'1); intros H'2.
+  generalize H'; case n; auto.
+  intros n0 H'0.
+  cut (r <> 0); [ intros Eq1 | idtac ].
+  cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
+  absurd (Rabs (/ r) ^ 0 < Rabs (/ r) ^ S n0); auto.
+  replace (Rabs (/ r) ^ S n0) with 1.
+  simpl in |- *; apply Rlt_irrefl; auto.
+  rewrite Rabs_Rinv; auto.
+  rewrite <- Rinv_pow; auto.
+  rewrite RPow_abs; auto.
+  rewrite H'0; rewrite Rabs_right; auto with real.
+  apply Rle_ge; auto with real.
+  apply Rlt_pow; auto with arith.
+  rewrite Rabs_Rinv; auto.
+  apply Rmult_lt_reg_l with (r := Rabs r).
+  case (Rabs_pos r); auto.
+  intros H'3; case Eq2; auto.
+  rewrite Rmult_1_r; rewrite Rinv_r; auto with real.
+  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
+  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
+  generalize H'; case n; auto.
+  intros n0 H'0.
+  cut (r <> 0); [ intros Eq1 | auto with real ].
+  cut (Rabs r <> 0); [ intros Eq2 | apply Rabs_no_R0 ]; auto.
+  absurd (Rabs r ^ 0 < Rabs r ^ S n0); auto with real arith.
+  repeat rewrite RPow_abs; rewrite H'0; simpl in |- *; auto with real.
+  red in |- *; intro; absurd (r ^ S n0 = 1); auto.
+  simpl in |- *; rewrite H; rewrite Rmult_0_l; auto with real.
 Qed.
 
 Lemma pow_Rsqr : forall (x:R) (n:nat), x ^ (2 * n) = Rsqr x ^ n.
 Proof.
-intros; induction  n as [| n Hrecn].
-reflexivity.
-replace (2 * S n)%nat with (S (S (2 * n))).
-replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)).
-rewrite Hrecn; reflexivity.
-simpl in |- *; ring.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
+  intros; induction  n as [| n Hrecn].
+  reflexivity.
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  replace (x ^ S (S (2 * n))) with (x * x * x ^ (2 * n)).
+  rewrite Hrecn; reflexivity.
+  simpl in |- *; ring.
+  ring_nat.
 Qed.
 
 Lemma pow_le : forall (a:R) (n:nat), 0 <= a -> 0 <= a ^ n.
 Proof.
-intros; induction  n as [| n Hrecn].
-simpl in |- *; left; apply Rlt_0_1.
-simpl in |- *; apply Rmult_le_pos; assumption.
+  intros; induction  n as [| n Hrecn].
+  simpl in |- *; left; apply Rlt_0_1.
+  simpl in |- *; apply Rmult_le_pos; assumption.
 Qed.
 
 (**********)
 Lemma pow_1_even : forall n:nat, (-1) ^ (2 * n) = 1.
 Proof.
-intro; induction  n as [| n Hrecn].
-reflexivity.
-replace (2 * S n)%nat with (2 + 2 * n)%nat.
-rewrite pow_add; rewrite Hrecn; simpl in |- *; ring.
-replace (S n) with (n + 1)%nat; [ ring | ring ].
+  intro; induction  n as [| n Hrecn].
+  reflexivity.
+  replace (2 * S n)%nat with (2 + 2 * n)%nat by ring.
+  rewrite pow_add; rewrite Hrecn; simpl in |- *; ring.
 Qed.
 
 (**********)
 Lemma pow_1_odd : forall n:nat, (-1) ^ S (2 * n) = -1.
 Proof.
-intro; replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ].
-rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring.
+  intro; replace (S (2 * n)) with (2 * n + 1)%nat by ring.
+  rewrite pow_add; rewrite pow_1_even; simpl in |- *; ring.
 Qed.
 
 (**********)
 Lemma pow_1_abs : forall n:nat, Rabs ((-1) ^ n) = 1.
 Proof.
-intro; induction  n as [| n Hrecn].
-simpl in |- *; apply Rabs_R1.
-replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
-rewrite Rabs_mult.
-rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r;
- rewrite Rabs_Ropp; apply Rabs_R1.
+  intro; induction  n as [| n Hrecn].
+  simpl in |- *; apply Rabs_R1.
+  replace (S n) with (n + 1)%nat; [ rewrite pow_add | ring ].
+  rewrite Rabs_mult.
+  rewrite Hrecn; rewrite Rmult_1_l; simpl in |- *; rewrite Rmult_1_r;
+    rewrite Rabs_Ropp; apply Rabs_R1.
 Qed.
 
 Lemma pow_mult : forall (x:R) (n1 n2:nat), x ^ (n1 * n2) = (x ^ n1) ^ n2.
 Proof.
-intros; induction  n2 as [| n2 Hrecn2].
-simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
-replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat.
-replace (S n2) with (n2 + 1)%nat; [ idtac | ring ].
-do 2 rewrite pow_add.
-rewrite Hrecn2.
-simpl in |- *.
-ring.
-apply INR_eq; rewrite plus_INR; do 2 rewrite mult_INR; rewrite S_INR; ring.
+  intros; induction  n2 as [| n2 Hrecn2].
+  simpl in |- *; replace (n1 * 0)%nat with 0%nat; [ reflexivity | ring ].
+  replace (n1 * S n2)%nat with (n1 * n2 + n1)%nat.
+  replace (S n2) with (n2 + 1)%nat by ring.
+  do 2 rewrite pow_add.
+  rewrite Hrecn2.
+  simpl in |- *.
+  ring.
+  ring_nat.
 Qed.
 
 Lemma pow_incr : forall (x y:R) (n:nat), 0 <= x <= y -> x ^ n <= y ^ n.
 Proof.
-intros.
-induction  n as [| n Hrecn].
-right; reflexivity.
-simpl in |- *.
-elim H; intros.
-apply Rle_trans with (y * x ^ n).
-do 2 rewrite <- (Rmult_comm (x ^ n)).
-apply Rmult_le_compat_l.
-apply pow_le; assumption.
-assumption.
-apply Rmult_le_compat_l.
-apply Rle_trans with x; assumption.
-apply Hrecn.
+  intros.
+  induction  n as [| n Hrecn].
+  right; reflexivity.
+  simpl in |- *.
+  elim H; intros.
+  apply Rle_trans with (y * x ^ n).
+  do 2 rewrite <- (Rmult_comm (x ^ n)).
+  apply Rmult_le_compat_l.
+  apply pow_le; assumption.
+  assumption.
+  apply Rmult_le_compat_l.
+  apply Rle_trans with x; assumption.
+  apply Hrecn.
 Qed.
 
 Lemma pow_R1_Rle : forall (x:R) (k:nat), 1 <= x -> 1 <= x ^ k.
 Proof.
-intros.
-induction  k as [| k Hreck].
-right; reflexivity.
-simpl in |- *.
-apply Rle_trans with (x * 1).
-rewrite Rmult_1_r; assumption.
-apply Rmult_le_compat_l.
-left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
-exact Hreck.
+  intros.
+  induction  k as [| k Hreck].
+  right; reflexivity.
+  simpl in |- *.
+  apply Rle_trans with (x * 1).
+  rewrite Rmult_1_r; assumption.
+  apply Rmult_le_compat_l.
+  left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
+  exact Hreck.
 Qed.
 
 Lemma Rle_pow :
- forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n.
+  forall (x:R) (m n:nat), 1 <= x -> (m <= n)%nat -> x ^ m <= x ^ n.
 Proof.
-intros.
-replace n with (n - m + m)%nat.
-rewrite pow_add.
-rewrite Rmult_comm.
-pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r.
-apply Rmult_le_compat_l.
-apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
-apply pow_R1_Rle; assumption.
-rewrite plus_comm.
-symmetry  in |- *; apply le_plus_minus; assumption.
+  intros.
+  replace n with (n - m + m)%nat.
+  rewrite pow_add.
+  rewrite Rmult_comm.
+  pattern (x ^ m) at 1 in |- *; rewrite <- Rmult_1_r.
+  apply Rmult_le_compat_l.
+  apply pow_le; left; apply Rlt_le_trans with 1; [ apply Rlt_0_1 | assumption ].
+  apply pow_R1_Rle; assumption.
+  rewrite plus_comm.
+  symmetry  in |- *; apply le_plus_minus; assumption.
 Qed.
 
 Lemma pow1 : forall n:nat, 1 ^ n = 1.
 Proof.
-intro; induction  n as [| n Hrecn].
-reflexivity.
-simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
+  intro; induction  n as [| n Hrecn].
+  reflexivity.
+  simpl in |- *; rewrite Hrecn; rewrite Rmult_1_r; reflexivity.
 Qed.
 
 Lemma pow_Rabs : forall (x:R) (n:nat), x ^ n <= Rabs x ^ n.
 Proof.
-intros; induction  n as [| n Hrecn].
-right; reflexivity.
-simpl in |- *; case (Rcase_abs x); intro.
-apply Rle_trans with (Rabs (x * x ^ n)).
-apply RRle_abs.
-rewrite Rabs_mult.
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-right; symmetry  in |- *; apply RPow_abs.
-pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r);
- apply Rmult_le_compat_l.
-apply Rge_le; exact r.
-apply Hrecn.
+  intros; induction  n as [| n Hrecn].
+  right; reflexivity.
+  simpl in |- *; case (Rcase_abs x); intro.
+  apply Rle_trans with (Rabs (x * x ^ n)).
+  apply RRle_abs.
+  rewrite Rabs_mult.
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  right; symmetry  in |- *; apply RPow_abs.
+  pattern (Rabs x) at 1 in |- *; rewrite (Rabs_right x r);
+    apply Rmult_le_compat_l.
+  apply Rge_le; exact r.
+  apply Hrecn.
 Qed.
 
 Lemma pow_maj_Rabs : forall (x y:R) (n:nat), Rabs y <= x -> y ^ n <= x ^ n.
 Proof.
-intros; cut (0 <= x).
-intro; apply Rle_trans with (Rabs y ^ n).
-apply pow_Rabs.
-induction  n as [| n Hrecn].
-right; reflexivity.
-simpl in |- *; apply Rle_trans with (x * Rabs y ^ n).
-do 2 rewrite <- (Rmult_comm (Rabs y ^ n)).
-apply Rmult_le_compat_l.
-apply pow_le; apply Rabs_pos.
-assumption.
-apply Rmult_le_compat_l.
-apply H0.
-apply Hrecn.
-apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ].
+  intros; cut (0 <= x).
+  intro; apply Rle_trans with (Rabs y ^ n).
+  apply pow_Rabs.
+  induction  n as [| n Hrecn].
+  right; reflexivity.
+  simpl in |- *; apply Rle_trans with (x * Rabs y ^ n).
+  do 2 rewrite <- (Rmult_comm (Rabs y ^ n)).
+  apply Rmult_le_compat_l.
+  apply pow_le; apply Rabs_pos.
+  assumption.
+  apply Rmult_le_compat_l.
+  apply H0.
+  apply Hrecn.
+  apply Rle_trans with (Rabs y); [ apply Rabs_pos | exact H ].
 Qed.
 
 (*******************************)
-(**         PowerRZ            *)
+(** *       PowerRZ            *)
 (*******************************)
 (*i Due to L.Thery i*)
 
@@ -529,151 +529,151 @@ Ltac case_eq name :=
 
 Definition powerRZ (x:R) (n:Z) :=
   match n with
-  | Z0 => 1
-  | Zpos p => x ^ nat_of_P p
-  | Zneg p => / x ^ nat_of_P p
+    | Z0 => 1
+    | Zpos p => x ^ nat_of_P p
+    | Zneg p => / x ^ nat_of_P p
   end.
 
 Infix Local "^Z" := powerRZ (at level 30, right associativity) : R_scope.
 
 Lemma Zpower_NR0 :
- forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z.
+  forall (x:Z) (n:nat), (0 <= x)%Z -> (0 <= Zpower_nat x n)%Z.
 Proof.
-induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith.
+  induction n; unfold Zpower_nat in |- *; simpl in |- *; auto with zarith.
 Qed.
 
 Lemma powerRZ_O : forall x:R, x ^Z 0 = 1.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
- 
+
 Lemma powerRZ_1 : forall x:R, x ^Z Zsucc 0 = x.
 Proof.
-simpl in |- *; auto with real.
+  simpl in |- *; auto with real.
 Qed.
- 
+
 Lemma powerRZ_NOR : forall (x:R) (z:Z), x <> 0 -> x ^Z z <> 0.
 Proof.
-destruct z; simpl in |- *; auto with real.
+  destruct z; simpl in |- *; auto with real.
 Qed.
- 
+
 Lemma powerRZ_add :
- forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m.
+  forall (x:R) (n m:Z), x <> 0 -> x ^Z (n + m) = x ^Z n * x ^Z m.
 Proof.
-intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *;
- auto with real.
+  intro x; destruct n as [| n1| n1]; destruct m as [| m1| m1]; simpl in |- *;
+    auto with real.
 (* POS/POS *)
-rewrite nat_of_P_plus_morphism; auto with real.
+  rewrite nat_of_P_plus_morphism; auto with real.
 (* POS/NEG *)
-case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
-intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
-intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
-rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
- auto with real.
-rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-rewrite Rinv_mult_distr; auto with real.
-rewrite Rinv_involutive; auto with real.
-apply lt_le_weak.
-apply nat_of_P_lt_Lt_compare_morphism; auto.
-apply ZC2; auto.
-intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
-rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
- auto with real.
-rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-apply lt_le_weak.
-change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
-apply nat_of_P_gt_Gt_compare_morphism; auto.
+  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
+  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
+  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
+  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
+    auto with real.
+  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+  rewrite Rinv_mult_distr; auto with real.
+  rewrite Rinv_involutive; auto with real.
+  apply lt_le_weak.
+  apply nat_of_P_lt_Lt_compare_morphism; auto.
+  apply ZC2; auto.
+  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
+  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
+    auto with real.
+  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+  apply lt_le_weak.
+  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
+  apply nat_of_P_gt_Gt_compare_morphism; auto.
 (* NEG/POS *)
-case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
-intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
-intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
-rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
- auto with real.
-rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-apply lt_le_weak.
-apply nat_of_P_lt_Lt_compare_morphism; auto.
-apply ZC2; auto.
-intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
-rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
- auto with real.
-rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
-rewrite Rinv_mult_distr; auto with real.
-apply lt_le_weak.
-change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
-apply nat_of_P_gt_Gt_compare_morphism; auto.
+  case_eq ((n1 ?= m1)%positive Datatypes.Eq); simpl in |- *; auto with real.
+  intros H' H'0; rewrite Pcompare_Eq_eq with (1 := H'); auto with real.
+  intros H' H'0; rewrite (nat_of_P_minus_morphism m1 n1); auto with real.
+  rewrite (pow_RN_plus x (nat_of_P m1 - nat_of_P n1) (nat_of_P n1));
+    auto with real.
+  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+  apply lt_le_weak.
+  apply nat_of_P_lt_Lt_compare_morphism; auto.
+  apply ZC2; auto.
+  intros H' H'0; rewrite (nat_of_P_minus_morphism n1 m1); auto with real.
+  rewrite (pow_RN_plus x (nat_of_P n1 - nat_of_P m1) (nat_of_P m1));
+    auto with real.
+  rewrite plus_comm; rewrite le_plus_minus_r; auto with real.
+  rewrite Rinv_mult_distr; auto with real.
+  apply lt_le_weak.
+  change (nat_of_P n1 > nat_of_P m1)%nat in |- *.
+  apply nat_of_P_gt_Gt_compare_morphism; auto.
 (* NEG/NEG *)
-rewrite nat_of_P_plus_morphism; auto with real.
-intros H'; rewrite pow_add; auto with real.
-apply Rinv_mult_distr; auto.
-apply pow_nonzero; auto.
-apply pow_nonzero; auto.
+  rewrite nat_of_P_plus_morphism; auto with real.
+  intros H'; rewrite pow_add; auto with real.
+  apply Rinv_mult_distr; auto.
+  apply pow_nonzero; auto.
+  apply pow_nonzero; auto.
 Qed.
 Hint Resolve powerRZ_O powerRZ_1 powerRZ_NOR powerRZ_add: real.
- 
+
 Lemma Zpower_nat_powerRZ :
- forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m.
-Proof.
-intros n m; elim m; simpl in |- *; auto with real.
-intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
-replace (Zpower_nat (Z_of_nat n) (S m1)) with
- (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z.
-rewrite mult_IZR; auto with real.
-repeat rewrite <- INR_IZR_INZ; simpl in |- *.
-rewrite H'; simpl in |- *.
-case m1; simpl in |- *; auto with real.
-intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
-unfold Zpower_nat in |- *; auto.
-Qed.
- 
+  forall n m:nat, IZR (Zpower_nat (Z_of_nat n) m) = INR n ^Z Z_of_nat m.
+Proof.
+  intros n m; elim m; simpl in |- *; auto with real.
+  intros m1 H'; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; simpl in |- *.
+  replace (Zpower_nat (Z_of_nat n) (S m1)) with
+  (Z_of_nat n * Zpower_nat (Z_of_nat n) m1)%Z.
+  rewrite mult_IZR; auto with real.
+  repeat rewrite <- INR_IZR_INZ; simpl in |- *.
+  rewrite H'; simpl in |- *.
+  case m1; simpl in |- *; auto with real.
+  intros m2; rewrite nat_of_P_o_P_of_succ_nat_eq_succ; auto.
+  unfold Zpower_nat in |- *; auto.
+Qed.
+
 Lemma powerRZ_lt : forall (x:R) (z:Z), 0 < x -> 0 < x ^Z z.
 Proof.
-intros x z; case z; simpl in |- *; auto with real.
+  intros x z; case z; simpl in |- *; auto with real.
 Qed.
 Hint Resolve powerRZ_lt: real.
- 
+
 Lemma powerRZ_le : forall (x:R) (z:Z), 0 < x -> 0 <= x ^Z z.
 Proof.
-intros x z H'; apply Rlt_le; auto with real.
+  intros x z H'; apply Rlt_le; auto with real.
 Qed.
 Hint Resolve powerRZ_le: real.
- 
+
 Lemma Zpower_nat_powerRZ_absolu :
- forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m.
+  forall n m:Z, (0 <= m)%Z -> IZR (Zpower_nat n (Zabs_nat m)) = IZR n ^Z m.
 Proof.
-intros n m; case m; simpl in |- *; auto with zarith.
-intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
-intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
-rewrite <- mult_IZR; auto.
-intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith.
+  intros n m; case m; simpl in |- *; auto with zarith.
+  intros p H'; elim (nat_of_P p); simpl in |- *; auto with zarith.
+  intros n0 H'0; rewrite <- H'0; simpl in |- *; auto with zarith.
+  rewrite <- mult_IZR; auto.
+  intros p H'; absurd (0 <= Zneg p)%Z; auto with zarith.
 Qed.
 
 Lemma powerRZ_R1 : forall n:Z, 1 ^Z n = 1.
 Proof.
-intros n; case n; simpl in |- *; auto.
-intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
- ring.
-intros p; elim (nat_of_P p); simpl in |- *.
-exact Rinv_1.
-intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
- auto with real.
+  intros n; case n; simpl in |- *; auto.
+  intros p; elim (nat_of_P p); simpl in |- *; auto; intros n0 H'; rewrite H';
+    ring.
+  intros p; elim (nat_of_P p); simpl in |- *.
+  exact Rinv_1.
+  intros n1 H'; rewrite Rinv_mult_distr; try rewrite Rinv_1; try rewrite H';
+    auto with real.
 Qed.
 
 (*******************************)
 (* For easy interface          *)
 (*******************************)
 (* decimal_exp r z is defined as r 10^z *)
- 
+
 Definition decimal_exp (r:R) (z:Z) : R := (r * 10 ^Z z).
 
 
 (*******************************)
-(** Sum of n first naturals    *)
+(** * Sum of n first naturals  *)
 (*******************************)
 (*********)
 Boxed Fixpoint sum_nat_f_O (f:nat -> nat) (n:nat) {struct n} : nat :=
   match n with
-  | O => f 0%nat
-  | S n' => (sum_nat_f_O f n' + f (S n'))%nat
+    | O => f 0%nat
+    | S n' => (sum_nat_f_O f n' + f (S n'))%nat
   end.
 
 (*********)
@@ -687,13 +687,13 @@ Definition sum_nat_O (n:nat) : nat := sum_nat_f_O (fun x:nat => x) n.
 Definition sum_nat (s n:nat) : nat := sum_nat_f s n (fun x:nat => x).
 
 (*******************************)
-(**            Sum             *)
+(** *          Sum             *)
 (*******************************)
 (*********)
 Fixpoint sum_f_R0 (f:nat -> R) (N:nat) {struct N} : R :=
   match N with
-  | O => f 0%nat
-  | S i => sum_f_R0 f i + f (S i)
+    | O => f 0%nat
+    | S i => sum_f_R0 f i + f (S i)
   end.
 
 (*********)
@@ -701,35 +701,35 @@ Definition sum_f (s n:nat) (f:nat -> R) : R :=
   sum_f_R0 (fun x:nat => f (x + s)%nat) (n - s).
 
 Lemma GP_finite :
- forall (x:R) (n:nat),
-   sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1.
+  forall (x:R) (n:nat),
+    sum_f_R0 (fun n:nat => x ^ n) n * (x - 1) = x ^ (n + 1) - 1.
 Proof.
-intros; induction  n as [| n Hrecn]; simpl in |- *.
-ring.
-rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n).
-intro H; rewrite H; simpl in |- *; ring.
-omega.
+  intros; induction  n as [| n Hrecn]; simpl in |- *.
+  ring.
+  rewrite Rmult_plus_distr_r; rewrite Hrecn; cut ((n + 1)%nat = S n).
+  intro H; rewrite H; simpl in |- *; ring.
+  omega.
 Qed.
 
 Lemma sum_f_R0_triangle :
- forall (x:nat -> R) (n:nat),
-   Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n.
-Proof.
-intro; simple induction n; simpl in |- *.
-unfold Rle in |- *; right; reflexivity.
-intro m; intro;
- apply
-  (Rle_trans (Rabs (sum_f_R0 x m + x (S m)))
-     (Rabs (sum_f_R0 x m) + Rabs (x (S m)))
-     (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))).
-apply Rabs_triang.
-rewrite Rplus_comm;
- rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m))));
- apply Rplus_le_compat_l; assumption.
+  forall (x:nat -> R) (n:nat),
+    Rabs (sum_f_R0 x n) <= sum_f_R0 (fun i:nat => Rabs (x i)) n.
+Proof.
+  intro; simple induction n; simpl in |- *.
+  unfold Rle in |- *; right; reflexivity.
+  intro m; intro;
+    apply
+      (Rle_trans (Rabs (sum_f_R0 x m + x (S m)))
+        (Rabs (sum_f_R0 x m) + Rabs (x (S m)))
+        (sum_f_R0 (fun i:nat => Rabs (x i)) m + Rabs (x (S m)))).
+  apply Rabs_triang.
+  rewrite Rplus_comm;
+    rewrite (Rplus_comm (sum_f_R0 (fun i:nat => Rabs (x i)) m) (Rabs (x (S m))));
+      apply Rplus_le_compat_l; assumption.
 Qed.
 
 (*******************************)
-(*        Distance  in R       *)
+(** *     Distance  in R       *)
 (*******************************)
 
 (*********)
@@ -738,64 +738,64 @@ Definition R_dist (x y:R) : R := Rabs (x - y).
 (*********)
 Lemma R_dist_pos : forall x y:R, R_dist x y >= 0.
 Proof.
-intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y));
- intro l.
-unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
-trivial.
+  intros; unfold R_dist in |- *; unfold Rabs in |- *; case (Rcase_abs (x - y));
+    intro l.
+  unfold Rge in |- *; left; apply (Ropp_gt_lt_0_contravar (x - y) l).
+  trivial.
 Qed.
 
 (*********)
 Lemma R_dist_sym : forall x y:R, R_dist x y = R_dist y x.
 Proof.
-unfold R_dist in |- *; intros; split_Rabs; ring.
-generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
- rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
- intro; unfold Rgt in H; elimtype False; auto.
-generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro;
- generalize (Rge_antisym x y H0 H); intro; rewrite H1; 
- ring.
+  unfold R_dist in |- *; intros; split_Rabs; try ring.
+  generalize (Ropp_gt_lt_0_contravar (y - x) r); intro;
+    rewrite (Ropp_minus_distr y x) in H; generalize (Rlt_asym (x - y) 0 r0);
+      intro; unfold Rgt in H; elimtype False; auto.
+  generalize (minus_Rge y x r); intro; generalize (minus_Rge x y r0); intro;
+    generalize (Rge_antisym x y H0 H); intro; rewrite H1; 
+      ring.
 Qed.
 
 (*********)
 Lemma R_dist_refl : forall x y:R, R_dist x y = 0 <-> x = y.
 Proof.
-unfold R_dist in |- *; intros; split_Rabs; split; intros.
-rewrite (Ropp_minus_distr x y) in H; apply sym_eq;
- apply (Rminus_diag_uniq y x H).
-rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro;
- apply (Rminus_diag_eq y x H0).
-apply (Rminus_diag_uniq x y H).
-apply (Rminus_diag_eq x y H). 
+  unfold R_dist in |- *; intros; split_Rabs; split; intros.
+  rewrite (Ropp_minus_distr x y) in H; apply sym_eq;
+    apply (Rminus_diag_uniq y x H).
+  rewrite (Ropp_minus_distr x y); generalize (sym_eq H); intro;
+    apply (Rminus_diag_eq y x H0).
+  apply (Rminus_diag_uniq x y H).
+  apply (Rminus_diag_eq x y H). 
 Qed.
 
 Lemma R_dist_eq : forall x:R, R_dist x x = 0.
 Proof.
-unfold R_dist in |- *; intros; split_Rabs; intros; ring.
+  unfold R_dist in |- *; intros; split_Rabs; intros; ring.
 Qed.
 
 (***********)
 Lemma R_dist_tri : forall x y z:R, R_dist x y <= R_dist x z + R_dist z y.
 Proof.
-intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y));
- [ apply (Rabs_triang (x - z) (z - y)) | ring ].
+  intros; unfold R_dist in |- *; replace (x - y) with (x - z + (z - y));
+    [ apply (Rabs_triang (x - z) (z - y)) | ring ].
 Qed.
 
 (*********)
 Lemma R_dist_plus :
- forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d.
+  forall a b c d:R, R_dist (a + c) (b + d) <= R_dist a b + R_dist c d.
 Proof.
-intros; unfold R_dist in |- *;
- replace (a + c - (b + d)) with (a - b + (c - d)).
-exact (Rabs_triang (a - b) (c - d)).
-ring.
+  intros; unfold R_dist in |- *;
+    replace (a + c - (b + d)) with (a - b + (c - d)).
+  exact (Rabs_triang (a - b) (c - d)).
+  ring.
 Qed.
 
 (*******************************)
-(**       Infinit Sum          *)
+(** *     Infinit Sum          *)
 (*******************************)
 (*********)
 Definition infinit_sum (s:nat -> R) (l:R) : Prop :=
   forall eps:R,
     eps > 0 ->
-     exists N : nat,
+    exists N : nat,
       (forall n:nat, (n >= N)%nat -> R_dist (sum_f_R0 s n) l < eps).
diff --git a/theories/Reals/Rgeom.v b/theories/Reals/Rgeom.v
index 9ce20839..8ac9c07f 100644
--- a/theories/Reals/Rgeom.v
+++ b/theories/Reals/Rgeom.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rgeom.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rgeom.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -14,174 +14,188 @@ Require Import SeqSeries.
 Require Import Rtrigo.
 Require Import R_sqrt. Open Local Scope R_scope.
 
+(** * Distance *)
+
 Definition dist_euc (x0 y0 x1 y1:R) : R :=
   sqrt (Rsqr (x0 - x1) + Rsqr (y0 - y1)).
 
 Lemma distance_refl : forall x0 y0:R, dist_euc x0 y0 x0 y0 = 0.
-intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj;
- [ apply sqrt_positivity; apply Rplus_le_le_0_compat;
-    [ apply Rle_0_sqr | apply Rle_0_sqr ]
- | right; reflexivity
- | rewrite Rsqr_0; rewrite Rsqr_sqrt;
-    [ unfold Rsqr in |- *; ring
-    | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ].
+Proof.
+  intros x0 y0; unfold dist_euc in |- *; apply Rsqr_inj;
+    [ apply sqrt_positivity; apply Rplus_le_le_0_compat;
+      [ apply Rle_0_sqr | apply Rle_0_sqr ]
+      | right; reflexivity
+      | rewrite Rsqr_0; rewrite Rsqr_sqrt;
+        [ unfold Rsqr in |- *; ring
+          | apply Rplus_le_le_0_compat; [ apply Rle_0_sqr | apply Rle_0_sqr ] ] ].
 Qed.
 
 Lemma distance_symm :
- forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. 
-intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj;
- [ apply sqrt_positivity; apply Rplus_le_le_0_compat
- | apply sqrt_positivity; apply Rplus_le_le_0_compat
- | repeat rewrite Rsqr_sqrt;
-    [ unfold Rsqr in |- *; ring
-    | apply Rplus_le_le_0_compat
-    | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
+  forall x0 y0 x1 y1:R, dist_euc x0 y0 x1 y1 = dist_euc x1 y1 x0 y0. 
+Proof.
+  intros x0 y0 x1 y1; unfold dist_euc in |- *; apply Rsqr_inj;
+    [ apply sqrt_positivity; apply Rplus_le_le_0_compat
+      | apply sqrt_positivity; apply Rplus_le_le_0_compat
+      | repeat rewrite Rsqr_sqrt;
+        [ unfold Rsqr in |- *; ring
+          | apply Rplus_le_le_0_compat
+          | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
 Qed.
 
 Lemma law_cosines :
- forall 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 in |- *; intros; repeat rewrite Rsqr_sqrt;
- [ rewrite H; unfold Rsqr in |- *; ring
- | apply Rplus_le_le_0_compat
- | apply Rplus_le_le_0_compat
- | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr.
+  forall 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).
+Proof.
+  unfold dist_euc in |- *; intros; repeat rewrite Rsqr_sqrt;
+    [ rewrite H; unfold Rsqr in |- *; ring
+      | apply Rplus_le_le_0_compat
+      | apply Rplus_le_le_0_compat
+      | apply Rplus_le_le_0_compat ]; apply Rle_0_sqr.
 Qed.
 
 Lemma triangle :
- forall x0 y0 x1 y1 x2 y2:R,
-   dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1.
-intros; unfold dist_euc in |- *; 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
+  forall x0 y0 x1 y1 x2 y2:R,
+    dist_euc x0 y0 x1 y1 <= dist_euc x0 y0 x2 y2 + dist_euc x2 y2 x1 y1.
+Proof.
+  intros; unfold dist_euc in |- *; apply Rsqr_incr_0;
+    [ 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 Rplus_le_reg_l with
-             (- Rsqr (x0 - x2) - Rsqr (x2 - x1) - Rsqr (y0 - y2) -
+            (- 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) +
+            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
+            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
+                  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))));
+                  (sqrt (Rsqr (x0 - x2) + Rsqr (y0 - y2)) *
+                    sqrt (Rsqr (x2 - x1) + Rsqr (y2 - y1))));
                 [ apply Rmult_le_compat_l;
-                   [ left; cut (0%nat <> 2%nat);
-                      [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H));
-                         intro H0; assumption
+                  [ left; cut (0%nat <> 2%nat);
+                    [ intros; generalize (lt_INR_0 2 (neq_O_lt 2 H));
+                      intro H0; assumption
                       | discriminate ]
-                   | apply sqrt_cauchy ]
+                    | apply sqrt_cauchy ]
+                  | ring ]
                 | ring ]
-             | ring ]
+            | ring_Rsqr ]
           | ring_Rsqr ]
-       | ring_Rsqr ]
-    | apply Rplus_le_le_0_compat; apply Rle_0_sqr
-    | apply Rplus_le_le_0_compat; apply Rle_0_sqr
-    | apply Rplus_le_le_0_compat; apply Rle_0_sqr ]
- | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr
- | apply Rplus_le_le_0_compat; apply sqrt_positivity;
-    apply Rplus_le_le_0_compat; apply Rle_0_sqr ].
+        | apply Rplus_le_le_0_compat; apply Rle_0_sqr
+        | apply Rplus_le_le_0_compat; apply Rle_0_sqr
+        | apply Rplus_le_le_0_compat; apply Rle_0_sqr ]
+      | apply sqrt_positivity; apply Rplus_le_le_0_compat; apply Rle_0_sqr
+      | apply Rplus_le_le_0_compat; apply sqrt_positivity;
+        apply Rplus_le_le_0_compat; apply Rle_0_sqr ].
 Qed.
 
 (******************************************************************)
-(**                         Translation                           *)
+(** *                       Translation                           *)
 (******************************************************************)
 
 Definition xt (x tx:R) : R := x + tx.
 Definition yt (y ty:R) : R := y + ty.
 
 Lemma translation_0 : forall x y:R, xt x 0 = x /\ yt y 0 = y.
-intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring.
+Proof.
+  intros x y; split; [ unfold xt in |- * | unfold yt in |- * ]; ring.
 Qed.
 
 Lemma isometric_translation :
- forall 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 in |- *; ring.
+  forall 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).
+Proof.
+  intros; unfold Rsqr, xt, yt in |- *; ring.
 Qed.
 
 (******************************************************************)
-(**                           Rotation                            *)
+(** *                         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 : forall x y:R, xr x y 0 = x /\ yr x y 0 = y.
-intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring.
+Proof.
+  intros x y; unfold xr, yr in |- *; split; rewrite cos_0; rewrite sin_0; ring.
 Qed.
 
 Lemma rotation_PI2 :
- forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x.
-intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2;
- ring.
+  forall x y:R, xr x y (PI / 2) = y /\ yr x y (PI / 2) = - x.
+Proof.
+  intros x y; unfold xr, yr in |- *; split; rewrite cos_PI2; rewrite sin_PI2;
+    ring.
 Qed.
 
 Lemma isometric_rotation_0 :
- forall 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 in |- *;
- 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_mult; repeat rewrite cos2;
-       ring; replace (x2 - x1) with (- (x1 - x2));
-       [ rewrite <- Rsqr_neg; ring | ring ]
-    | ring ]
- | ring ].
+  forall 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).
+Proof.
+  intros; unfold xr, yr in |- *;
+    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_mult; repeat rewrite cos2;
+          ring_simplify; replace (x2 - x1) with (- (x1 - x2));
+          [ rewrite <- Rsqr_neg; ring | ring ]
+          | ring ]
+      | ring ].
 Qed.
 
 Lemma isometric_rotation :
- forall 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 in |- *; intros; apply Rsqr_inj;
- [ apply sqrt_positivity; apply Rplus_le_le_0_compat
- | apply sqrt_positivity; apply Rplus_le_le_0_compat
- | repeat rewrite Rsqr_sqrt;
-    [ apply isometric_rotation_0
-    | apply Rplus_le_le_0_compat
-    | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
+  forall 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).
+Proof.
+  unfold dist_euc in |- *; intros; apply Rsqr_inj;
+    [ apply sqrt_positivity; apply Rplus_le_le_0_compat
+      | apply sqrt_positivity; apply Rplus_le_le_0_compat
+      | repeat rewrite Rsqr_sqrt;
+        [ apply isometric_rotation_0
+          | apply Rplus_le_le_0_compat
+          | apply Rplus_le_le_0_compat ] ]; apply Rle_0_sqr.
 Qed.
 
 (******************************************************************)
-(**                         Similarity                            *)
+(** *                       Similarity                            *)
 (******************************************************************)
 
 Lemma isometric_rot_trans :
- forall 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.
+  forall 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). 
+Proof.
+  intros; rewrite <- isometric_rotation_0; apply isometric_translation.
 Qed.
 
 Lemma isometric_trans_rot :
- forall 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.
\ No newline at end of file
+  forall 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). 
+Proof.
+  intros; rewrite <- isometric_translation; apply isometric_rotation_0.
+Qed.
diff --git a/theories/Reals/RiemannInt.v b/theories/Reals/RiemannInt.v
index 79cb7797..1cba821e 100644
--- a/theories/Reals/RiemannInt.v
+++ b/theories/Reals/RiemannInt.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: RiemannInt.v 7223 2005-07-13 23:43:54Z herbelin $ i*)
+
+(*i $Id: RiemannInt.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rfunctions.
 Require Import SeqSeries.
@@ -20,3244 +20,3298 @@ Require Import Max. Open Local Scope R_scope.
 Set Implicit Arguments.
 
 (********************************************)
-(*            Riemann's Integral            *)
+(**           Riemann's Integral            *)
 (********************************************)
 
 Definition Riemann_integrable (f:R -> R) (a b:R) : Type :=
   forall eps:posreal,
     sigT
-      (fun phi:StepFun a b =>
-         sigT
-           (fun psi:StepFun a b =>
-              (forall t:R,
-                 Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\
-              Rabs (RiemannInt_SF psi) < eps)).
+    (fun phi:StepFun a b =>
+      sigT
+      (fun psi:StepFun a b =>
+        (forall t:R,
+          Rmin a b <= t <= Rmax a b -> Rabs (f t - phi t) <= psi t) /\
+        Rabs (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 :
- forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b)
-   (N:nat),
-   sigT
-     (fun psi:StepFun a b =>
-        (forall t:R,
-           Rmin a b <= t <= Rmax a b ->
-           Rabs (f t - phi_sequence un pr N t) <= psi t) /\
-        Rabs (RiemannInt_SF psi) < un N).
-intros; apply (projT2 (pr (un N))).
+  forall (un:nat -> posreal) (f:R -> R) (a b:R) (pr:Riemann_integrable f a b)
+    (N:nat),
+    sigT
+    (fun psi:StepFun a b =>
+      (forall t:R,
+        Rmin a b <= t <= Rmax a b ->
+        Rabs (f t - phi_sequence un pr N t) <= psi t) /\
+      Rabs (RiemannInt_SF psi) < un N).
+Proof.
+  intros; apply (projT2 (pr (un N))).
 Qed.
 
 Lemma RiemannInt_P1 :
- forall (f:R -> R) (a b:R),
-   Riemann_integrable f a b -> Riemann_integrable f b a.
-unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros;
- elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x)));
- apply 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 in |- *
- | apply Rle_trans with (Rmax b a); try assumption; right;
-    unfold Rmax in |- * ];
- (case (Rle_dec a b); case (Rle_dec b a); intros;
-   try reflexivity || apply Rle_antisym;
-   [ assumption | assumption | auto with real | auto with real ]).
-generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
- case (Rle_dec 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 Rabs_Ropp; apply H1.
-rewrite Rabs_Ropp in H1; apply H1.
-apply H1.
+  forall (f:R -> R) (a b:R),
+    Riemann_integrable f a b -> Riemann_integrable f b a.
+Proof.
+  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X; intros;
+    elim p; clear p; intros; apply existT with (mkStepFun (StepFun_P6 (pre x)));
+      apply 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 in |- *
+      | apply Rle_trans with (Rmax b a); try assumption; right;
+        unfold Rmax in |- * ];
+    (case (Rle_dec a b); case (Rle_dec b a); intros;
+      try reflexivity || apply Rle_antisym;
+        [ assumption | assumption | auto with real | auto with real ]).
+  generalize H0; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+    case (Rle_dec 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 Rabs_Ropp; apply H1.
+  rewrite Rabs_Ropp in H1; apply H1.
+  apply H1.
 Qed.
 
 Lemma RiemannInt_P2 :
- forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
-   Un_cv un 0 ->
-   a <= b ->
-   (forall n:nat,
+  forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
+    Un_cv un 0 ->
+    a <= b ->
+    (forall n:nat,
       (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\
       Rabs (RiemannInt_SF (wn n)) < un n) ->
-   sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
-intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *;
- intros; assert (H3 : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *;
- 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 1 (wn n) (wn m)))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *;
- apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)).
-replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x));
- [ apply Rabs_triang | ring ].
-assert (H12 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H13 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11;
- rewrite Rmult_1_l; apply Rplus_le_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9.
-elim H11; intros; split; left; assumption.
-apply H7.
-elim H11; intros; split; left; assumption.
-rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m).
-apply Rle_lt_trans with
- (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))).
-apply Rplus_le_compat; apply RRle_abs.
-apply Rplus_lt_compat; assumption.
-apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)).
-apply Rplus_le_compat; apply RRle_abs.
-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_compat; apply H4; 
- assumption.
+    sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
+Proof.
+  intros; apply R_complete; unfold Un_cv in H; unfold Cauchy_crit in |- *;
+    intros; assert (H3 : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H _ H3); intros N0 H4; exists N0; intros; unfold R_dist in |- *;
+    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 1 (wn n) (wn m)))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *;
+    apply Rle_trans with (Rabs (vn n x - f x) + Rabs (f x - vn m x)).
+  replace (vn n x + -1 * vn m x) with (vn n x - f x + (f x - vn m x));
+  [ apply Rabs_triang | ring ].
+  assert (H12 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H13 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  rewrite <- H12 in H11; pattern b at 2 in H11; rewrite <- H13 in H11;
+    rewrite Rmult_1_l; apply Rplus_le_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H9.
+  elim H11; intros; split; left; assumption.
+  apply H7.
+  elim H11; intros; split; left; assumption.
+  rewrite StepFun_P30; rewrite Rmult_1_l; apply Rlt_trans with (un n + un m).
+  apply Rle_lt_trans with
+    (Rabs (RiemannInt_SF (wn n)) + Rabs (RiemannInt_SF (wn m))).
+  apply Rplus_le_compat; apply RRle_abs.
+  apply Rplus_lt_compat; assumption.
+  apply Rle_lt_trans with (Rabs (un n) + Rabs (un m)).
+  apply Rplus_le_compat; apply RRle_abs.
+  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_compat; apply H4; 
+    assumption.
 Qed.
 
 Lemma RiemannInt_P3 :
- forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
-   Un_cv un 0 ->
-   (forall n:nat,
+  forall (f:R -> R) (a b:R) (un:nat -> posreal) (vn wn:nat -> StepFun a b),
+    Un_cv un 0 ->
+    (forall n:nat,
       (forall t:R, Rmin a b <= t <= Rmax a b -> Rabs (f t - vn n t) <= wn n t) /\
       Rabs (RiemannInt_SF (wn n)) < un n) ->
-   sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
-intros; case (Rle_dec a b); intro.
-apply RiemannInt_P2 with f un wn; assumption.
-assert (H1 : b <= a); auto with real.
-set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n))));
- set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n))));
- assert
-  (H2 :
-   forall n:nat,
-     (forall t:R,
-        Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\
-     Rabs (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 in |- *
- | apply Rle_trans with (Rmax b a); try assumption; right;
-    unfold Rmax in |- * ];
- (case (Rle_dec a b); case (Rle_dec b a); intros;
-   try reflexivity || apply Rle_antisym;
-   [ assumption | assumption | auto with real | auto with real ]).
-generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
- case (Rle_dec b a); unfold wn' in |- *; intros;
- (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 Rabs_Ropp; apply H4.
-rewrite Rabs_Ropp in H4; apply H4.
-apply H4.
-assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros;
- apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; 
- intros; elim (p _ H4); intros; exists x0; intros; 
- generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *;
- case (Rle_dec b a); case (Rle_dec a b); intros.
-elim n; assumption.
-unfold vn' in H7;
- replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with
-  (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0)))))
-     (subdivision (mkStepFun (StepFun_P6 (pre (vn n0))))));
- [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
-    rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
-    apply H7
- | symmetry  in |- *; 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.
+    sigT (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (vn N)) l).
+Proof.
+  intros; case (Rle_dec a b); intro.
+  apply RiemannInt_P2 with f un wn; assumption.
+  assert (H1 : b <= a); auto with real.
+  set (vn' := fun n:nat => mkStepFun (StepFun_P6 (pre (vn n))));
+    set (wn' := fun n:nat => mkStepFun (StepFun_P6 (pre (wn n))));
+      assert
+        (H2 :
+          forall n:nat,
+            (forall t:R,
+              Rmin b a <= t <= Rmax b a -> Rabs (f t - vn' n t) <= wn' n t) /\
+            Rabs (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 in |- *
+      | apply Rle_trans with (Rmax b a); try assumption; right;
+        unfold Rmax in |- * ];
+    (case (Rle_dec a b); case (Rle_dec b a); intros;
+      try reflexivity || apply Rle_antisym;
+        [ assumption | assumption | auto with real | auto with real ]).
+  generalize H3; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+    case (Rle_dec b a); unfold wn' in |- *; intros;
+      (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 Rabs_Ropp; apply H4.
+  rewrite Rabs_Ropp in H4; apply H4.
+  apply H4.
+  assert (H3 := RiemannInt_P2 _ _ _ _ H H1 H2); elim H3; intros;
+    apply existT with (- x); unfold Un_cv in |- *; unfold Un_cv in p; 
+      intros; elim (p _ H4); intros; exists x0; intros; 
+        generalize (H5 _ H6); unfold R_dist, RiemannInt_SF in |- *;
+          case (Rle_dec b a); case (Rle_dec a b); intros.
+  elim n; assumption.
+  unfold vn' in H7;
+    replace (Int_SF (subdivision_val (vn n0)) (subdivision (vn n0))) with
+    (Int_SF (subdivision_val (mkStepFun (StepFun_P6 (pre (vn n0)))))
+      (subdivision (mkStepFun (StepFun_P6 (pre (vn n0))))));
+    [ unfold Rminus in |- *; rewrite Ropp_involutive; rewrite <- Rabs_Ropp;
+      rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
+        apply H7
+      | symmetry  in |- *; 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 :
- forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) 
-   (un:nat -> posreal),
-   Un_cv un 0 ->
-   sigT
-     (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l).
-intros f; intros;
- apply RiemannInt_P3 with
-  f un (fun n:nat => projT1 (phi_sequence_prop un pr n));
- [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ].
+  forall (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) 
+    (un:nat -> posreal),
+    Un_cv un 0 ->
+    sigT
+    (fun l:R => Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr N)) l).
+Proof.
+  intros f; intros;
+    apply RiemannInt_P3 with
+      f un (fun n:nat => projT1 (phi_sequence_prop un pr n));
+      [ apply H | intro; apply (projT2 (phi_sequence_prop un pr n)) ].
 Qed.
 
 Lemma RiemannInt_P4 :
- forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b)
-   (un vn:nat -> posreal),
-   Un_cv un 0 ->
-   Un_cv vn 0 ->
-   Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l ->
-   Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros;
- assert (H3 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0;
- elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2);
- exists N; intros;
- apply Rle_lt_trans with
-  (Rabs
-     (RiemannInt_SF (phi_sequence vn pr2 n) -
-      RiemannInt_SF (phi_sequence un pr1 n)) +
-   Rabs (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 Rabs_triang | ring ].
-replace eps with (2 * (eps / 3) + eps / 3).
-apply Rplus_lt_compat.
-elim (phi_sequence_prop vn pr2 n); intros psi_vn H5;
- elim (phi_sequence_prop un pr1 n); intros psi_un H6;
- replace
+  forall (f:R -> R) (a b l:R) (pr1 pr2:Riemann_integrable f a b)
+    (un vn:nat -> posreal),
+    Un_cv un 0 ->
+    Un_cv vn 0 ->
+    Un_cv (fun N:nat => RiemannInt_SF (phi_sequence un pr1 N)) l ->
+    Un_cv (fun N:nat => RiemannInt_SF (phi_sequence vn pr2 N)) l.
+Proof.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros f; intros;
+    assert (H3 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H _ H3); clear H; intros N0 H; elim (H0 _ H3); clear H0; intros N1 H0;
+    elim (H1 _ H3); clear H1; intros N2 H1; set (N := max (max N0 N1) N2);
+      exists N; intros;
+        apply Rle_lt_trans with
+          (Rabs
+            (RiemannInt_SF (phi_sequence vn pr2 n) -
+              RiemannInt_SF (phi_sequence un pr1 n)) +
+            Rabs (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)) with
-  (RiemannInt_SF (phi_sequence vn pr2 n) +
-   -1 * RiemannInt_SF (phi_sequence un pr1 n)); [ idtac | ring ];
- rewrite <- StepFun_P30.
-case (Rle_dec a b); intro.
-apply Rle_lt_trans with
- (RiemannInt_SF
-    (mkStepFun
-       (StepFun_P32
+    RiemannInt_SF (phi_sequence un pr1 n) +
+    (RiemannInt_SF (phi_sequence un pr1 n) - l)); [ apply Rabs_triang | ring ].
+  replace eps with (2 * (eps / 3) + eps / 3).
+  apply Rplus_lt_compat.
+  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 (Rle_dec 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 1 psi_un psi_vn))).
-apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l;
- apply Rle_trans with
-  (Rabs (phi_sequence vn pr2 n x - f x) +
-   Rabs (f x - phi_sequence un pr1 n x)).
-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 Rabs_triang | ring ].
-assert (H10 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H11 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
-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_1_l; rewrite double; apply Rplus_lt_compat.
-apply Rlt_trans with (pos (un n)).
-elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
-apply RRle_abs.
-assumption.
-replace (pos (un n)) with (Rabs (un n - 0));
- [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+            (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 1 psi_un psi_vn))).
+  apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with
+      (Rabs (phi_sequence vn pr2 n x - f x) +
+        Rabs (f x - phi_sequence un pr1 n x)).
+  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 Rabs_triang | ring ].
+  assert (H10 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H11 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  rewrite (Rplus_comm (psi_un x)); apply Rplus_le_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim H5; intros; apply H8.
+  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_1_l; rewrite double; apply Rplus_lt_compat.
+  apply Rlt_trans with (pos (un n)).
+  elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
+  apply RRle_abs.
+  assumption.
+  replace (pos (un n)) with (Rabs (un n - 0));
+  [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
     unfold N in |- *; apply le_trans with (max N0 N1); 
-    apply le_max_l
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    apply Rle_ge; left; apply (cond_pos (un n)) ].
-apply Rlt_trans with (pos (vn n)).
-elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
-apply RRle_abs; assumption.
-assumption.
-replace (pos (vn n)) with (Rabs (vn n - 0));
- [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
+      apply le_max_l
+    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+      apply Rle_ge; left; apply (cond_pos (un n)) ].
+  apply Rlt_trans with (pos (vn n)).
+  elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
+  apply RRle_abs; assumption.
+  assumption.
+  replace (pos (vn n)) with (Rabs (vn n - 0));
+  [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
     unfold N in |- *; apply le_trans with (max N0 N1);
-    [ apply le_max_r | apply le_max_l ]
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    apply Rle_ge; left; apply (cond_pos (vn n)) ].
-rewrite StepFun_P39; rewrite Rabs_Ropp;
- apply Rle_lt_trans with
-  (RiemannInt_SF
-     (mkStepFun
-        (StepFun_P32
-           (mkStepFun
+      [ apply le_max_r | apply le_max_l ]
+    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+      apply Rle_ge; left; apply (cond_pos (vn n)) ].
+  rewrite StepFun_P39; rewrite Rabs_Ropp;
+    apply Rle_lt_trans with
+      (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 1 psi_vn psi_un)))))).
-apply StepFun_P37.
-auto with real.
-intros; simpl in |- *; rewrite Rmult_1_l;
- apply Rle_trans with
-  (Rabs (phi_sequence vn pr2 n x - f x) +
-   Rabs (f x - phi_sequence un pr1 n x)).
-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 Rabs_triang | ring ].
-assert (H10 : Rmin a b = b).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
-assert (H11 : Rmax a b = a).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
-apply Rplus_le_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_involutive
+                (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
+      (mkStepFun (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))).
+  apply StepFun_P37.
+  auto with real.
+  intros; simpl in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with
+      (Rabs (phi_sequence vn pr2 n x - f x) +
+        Rabs (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 Rabs_triang | ring ].
+  assert (H10 : Rmin a b = b).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ elim n0; assumption | reflexivity ].
+  assert (H11 : Rmax a b = a).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ elim n0; assumption | reflexivity ].
+  apply Rplus_le_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_involutive
+      (RiemannInt_SF
+        (mkStepFun
           (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 psi_vn psi_un)))))))
- ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l;
- rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat.
-apply Rlt_trans with (pos (vn n)).
-elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-assumption.
-replace (pos (vn n)) with (Rabs (vn n - 0));
- [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
+    ; rewrite <- StepFun_P39; rewrite StepFun_P30; rewrite Rmult_1_l;
+      rewrite double; rewrite Ropp_plus_distr; apply Rplus_lt_compat.
+  apply Rlt_trans with (pos (vn n)).
+  elim H5; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_vn)).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  assumption.
+  replace (pos (vn n)) with (Rabs (vn n - 0));
+  [ apply H0; unfold ge in |- *; apply le_trans with N; try assumption;
     unfold N in |- *; apply le_trans with (max N0 N1);
-    [ apply le_max_r | apply le_max_l ]
- | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
-    rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
-    left; apply (cond_pos (vn n)) ].
-apply Rlt_trans with (pos (un n)).
-elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
-rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
-assumption.
-replace (pos (un n)) with (Rabs (un n - 0));
- [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+      [ apply le_max_r | apply le_max_l ]
+    | unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+      rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
+        left; apply (cond_pos (vn n)) ].
+  apply Rlt_trans with (pos (un n)).
+  elim H6; intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF psi_un)).
+  rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
+  assumption.
+  replace (pos (un n)) with (Rabs (un n - 0));
+  [ apply H; unfold ge in |- *; apply le_trans with N; try assumption;
     unfold N in |- *; apply le_trans with (max N0 N1); 
-    apply le_max_l
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    apply Rle_ge; left; apply (cond_pos (un n)) ].
-apply H1; unfold ge in |- *; apply le_trans with N; try assumption;
- unfold N in |- *; apply le_max_r.
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ].
+      apply le_max_l
+    | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+      apply Rle_ge; left; apply (cond_pos (un n)) ].
+  apply H1; unfold ge in |- *; apply le_trans with N; try assumption;
+    unfold N in |- *; apply le_max_r.
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ].
 Qed.
 
 Lemma RinvN_pos : forall n:nat, 0 < / (INR n + 1).
-intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat;
- [ apply pos_INR | apply Rlt_0_1 ].
+Proof.
+  intro; apply Rinv_0_lt_compat; apply Rplus_le_lt_0_compat;
+    [ apply pos_INR | apply Rlt_0_1 ].
 Qed.
 
 Definition RinvN (N:nat) : posreal := mkposreal _ (RinvN_pos N).
- 
+
 Lemma RinvN_cv : Un_cv RinvN 0.
-unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0;
- clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z).
-apply le_IZR; left; apply Rlt_trans with (/ eps);
- [ apply Rinv_0_lt_compat; assumption | assumption ].
-elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *;
- simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; 
- rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1).
-apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
-rewrite Rabs_right;
- [ idtac
- | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat;
-    assumption ]; apply Rle_lt_trans with (/ (INR x + 1)).
-apply Rle_Rinv.
-apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
-assumption.
-do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR;
- apply H4.
-rewrite <- (Rinv_involutive eps).
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat.
-apply Rinv_0_lt_compat; assumption.
-apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
-apply Rlt_trans with (INR x);
- [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0
- | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r;
-    apply Rplus_lt_compat_l; apply Rlt_0_1 ].
-red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
+Proof.
+  unfold Un_cv in |- *; intros; assert (H0 := archimed (/ eps)); elim H0;
+    clear H0; intros; assert (H2 : (0 <= up (/ eps))%Z).
+  apply le_IZR; left; apply Rlt_trans with (/ eps);
+    [ apply Rinv_0_lt_compat; assumption | assumption ].
+  elim (IZN _ H2); intros; exists x; intros; unfold R_dist in |- *;
+    simpl in |- *; unfold Rminus in |- *; rewrite Ropp_0; 
+      rewrite Rplus_0_r; assert (H5 : 0 < INR n + 1).
+  apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+  rewrite Rabs_right;
+    [ idtac
+      | left; change (0 < / (INR n + 1)) in |- *; apply Rinv_0_lt_compat;
+        assumption ]; apply Rle_lt_trans with (/ (INR x + 1)).
+  apply Rle_Rinv.
+  apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+  assumption.
+  do 2 rewrite <- (Rplus_comm 1); apply Rplus_le_compat_l; apply le_INR;
+    apply H4.
+  rewrite <- (Rinv_involutive eps).
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat.
+  apply Rinv_0_lt_compat; assumption.
+  apply Rplus_le_lt_0_compat; [ apply pos_INR | apply Rlt_0_1 ].
+  apply Rlt_trans with (INR x);
+    [ rewrite INR_IZR_INZ; rewrite <- H3; apply H0
+      | pattern (INR x) at 1 in |- *; rewrite <- Rplus_0_r;
+        apply Rplus_lt_compat_l; apply Rlt_0_1 ].
+  red in |- *; intro; rewrite H6 in H; elim (Rlt_irrefl _ H).
 Qed.
 
 (**********) 
 Definition RiemannInt (f:R -> R) (a b:R) (pr:Riemann_integrable f a b) : R :=
   match RiemannInt_exists pr RinvN RinvN_cv with
-  | existT a' b' => a'
+    | existT a' b' => a'
   end.
 
 Lemma RiemannInt_P5 :
- forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b),
-   RiemannInt pr1 = RiemannInt pr2.
-intros; unfold RiemannInt in |- *;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; 
- eapply UL_sequence;
- [ apply u0
- | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ].
+  forall (f:R -> R) (a b:R) (pr1 pr2:Riemann_integrable f a b),
+    RiemannInt pr1 = RiemannInt pr2.
+Proof.
+  intros; unfold RiemannInt in |- *;
+    case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; 
+      eapply UL_sequence;
+        [ apply u0
+          | apply RiemannInt_P4 with pr2 RinvN; apply RinvN_cv || assumption ].
 Qed.
 
-(**************************************)
-(* C°([a,b]) is included in L1([a,b]) *)
-(**************************************)
+(***************************************)
+(** C°([a,b]) is included in L1([a,b]) *)
+(***************************************)
 
 Lemma maxN :
- forall (a b:R) (del:posreal),
-   a < b ->
-   sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del).
-intros; set (I := fun n:nat => a + INR n * del < b);
- assert (H0 :  exists n : nat, I n).
-exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r;
- 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  in |- *; assumption.
-left; apply r.
-assert (H1 : 0 <= (b - a) / del).
-unfold Rdiv in |- *; apply Rmult_le_pos;
- [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H
- | left; apply Rinv_0_lt_compat; apply (cond_pos del) ].
-elim (archimed ((b - a) / del)); intros;
- assert (H4 : (0 <= up ((b - a) / del))%Z).
-apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del);
- assumption.
-assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5;
- unfold Nbound in |- *; exists N; intros; unfold I in H6; 
- apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; 
- left; apply Rle_lt_trans with ((b - a) / del); try assumption;
- apply Rmult_le_reg_l with (pos del);
- [ apply (cond_pos del)
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del));
-    rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a;
-       replace (a + (b - a)) with b; [ left; assumption | ring ]
-    | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7;
-       elim (Rlt_irrefl _ H7) ] ].
+  forall (a b:R) (del:posreal),
+    a < b ->
+    sigT (fun n:nat => a + INR n * del < b /\ b <= a + INR (S n) * del).
+Proof.
+  intros; set (I := fun n:nat => a + INR n * del < b);
+    assert (H0 :  exists n : nat, I n).
+  exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r;
+    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  in |- *; assumption.
+  left; apply r.
+  assert (H1 : 0 <= (b - a) / del).
+  unfold Rdiv in |- *; apply Rmult_le_pos;
+    [ apply Rge_le; apply Rge_minus; apply Rle_ge; left; apply H
+      | left; apply Rinv_0_lt_compat; apply (cond_pos del) ].
+  elim (archimed ((b - a) / del)); intros;
+    assert (H4 : (0 <= up ((b - a) / del))%Z).
+  apply le_IZR; simpl in |- *; left; apply Rle_lt_trans with ((b - a) / del);
+    assumption.
+  assert (H5 := IZN _ H4); elim H5; clear H5; intros N H5;
+    unfold Nbound in |- *; exists N; intros; unfold I in H6; 
+      apply INR_le; rewrite H5 in H2; rewrite <- INR_IZR_INZ in H2; 
+        left; apply Rle_lt_trans with ((b - a) / del); try assumption;
+          apply Rmult_le_reg_l with (pos del);
+            [ apply (cond_pos del)
+              | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ del));
+                rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+                  [ rewrite Rmult_1_l; rewrite Rmult_comm; apply Rplus_le_reg_l with a;
+                    replace (a + (b - a)) with b; [ left; assumption | ring ]
+                    | assert (H7 := cond_pos del); red in |- *; intro; rewrite H8 in H7;
+                      elim (Rlt_irrefl _ H7) ] ].
 Qed.
 
 Fixpoint SubEquiN (N:nat) (x y:R) (del:posreal) {struct N} : Rlist :=
   match N with
-  | O => cons y nil
-  | S p => cons x (SubEquiN p (x + del) y del)
+    | 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 :=
   match maxN del h with
-  | existT N H0 => N
+    | existT 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 :
- forall (f:R -> R) (a b:R),
-   a < b ->
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   forall eps:posreal,
-     sigT
-       (fun delta:posreal =>
-          delta <= b - a /\
+  forall (f:R -> R) (a b:R),
+    a < b ->
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    forall eps:posreal,
+      sigT
+      (fun delta:posreal =>
+        delta <= b - a /\
+        (forall x y:R,
+          a <= x <= b ->
+          a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)).
+Proof.
+  intro f; intros;
+    set
+      (E :=
+        fun l:R =>
+          0 < l <= b - a /\
           (forall x y:R,
-             a <= x <= b ->
-             a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps)).
-intro f; intros;
- set
-  (E :=
-   fun l:R =>
-     0 < l <= b - a /\
-     (forall x y:R,
-        a <= x <= b ->
-        a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps));
- assert (H1 : bound E).
-unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros;
- unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; 
- intros; assumption.
-assert (H2 :  exists x : R, E x).
-assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps);
- elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; 
- split;
- [ split;
-    [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro;
-       [ apply (cond_pos x) | apply Rlt_Rminus; assumption ]
-    | apply Rmin_r ]
- | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a));
-    [ assumption | apply Rmin_l ] ].
-assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a).
-intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split.
-apply H5.
-unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6;
- set (D := Rabs (x0 - y)); elim (classic (exists 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 _ (fun y:R => D < y /\ E y) H11);
- assert (H13 : is_upper_bound E D).
-unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1);
- elim (not_and_or (D < x1) (E x1) H14); intro.
-case (Rle_dec x1 D); intro.
-assumption.
-elim H15; auto with real.
-elim H15; assumption.
-assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (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.
+            a <= x <= b ->
+            a <= y <= b -> Rabs (x - y) < l -> Rabs (f x - f y) < eps));
+      assert (H1 : bound E).
+  unfold bound in |- *; exists (b - a); unfold is_upper_bound in |- *; intros;
+    unfold E in H1; elim H1; clear H1; intros H1 _; elim H1; 
+      intros; assumption.
+  assert (H2 :  exists x : R, E x).
+  assert (H2 := Heine f (fun x:R => a <= x <= b) (compact_P3 a b) H0 eps);
+    elim H2; intros; exists (Rmin x (b - a)); unfold E in |- *; 
+      split;
+        [ split;
+          [ unfold Rmin in |- *; case (Rle_dec x (b - a)); intro;
+            [ apply (cond_pos x) | apply Rlt_Rminus; assumption ]
+            | apply Rmin_r ]
+          | intros; apply H3; try assumption; apply Rlt_le_trans with (Rmin x (b - a));
+            [ assumption | apply Rmin_l ] ].
+  assert (H3 := completeness E H1 H2); elim H3; intros; cut (0 < x <= b - a).
+  intro; elim H4; clear H4; intros; apply existT with (mkposreal _ H4); split.
+  apply H5.
+  unfold is_lub in p; elim p; intros; unfold is_upper_bound in H6;
+    set (D := Rabs (x0 - y)); elim (classic (exists 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 _ (fun y:R => D < y /\ E y) H11);
+    assert (H13 : is_upper_bound E D).
+  unfold is_upper_bound in |- *; intros; assert (H14 := H12 x1);
+    elim (not_and_or (D < x1) (E x1) H14); intro.
+  case (Rle_dec x1 D); intro.
+  assumption.
+  elim H15; auto with real.
+  elim H15; assumption.
+  assert (H14 := H7 _ H13); elim (Rlt_irrefl _ (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 :
- forall (f:R -> R) (a b:R),
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   forall eps:posreal,
-     sigT
-       (fun delta:posreal =>
-          forall x y:R,
-            a <= x <= b ->
-            a <= y <= b -> Rabs (x - y) < delta -> Rabs (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 existT with x;
- elim p; intros; apply H2; assumption.
-apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y);
- [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5;
-    apply Rle_antisym; apply Rle_trans with b; assumption
- | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
-    apply (cond_pos eps) ].
-apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros;
- elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)).
+  forall (f:R -> R) (a b:R),
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    forall eps:posreal,
+      sigT
+      (fun delta:posreal =>
+        forall x y:R,
+          a <= x <= b ->
+          a <= y <= b -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps).
+Proof.
+  intro f; intros; case (total_order_T a b); intro.
+  elim s; intro.
+  assert (H0 := Heine_cor1 a0 H eps); elim H0; intros; apply existT with x;
+    elim p; intros; apply H2; assumption.
+  apply existT with (mkposreal _ Rlt_0_1); intros; assert (H3 : x = y);
+    [ elim H0; elim H1; intros; rewrite b0 in H3; rewrite b0 in H5;
+      apply Rle_antisym; apply Rle_trans with b; assumption
+      | rewrite H3; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+        apply (cond_pos eps) ].
+  apply existT with (mkposreal _ Rlt_0_1); intros; elim H0; intros;
+    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H3 H4) r)).
 Qed.
 
 Lemma SubEqui_P1 :
- forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a.
-intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity.
+  forall (a b:R) (del:posreal) (h:a < b), pos_Rl (SubEqui del h) 0 = a.
+Proof.
+  intros; unfold SubEqui in |- *; case (maxN del h); intros; reflexivity.
 Qed.
 
 Lemma SubEqui_P2 :
- forall (a b:R) (del:posreal) (h:a < b),
-   pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b.
-intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0;
- cut
-  (forall (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
- | simple 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) 
-        in |- *; apply H ] ].
+  forall (a b:R) (del:posreal) (h:a < b),
+    pos_Rl (SubEqui del h) (pred (Rlength (SubEqui del h))) = b.
+Proof.
+  intros; unfold SubEqui in |- *; case (maxN del h); intros; clear a0;
+    cut
+      (forall (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
+        | simple 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) 
+                in |- *; apply H ] ].
 Qed.
 
 Lemma SubEqui_P3 :
- forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N.
-simple induction N; intros;
- [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
+  forall (N:nat) (a b:R) (del:posreal), Rlength (SubEquiN N a b del) = S N.
+Proof.
+  simple induction N; intros;
+    [ reflexivity | simpl in |- *; rewrite H; reflexivity ].
 Qed.
 
 Lemma SubEqui_P4 :
- forall (N:nat) (a b:R) (del:posreal) (i:nat),
-   (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del.
-simple induction N;
- [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ]
- | intros; induction  i as [| i Hreci];
-    [ simpl in |- *; ring
-    | change
-        (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del)
-       in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ].
+  forall (N:nat) (a b:R) (del:posreal) (i:nat),
+    (i < S N)%nat -> pos_Rl (SubEquiN (S N) a b del) i = a + INR i * del.
+Proof.
+  simple induction N;
+    [ intros; inversion H; [ simpl in |- *; ring | elim (le_Sn_O _ H1) ]
+      | intros; induction  i as [| i Hreci];
+        [ simpl in |- *; ring
+          | change
+            (pos_Rl (SubEquiN (S n) (a + del) b del) i = a + INR (S i) * del)
+            in |- *; rewrite H; [ rewrite S_INR; ring | apply lt_S_n; apply H0 ] ] ].
 Qed.
 
 Lemma SubEqui_P5 :
- forall (a b:R) (del:posreal) (h:a < b),
-   Rlength (SubEqui del h) = S (S (max_N del h)).
-intros; unfold SubEqui in |- *; apply SubEqui_P3.
+  forall (a b:R) (del:posreal) (h:a < b),
+    Rlength (SubEqui del h) = S (S (max_N del h)).
+Proof.
+  intros; unfold SubEqui in |- *; apply SubEqui_P3.
 Qed.
 
 Lemma SubEqui_P6 :
- forall (a b:R) (del:posreal) (h:a < b) (i:nat),
-   (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del.
-intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption.
+  forall (a b:R) (del:posreal) (h:a < b) (i:nat),
+    (i < S (max_N del h))%nat -> pos_Rl (SubEqui del h) i = a + INR i * del.
+Proof.
+  intros; unfold SubEqui in |- *; apply SubEqui_P4; assumption.
 Qed.
 
 Lemma SubEqui_P7 :
- forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h).
-intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H;
- simpl in H; inversion H.
-rewrite (SubEqui_P6 del h (i:=(max_N del h))).
-replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
-rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left;
- 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 Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r;
- pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l; rewrite Rmult_1_l; left; 
- apply (cond_pos del).
+  forall (a b:R) (del:posreal) (h:a < b), ordered_Rlist (SubEqui del h).
+Proof.
+  intros; unfold ordered_Rlist in |- *; intros; rewrite SubEqui_P5 in H;
+    simpl in H; inversion H.
+  rewrite (SubEqui_P6 del h (i:=(max_N del h))).
+  replace (S (max_N del h)) with (pred (Rlength (SubEqui del h))).
+  rewrite SubEqui_P2; unfold max_N in |- *; case (maxN del h); intros; left;
+    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 Rplus_le_compat_l; rewrite S_INR; rewrite Rmult_plus_distr_r;
+    pattern (INR i * del) at 1 in |- *; rewrite <- Rplus_0_r;
+      apply Rplus_le_compat_l; rewrite Rmult_1_l; left; 
+        apply (cond_pos del).
 Qed.
 
 Lemma SubEqui_P8 :
- forall (a b:R) (del:posreal) (h:a < b) (i:nat),
-   (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b.
-intros; split.
-pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5.
-apply SubEqui_P7.
-elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1;
- exists i; split; [ reflexivity | assumption ].
-pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7;
- [ apply SubEqui_P7
- | elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros;
-    apply H1; exists i; split; [ reflexivity | assumption ] ].
+  forall (a b:R) (del:posreal) (h:a < b) (i:nat),
+    (i < Rlength (SubEqui del h))%nat -> a <= pos_Rl (SubEqui del h) i <= b.
+Proof.
+  intros; split.
+  pattern a at 1 in |- *; rewrite <- (SubEqui_P1 del h); apply RList_P5.
+  apply SubEqui_P7.
+  elim (RList_P3 (SubEqui del h) (pos_Rl (SubEqui del h) i)); intros; apply H1;
+    exists i; split; [ reflexivity | assumption ].
+  pattern b at 2 in |- *; rewrite <- (SubEqui_P2 del h); apply RList_P7;
+    [ 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 :
- forall (a b:R) (del:posreal) (f:R -> R) (h:a < b),
-   sigT
-     (fun g:StepFun a b =>
-        g b = f b /\
-        (forall i:nat,
-           (i < pred (Rlength (SubEqui del h)))%nat ->
-           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 ].
+  forall (a b:R) (del:posreal) (f:R -> R) (h:a < b),
+    sigT
+    (fun g:StepFun a b =>
+      g b = f b /\
+      (forall i:nat,
+        (i < pred (Rlength (SubEqui del h)))%nat ->
+        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)))).
+Proof.
+  intros; apply StepFun_P38;
+    [ apply SubEqui_P7 | apply SubEqui_P1 | apply SubEqui_P2 ].
 Qed.
 
 Lemma RiemannInt_P6 :
- forall (f:R -> R) (a b:R),
-   a < b ->
-   (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
-intros; unfold Riemann_integrable in |- *; intro;
- assert (H1 : 0 < eps / (2 * (b - a))).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps)
- | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
-    [ prove_sup0 | apply Rlt_Rminus; assumption ] ].
-assert (H2 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; left; assumption ].
-assert (H3 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; left; assumption ].
-elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4;
- elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi;
- split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); 
- split.
-2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-2: rewrite Rmult_1_r; rewrite Rabs_right.
-2: apply Rmult_lt_reg_l with 2.
-2: prove_sup0.
-2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+  forall (f:R -> R) (a b:R),
+    a < b ->
+    (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
+Proof.
+  intros; unfold Riemann_integrable in |- *; intro;
+    assert (H1 : 0 < eps / (2 * (b - a))).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos eps)
+      | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+        [ prove_sup0 | apply Rlt_Rminus; assumption ] ].
+  assert (H2 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; left; assumption ].
+  assert (H3 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; left; assumption ].
+  elim (Heine_cor2 H0 (mkposreal _ H1)); intros del H4;
+    elim (SubEqui_P9 del f H); intros phi [H5 H6]; split with phi;
+      split with (mkStepFun (StepFun_P4 a b (eps / (2 * (b - a))))); 
+        split.
+  2: rewrite StepFun_P18; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  2: do 2 rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  2: rewrite Rmult_1_r; rewrite Rabs_right.
+  2: apply Rmult_lt_reg_l with 2.
+  2: prove_sup0.
+  2: rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
     rewrite <- Rinv_r_sym.
-2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+  2: rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
     rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
-2: discrR.
-2: apply Rle_ge; left; apply Rmult_lt_0_compat.
-2: apply (cond_pos eps).
-2: apply Rinv_0_lt_compat; prove_sup0.
-2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+  2: discrR.
+  2: apply Rle_ge; left; apply Rmult_lt_0_compat.
+  2: apply (cond_pos eps).
+  2: apply Rinv_0_lt_compat; prove_sup0.
+  2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
     elim (Rlt_irrefl _ H).
-2: discrR.
-2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
+  2: discrR.
+  2: apply Rminus_eq_contra; red in |- *; intro; clear H6; rewrite H7 in H;
     elim (Rlt_irrefl _ H).
-intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *;
- unfold fct_cte in |- *;
- cut
-  (forall t:R,
-     a <= t <= b ->
-     t = b \/
-     (exists i : nat,
-        (i < pred (Rlength (SubEqui del H)))%nat /\
-        co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i))
-          t)).
-intro; elim (H8 _ H7); intro.
-rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; left; assumption.
-elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10);
- rewrite H11; left; apply H4.
-assumption.
-apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))).
-assumption.
-apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9;
- elim (lt_n_O _ H9).
-unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right.
-rewrite SubEqui_P5 in H9; simpl in H9; inversion H9.
-apply Rplus_lt_reg_r 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 in |- *; case (maxN del H); intros; elim a0; clear a0;
- intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del);
- [ assumption | rewrite S_INR; ring ].
-apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I);
- 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_ge; assumption.
-intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro.
-left; assumption.
-right; set (I := fun j:nat => a + INR j * del <= t0);
- assert (H1 :  exists n : nat, I n).
-exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8;
- intros; assumption.
-assert (H4 : Nbound I).
-unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *;
- case (maxN del H); intros; elim a0; clear a0; intros _ H5; 
- apply INR_le; apply Rmult_le_reg_l with (pos del).
-apply (cond_pos del).
-apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm 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 : (N < S (max_N del H))%nat).
-unfold max_N in |- *; case (maxN del H); intros; apply INR_lt;
- apply Rmult_lt_reg_l with (pos del).
-apply (cond_pos del).
-apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del);
- 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 in |- *; assumption.
-unfold co_interval in |- *; 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 (Rle_dec (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.
+  intros; rewrite H2 in H7; rewrite H3 in H7; simpl in |- *;
+    unfold fct_cte in |- *;
+      cut
+        (forall t:R,
+          a <= t <= b ->
+          t = b \/
+          (exists i : nat,
+            (i < pred (Rlength (SubEqui del H)))%nat /\
+            co_interval (pos_Rl (SubEqui del H) i) (pos_Rl (SubEqui del H) (S i))
+            t)).
+  intro; elim (H8 _ H7); intro.
+  rewrite H9; rewrite H5; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; left; assumption.
+  elim H9; clear H9; intros I [H9 H10]; assert (H11 := H6 I H9 t H10);
+    rewrite H11; left; apply H4.
+  assumption.
+  apply SubEqui_P8; apply lt_trans with (pred (Rlength (SubEqui del H))).
+  assumption.
+  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H9;
+    elim (lt_n_O _ H9).
+  unfold co_interval in H10; elim H10; clear H10; intros; rewrite Rabs_right.
+  rewrite SubEqui_P5 in H9; simpl in H9; inversion H9.
+  apply Rplus_lt_reg_r 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 in |- *; case (maxN del H); intros; elim a0; clear a0;
+    intros _ H13; replace (a + INR x * del + del) with (a + INR (S x) * del);
+      [ assumption | rewrite S_INR; ring ].
+  apply Rplus_lt_reg_r with (pos_Rl (SubEqui del H) I);
+    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_ge; assumption.
+  intros; clear H0 H1 H4 phi H5 H6 t H7; case (Req_dec t0 b); intro.
+  left; assumption.
+  right; set (I := fun j:nat => a + INR j * del <= t0);
+    assert (H1 :  exists n : nat, I n).
+  exists 0%nat; unfold I in |- *; rewrite Rmult_0_l; rewrite Rplus_0_r; elim H8;
+    intros; assumption.
+  assert (H4 : Nbound I).
+  unfold Nbound in |- *; exists (S (max_N del H)); intros; unfold max_N in |- *;
+    case (maxN del H); intros; elim a0; clear a0; intros _ H5; 
+      apply INR_le; apply Rmult_le_reg_l with (pos del).
+  apply (cond_pos del).
+  apply Rplus_le_reg_l with a; do 2 rewrite (Rmult_comm 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 : (N < S (max_N del H))%nat).
+  unfold max_N in |- *; case (maxN del H); intros; apply INR_lt;
+    apply Rmult_lt_reg_l with (pos del).
+  apply (cond_pos del).
+  apply Rplus_lt_reg_r with a; do 2 rewrite (Rmult_comm del);
+    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 in |- *; assumption.
+  unfold co_interval in |- *; 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 (Rle_dec (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 : forall (f:R -> R) (a:R), Riemann_integrable f a a.
-unfold Riemann_integrable in |- *; intro f; intros;
- split with (mkStepFun (StepFun_P4 a a (f a)));
- split with (mkStepFun (StepFun_P4 a a 0)); split.
-intros; simpl in |- *; unfold fct_cte in |- *; replace t with a.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
- reflexivity.
-generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0;
- intros; apply Rle_antisym; assumption.
-rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps).
+Proof.
+  unfold Riemann_integrable in |- *; intro f; intros;
+    split with (mkStepFun (StepFun_P4 a a (f a)));
+      split with (mkStepFun (StepFun_P4 a a 0)); split.
+  intros; simpl in |- *; unfold fct_cte in |- *; replace t with a.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; right;
+    reflexivity.
+  generalize H; unfold Rmin, Rmax in |- *; case (Rle_dec a a); intros; elim H0;
+    intros; apply Rle_antisym; assumption.
+  rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0; apply (cond_pos eps).
 Qed.
 
 Lemma continuity_implies_RiemannInt :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall 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_irrefl _ (Rle_lt_trans _ _ _ H r)) ].
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall x:R, a <= x <= b -> continuity_pt f x) -> Riemann_integrable f a b.
+Proof.
+  intros; case (total_order_T a b); intro;
+    [ elim s; intro;
+      [ apply RiemannInt_P6; assumption | rewrite b0; apply RiemannInt_P7 ]
+      | elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)) ].
 Qed.
 
 Lemma RiemannInt_P8 :
- forall (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 in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv);
- intros; apply u.
-unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv);
- intros;
- cut
-  (exists psi1 : nat -> StepFun a b,
-     (forall n:nat,
+  forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable f b a), RiemannInt pr1 = - RiemannInt pr2.
+Proof.
+  intro f; intros; eapply UL_sequence.
+  unfold RiemannInt in |- *; case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    intros; apply u.
+  unfold RiemannInt in |- *; case (RiemannInt_exists pr2 RinvN RinvN_cv);
+    intros;
+      cut
+        (exists psi1 : nat -> StepFun a b,
+          (forall n:nat,
+            (forall t:R,
+              Rmin a b <= t /\ t <= Rmax a b ->
+              Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+            Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+  cut
+    (exists psi2 : nat -> StepFun b a,
+      (forall n:nat,
         (forall t:R,
-           Rmin a b <= t /\ t <= Rmax a b ->
-           Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
-        Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
-cut
- (exists psi2 : nat -> StepFun b a,
-    (forall n:nat,
-       (forall t:R,
           Rmin a b <= t /\ t <= Rmax a b ->
           Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0;
- assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros;
- assert (H3 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1;
- unfold R_dist in H1; simpl in H1;
- assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
-intros; assert (H5 := H1 _ H4);
- replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0));
- [ assumption
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    left; apply (cond_pos (RinvN n)) ].
-clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1;
- exists (max N0 N1); intros; unfold R_dist in |- *;
- apply Rle_lt_trans with
-  (Rabs
-     (RiemannInt_SF (phi_sequence RinvN pr1 n) +
-      RiemannInt_SF (phi_sequence RinvN pr2 n)) +
-   Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
-rewrite <- (Rabs_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 Rabs_triang | ring ].
-replace eps with (2 * (eps / 3) + eps / 3).
-apply Rplus_lt_compat.
-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 (Rle_dec 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 in |- *; rewrite Rmult_1_l;
- apply Rle_trans with
-  (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
-   Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
-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 Rabs_triang | ring ].
-assert (H7 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H8 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-apply Rplus_le_compat.
-elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_1_l; rewrite double; apply Rplus_lt_compat.
-elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
- [ apply RRle_abs
- | apply Rlt_trans with (pos (RinvN n));
-    [ assumption
-    | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
-       [ apply le_max_l | assumption ] ] ].
-elim (H n); intros;
- rewrite <-
-  (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n))))))
-  ; rewrite <- StepFun_P39;
- apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
- [ rewrite <- Rabs_Ropp; apply RRle_abs
- | apply Rlt_trans with (pos (RinvN n));
+        Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  intros; elim H; clear H; intros psi2 H; elim H0; clear H0; intros psi1 H0;
+    assert (H1 := RinvN_cv); unfold Un_cv in |- *; intros;
+      assert (H3 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  unfold Un_cv in H1; elim (H1 _ H3); clear H1; intros N0 H1;
+    unfold R_dist in H1; simpl in H1;
+      assert (H4 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
+  intros; assert (H5 := H1 _ H4);
+    replace (pos (RinvN n)) with (Rabs (/ (INR n + 1) - 0));
     [ assumption
-    | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
-       [ apply le_max_l | assumption ] ] ].
-assert (Hyp : b <= a).
-auto with real.
-rewrite StepFun_P39; rewrite Rabs_Ropp;
- apply Rle_lt_trans with
-  (RiemannInt_SF
-     (mkStepFun
+      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+        left; apply (cond_pos (RinvN n)) ].
+  clear H1; unfold Un_cv in u; elim (u _ H3); clear u; intros N1 H1;
+    exists (max N0 N1); intros; unfold R_dist in |- *;
+      apply Rle_lt_trans with
+        (Rabs
+          (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+            RiemannInt_SF (phi_sequence RinvN pr2 n)) +
+          Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
+  rewrite <- (Rabs_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 Rabs_triang | ring ].
+  replace eps with (2 * (eps / 3) + eps / 3).
+  apply Rplus_lt_compat.
+  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 (Rle_dec a b); intro.
+  apply Rle_lt_trans with
+    (RiemannInt_SF
+      (mkStepFun
         (StepFun_P32
-           (mkStepFun
+          (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 in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with
+      (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
+        Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
+  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 Rabs_triang | ring ].
+  assert (H7 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H8 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  apply Rplus_le_compat.
+  elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_1_l; rewrite double; apply Rplus_lt_compat.
+  elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+    [ apply RRle_abs
+      | apply Rlt_trans with (pos (RinvN n));
+        [ assumption
+          | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+            [ apply le_max_l | assumption ] ] ].
+  elim (H n); intros;
+    rewrite <-
+      (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi2 n))))))
+      ; rewrite <- StepFun_P39;
+        apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+          [ rewrite <- Rabs_Ropp; apply RRle_abs
+            | apply Rlt_trans with (pos (RinvN n));
+              [ assumption
+                | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+                  [ apply le_max_l | assumption ] ] ].
+  assert (Hyp : b <= a).
+  auto with real.
+  rewrite StepFun_P39; rewrite Rabs_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 in |- *; rewrite Rmult_1_l;
- apply Rle_trans with
-  (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
-   Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
-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 Rabs_triang | ring ].
-assert (H7 : Rmin a b = b).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
-assert (H8 : Rmax a b = a).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ elim n0; assumption | reflexivity ].
-apply Rplus_le_compat.
-elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_1_l; rewrite double; apply Rplus_lt_compat.
-elim (H0 n); intros;
- rewrite <-
-  (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n))))))
-  ; rewrite <- StepFun_P39;
- apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
- [ rewrite <- Rabs_Ropp; apply RRle_abs
- | apply Rlt_trans with (pos (RinvN n));
-    [ assumption
-    | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
-       [ apply le_max_l | assumption ] ] ].
-elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
- [ apply RRle_abs
- | apply Rlt_trans with (pos (RinvN n));
-    [ assumption
-    | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
-       [ apply le_max_l | assumption ] ] ].
-unfold R_dist in H1; apply H1; unfold ge in |- *;
- apply le_trans with (max N0 N1); [ apply le_max_r | assumption ].
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ].
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
- rewrite Rmin_comm; rewrite RmaxSym;
- apply (projT2 (phi_sequence_prop RinvN pr2 n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr1 n)).
+                (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 in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with
+      (Rabs (phi_sequence RinvN pr1 n x0 - f x0) +
+        Rabs (f x0 - phi_sequence RinvN pr2 n x0)).
+  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 Rabs_triang | ring ].
+  assert (H7 : Rmin a b = b).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ elim n0; assumption | reflexivity ].
+  assert (H8 : Rmax a b = a).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ elim n0; assumption | reflexivity ].
+  apply Rplus_le_compat.
+  elim (H0 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; 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_1_l; rewrite double; apply Rplus_lt_compat.
+  elim (H0 n); intros;
+    rewrite <-
+      (Ropp_involutive (RiemannInt_SF (mkStepFun (StepFun_P6 (pre (psi1 n))))))
+      ; rewrite <- StepFun_P39;
+        apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+          [ rewrite <- Rabs_Ropp; apply RRle_abs
+            | apply Rlt_trans with (pos (RinvN n));
+              [ assumption
+                | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+                  [ apply le_max_l | assumption ] ] ].
+  elim (H n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+    [ apply RRle_abs
+      | apply Rlt_trans with (pos (RinvN n));
+        [ assumption
+          | apply H4; unfold ge in |- *; apply le_trans with (max N0 N1);
+            [ apply le_max_l | assumption ] ] ].
+  unfold R_dist in H1; apply H1; unfold ge in |- *;
+    apply le_trans with (max N0 N1); [ apply le_max_r | assumption ].
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ].
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+    rewrite Rmin_comm; rewrite RmaxSym;
+      apply (projT2 (phi_sequence_prop RinvN pr2 n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr1 n)).
 Qed.
 
 Lemma RiemannInt_P9 :
- forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0.
-intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2;
- [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *;
-    rewrite H; apply Rplus_opp_r
- | discrR ].
+  forall (f:R -> R) (a:R) (pr:Riemann_integrable f a a), RiemannInt pr = 0.
+Proof.
+  intros; assert (H := RiemannInt_P8 pr pr); apply Rmult_eq_reg_l with 2;
+    [ rewrite Rmult_0_r; rewrite double; pattern (RiemannInt pr) at 2 in |- *;
+      rewrite H; apply Rplus_opp_r
+      | discrR ].
 Qed.
 
 Lemma Req_EM_T : forall r1 r2:R, {r1 = r2} + {r1 <> r2}.
-intros; elim (total_order_T r1 r2); intros;
- [ elim a; intro;
-    [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
-    | left; assumption ]
- | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
+Proof.
+  intros; elim (total_order_T r1 r2); intros;
+    [ elim a; intro;
+      [ right; red in |- *; intro; rewrite H in a0; elim (Rlt_irrefl r2 a0)
+        | left; assumption ]
+      | right; red in |- *; intro; rewrite H in b; elim (Rlt_irrefl r2 b) ].
 Qed.
 
 (* L1([a,b]) is a vectorial space *)
 Lemma RiemannInt_P10 :
- forall (f g:R -> R) (a b l:R),
-   Riemann_integrable f a b ->
-   Riemann_integrable g a b ->
-   Riemann_integrable (fun x:R => f x + l * g x) a b.
-unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0);
- intro.
-elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0;
- intros; split; try assumption; rewrite e; intros; 
- rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption.
-assert (H : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
-assert (H0 : 0 < eps / (2 * Rabs l)).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps)
- | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
-    [ prove_sup0 | apply Rabs_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 (Rabs l) x1 x2)); 
- elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split.
-intros; simpl in |- *;
- apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))).
-replace (f t + l * g t - (x t + l * x0 t)) with
- (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ].
-apply Rplus_le_compat;
- [ apply H3; assumption
- | rewrite Rabs_mult; apply Rmult_le_compat_l;
-    [ apply Rabs_pos | apply H1; assumption ] ].
-rewrite StepFun_P30;
- apply Rle_lt_trans with
-  (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)).
-apply Rabs_triang.
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply H4.
-rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym;
- [ rewrite Rmult_1_l;
-    replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l));
-    [ apply H2
-    | unfold Rdiv in |- *; rewrite Rinv_mult_distr;
-       [ ring | discrR | apply Rabs_no_R0; assumption ] ]
- | apply Rabs_no_R0; assumption ].
+  forall (f g:R -> R) (a b l:R),
+    Riemann_integrable f a b ->
+    Riemann_integrable g a b ->
+    Riemann_integrable (fun x:R => f x + l * g x) a b.
+Proof.
+  unfold Riemann_integrable in |- *; intros f g; intros; case (Req_EM_T l 0);
+    intro.
+  elim (X eps); intros; split with x; elim p; intros; split with x0; elim p0;
+    intros; split; try assumption; rewrite e; intros; 
+      rewrite Rmult_0_l; rewrite Rplus_0_r; apply H; assumption.
+  assert (H : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+  assert (H0 : 0 < eps / (2 * Rabs l)).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos eps)
+      | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+        [ prove_sup0 | apply Rabs_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 (Rabs l) x1 x2)); 
+        elim p1; elim p2; clear p1 p2 p0 p X X0; intros; split.
+  intros; simpl in |- *;
+    apply Rle_trans with (Rabs (f t - x t) + Rabs (l * (g t - x0 t))).
+  replace (f t + l * g t - (x t + l * x0 t)) with
+  (f t - x t + l * (g t - x0 t)); [ apply Rabs_triang | ring ].
+  apply Rplus_le_compat;
+    [ apply H3; assumption
+      | rewrite Rabs_mult; apply Rmult_le_compat_l;
+        [ apply Rabs_pos | apply H1; assumption ] ].
+  rewrite StepFun_P30;
+    apply Rle_lt_trans with
+      (Rabs (RiemannInt_SF x1) + Rabs (Rabs l * RiemannInt_SF x2)).
+  apply Rabs_triang.
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply H4.
+  rewrite Rabs_mult; rewrite Rabs_Rabsolu; apply Rmult_lt_reg_l with (/ Rabs l).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym;
+    [ rewrite Rmult_1_l;
+      replace (/ Rabs l * (eps / 2)) with (eps / (2 * Rabs l));
+      [ apply H2
+        | unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+          [ ring | discrR | apply Rabs_no_R0; assumption ] ]
+      | apply Rabs_no_R0; assumption ].
 Qed.
 
 Lemma RiemannInt_P11 :
- forall (f:R -> R) (a b l:R) (un:nat -> posreal)
-   (phi1 phi2 psi1 psi2:nat -> StepFun a b),
-   Un_cv un 0 ->
-   (forall n:nat,
+  forall (f:R -> R) (a b l:R) (un:nat -> posreal)
+    (phi1 phi2 psi1 psi2:nat -> StepFun a b),
+    Un_cv un 0 ->
+    (forall n:nat,
       (forall t:R,
-         Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\
+        Rmin a b <= t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi1 n t) /\
       Rabs (RiemannInt_SF (psi1 n)) < un n) ->
-   (forall n:nat,
+    (forall n:nat,
       (forall t:R,
-         Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\
+        Rmin a b <= t <= Rmax a b -> Rabs (f t - phi2 n t) <= psi2 n t) /\
       Rabs (RiemannInt_SF (psi2 n)) < un n) ->
-   Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l ->
-   Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l.
-unfold Un_cv in |- *; intro f; intros; intros.
-case (Rle_dec a b); intro Hyp.
-assert (H4 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H _ H4); clear H; intros N0 H.
-elim (H2 _ H4); clear H2; intros N1 H2.
-set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
-apply Rle_lt_trans with
- (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
-  Rabs (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 Rabs_triang | ring ].
-replace eps with (2 * (eps / 3) + eps / 3).
-apply Rplus_lt_compat.
-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 1 (psi1 n) (psi2 n)))).
-apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l.
-apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
-replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
- [ apply Rabs_triang | ring ].
-rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
-assert (H10 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H11 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
-elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H11 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
-rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
-apply Rlt_trans with (pos (un n)).
-elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
-apply RRle_abs.
-assumption.
-replace (pos (un n)) with (R_dist (un n) 0).
-apply H; unfold ge in |- *; apply le_trans with N; try assumption.
-unfold N in |- *; apply le_max_l.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply Rabs_right.
-apply Rle_ge; left; apply (cond_pos (un n)).
-apply Rlt_trans with (pos (un n)).
-elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
-apply RRle_abs; assumption.
-assumption.
-replace (pos (un n)) with (R_dist (un n) 0).
-apply H; unfold ge in |- *; apply le_trans with N; try assumption;
- unfold N in |- *; apply le_max_l.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
- left; apply (cond_pos (un n)).
-unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
- try assumption; unfold N in |- *; apply le_max_r.
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ].
-assert (H4 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H _ H4); clear H; intros N0 H.
-elim (H2 _ H4); clear H2; intros N1 H2.
-set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
-apply Rle_lt_trans with
- (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
-  Rabs (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 Rabs_triang | ring ].
-assert (Hyp_b : b <= a).
-auto with real.
-replace eps with (2 * (eps / 3) + eps / 3).
-apply Rplus_lt_compat.
-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 Rabs_Ropp.
-apply Rle_lt_trans with
- (RiemannInt_SF
-    (mkStepFun
-       (StepFun_P32
+    Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) l ->
+    Un_cv (fun N:nat => RiemannInt_SF (phi2 N)) l.
+Proof.
+  unfold Un_cv in |- *; intro f; intros; intros.
+  case (Rle_dec a b); intro Hyp.
+  assert (H4 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H _ H4); clear H; intros N0 H.
+  elim (H2 _ H4); clear H2; intros N1 H2.
+  set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+  apply Rle_lt_trans with
+    (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
+      Rabs (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 Rabs_triang | ring ].
+  replace eps with (2 * (eps / 3) + eps / 3).
+  apply Rplus_lt_compat.
+  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 1 (psi1 n) (psi2 n)))).
+  apply StepFun_P37; try assumption; intros; simpl in |- *; rewrite Rmult_1_l.
+  apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
+  replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
+  [ apply Rabs_triang | ring ].
+  rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
+  assert (H10 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H11 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+  elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H11 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+  rewrite StepFun_P30; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat.
+  apply Rlt_trans with (pos (un n)).
+  elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+  apply RRle_abs.
+  assumption.
+  replace (pos (un n)) with (R_dist (un n) 0).
+  apply H; unfold ge in |- *; apply le_trans with N; try assumption.
+  unfold N in |- *; apply le_max_l.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply Rabs_right.
+  apply Rle_ge; left; apply (cond_pos (un n)).
+  apply Rlt_trans with (pos (un n)).
+  elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+  apply RRle_abs; assumption.
+  assumption.
+  replace (pos (un n)) with (R_dist (un n) 0).
+  apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+    unfold N in |- *; apply le_max_l.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
+      left; apply (cond_pos (un n)).
+  unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
+    try assumption; unfold N in |- *; apply le_max_r.
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ].
+  assert (H4 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H _ H4); clear H; intros N0 H.
+  elim (H2 _ H4); clear H2; intros N1 H2.
+  set (N := max N0 N1); exists N; intros; unfold R_dist in |- *.
+  apply Rle_lt_trans with
+    (Rabs (RiemannInt_SF (phi2 n) - RiemannInt_SF (phi1 n)) +
+      Rabs (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 Rabs_triang | ring ].
+  assert (Hyp_b : b <= a).
+  auto with real.
+  replace eps with (2 * (eps / 3) + eps / 3).
+  apply Rplus_lt_compat.
+  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 Rabs_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 1 (psi1 n) (psi2 n))))))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; rewrite Rmult_1_l.
-apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
-replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
- [ apply Rabs_triang | ring ].
-rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
-assert (H10 : Rmin a b = b).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ elim Hyp; assumption | reflexivity ].
-assert (H11 : Rmax a b = a).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ elim Hyp; assumption | reflexivity ].
-rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
-elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ elim Hyp; assumption | reflexivity ].
-assert (H11 : Rmax a b = a).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ elim Hyp; assumption | reflexivity ].
-rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
-rewrite <-
- (Ropp_involutive
+            (StepFun_P6
+              (pre (mkStepFun (StepFun_P28 (-1) (phi2 n) (phi1 n))))))))).
+  apply StepFun_P34; try assumption.
+  apply Rle_lt_trans with
     (RiemannInt_SF
-       (mkStepFun
+      (mkStepFun
+        (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; rewrite Rmult_1_l.
+  apply Rle_trans with (Rabs (phi2 n x - f x) + Rabs (f x - phi1 n x)).
+  replace (phi2 n x + -1 * phi1 n x) with (phi2 n x - f x + (f x - phi1 n x));
+  [ apply Rabs_triang | ring ].
+  rewrite (Rplus_comm (psi1 n x)); apply Rplus_le_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; elim (H1 n); intros; apply H7.
+  assert (H10 : Rmin a b = b).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ elim Hyp; assumption | reflexivity ].
+  assert (H11 : Rmax a b = a).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ elim Hyp; assumption | reflexivity ].
+  rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+  elim (H0 n); intros; apply H7; assert (H10 : Rmin a b = b).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ elim Hyp; assumption | reflexivity ].
+  assert (H11 : Rmax a b = a).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ elim Hyp; assumption | reflexivity ].
+  rewrite H10; rewrite H11; elim H6; intros; split; left; assumption.
+  rewrite <-
+    (Ropp_involutive
+      (RiemannInt_SF
+        (mkStepFun
           (StepFun_P6 (pre (mkStepFun (StepFun_P28 1 (psi1 n) (psi2 n))))))))
- .
-rewrite <- StepFun_P39.
-rewrite StepFun_P30.
-rewrite Rmult_1_l; rewrite double.
-rewrite Ropp_plus_distr; apply Rplus_lt_compat.
-apply Rlt_trans with (pos (un n)).
-elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-assumption.
-replace (pos (un n)) with (R_dist (un n) 0).
-apply H; unfold ge in |- *; apply le_trans with N; try assumption.
-unfold N in |- *; apply le_max_l.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply Rabs_right.
-apply Rle_ge; left; apply (cond_pos (un n)).
-apply Rlt_trans with (pos (un n)).
-elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
-rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
-assumption.
-replace (pos (un n)) with (R_dist (un n) 0).
-apply H; unfold ge in |- *; apply le_trans with N; try assumption;
- unfold N in |- *; apply le_max_l.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
- left; apply (cond_pos (un n)).
-unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
- try assumption; unfold N in |- *; apply le_max_r.
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ].
+    .
+  rewrite <- StepFun_P39.
+  rewrite StepFun_P30.
+  rewrite Rmult_1_l; rewrite double.
+  rewrite Ropp_plus_distr; apply Rplus_lt_compat.
+  apply Rlt_trans with (pos (un n)).
+  elim (H0 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  assumption.
+  replace (pos (un n)) with (R_dist (un n) 0).
+  apply H; unfold ge in |- *; apply le_trans with N; try assumption.
+  unfold N in |- *; apply le_max_l.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply Rabs_right.
+  apply Rle_ge; left; apply (cond_pos (un n)).
+  apply Rlt_trans with (pos (un n)).
+  elim (H1 n); intros; apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+  rewrite <- Rabs_Ropp; apply RRle_abs; assumption.
+  assumption.
+  replace (pos (un n)) with (R_dist (un n) 0).
+  apply H; unfold ge in |- *; apply le_trans with N; try assumption;
+    unfold N in |- *; apply le_max_l.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
+      left; apply (cond_pos (un n)).
+  unfold R_dist in H2; apply H2; unfold ge in |- *; apply le_trans with N;
+    try assumption; unfold N in |- *; apply le_max_r.
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 3); repeat rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ].
 Qed.
 
 Lemma RiemannInt_P12 :
- forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
-   (pr2:Riemann_integrable g a b)
-   (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
-   a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
-intro f; intros; case (Req_dec l 0); intro.
-pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
- unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
- case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; 
- eapply UL_sequence;
- [ apply u0
- | set (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n));
-    set (psi2 := fun 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 :
-         (forall t:R,
-            Rmin a b <= t /\ t <= Rmax a b ->
-            Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\
-         Rabs (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 in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
- intros; apply u.
-unfold Un_cv in |- *; intros; unfold RiemannInt in |- *;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; 
- intros; assert (H2 : 0 < eps / 5).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv);
- unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4;
- assert (H5 : 0 < eps / (5 * Rabs l)). 
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption
- | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
-    [ prove_sup0 | apply Rabs_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; set (N := max (max N0 N1) (max N2 N3)).
-assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5).
-intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
- [ unfold RinvN in |- *; apply H4; assumption
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    left; apply (cond_pos (RinvN n)) ].
-clear H4; assert (H4 := H7); clear H7;
- assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)).
-intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
- [ unfold RinvN in |- *; apply H5; assumption
- | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
-    left; apply (cond_pos (RinvN n)) ].
-clear H5; assert (H5 := H7); clear H7; exists N; intros;
- unfold R_dist in |- *.
-apply Rle_lt_trans with
- (Rabs
-    (RiemannInt_SF (phi_sequence RinvN pr3 n) -
-     (RiemannInt_SF (phi_sequence RinvN pr1 n) +
-      l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
-  Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) +
-  Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
-apply Rle_trans with
- (Rabs
-    (RiemannInt_SF (phi_sequence RinvN pr3 n) -
-     (RiemannInt_SF (phi_sequence RinvN pr1 n) +
-      l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
-  Rabs
-    (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 Rabs_triang | ring ].
-rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_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 Rabs_triang | ring ].
-replace eps with (3 * (eps / 5) + eps / 5 + eps / 5).
-repeat apply Rplus_lt_compat.
-assert
- (H7 :
-   exists psi1 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b ->
-          Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
-       Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr1 n0)).
-assert
- (H8 :
-   exists psi2 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b ->
-          Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr2 n0)).
-assert
- (H9 :
-   exists psi3 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b ->
-          Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
-       Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
-split with (fun 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
+  forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable g a b)
+    (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
+    a <= b -> RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
+Proof.
+  intro f; intros; case (Req_dec l 0); intro.
+  pattern l at 2 in |- *; rewrite H0; rewrite Rmult_0_l; rewrite Rplus_0_r;
+    unfold RiemannInt in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+      case (RiemannInt_exists pr1 RinvN RinvN_cv); intros; 
+        eapply UL_sequence;
+          [ apply u0
+            | set (psi1 := fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n));
+              set (psi2 := fun 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 :
+                          (forall t:R,
+                            Rmin a b <= t /\ t <= Rmax a b ->
+                            Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi2 n t) /\
+                          Rabs (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 in |- *; case (RiemannInt_exists pr3 RinvN RinvN_cv);
+    intros; apply u.
+  unfold Un_cv in |- *; intros; unfold RiemannInt in |- *;
+    case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    case (RiemannInt_exists pr2 RinvN RinvN_cv); unfold Un_cv in |- *; 
+      intros; assert (H2 : 0 < eps / 5).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (u0 _ H2); clear u0; intros N0 H3; assert (H4 := RinvN_cv);
+    unfold Un_cv in H4; elim (H4 _ H2); clear H4 H2; intros N1 H4;
+      assert (H5 : 0 < eps / (5 * Rabs l)). 
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption
+      | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+        [ prove_sup0 | apply Rabs_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; set (N := max (max N0 N1) (max N2 N3)).
+  assert (H7 : forall n:nat, (n >= N1)%nat -> RinvN n < eps / 5).
+  intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
+    [ unfold RinvN in |- *; apply H4; assumption
+      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+        left; apply (cond_pos (RinvN n)) ].
+  clear H4; assert (H4 := H7); clear H7;
+    assert (H7 : forall n:nat, (n >= N3)%nat -> RinvN n < eps / (5 * Rabs l)).
+  intros; replace (pos (RinvN n)) with (Rabs (RinvN n - 0));
+    [ unfold RinvN in |- *; apply H5; assumption
+      | unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply Rabs_right;
+        left; apply (cond_pos (RinvN n)) ].
+  clear H5; assert (H5 := H7); clear H7; exists N; intros;
+    unfold R_dist in |- *.
+  apply Rle_lt_trans with
+    (Rabs
+      (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+        (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+          l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+      Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x0) +
+      Rabs l * Rabs (RiemannInt_SF (phi_sequence RinvN pr2 n) - x)).
+  apply Rle_trans with
+    (Rabs
+      (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+        (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+          l * RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+      Rabs
+      (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))) 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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-assert (H11 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ 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
+    (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 Rabs_triang | ring ].
+  rewrite Rplus_assoc; apply Rplus_le_compat_l; rewrite <- Rabs_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 Rabs_triang | ring ].
+  replace eps with (3 * (eps / 5) + eps / 5 + eps / 5).
+  repeat apply Rplus_lt_compat.
+  assert
+    (H7 :
+      exists psi1 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b ->
+            Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+          Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr1 n0)).
+  assert
+    (H8 :
+      exists psi2 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b ->
+            Rabs (g t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
+          Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr2 n0)).
+  assert
+    (H9 :
+      exists psi3 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b ->
+            Rabs (f t + l * g t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
+          Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+  split with (fun 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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  assert (H11 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ 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 1 (psi3 n)
+                      (phi_sequence RinvN pr2 n)))))))).
+  apply StepFun_P34; assumption.
+  apply Rle_lt_trans with
+    (RiemannInt_SF
+      (mkStepFun
+        (StepFun_P28 1 (psi3 n)
           (mkStepFun (StepFun_P28 (Rabs l) (psi1 n) (psi2 n)))))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; rewrite Rmult_1_l.
-apply Rle_trans with
- (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) +
-  Rabs
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; rewrite Rmult_1_l.
+  apply Rle_trans with
+    (Rabs (phi_sequence RinvN pr3 n x1 - (f x1 + l * g x1)) +
+      Rabs
+      (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))).
-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 Rabs_triang | ring ].
-rewrite Rplus_assoc; apply Rplus_le_compat.
-elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
- apply H13.
-elim H12; intros; split; left; assumption. 
-apply Rle_trans with
- (Rabs (f x1 - phi_sequence RinvN pr1 n x1) +
-  Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)).
-rewrite <- Rabs_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 Rabs_triang | ring ].
-apply Rplus_le_compat.
-elim (H7 n); intros; apply H13.
-elim H12; intros; split; left; assumption.
-apply Rmult_le_compat_l;
- [ apply Rabs_pos
- | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ].
-do 2 rewrite StepFun_P30; rewrite Rmult_1_l;
- replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5));
- [ repeat apply Rplus_lt_compat | ring ].
-apply Rlt_trans with (pos (RinvN n));
- [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n)));
-    [ apply RRle_abs | elim (H9 n); intros; assumption ]
- | apply H4; unfold ge in |- *; apply le_trans with N;
-    [ apply le_trans with (max N0 N1);
-       [ apply le_max_r | unfold N in |- *; apply le_max_l ]
-    | assumption ] ].
-apply Rlt_trans with (pos (RinvN n));
- [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
-    [ apply RRle_abs | elim (H7 n); intros; assumption ]
- | apply H4; unfold ge in |- *; apply le_trans with N;
-    [ apply le_trans with (max N0 N1);
-       [ apply le_max_r | unfold N in |- *; apply le_max_l ]
-    | assumption ] ].
-apply Rmult_lt_reg_l with (/ Rabs l).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
-apply Rlt_trans with (pos (RinvN n));
- [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
-    [ apply RRle_abs | elim (H8 n); intros; assumption ]
- | apply H5; unfold ge in |- *; apply le_trans with N;
-    [ apply le_trans with (max N2 N3);
-       [ apply le_max_r | unfold N in |- *; apply le_max_r ]
-    | assumption ] ].
-unfold Rdiv in |- *; rewrite Rinv_mult_distr;
- [ ring | discrR | apply Rabs_no_R0; assumption ].
-apply Rabs_no_R0; assumption.
-apply H3; unfold ge in |- *; apply le_trans with (max N0 N1);
- [ apply le_max_l
- | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ].
-apply Rmult_lt_reg_l with (/ Rabs l).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
-apply H6; unfold ge in |- *; apply le_trans with (max N2 N3);
- [ apply le_max_l
- | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ].
-unfold Rdiv in |- *; rewrite Rinv_mult_distr;
- [ ring | discrR | apply Rabs_no_R0; assumption ].
-apply Rabs_no_R0; assumption.
-apply Rmult_eq_reg_l with 5;
- [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l;
-    do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ]. 
+      -1 * (phi_sequence RinvN pr1 n x1 + l * phi_sequence RinvN pr2 n x1)));
+  [ apply Rabs_triang | ring ].
+  rewrite Rplus_assoc; apply Rplus_le_compat.
+  elim (H9 n); intros; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
+    apply H13.
+  elim H12; intros; split; left; assumption. 
+  apply Rle_trans with
+    (Rabs (f x1 - phi_sequence RinvN pr1 n x1) +
+      Rabs l * Rabs (g x1 - phi_sequence RinvN pr2 n x1)).
+  rewrite <- Rabs_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 Rabs_triang | ring ].
+  apply Rplus_le_compat.
+  elim (H7 n); intros; apply H13.
+  elim H12; intros; split; left; assumption.
+  apply Rmult_le_compat_l;
+    [ apply Rabs_pos
+      | elim (H8 n); intros; apply H13; elim H12; intros; split; left; assumption ].
+  do 2 rewrite StepFun_P30; rewrite Rmult_1_l;
+    replace (3 * (eps / 5)) with (eps / 5 + (eps / 5 + eps / 5));
+    [ repeat apply Rplus_lt_compat | ring ].
+  apply Rlt_trans with (pos (RinvN n));
+    [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n)));
+      [ apply RRle_abs | elim (H9 n); intros; assumption ]
+      | apply H4; unfold ge in |- *; apply le_trans with N;
+        [ apply le_trans with (max N0 N1);
+          [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+          | assumption ] ].
+  apply Rlt_trans with (pos (RinvN n));
+    [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n)));
+      [ apply RRle_abs | elim (H7 n); intros; assumption ]
+      | apply H4; unfold ge in |- *; apply le_trans with N;
+        [ apply le_trans with (max N0 N1);
+          [ apply le_max_r | unfold N in |- *; apply le_max_l ]
+          | assumption ] ].
+  apply Rmult_lt_reg_l with (/ Rabs l).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
+  apply Rlt_trans with (pos (RinvN n));
+    [ apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n)));
+      [ apply RRle_abs | elim (H8 n); intros; assumption ]
+      | apply H5; unfold ge in |- *; apply le_trans with N;
+        [ apply le_trans with (max N2 N3);
+          [ apply le_max_r | unfold N in |- *; apply le_max_r ]
+          | assumption ] ].
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+    [ ring | discrR | apply Rabs_no_R0; assumption ].
+  apply Rabs_no_R0; assumption.
+  apply H3; unfold ge in |- *; apply le_trans with (max N0 N1);
+    [ apply le_max_l
+      | apply le_trans with N; [ unfold N in |- *; apply le_max_l | assumption ] ].
+  apply Rmult_lt_reg_l with (/ Rabs l).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; replace (/ Rabs l * (eps / 5)) with (eps / (5 * Rabs l)).
+  apply H6; unfold ge in |- *; apply le_trans with (max N2 N3);
+    [ apply le_max_l
+      | apply le_trans with N; [ unfold N in |- *; apply le_max_r | assumption ] ].
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr;
+    [ ring | discrR | apply Rabs_no_R0; assumption ].
+  apply Rabs_no_R0; assumption.
+  apply Rmult_eq_reg_l with 5;
+    [ unfold Rdiv in |- *; do 2 rewrite Rmult_plus_distr_l;
+      do 3 rewrite (Rmult_comm 5); repeat rewrite Rmult_assoc;
+        rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ]. 
 Qed.
 
 Lemma RiemannInt_P13 :
- forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
-   (pr2:Riemann_integrable g a b)
-   (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
-   RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
-intros; case (Rle_dec a b); intro;
- [ apply RiemannInt_P12; assumption
- | assert (H : b <= a);
-    [ auto with real
-    | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3));
-       [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
-       replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2));
-       [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
-       replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1));
-       [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
-       rewrite
-        (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2)
-           (RiemannInt_P1 pr3) H); ring ] ].
+  forall (f g:R -> R) (a b l:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable g a b)
+    (pr3:Riemann_integrable (fun x:R => f x + l * g x) a b),
+    RiemannInt pr3 = RiemannInt pr1 + l * RiemannInt pr2.
+Proof.
+  intros; case (Rle_dec a b); intro;
+    [ apply RiemannInt_P12; assumption
+      | assert (H : b <= a);
+        [ auto with real
+          | replace (RiemannInt pr3) with (- RiemannInt (RiemannInt_P1 pr3));
+            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            replace (RiemannInt pr2) with (- RiemannInt (RiemannInt_P1 pr2));
+            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            replace (RiemannInt pr1) with (- RiemannInt (RiemannInt_P1 pr1));
+            [ idtac | symmetry  in |- *; apply RiemannInt_P8 ];
+            rewrite
+              (RiemannInt_P12 (RiemannInt_P1 pr1) (RiemannInt_P1 pr2)
+                (RiemannInt_P1 pr3) H); ring ] ].
 Qed.
 
 Lemma RiemannInt_P14 : forall a b c:R, Riemann_integrable (fct_cte c) a b.
-unfold Riemann_integrable in |- *; intros;
- split with (mkStepFun (StepFun_P4 a b c));
- split with (mkStepFun (StepFun_P4 a b 0)); split;
- [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
-    rewrite Rabs_R0; unfold fct_cte in |- *; right; 
-    reflexivity
- | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
-    apply (cond_pos eps) ].
+Proof.
+  unfold Riemann_integrable in |- *; intros;
+    split with (mkStepFun (StepFun_P4 a b c));
+      split with (mkStepFun (StepFun_P4 a b 0)); split;
+        [ intros; simpl in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+          rewrite Rabs_R0; unfold fct_cte in |- *; right; 
+            reflexivity
+          | rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
+            apply (cond_pos eps) ].
 Qed.
 
 Lemma RiemannInt_P15 :
- forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b),
-   RiemannInt pr = c * (b - a).
-intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv);
- intros; eapply UL_sequence.
-apply u.
-set (phi1 := fun N:nat => phi_sequence RinvN pr N);
- change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *;
- set (f := fct_cte c);
- assert
-  (H1 :
-    exists psi1 : nat -> StepFun a b,
-     (forall n:nat,
-        (forall t:R,
-           Rmin a b <= t /\ t <= Rmax a b ->
-           Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\
-        Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
-split with (fun 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;
- set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c));
- set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0));
- apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; 
- try assumption.
-apply RinvN_cv.
-intro; split.
-intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *;
- rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; 
- right; reflexivity.
-unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
- apply (cond_pos (RinvN n)).
-unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *;
- unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *;
- rewrite Rplus_opp_r; rewrite Rabs_R0; apply H.
+  forall (a b c:R) (pr:Riemann_integrable (fct_cte c) a b),
+    RiemannInt pr = c * (b - a).
+Proof.
+  intros; unfold RiemannInt in |- *; case (RiemannInt_exists pr RinvN RinvN_cv);
+    intros; eapply UL_sequence.
+  apply u.
+  set (phi1 := fun N:nat => phi_sequence RinvN pr N);
+    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) (c * (b - a))) in |- *;
+      set (f := fct_cte c);
+        assert
+          (H1 :
+            exists psi1 : nat -> StepFun a b,
+              (forall n:nat,
+                (forall t:R,
+                  Rmin a b <= t /\ t <= Rmax a b ->
+                  Rabs (f t - phi_sequence RinvN pr n t) <= psi1 n t) /\
+                Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+  split with (fun 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;
+    set (phi2 := fun n:nat => mkStepFun (StepFun_P4 a b c));
+      set (psi2 := fun n:nat => mkStepFun (StepFun_P4 a b 0));
+        apply RiemannInt_P11 with f RinvN phi2 psi2 psi1; 
+          try assumption.
+  apply RinvN_cv.
+  intro; split.
+  intros; unfold f in |- *; simpl in |- *; unfold Rminus in |- *;
+    rewrite Rplus_opp_r; rewrite Rabs_R0; unfold fct_cte in |- *; 
+      right; reflexivity.
+  unfold psi2 in |- *; rewrite StepFun_P18; rewrite Rmult_0_l; rewrite Rabs_R0;
+    apply (cond_pos (RinvN n)).
+  unfold Un_cv in |- *; intros; split with 0%nat; intros; unfold R_dist in |- *;
+    unfold phi2 in |- *; rewrite StepFun_P18; unfold Rminus in |- *;
+      rewrite Rplus_opp_r; rewrite Rabs_R0; apply H.
 Qed.
 
 Lemma RiemannInt_P16 :
- forall (f:R -> R) (a b:R),
-   Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b.
-unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X;
- intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi));
- split with psi; split; try assumption; intros; simpl in |- *;
- apply Rle_trans with (Rabs (f t - phi t));
- [ apply Rabs_triang_inv2 | apply H; assumption ].
+  forall (f:R -> R) (a b:R),
+    Riemann_integrable f a b -> Riemann_integrable (fun x:R => Rabs (f x)) a b.
+Proof.
+  unfold Riemann_integrable in |- *; intro f; intros; elim (X eps); clear X;
+    intros phi [psi [H H0]]; split with (mkStepFun (StepFun_P32 phi));
+      split with psi; split; try assumption; intros; simpl in |- *;
+        apply Rle_trans with (Rabs (f t - phi t));
+          [ apply Rabs_triang_inv2 | apply H; assumption ].
 Qed.
 
 Lemma Rle_cv_lim :
- forall (Un Vn:nat -> R) (l1 l2:R),
-   (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2.
-intros; case (Rle_dec l1 l2); intro.
-assumption.
-assert (H2 : l2 < l1).
-auto with real.
-clear n; assert (H3 : 0 < (l1 - l2) / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros;
- set (N := max x x0); cut (Vn N < Un N).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)).
-apply Rlt_trans with ((l1 + l2) / 2).
-apply Rplus_lt_reg_r with (- l2);
- replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2).
-rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)).
-apply RRle_abs.
-apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r.
-apply Rmult_eq_reg_l with 2;
- [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
-    rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2);
-    repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; 
-    [ ring | discrR ]
- | discrR ].
-apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1;
- replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2).
-apply Rle_lt_trans with (Rabs (Un N - l1)).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
-apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l.
-apply Rmult_eq_reg_l with 2;
- [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
-    rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2);
-    rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | discrR ]
- | discrR ].
+  forall (Un Vn:nat -> R) (l1 l2:R),
+    (forall n:nat, Un n <= Vn n) -> Un_cv Un l1 -> Un_cv Vn l2 -> l1 <= l2.
+Proof.
+  intros; case (Rle_dec l1 l2); intro.
+  assumption.
+  assert (H2 : l2 < l1).
+  auto with real.
+  clear n; assert (H3 : 0 < (l1 - l2) / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply Rlt_Rminus; assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H1 _ H3); elim (H0 _ H3); clear H0 H1; unfold R_dist in |- *; intros;
+    set (N := max x x0); cut (Vn N < Un N).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ (H N) H4)).
+  apply Rlt_trans with ((l1 + l2) / 2).
+  apply Rplus_lt_reg_r with (- l2);
+    replace (- l2 + (l1 + l2) / 2) with ((l1 - l2) / 2).
+  rewrite Rplus_comm; apply Rle_lt_trans with (Rabs (Vn N - l2)).
+  apply RRle_abs.
+  apply H1; unfold ge in |- *; unfold N in |- *; apply le_max_r.
+  apply Rmult_eq_reg_l with 2;
+    [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+      rewrite (Rmult_plus_distr_r (- l2) ((l1 + l2) * / 2) 2);
+        repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; 
+          [ ring | discrR ]
+      | discrR ].
+  apply Ropp_lt_cancel; apply Rplus_lt_reg_r with l1;
+    replace (l1 + - ((l1 + l2) / 2)) with ((l1 - l2) / 2).
+  apply Rle_lt_trans with (Rabs (Un N - l1)).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+  apply H0; unfold ge in |- *; unfold N in |- *; apply le_max_l.
+  apply Rmult_eq_reg_l with 2;
+    [ unfold Rdiv in |- *; do 2 rewrite (Rmult_comm 2);
+      rewrite (Rmult_plus_distr_r l1 (- ((l1 + l2) * / 2)) 2);
+        rewrite <- Ropp_mult_distr_l_reverse; repeat rewrite Rmult_assoc;
+          rewrite <- Rinv_l_sym; [ ring | discrR ]
+      | discrR ].
 Qed.
 
 Lemma RiemannInt_P17 :
- forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
-   (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b),
-   a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2.
-intro f; intros; unfold RiemannInt in |- *;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
- set (phi1 := phi_sequence RinvN pr1) in u0;
- set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N)));
- apply Rle_cv_lim with
-  (fun N:nat => Rabs (RiemannInt_SF (phi1 N)))
-  (fun N:nat => RiemannInt_SF (phi2 N)).
-intro; unfold phi2 in |- *; apply StepFun_P34; assumption.
- apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0);
- try assumption.
-apply Rcontinuity_abs.
-set (phi3 := phi_sequence RinvN pr2);
- assert
-  (H0 :
-    exists psi3 : nat -> StepFun a b,
-     (forall n:nat,
-        (forall t:R,
-           Rmin a b <= t /\ t <= Rmax a b ->
-           Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\
-        Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr2 n)). 
-assert
- (H1 :
-   exists psi2 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b ->
-          Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-assert
- (H1 :
-   exists psi2 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-split with (fun 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 in |- *; simpl in |- *;
- apply Rle_trans with (Rabs (f t - phi1 n t)).
-apply Rabs_triang_inv2.
-apply H1; assumption.
-elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1;
- apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2;
- try assumption; apply RinvN_cv.
+  forall (f:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable (fun x:R => Rabs (f x)) a b),
+    a <= b -> Rabs (RiemannInt pr1) <= RiemannInt pr2.
+Proof.
+  intro f; intros; unfold RiemannInt in |- *;
+    case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    case (RiemannInt_exists pr2 RinvN RinvN_cv); intros;
+      set (phi1 := phi_sequence RinvN pr1) in u0;
+        set (phi2 := fun N:nat => mkStepFun (StepFun_P32 (phi1 N)));
+          apply Rle_cv_lim with
+            (fun N:nat => Rabs (RiemannInt_SF (phi1 N)))
+            (fun N:nat => RiemannInt_SF (phi2 N)).
+  intro; unfold phi2 in |- *; apply StepFun_P34; assumption.
+  apply (continuity_seq Rabs (fun N:nat => RiemannInt_SF (phi1 N)) x0);
+    try assumption.
+  apply Rcontinuity_abs.
+  set (phi3 := phi_sequence RinvN pr2);
+    assert
+      (H0 :
+        exists psi3 : nat -> StepFun a b,
+          (forall n:nat,
+            (forall t:R,
+              Rmin a b <= t /\ t <= Rmax a b ->
+              Rabs (Rabs (f t) - phi3 n t) <= psi3 n t) /\
+            Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr2 n)). 
+  assert
+    (H1 :
+      exists psi2 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b ->
+            Rabs (Rabs (f t) - phi2 n t) <= psi2 n t) /\
+          Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  assert
+    (H1 :
+      exists psi2 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b -> Rabs (f t - phi1 n t) <= psi2 n t) /\
+          Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  split with (fun 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 in |- *; simpl in |- *;
+    apply Rle_trans with (Rabs (f t - phi1 n t)).
+  apply Rabs_triang_inv2.
+  apply H1; assumption.
+  elim H0; clear H0; intros psi3 H0; elim H1; clear H1; intros psi2 H1;
+    apply RiemannInt_P11 with (fun x:R => Rabs (f x)) RinvN phi3 psi3 psi2;
+      try assumption; apply RinvN_cv.
 Qed.
 
 Lemma RiemannInt_P18 :
- forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
-   (pr2:Riemann_integrable g a b),
-   a <= b ->
-   (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2.
-intro f; intros; unfold RiemannInt in |- *;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; 
- eapply UL_sequence.
-apply u0.
-set (phi1 := fun N:nat => phi_sequence RinvN pr1 N);
- change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *;
- assert
-  (H1 :
-    exists psi1 : nat -> StepFun a b,
-     (forall n:nat,
-        (forall t:R,
-           Rmin a b <= t /\ t <= Rmax a b ->
-           Rabs (f t - phi1 n t) <= psi1 n t) /\
-        Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
-split with (fun 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;
- set (phi2 := fun N:nat => phi_sequence RinvN pr2 N).
-set
- (phi2_aux :=
-  fun (N:nat) (x:R) =>
-    match Req_EM_T x a with
-    | left _ => f a
-    | right _ =>
-        match Req_EM_T x b with
-        | left _ => f b
-        | right _ => phi2 N x
-        end
-    end).
-cut (forall N:nat, IsStepFun (phi2_aux N) a b).
-intro; set (phi2_m := fun N:nat => mkStepFun (X N)).
-assert
- (H2 :
-   exists psi2 : nat -> StepFun a b,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-split with (fun 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 in |- *; simpl in |- *; unfold phi2_aux in |- *;
- case (Req_EM_T t a); case (Req_EM_T t b); intros.
-rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply Rle_trans with (Rabs (g t - phi2 n t)).
-apply Rabs_pos.
-pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption.
-rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply Rle_trans with (Rabs (g t - phi2 n t)).
-apply Rabs_pos.
-pattern a at 3 in |- *; rewrite <- e; apply H3; assumption.
-rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply Rle_trans with (Rabs (g t - phi2 n t)).
-apply Rabs_pos.
-pattern b at 3 in |- *; rewrite <- e; apply H3; assumption.
-replace (f t) with (g t).
-apply H3; assumption.
-symmetry  in |- *; apply H0; elim H5; clear H5; intros.
-assert (H7 : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n2; assumption ].
-assert (H8 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n2; assumption ].
-rewrite H7 in H5; rewrite H8 in H6; split.
-elim H5; intro; [ assumption | elim n1; symmetry  in |- *; assumption ].
-elim H6; intro; [ assumption | elim n0; assumption ].
-cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)).
-intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros;
- rewrite (H3 n); apply H5; assumption.
-intro; apply Rle_antisym.
-apply StepFun_P37; try assumption.
-intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
- case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
-elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
-elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
-elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
-right; reflexivity.
-apply StepFun_P37; try assumption.
-intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
- case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
-elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
-elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
-elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
-right; reflexivity.
-intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2;
- unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2];
- split with l; split with lf; unfold adapted_couple in H2; 
- decompose [and] H2; clear H2; unfold adapted_couple in |- *; 
- repeat split; try assumption.
-intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9;
- unfold constant_D_eq, open_interval in |- *; intros; 
- 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 in |- *; case (Rle_dec 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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a);
- case (Req_EM_T x1 b); intros.
-rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
-rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
-rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
-reflexivity.
+  forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable g a b),
+    a <= b ->
+    (forall x:R, a < x < b -> f x = g x) -> RiemannInt pr1 = RiemannInt pr2.
+Proof.
+  intro f; intros; unfold RiemannInt in |- *;
+    case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    case (RiemannInt_exists pr2 RinvN RinvN_cv); intros; 
+      eapply UL_sequence.
+  apply u0.
+  set (phi1 := fun N:nat => phi_sequence RinvN pr1 N);
+    change (Un_cv (fun N:nat => RiemannInt_SF (phi1 N)) x) in |- *;
+      assert
+        (H1 :
+          exists psi1 : nat -> StepFun a b,
+            (forall n:nat,
+              (forall t:R,
+                Rmin a b <= t /\ t <= Rmax a b ->
+                Rabs (f t - phi1 n t) <= psi1 n t) /\
+              Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+  split with (fun 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;
+    set (phi2 := fun N:nat => phi_sequence RinvN pr2 N).
+  set
+    (phi2_aux :=
+      fun (N:nat) (x:R) =>
+        match Req_EM_T x a with
+          | left _ => f a
+          | right _ =>
+            match Req_EM_T x b with
+              | left _ => f b
+              | right _ => phi2 N x
+            end
+        end).
+  cut (forall N:nat, IsStepFun (phi2_aux N) a b).
+  intro; set (phi2_m := fun N:nat => mkStepFun (X N)).
+  assert
+    (H2 :
+      exists psi2 : nat -> StepFun a b,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a b <= t /\ t <= Rmax a b -> Rabs (g t - phi2 n t) <= psi2 n t) /\
+          Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  split with (fun 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 in |- *; simpl in |- *; unfold phi2_aux in |- *;
+    case (Req_EM_T t a); case (Req_EM_T t b); intros.
+  rewrite e0; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply Rle_trans with (Rabs (g t - phi2 n t)).
+  apply Rabs_pos.
+  pattern a at 3 in |- *; rewrite <- e0; apply H3; assumption.
+  rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply Rle_trans with (Rabs (g t - phi2 n t)).
+  apply Rabs_pos.
+  pattern a at 3 in |- *; rewrite <- e; apply H3; assumption.
+  rewrite e; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply Rle_trans with (Rabs (g t - phi2 n t)).
+  apply Rabs_pos.
+  pattern b at 3 in |- *; rewrite <- e; apply H3; assumption.
+  replace (f t) with (g t).
+  apply H3; assumption.
+  symmetry  in |- *; apply H0; elim H5; clear H5; intros.
+  assert (H7 : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n2; assumption ].
+  assert (H8 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n2; assumption ].
+  rewrite H7 in H5; rewrite H8 in H6; split.
+  elim H5; intro; [ assumption | elim n1; symmetry  in |- *; assumption ].
+  elim H6; intro; [ assumption | elim n0; assumption ].
+  cut (forall N:nat, RiemannInt_SF (phi2_m N) = RiemannInt_SF (phi2 N)).
+  intro; unfold Un_cv in |- *; intros; elim (u _ H4); intros; exists x1; intros;
+    rewrite (H3 n); apply H5; assumption.
+  intro; apply Rle_antisym.
+  apply StepFun_P37; try assumption.
+  intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+    case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
+  elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
+  elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
+  elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+  right; reflexivity.
+  apply StepFun_P37; try assumption.
+  intros; unfold phi2_m in |- *; simpl in |- *; unfold phi2_aux in |- *;
+    case (Req_EM_T x1 a); case (Req_EM_T x1 b); intros.
+  elim H3; intros; rewrite e0 in H4; elim (Rlt_irrefl _ H4).
+  elim H3; intros; rewrite e in H4; elim (Rlt_irrefl _ H4).
+  elim H3; intros; rewrite e in H5; elim (Rlt_irrefl _ H5).
+  right; reflexivity.
+  intro; assert (H2 := pre (phi2 N)); unfold IsStepFun in H2;
+    unfold is_subdivision in H2; elim H2; clear H2; intros l [lf H2];
+      split with l; split with lf; unfold adapted_couple in H2; 
+        decompose [and] H2; clear H2; unfold adapted_couple in |- *; 
+          repeat split; try assumption.
+  intros; assert (H9 := H8 i H2); unfold constant_D_eq, open_interval in H9;
+    unfold constant_D_eq, open_interval in |- *; intros; 
+      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 in |- *; case (Rle_dec 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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  elim H7; clear H7; intros; unfold phi2_aux in |- *; case (Req_EM_T x1 a);
+    case (Req_EM_T x1 b); intros.
+  rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+  rewrite e in H7; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H7)).
+  rewrite e in H12; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H11 H12)).
+  reflexivity.
 Qed.
 
 Lemma RiemannInt_P19 :
- forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
-   (pr2:Riemann_integrable g a b),
-   a <= b ->
-   (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2.
-intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1);
- rewrite Rplus_opp_l; rewrite Rplus_comm;
- apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))).
-apply Rabs_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 Rabs_right.
-apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r;
- 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 ].
+  forall (f g:R -> R) (a b:R) (pr1:Riemann_integrable f a b)
+    (pr2:Riemann_integrable g a b),
+    a <= b ->
+    (forall x:R, a < x < b -> f x <= g x) -> RiemannInt pr1 <= RiemannInt pr2.
+Proof.
+  intro f; intros; apply Rplus_le_reg_l with (- RiemannInt pr1);
+    rewrite Rplus_opp_l; rewrite Rplus_comm;
+      apply Rle_trans with (Rabs (RiemannInt (RiemannInt_P10 (-1) pr2 pr1))).
+  apply Rabs_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 Rabs_right.
+  apply Rle_ge; apply Rplus_le_reg_l with (f x); rewrite Rplus_0_r;
+    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 :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   forall 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 || apply Rle_trans with x; assumption ].
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    forall x:R, a <= x -> x <= b -> Riemann_integrable f a x.
+Proof.
+  intros; apply continuity_implies_RiemannInt;
+    [ assumption
+      | intros; apply H0; elim H3; intros; split;
+        assumption || apply Rle_trans with x; assumption ].
 Qed.
 
 Definition primitive (f:R -> R) (a b:R) (h:a <= b)
   (pr:forall x:R, a <= x -> x <= b -> Riemann_integrable f a x) 
   (x:R) : R :=
   match Rle_dec a x with
-  | left r =>
+    | left r =>
       match Rle_dec x b with
-      | left r0 => RiemannInt (pr x r r0)
-      | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b))
+        | left r0 => RiemannInt (pr x r r0)
+        | right _ => f b * (x - b) + RiemannInt (pr b h (Rle_refl b))
       end
-  | right _ => f a * (x - a)
+    | right _ => f a * (x - a)
   end.
 
 Lemma RiemannInt_P20 :
- forall (f:R -> R) (a b:R) (h:a <= b)
-   (pr:forall 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 0.
-replace (RiemannInt pr0) with (primitive h pr b).
-ring.
-unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros;
- [ apply RiemannInt_P5
- | elim n; right; reflexivity
- | elim n; assumption
- | elim n0; assumption ].
-symmetry  in |- *; unfold primitive in |- *; case (Rle_dec a a);
- case (Rle_dec a b); intros;
- [ apply RiemannInt_P9
- | elim n; assumption
- | elim n; right; reflexivity
- | elim n0; right; reflexivity ].
+  forall (f:R -> R) (a b:R) (h:a <= b)
+    (pr:forall 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.
+Proof.
+  intros; replace (primitive h pr a) with 0.
+  replace (RiemannInt pr0) with (primitive h pr b).
+  ring.
+  unfold primitive in |- *; case (Rle_dec a b); case (Rle_dec b b); intros;
+    [ apply RiemannInt_P5
+      | elim n; right; reflexivity
+      | elim n; assumption
+      | elim n0; assumption ].
+  symmetry  in |- *; unfold primitive in |- *; case (Rle_dec a a);
+    case (Rle_dec a b); intros;
+      [ apply RiemannInt_P9
+        | elim n; assumption
+        | elim n; right; reflexivity
+        | elim n0; right; reflexivity ].
 Qed.
 
 Lemma RiemannInt_P21 :
- forall (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 in |- *; intros f a b c Hyp1 Hyp2 X X0 eps.
-assert (H : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1];
- elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2].
-set
- (phi3 :=
-  fun x:R =>
-    match Rle_dec a x with
-    | left _ =>
-        match Rle_dec x b with
-        | left _ => phi1 x
-        | right _ => phi2 x
-        end
-    | right _ => 0
-    end).
-set
- (psi3 :=
-  fun x:R =>
-    match Rle_dec a x with
-    | left _ =>
-        match Rle_dec x b with
-        | left _ => psi1 x
-        | right _ => psi2 x
-        end
-    | right _ => 0
-    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 in |- *;
- split.
-intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t);
- intros.
-elim H1; intros; apply H3.
-replace (Rmin a b) with a.
-replace (Rmax a b) with b.
-split; assumption.
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-elim n; replace a with (Rmin a c).
-elim H0; intros; assumption.
-unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
-elim H2; intros; apply H3.
-replace (Rmax b c) with (Rmax a c).
-elim H0; intros; split; try assumption.
-replace (Rmin b c) with b.
-auto with real.
-unfold Rmin in |- *; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
-unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros;
- try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption).
-reflexivity.
-elim n; replace a with (Rmin a c).
-elim H0; intros; assumption.
-unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n1; apply Rle_trans with b; assumption ].
-rewrite <- (StepFun_P43 X0 X1 X2).
-apply Rle_lt_trans with
- (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))).
-apply Rabs_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_compat.
-elim H1; intros; assumption.
-elim H2; intros; assumption.
-apply Rle_antisym.
-apply StepFun_P37; try assumption.
-simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
- | right; reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
-apply StepFun_P37; try assumption.
-simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
- | right; reflexivity
- | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
- | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
-apply Rle_antisym.
-apply StepFun_P37; try assumption.
-simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ right; reflexivity
- | elim n; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
-apply StepFun_P37; try assumption.
-simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
- case (Rle_dec a x); case (Rle_dec x b); intros;
- [ right; reflexivity
- | elim n; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
-apply StepFun_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 in |- *; repeat split; 
- try assumption.
-intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
- unfold constant_D_eq, open_interval in H9; intros; 
- rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
-apply Rle_lt_trans with (pos_Rl l1 i).
-replace b with (Rmin b c).
-rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
-apply le_O_n.
-apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
- apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; 
- discriminate. 
-unfold Rmin in |- *; case (Rle_dec b c); intro;
- [ reflexivity | elim n; assumption ].
-elim H7; intros; assumption.
-case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (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 in |- *; repeat split; 
- try assumption.
-intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
- unfold constant_D_eq, open_interval in H9; intros; 
- rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
-apply Rle_trans with (pos_Rl l1 (S i)).
-elim H7; intros; left; assumption.
-replace b with (Rmax a b).
-rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
-apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
- discriminate. 
-unfold Rmax in |- *; case (Rle_dec 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 in |- *; intro; rewrite <- H13 in H6; 
- discriminate. 
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-left; elim H7; intros; assumption.
-case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n;
- 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 in |- *; repeat split; 
- try assumption.
-intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
- unfold constant_D_eq, open_interval in H9; intros; 
- rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
-apply Rle_trans with (pos_Rl l1 (S i)).
-elim H7; intros; left; assumption.
-replace b with (Rmax a b).
-rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
-apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
- discriminate. 
-unfold Rmax in |- *; case (Rle_dec 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 in |- *; intro; rewrite <- H13 in H6; 
- discriminate. 
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-left; elim H7; intros; assumption.
-unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
- reflexivity || elim n; assumption.
-assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
- elim H3; clear H3; intros l1 [lf1 H3]; split with l1; 
- split with lf1; unfold adapted_couple in H3; decompose [and] H3; 
- clear H3; unfold adapted_couple in |- *; repeat split; 
- try assumption.
-intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
- unfold constant_D_eq, open_interval in H9; intros; 
- rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
-apply Rle_lt_trans with (pos_Rl l1 i).
-replace b with (Rmin b c).
-rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
-apply le_O_n.
-apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
- apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; 
- discriminate. 
-unfold Rmin in |- *; case (Rle_dec b c); intro;
- [ reflexivity | elim n; assumption ].
-elim H7; intros; assumption.
-unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
- [ elim (Rlt_irrefl _ (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 ] ].
+  forall (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.
+Proof.
+  unfold Riemann_integrable in |- *; intros f a b c Hyp1 Hyp2 X X0 eps.
+  assert (H : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (X (mkposreal _ H)); clear X; intros phi1 [psi1 H1];
+    elim (X0 (mkposreal _ H)); clear X0; intros phi2 [psi2 H2].
+  set
+    (phi3 :=
+      fun x:R =>
+        match Rle_dec a x with
+          | left _ =>
+            match Rle_dec x b with
+              | left _ => phi1 x
+              | right _ => phi2 x
+            end
+          | right _ => 0
+        end).
+  set
+    (psi3 :=
+      fun x:R =>
+        match Rle_dec a x with
+          | left _ =>
+            match Rle_dec x b with
+              | left _ => psi1 x
+              | right _ => psi2 x
+            end
+          | right _ => 0
+        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 in |- *;
+    split.
+  intros; unfold phi3, psi3 in |- *; case (Rle_dec t b); case (Rle_dec a t);
+    intros.
+  elim H1; intros; apply H3.
+  replace (Rmin a b) with a.
+  replace (Rmax a b) with b.
+  split; assumption.
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  elim n; replace a with (Rmin a c).
+  elim H0; intros; assumption.
+  unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+  elim H2; intros; apply H3.
+  replace (Rmax b c) with (Rmax a c).
+  elim H0; intros; split; try assumption.
+  replace (Rmin b c) with b.
+  auto with real.
+  unfold Rmin in |- *; case (Rle_dec b c); intro;
+    [ reflexivity | elim n0; assumption ].
+  unfold Rmax in |- *; case (Rle_dec a c); case (Rle_dec b c); intros;
+    try (elim n0; assumption || elim n0; apply Rle_trans with b; assumption).
+  reflexivity.
+  elim n; replace a with (Rmin a c).
+  elim H0; intros; assumption.
+  unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n1; apply Rle_trans with b; assumption ].
+  rewrite <- (StepFun_P43 X0 X1 X2).
+  apply Rle_lt_trans with
+    (Rabs (RiemannInt_SF (mkStepFun X0)) + Rabs (RiemannInt_SF (mkStepFun X1))).
+  apply Rabs_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_compat.
+  elim H1; intros; assumption.
+  elim H2; intros; assumption.
+  apply Rle_antisym.
+  apply StepFun_P37; try assumption.
+  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+    case (Rle_dec a x); case (Rle_dec x b); intros;
+      [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+        | right; reflexivity
+        | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+        | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+  apply StepFun_P37; try assumption.
+  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+    case (Rle_dec a x); case (Rle_dec x b); intros;
+      [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H0))
+        | right; reflexivity
+        | elim n; apply Rle_trans with b; [ assumption | left; assumption ]
+        | elim n0; apply Rle_trans with b; [ assumption | left; assumption ] ].
+  apply Rle_antisym.
+  apply StepFun_P37; try assumption.
+  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+    case (Rle_dec a x); case (Rle_dec x b); intros;
+      [ right; reflexivity
+        | elim n; left; assumption
+        | elim n; left; assumption
+        | elim n0; left; assumption ].
+  apply StepFun_P37; try assumption.
+  simpl in |- *; intros; unfold psi3 in |- *; elim H0; clear H0; intros;
+    case (Rle_dec a x); case (Rle_dec x b); intros;
+      [ right; reflexivity
+        | elim n; left; assumption
+        | elim n; left; assumption
+        | elim n0; left; assumption ].
+  apply StepFun_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 in |- *; repeat split; 
+          try assumption.
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+    unfold constant_D_eq, open_interval in H9; intros; 
+      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+  apply Rle_lt_trans with (pos_Rl l1 i).
+  replace b with (Rmin b c).
+  rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
+  apply le_O_n.
+  apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+    apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; 
+      discriminate. 
+  unfold Rmin in |- *; case (Rle_dec b c); intro;
+    [ reflexivity | elim n; assumption ].
+  elim H7; intros; assumption.
+  case (Rle_dec a x); case (Rle_dec x b); intros;
+    [ elim (Rlt_irrefl _ (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 in |- *; repeat split; 
+          try assumption.
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+    unfold constant_D_eq, open_interval in H9; intros; 
+      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+  apply Rle_trans with (pos_Rl l1 (S i)).
+  elim H7; intros; left; assumption.
+  replace b with (Rmax a b).
+  rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
+  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+    discriminate. 
+  unfold Rmax in |- *; case (Rle_dec 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 in |- *; intro; rewrite <- H13 in H6; 
+      discriminate. 
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  left; elim H7; intros; assumption.
+  case (Rle_dec a x); case (Rle_dec x b); intros; reflexivity || elim n;
+    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 in |- *; repeat split; 
+          try assumption.
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+    unfold constant_D_eq, open_interval in H9; intros; 
+      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : x <= b).
+  apply Rle_trans with (pos_Rl l1 (S i)).
+  elim H7; intros; left; assumption.
+  replace b with (Rmax a b).
+  rewrite <- H4; elim (RList_P6 l1); intros; apply H10; try assumption.
+  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6;
+    discriminate. 
+  unfold Rmax in |- *; case (Rle_dec 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 in |- *; intro; rewrite <- H13 in H6; 
+      discriminate. 
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  left; elim H7; intros; assumption.
+  unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+    reflexivity || elim n; assumption.
+  assert (H3 := pre phi2); unfold IsStepFun in H3; unfold is_subdivision in H3;
+    elim H3; clear H3; intros l1 [lf1 H3]; split with l1; 
+      split with lf1; unfold adapted_couple in H3; decompose [and] H3; 
+        clear H3; unfold adapted_couple in |- *; repeat split; 
+          try assumption.
+  intros; assert (H9 := H8 i H3); unfold constant_D_eq, open_interval in |- *;
+    unfold constant_D_eq, open_interval in H9; intros; 
+      rewrite <- (H9 x H7); unfold psi3 in |- *; assert (H10 : b < x).
+  apply Rle_lt_trans with (pos_Rl l1 i).
+  replace b with (Rmin b c).
+  rewrite <- H5; elim (RList_P6 l1); intros; apply H10; try assumption.
+  apply le_O_n.
+  apply lt_trans with (pred (Rlength l1)); try assumption; apply lt_pred_n_n;
+    apply neq_O_lt; red in |- *; intro; rewrite <- H12 in H6; 
+      discriminate. 
+  unfold Rmin in |- *; case (Rle_dec b c); intro;
+    [ reflexivity | elim n; assumption ].
+  elim H7; intros; assumption.
+  unfold phi3 in |- *; case (Rle_dec a x); case (Rle_dec x b); intros;
+    [ elim (Rlt_irrefl _ (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 :
- forall (f:R -> R) (a b c:R),
-   Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c.
-unfold Riemann_integrable in |- *; 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 in |- *; intros; apply H.
-replace (Rmin a b) with (Rmin a c).
-elim H5; intros; split; try assumption.
-apply Rle_trans with (Rmax a c); try assumption.
-replace (Rmax a b) with b.
-replace (Rmax a c) with c.
-assumption.
-unfold Rmax in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros;
- [ reflexivity
- | elim n; apply Rle_trans with c; assumption
- | elim n; assumption
- | elim n0; assumption ].
-rewrite Rabs_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 in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
- rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
- apply Ropp_ge_le_contravar; apply Rle_ge;
- replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; unfold fct_cte in |- *;
- apply Rle_trans with (Rabs (f x - phi x)).
-apply Rabs_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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-rewrite StepFun_P18; ring.
-apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
-apply RRle_abs.
-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 in |- *; case (Rle_dec a b); intro.
-eapply StepFun_P17.
-apply StepFun_P1.
-simpl in |- *; apply StepFun_P1.
-apply Ropp_eq_compat; eapply StepFun_P17.
-apply StepFun_P1.
-simpl in |- *; apply StepFun_P1.
-apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; unfold fct_cte in |- *;
- apply Rle_trans with (Rabs (f x - phi x)).
-apply Rabs_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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-rewrite StepFun_P18; ring.
+  forall (f:R -> R) (a b c:R),
+    Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f a c.
+Proof.
+  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+    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 in |- *; intros; apply H.
+  replace (Rmin a b) with (Rmin a c).
+  elim H5; intros; split; try assumption.
+  apply Rle_trans with (Rmax a c); try assumption.
+  replace (Rmax a b) with b.
+  replace (Rmax a c) with c.
+  assumption.
+  unfold Rmax in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a c); case (Rle_dec a b); intros;
+    [ reflexivity
+      | elim n; apply Rle_trans with c; assumption
+      | elim n; assumption
+      | elim n0; assumption ].
+  rewrite Rabs_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 in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+    rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
+      apply Ropp_ge_le_contravar; apply Rle_ge;
+        replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; unfold fct_cte in |- *;
+    apply Rle_trans with (Rabs (f x - phi x)).
+  apply Rabs_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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  rewrite StepFun_P18; ring.
+  apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
+  apply RRle_abs.
+  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 in |- *; case (Rle_dec a b); intro.
+  eapply StepFun_P17.
+  apply StepFun_P1.
+  simpl in |- *; apply StepFun_P1.
+  apply Ropp_eq_compat; eapply StepFun_P17.
+  apply StepFun_P1.
+  simpl in |- *; apply StepFun_P1.
+  apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; unfold fct_cte in |- *;
+    apply Rle_trans with (Rabs (f x - phi x)).
+  apply Rabs_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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  rewrite StepFun_P18; ring.
 Qed.
 
 Lemma RiemannInt_P23 :
- forall (f:R -> R) (a b c:R),
-   Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b.
-unfold Riemann_integrable in |- *; 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 in |- *; intros; apply H.
-replace (Rmax a b) with (Rmax c b).
-elim H5; intros; split; try assumption.
-apply Rle_trans with (Rmin c b); try assumption.
-replace (Rmin a b) with a.
-replace (Rmin c b) with c.
-assumption.
-unfold Rmin in |- *; case (Rle_dec c b); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros;
- [ reflexivity
- | elim n; apply Rle_trans with c; assumption
- | elim n; assumption
- | elim n0; assumption ].
-rewrite Rabs_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 in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
- rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
- apply Ropp_ge_le_contravar; apply Rle_ge;
- replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; unfold fct_cte in |- *;
- apply Rle_trans with (Rabs (f x - phi x)).
-apply Rabs_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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-rewrite StepFun_P18; ring.
-apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
-apply RRle_abs.
-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 in |- *; case (Rle_dec a b); intro.
-eapply StepFun_P17.
-apply StepFun_P1.
-simpl in |- *; apply StepFun_P1.
-apply Ropp_eq_compat; eapply StepFun_P17.
-apply StepFun_P1.
-simpl in |- *; apply StepFun_P1.
-apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
-apply StepFun_P37; try assumption.
-intros; simpl in |- *; unfold fct_cte in |- *;
- apply Rle_trans with (Rabs (f x - phi x)).
-apply Rabs_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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; apply Rle_trans with c; assumption ].
-rewrite StepFun_P18; ring.
+  forall (f:R -> R) (a b c:R),
+    Riemann_integrable f a b -> a <= c <= b -> Riemann_integrable f c b.
+Proof.
+  unfold Riemann_integrable in |- *; intros; elim (X eps); clear X;
+    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 in |- *; intros; apply H.
+  replace (Rmax a b) with (Rmax c b).
+  elim H5; intros; split; try assumption.
+  apply Rle_trans with (Rmin c b); try assumption.
+  replace (Rmin a b) with a.
+  replace (Rmin c b) with c.
+  assumption.
+  unfold Rmin in |- *; case (Rle_dec c b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmax in |- *; case (Rle_dec c b); case (Rle_dec a b); intros;
+    [ reflexivity
+      | elim n; apply Rle_trans with c; assumption
+      | elim n; assumption
+      | elim n0; assumption ].
+  rewrite Rabs_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 in |- *; pattern (RiemannInt_SF psi) at 2 in |- *;
+    rewrite <- Rplus_0_r; apply Rplus_le_compat_l; rewrite <- Ropp_0;
+      apply Ropp_ge_le_contravar; apply Rle_ge;
+        replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 a c 0))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; unfold fct_cte in |- *;
+    apply Rle_trans with (Rabs (f x - phi x)).
+  apply Rabs_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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  rewrite StepFun_P18; ring.
+  apply Rle_lt_trans with (Rabs (RiemannInt_SF psi)).
+  apply RRle_abs.
+  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 in |- *; case (Rle_dec a b); intro.
+  eapply StepFun_P17.
+  apply StepFun_P1.
+  simpl in |- *; apply StepFun_P1.
+  apply Ropp_eq_compat; eapply StepFun_P17.
+  apply StepFun_P1.
+  simpl in |- *; apply StepFun_P1.
+  apply Rle_ge; replace 0 with (RiemannInt_SF (mkStepFun (StepFun_P4 c b 0))).
+  apply StepFun_P37; try assumption.
+  intros; simpl in |- *; unfold fct_cte in |- *;
+    apply Rle_trans with (Rabs (f x - phi x)).
+  apply Rabs_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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; apply Rle_trans with c; assumption ].
+  rewrite StepFun_P18; ring.
 Qed.
 
 Lemma RiemannInt_P24 :
- forall (f:R -> R) (a b c:R),
-   Riemann_integrable f a b ->
-   Riemann_integrable f b c -> Riemann_integrable f a c.
-intros; case (Rle_dec a b); case (Rle_dec b c); intros.
-apply RiemannInt_P21 with b; assumption.
-case (Rle_dec 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 (Rle_dec 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 || apply RiemannInt_P1; assumption.
+  forall (f:R -> R) (a b c:R),
+    Riemann_integrable f a b ->
+    Riemann_integrable f b c -> Riemann_integrable f a c.
+Proof.
+  intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+  apply RiemannInt_P21 with b; assumption.
+  case (Rle_dec 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 (Rle_dec 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 || apply RiemannInt_P1; assumption.
 Qed.
 
 Lemma RiemannInt_P25 :
- forall (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 in |- *;
- case (RiemannInt_exists pr1 RinvN RinvN_cv);
- case (RiemannInt_exists pr2 RinvN RinvN_cv);
- case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; 
- symmetry  in |- *; eapply UL_sequence.
-apply u.
-unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0;
- intros N2 H2;
- cut
-  (Un_cv
-     (fun n:nat =>
-        RiemannInt_SF (phi_sequence RinvN pr3 n) -
-        (RiemannInt_SF (phi_sequence RinvN pr1 n) +
-         RiemannInt_SF (phi_sequence RinvN pr2 n))) 0).
-intro; elim (H3 _ H0); clear H3; intros N3 H3;
- set (N0 := max (max N1 N2) N3); exists N0; intros; 
- unfold R_dist in |- *;
- apply Rle_lt_trans with
-  (Rabs
-     (RiemannInt_SF (phi_sequence RinvN pr3 n) -
-      (RiemannInt_SF (phi_sequence RinvN pr1 n) +
-       RiemannInt_SF (phi_sequence RinvN pr2 n))) +
-   Rabs
-     (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)) +
+  forall (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.
+Proof.
+  intros f a b c pr1 pr2 pr3 Hyp1 Hyp2; unfold RiemannInt in |- *;
+    case (RiemannInt_exists pr1 RinvN RinvN_cv);
+    case (RiemannInt_exists pr2 RinvN RinvN_cv);
+    case (RiemannInt_exists pr3 RinvN RinvN_cv); intros; 
+      symmetry  in |- *; eapply UL_sequence.
+  apply u.
+  unfold Un_cv in |- *; intros; assert (H0 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (u1 _ H0); clear u1; intros N1 H1; elim (u0 _ H0); clear u0;
+    intros N2 H2;
+      cut
+        (Un_cv
+          (fun n:nat =>
+            RiemannInt_SF (phi_sequence RinvN pr3 n) -
+            (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+              RiemannInt_SF (phi_sequence RinvN pr2 n))) 0).
+  intro; elim (H3 _ H0); clear H3; intros N3 H3;
+    set (N0 := max (max N1 N2) N3); exists N0; intros; 
+      unfold R_dist in |- *;
+        apply Rle_lt_trans with
+          (Rabs
+            (RiemannInt_SF (phi_sequence RinvN pr3 n) -
+              (RiemannInt_SF (phi_sequence RinvN pr1 n) +
+                RiemannInt_SF (phi_sequence RinvN pr2 n))) +
+            Rabs
+            (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 Rabs_triang | ring ].
+  replace eps with (eps / 3 + eps / 3 + eps / 3).
+  rewrite Rplus_assoc; apply Rplus_lt_compat.
+  unfold R_dist in H3; cut (n >= N3)%nat.
+  intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6;
+    rewrite Rplus_0_r in H6; apply H6.
+  unfold ge in |- *; apply le_trans with N0;
+    [ unfold N0 in |- *; apply le_max_r | assumption ].
+  apply Rle_lt_trans with
+    (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) +
+      Rabs (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)));
- [ apply Rabs_triang | ring ].
-replace eps with (eps / 3 + eps / 3 + eps / 3).
-rewrite Rplus_assoc; apply Rplus_lt_compat.
-unfold R_dist in H3; cut (n >= N3)%nat.
-intro; assert (H6 := H3 _ H5); unfold Rminus in H6; rewrite Ropp_0 in H6;
- rewrite Rplus_0_r in H6; apply H6.
-unfold ge in |- *; apply le_trans with N0;
- [ unfold N0 in |- *; apply le_max_r | assumption ].
-apply Rle_lt_trans with
- (Rabs (RiemannInt_SF (phi_sequence RinvN pr1 n) - x1) +
-  Rabs (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 Rabs_triang | ring ].
-apply Rplus_lt_compat.
-unfold R_dist in H1; apply H1.
-unfold ge in |- *; apply le_trans with N0;
- [ apply le_trans with (max N1 N2);
-    [ apply le_max_l | unfold N0 in |- *; apply le_max_l ]
- | assumption ].
-unfold R_dist in H2; apply H2.
-unfold ge in |- *; apply le_trans with N0;
- [ apply le_trans with (max N1 N2);
-    [ apply le_max_r | unfold N0 in |- *; apply le_max_l ]
- | assumption ].
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 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 :
-    exists psi1 : nat -> StepFun a b,
-     (forall n:nat,
-        (forall t:R,
-           Rmin a b <= t /\ t <= Rmax a b ->
-           Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
-        Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr1 n)). 
-assert
- (H2 :
-   exists psi2 : nat -> StepFun b c,
-    (forall n:nat,
-       (forall t:R,
-          Rmin b c <= t /\ t <= Rmax b c ->
-          Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
-       Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
-split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
- apply (projT2 (phi_sequence_prop RinvN pr2 n)). 
-assert
- (H3 :
-   exists psi3 : nat -> StepFun a c,
-    (forall n:nat,
-       (forall t:R,
-          Rmin a c <= t /\ t <= Rmax a c ->
-          Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
-       Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
-split with (fun 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 in |- *; intros; assert (H4 : 0 < eps / 3).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H _ H4); clear H; intros N0 H;
- assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
-intros;
- replace (pos (RinvN n)) with
-  (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0).
-apply H; assumption.
-unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
- left; apply (cond_pos (RinvN n)).
-exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3;
- intros; unfold R_dist in |- *; unfold Rminus in |- *; 
- rewrite Ropp_0; rewrite Rplus_0_r; 
- set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *;
- set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; 
- set (phi3 := phi_sequence RinvN pr3 n) 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
- (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) +
-  Rabs (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 Rabs_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
- (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) +
-  RiemannInt_SF
-    (mkStepFun
-       (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))).
-apply Rplus_le_compat_l.
-apply StepFun_P34; try assumption.
-do 2
- rewrite <-
-  (Rplus_comm
-     (RiemannInt_SF
-        (mkStepFun
-           (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))))
-  ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption.
-apply Rle_lt_trans with
- (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) +
-  RiemannInt_SF (mkStepFun (StepFun_P28 1 (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 1 (mkStepFun H13) (psi2 n)))).
-apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
-intros; simpl in |- *; rewrite Rmult_1_l;
- apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)).
-rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
- replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x));
- [ apply Rabs_triang | ring ].
-apply Rplus_le_compat.
-apply H1.
-elim H14; intros; split.
-replace (Rmin a c) with a.
-apply Rle_trans with b; try assumption.
-left; assumption.
-unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
-replace (Rmax a c) with c.
-left; assumption.
-unfold Rmax in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
-apply H3.
-elim H14; intros; split.
-replace (Rmin b c) with b.
-left; assumption.
-unfold Rmin in |- *; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
-replace (Rmax b c) with c.
-left; assumption.
-unfold Rmax in |- *; case (Rle_dec b c); intro;
- [ reflexivity | elim n0; assumption ].
-do 2
- rewrite <-
-  (Rplus_comm
-     (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))))
-  ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
-intros; simpl in |- *; rewrite Rmult_1_l;
- apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)).
-rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
- replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x));
- [ apply Rabs_triang | ring ].
-apply Rplus_le_compat.
-apply H1.
-elim H14; intros; split.
-replace (Rmin a c) with a.
-left; assumption.
-unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
-replace (Rmax a c) with c.
-apply Rle_trans with b.
-left; assumption.
-assumption.
-unfold Rmax in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
-apply H8.
-elim H14; intros; split.
-replace (Rmin a b) with a.
-left; assumption.
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-replace (Rmax a b) with b.
-left; assumption.
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n0; assumption ].
-do 2 rewrite StepFun_P30.
-do 2 rewrite Rmult_1_l;
- 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_compat.
-apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))).
-apply RRle_abs.
-apply Rlt_trans with (pos (RinvN n)).
-assumption.
-apply H5; assumption.
-apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
-apply RRle_abs.
-apply Rlt_trans with (pos (RinvN n)).
-assumption.
-apply H5; assumption.
-apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
-apply RRle_abs.
-apply Rlt_trans with (pos (RinvN n)).
-assumption.
-apply H5; assumption.
-apply Rmult_eq_reg_l with 3;
- [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
-    do 2 rewrite (Rmult_comm 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)).
+    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 Rabs_triang | ring ].
+  apply Rplus_lt_compat.
+  unfold R_dist in H1; apply H1.
+  unfold ge in |- *; apply le_trans with N0;
+    [ apply le_trans with (max N1 N2);
+      [ apply le_max_l | unfold N0 in |- *; apply le_max_l ]
+      | assumption ].
+  unfold R_dist in H2; apply H2.
+  unfold ge in |- *; apply le_trans with N0;
+    [ apply le_trans with (max N1 N2);
+      [ apply le_max_r | unfold N0 in |- *; apply le_max_l ]
+      | assumption ].
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 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 :
+        exists psi1 : nat -> StepFun a b,
+          (forall n:nat,
+            (forall t:R,
+              Rmin a b <= t /\ t <= Rmax a b ->
+              Rabs (f t - phi_sequence RinvN pr1 n t) <= psi1 n t) /\
+            Rabs (RiemannInt_SF (psi1 n)) < RinvN n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr1 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr1 n)). 
+  assert
+    (H2 :
+      exists psi2 : nat -> StepFun b c,
+        (forall n:nat,
+          (forall t:R,
+            Rmin b c <= t /\ t <= Rmax b c ->
+            Rabs (f t - phi_sequence RinvN pr2 n t) <= psi2 n t) /\
+          Rabs (RiemannInt_SF (psi2 n)) < RinvN n)).
+  split with (fun n:nat => projT1 (phi_sequence_prop RinvN pr2 n)); intro;
+    apply (projT2 (phi_sequence_prop RinvN pr2 n)). 
+  assert
+    (H3 :
+      exists psi3 : nat -> StepFun a c,
+        (forall n:nat,
+          (forall t:R,
+            Rmin a c <= t /\ t <= Rmax a c ->
+            Rabs (f t - phi_sequence RinvN pr3 n t) <= psi3 n t) /\
+          Rabs (RiemannInt_SF (psi3 n)) < RinvN n)).
+  split with (fun 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 in |- *; intros; assert (H4 : 0 < eps / 3).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H _ H4); clear H; intros N0 H;
+    assert (H5 : forall n:nat, (n >= N0)%nat -> RinvN n < eps / 3).
+  intros;
+    replace (pos (RinvN n)) with
+    (R_dist (mkposreal (/ (INR n + 1)) (RinvN_pos n)) 0).
+  apply H; assumption.
+  unfold R_dist in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply Rabs_right; apply Rle_ge; 
+      left; apply (cond_pos (RinvN n)).
+  exists N0; intros; elim (H1 n); elim (H2 n); elim (H3 n); clear H1 H2 H3;
+    intros; unfold R_dist in |- *; unfold Rminus in |- *; 
+      rewrite Ropp_0; rewrite Rplus_0_r; 
+        set (phi1 := phi_sequence RinvN pr1 n) in H8 |- *;
+          set (phi2 := phi_sequence RinvN pr2 n) in H3 |- *; 
+            set (phi3 := phi_sequence RinvN pr3 n) 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
+    (Rabs (RiemannInt_SF (mkStepFun H10) - RiemannInt_SF phi1) +
+      Rabs (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 Rabs_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
+    (Rabs (RiemannInt_SF (mkStepFun (StepFun_P28 (-1) (mkStepFun H10) phi1))) +
+      RiemannInt_SF
+      (mkStepFun
+        (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))).
+  apply Rplus_le_compat_l.
+  apply StepFun_P34; try assumption.
+  do 2
+    rewrite <-
+      (Rplus_comm
+        (RiemannInt_SF
+          (mkStepFun
+            (StepFun_P32 (mkStepFun (StepFun_P28 (-1) (mkStepFun H12) phi2))))))
+      ; apply Rplus_le_compat_l; apply StepFun_P34; try assumption.
+  apply Rle_lt_trans with
+    (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H11) (psi1 n))) +
+      RiemannInt_SF (mkStepFun (StepFun_P28 1 (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 1 (mkStepFun H13) (psi2 n)))).
+  apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
+  intros; simpl in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi2 x)).
+  rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
+    replace (phi3 x + -1 * phi2 x) with (phi3 x - f x + (f x - phi2 x));
+    [ apply Rabs_triang | ring ].
+  apply Rplus_le_compat.
+  apply H1.
+  elim H14; intros; split.
+  replace (Rmin a c) with a.
+  apply Rle_trans with b; try assumption.
+  left; assumption.
+  unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+  replace (Rmax a c) with c.
+  left; assumption.
+  unfold Rmax in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+  apply H3.
+  elim H14; intros; split.
+  replace (Rmin b c) with b.
+  left; assumption.
+  unfold Rmin in |- *; case (Rle_dec b c); intro;
+    [ reflexivity | elim n0; assumption ].
+  replace (Rmax b c) with c.
+  left; assumption.
+  unfold Rmax in |- *; case (Rle_dec b c); intro;
+    [ reflexivity | elim n0; assumption ].
+  do 2
+    rewrite <-
+      (Rplus_comm
+        (RiemannInt_SF (mkStepFun (StepFun_P28 1 (mkStepFun H13) (psi2 n)))))
+      ; apply Rplus_le_compat_l; apply StepFun_P37; try assumption.
+  intros; simpl in |- *; rewrite Rmult_1_l;
+    apply Rle_trans with (Rabs (f x - phi3 x) + Rabs (f x - phi1 x)).
+  rewrite <- (Rabs_Ropp (f x - phi3 x)); rewrite Ropp_minus_distr;
+    replace (phi3 x + -1 * phi1 x) with (phi3 x - f x + (f x - phi1 x));
+    [ apply Rabs_triang | ring ].
+  apply Rplus_le_compat.
+  apply H1.
+  elim H14; intros; split.
+  replace (Rmin a c) with a.
+  left; assumption.
+  unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+  replace (Rmax a c) with c.
+  apply Rle_trans with b.
+  left; assumption.
+  assumption.
+  unfold Rmax in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n0; apply Rle_trans with b; assumption ].
+  apply H8.
+  elim H14; intros; split.
+  replace (Rmin a b) with a.
+  left; assumption.
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  replace (Rmax a b) with b.
+  left; assumption.
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n0; assumption ].
+  do 2 rewrite StepFun_P30.
+  do 2 rewrite Rmult_1_l;
+    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_compat.
+  apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi3 n))).
+  apply RRle_abs.
+  apply Rlt_trans with (pos (RinvN n)).
+  assumption.
+  apply H5; assumption.
+  apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi1 n))).
+  apply RRle_abs.
+  apply Rlt_trans with (pos (RinvN n)).
+  assumption.
+  apply H5; assumption.
+  apply Rle_lt_trans with (Rabs (RiemannInt_SF (psi2 n))).
+  apply RRle_abs.
+  apply Rlt_trans with (pos (RinvN n)).
+  assumption.
+  apply H5; assumption.
+  apply Rmult_eq_reg_l with 3;
+    [ unfold Rdiv in |- *; repeat rewrite Rmult_plus_distr_l;
+      do 2 rewrite (Rmult_comm 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 :
- forall (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 (Rle_dec a b); case (Rle_dec b c); intros.
-apply RiemannInt_P25; assumption.
-case (Rle_dec 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 (Rle_dec 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 ].
+  forall (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.
+Proof.
+  intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+  apply RiemannInt_P25; assumption.
+  case (Rle_dec 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 (Rle_dec 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 :
- forall (f:R -> R) (a b x:R) (h:a <= b)
-   (C0:forall 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 in |- *; intros; assert (Hyp : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *;
- unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a)));
- assert (H4 : 0 < del).
-unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a));
- intro.
-case (Rle_dec x0 (b - x)); intro;
- [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
-case (Rle_dec 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 (Rle_dec 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 Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0);
- [ apply RRle_abs | apply H6 ].
-unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)).
-apply Rplus_le_compat_l; apply Rmin_r.
-pattern b at 2 in |- *; replace b with (x + (b - x));
- [ apply Rplus_le_compat_l; apply Rmin_l | ring ].
-apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real.
-intros; apply C0; elim H7; intros; split.
-apply Rle_trans with (x + h0).
-left; apply Rle_lt_trans with (x - del).
-unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)).
-pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ].
-unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
-rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
- rewrite (Rplus_comm x); apply Rmin_r.
-unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
-do 2 rewrite Ropp_involutive; apply Rmin_r.
-unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel.
-rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0);
- [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ].
-assumption.
-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 in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
-apply Rle_lt_trans with
- (RiemannInt
-    (RiemannInt_P16
-       (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) *
-  Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_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)) * Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_pos.
-apply RiemannInt_P19; try assumption.
-intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
-unfold fct_cte in |- *; case (Req_dec x x1); intro.
-rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
- assumption.
-elim H3; intros; left; apply H11.
-repeat split.
-assumption.
-rewrite Rabs_right.
-apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ].
-apply Rlt_le_trans with (x + h0).
-elim H8; intros; assumption.
-apply Rplus_le_compat_l; apply Rle_trans with del.
-left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ].
-unfold del in |- *; apply Rmin_l.
-apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption.
-unfold fct_cte in |- *; ring.
-rewrite RiemannInt_P15.
-rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1.
-rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite Rabs_right.
-replace (x + h0 - x) with h0; [ idtac | ring ].
-apply Rinv_r_sym.
-assumption.
-apply Rle_ge; left; apply Rinv_0_lt_compat.
-elim r; intro.
-apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
-elim H5; symmetry  in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
- assumption.
-apply Rle_lt_trans with
- (RiemannInt
-    (RiemannInt_P16
-       (RiemannInt_P1
+  forall (f:R -> R) (a b x:R) (h:a <= b)
+    (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+    a < x < b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x).
+Proof.
+  intro f; intros; elim H; clear H; intros; assert (H1 : continuity_pt f x).
+  apply C0; split; left; assumption.
+  unfold derivable_pt_lim in |- *; intros; assert (Hyp : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H1 _ Hyp); unfold dist, D_x, no_cond in |- *; simpl in |- *;
+    unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin (b - x) (x - a)));
+      assert (H4 : 0 < del).
+  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec (b - x) (x - a));
+    intro.
+  case (Rle_dec x0 (b - x)); intro;
+    [ elim H3; intros; assumption | apply Rlt_Rminus; assumption ].
+  case (Rle_dec 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 (Rle_dec 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 Rplus_lt_compat_l; apply Rle_lt_trans with (Rabs h0);
+    [ apply RRle_abs | apply H6 ].
+  unfold del in |- *; apply Rle_trans with (x + Rmin (b - x) (x - a)).
+  apply Rplus_le_compat_l; apply Rmin_r.
+  pattern b at 2 in |- *; replace b with (x + (b - x));
+    [ apply Rplus_le_compat_l; apply Rmin_l | ring ].
+  apply RiemannInt_P1; apply continuity_implies_RiemannInt; auto with real.
+  intros; apply C0; elim H7; intros; split.
+  apply Rle_trans with (x + h0).
+  left; apply Rle_lt_trans with (x - del).
+  unfold del in |- *; apply Rle_trans with (x - Rmin (b - x) (x - a)).
+  pattern a at 1 in |- *; replace a with (x + (a - x)); [ idtac | ring ].
+  unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  rewrite Ropp_involutive; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+    rewrite (Rplus_comm x); apply Rmin_r.
+  unfold Rminus in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  do 2 rewrite Ropp_involutive; apply Rmin_r.
+  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel.
+  rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0);
+    [ rewrite <- Rabs_Ropp; apply RRle_abs | apply H6 ].
+  assumption.
+  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 in |- *; rewrite Rabs_mult; case (Rle_dec x (x + h0)); intro.
+  apply Rle_lt_trans with
+    (RiemannInt
+      (RiemannInt_P16
+        (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) *
+      Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_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)) * Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  apply RiemannInt_P19; try assumption.
+  intros; replace (f x1 + -1 * fct_cte (f x) x1) with (f x1 - f x).
+  unfold fct_cte in |- *; case (Req_dec x x1); intro.
+  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+    assumption.
+  elim H3; intros; left; apply H11.
+  repeat split.
+  assumption.
+  rewrite Rabs_right.
+  apply Rplus_lt_reg_r with x; replace (x + (x1 - x)) with x1; [ idtac | ring ].
+  apply Rlt_le_trans with (x + h0).
+  elim H8; intros; assumption.
+  apply Rplus_le_compat_l; apply Rle_trans with del.
+  left; apply Rle_lt_trans with (Rabs h0); [ apply RRle_abs | assumption ].
+  unfold del in |- *; apply Rmin_l.
+  apply Rge_minus; apply Rle_ge; left; elim H8; intros; assumption.
+  unfold fct_cte in |- *; ring.
+  rewrite RiemannInt_P15.
+  rewrite Rmult_assoc; replace ((x + h0 - x) * Rabs (/ h0)) with 1.
+  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite Rabs_right.
+  replace (x + h0 - x) with h0; [ idtac | ring ].
+  apply Rinv_r_sym.
+  assumption.
+  apply Rle_ge; left; apply Rinv_0_lt_compat.
+  elim r; intro.
+  apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; assumption.
+  elim H5; symmetry  in |- *; apply Rplus_eq_reg_l with x; rewrite Rplus_0_r;
+    assumption.
+  apply Rle_lt_trans with
+    (RiemannInt
+      (RiemannInt_P16
+        (RiemannInt_P1
           (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))) *
-  Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_pos.
-replace
- (RiemannInt (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x)))) with
- (-
-  RiemannInt
+      Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_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 Rabs_Ropp;
- apply
-  (RiemannInt_P17
-     (RiemannInt_P1
-        (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))
-     (RiemannInt_P16
+  rewrite Rabs_Ropp;
+    apply
+      (RiemannInt_P17
         (RiemannInt_P1
-           (RiemannInt_P10 (-1) H7 (RiemannInt_P14 x (x + h0) (f x))))));
- auto with real.
-symmetry  in |- *; apply RiemannInt_P8.
-apply Rle_lt_trans with
- (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_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 in |- *; case (Req_dec x x1); intro.
-rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
- assumption.
-elim H3; intros; left; apply H11.
-repeat split.
-assumption.
-rewrite Rabs_left.
-apply Rplus_lt_reg_r 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 in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
-rewrite Ropp_involutive; apply Rle_trans with (Rabs h0).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-apply Rle_trans with del;
- [ left; assumption | unfold del in |- *; apply Rmin_l ].
-elim H8; intros; assumption.
-apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
- replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ].
-unfold fct_cte in |- *; ring.
-rewrite RiemannInt_P15.
-rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1.
-rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite Rabs_left.
-replace (x - (x + h0)) with (- h0); [ idtac | ring ].
-rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse;
- rewrite Ropp_involutive; apply Rinv_r_sym.
-assumption.
-apply Rinv_lt_0_compat.
-assert (H8 : x + h0 < x).
-auto with real.
-apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; 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 in |- *; rewrite Rmult_plus_distr_r; ring.
-rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0;
- [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc;
-    rewrite <- Rinv_l_sym; [ ring | assumption ]
- | assumption ].
-cut (a <= x + h0).
-cut (x + h0 <= b).
-intros; unfold primitive in |- *.
-case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x);
- case (Rle_dec x b); intros; try (elim n; assumption || left; assumption).
-rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring.
-apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0;
- [ idtac | ring ].
-rewrite Rplus_comm; apply Rle_trans with (Rabs h0).
-apply RRle_abs.
-apply Rle_trans with del;
- [ left; assumption
- | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
-    [ apply Rmin_r | apply Rmin_l ] ].
-apply Ropp_le_cancel; apply Rplus_le_reg_l with x;
- replace (x + - (x + h0)) with (- h0); [ idtac | ring ].
-apply Rle_trans with (Rabs h0);
- [ rewrite <- Rabs_Ropp; apply RRle_abs
- | apply Rle_trans with del;
+          (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  in |- *; apply RiemannInt_P8.
+  apply Rle_lt_trans with
+    (RiemannInt (RiemannInt_P14 (x + h0) x (eps / 2)) * Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_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 in |- *; case (Req_dec x x1); intro.
+  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; left;
+    assumption.
+  elim H3; intros; left; apply H11.
+  repeat split.
+  assumption.
+  rewrite Rabs_left.
+  apply Rplus_lt_reg_r 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 in |- *; apply Rplus_le_compat_l; apply Ropp_le_cancel.
+  rewrite Ropp_involutive; apply Rle_trans with (Rabs h0).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  apply Rle_trans with del;
+    [ left; assumption | unfold del in |- *; apply Rmin_l ].
+  elim H8; intros; assumption.
+  apply Rplus_lt_reg_r with x; rewrite Rplus_0_r;
+    replace (x + (x1 - x)) with x1; [ elim H8; intros; assumption | ring ].
+  unfold fct_cte in |- *; ring.
+  rewrite RiemannInt_P15.
+  rewrite Rmult_assoc; replace ((x - (x + h0)) * Rabs (/ h0)) with 1.
+  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite Rabs_left.
+  replace (x - (x + h0)) with (- h0); [ idtac | ring ].
+  rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_mult_distr_r_reverse;
+    rewrite Ropp_involutive; apply Rinv_r_sym.
+  assumption.
+  apply Rinv_lt_0_compat.
+  assert (H8 : x + h0 < x).
+  auto with real.
+  apply Rplus_lt_reg_r with x; rewrite Rplus_0_r; 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 in |- *; rewrite Rmult_plus_distr_r; ring.
+  rewrite RiemannInt_P15; apply Rmult_eq_reg_l with h0;
+    [ unfold Rdiv in |- *; rewrite (Rmult_comm h0); repeat rewrite Rmult_assoc;
+      rewrite <- Rinv_l_sym; [ ring | assumption ]
+      | assumption ].
+  cut (a <= x + h0).
+  cut (x + h0 <= b).
+  intros; unfold primitive in |- *.
+  case (Rle_dec a (x + h0)); case (Rle_dec (x + h0) b); case (Rle_dec a x);
+  case (Rle_dec x b); intros; try (elim n; assumption || left; assumption).
+  rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r0 r) H7 (FTC_P1 h C0 r2 r1)); ring.
+  apply Rplus_le_reg_l with (- x); replace (- x + (x + h0)) with h0;
+    [ idtac | ring ].
+  rewrite Rplus_comm; apply Rle_trans with (Rabs h0).
+  apply RRle_abs.
+  apply Rle_trans with del;
     [ left; assumption
-    | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
-       apply Rmin_r ] ].
+      | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+        [ apply Rmin_r | apply Rmin_l ] ].
+  apply Ropp_le_cancel; apply Rplus_le_reg_l with x;
+    replace (x + - (x + h0)) with (- h0); [ idtac | ring ].
+  apply Rle_trans with (Rabs h0);
+    [ rewrite <- Rabs_Ropp; apply RRle_abs
+      | apply Rle_trans with del;
+        [ left; assumption
+          | unfold del in |- *; apply Rle_trans with (Rmin (b - x) (x - a));
+            apply Rmin_r ] ].
 Qed.
 
 Lemma RiemannInt_P28 :
- forall (f:R -> R) (a b x:R) (h:a <= b)
-   (C0:forall 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.
-set
- (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b)));
- rewrite H3.
-assert (H4 : derivable_pt_lim f_b b (f b)).
-unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
-change
-  (derivable_pt_lim
-     ((fct_cte (f b) * (id - fct_cte b))%F +
-      fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
-     f b + 0)) in |- *. 
-apply derivable_pt_lim_plus.
-pattern (f b) at 2 in |- *;
- replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_const.
-replace 1 with (1 - 0); [ idtac | ring ].
-apply derivable_pt_lim_minus.
-apply derivable_pt_lim_id.
-apply derivable_pt_lim_const.
-unfold fct_cte in |- *; ring.
-apply derivable_pt_lim_const.
-ring.
-unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros;
- assert (H7 : continuity_pt f b).
-apply C0; split; [ left; assumption | right; reflexivity ].
-assert (H8 : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *;
- unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a)));
- assert (H10 : 0 < del).
-unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros.
-case (Rle_dec x0 x1); intro;
- [ apply (cond_pos x0) | elim H9; intros; assumption ].
-case (Rle_dec x0 (b - a)); intro;
- [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ].
-split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro.
-assert (H14 : b + h0 < b).
-pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- 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 Rplus_le_reg_l 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 (Rabs h0).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-left; assumption.
-unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
-replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b)
- with (- RiemannInt H13).
-replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0).
-rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *;
- rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr;
- repeat rewrite Ropp_involutive;
- 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 in |- *; rewrite Rabs_mult;
- apply Rle_lt_trans with
-  (RiemannInt
-     (RiemannInt_P16
-        (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) *
-   Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_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)) * Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_pos.
-apply RiemannInt_P19.
-left; assumption.
-intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b).
-unfold fct_cte in |- *; case (Req_dec b x2); intro.
-rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- left; assumption.
-elim H9; intros; left; apply H18.
-repeat split.
-assumption.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
-apply Rplus_lt_reg_r 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 in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel;
- rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-apply Rlt_le_trans with del;
- [ assumption
- | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
-    [ apply Rmin_r | apply Rmin_l ] ].
-apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption.
-unfold fct_cte in |- *; ring.
-rewrite RiemannInt_P15.
-rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1.
-rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite Rabs_left.
-apply Rmult_eq_reg_l with h0;
- [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc;
-    rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym;
-    [ ring | assumption ]
- | assumption ].
-apply Rinv_lt_0_compat; 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 in |- *; rewrite Rmult_plus_distr_r; ring.
-rewrite RiemannInt_P15.
-rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0;
- [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *;
-    repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; 
-    [ ring | assumption ]
- | assumption ].
-cut (a <= b + h0).
-cut (b + h0 <= b).
-intros; unfold primitive in |- *; case (Rle_dec a (b + h0));
- case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); 
- intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
-rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring.
-elim n; assumption.
-left; assumption.
-apply Rplus_le_reg_l 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 (Rabs h0).
-rewrite <- Rabs_Ropp; apply RRle_abs.
-left; assumption.
-unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
-cut (primitive h (FTC_P1 h C0) b = f_b b).
-intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)).
-intro; rewrite H13; rewrite H14; apply H6.
-assumption.
-apply Rlt_le_trans with del;
- [ assumption | unfold del in |- *; apply Rmin_l ].
-assert (H14 : b < b + h0).
-pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
-assert (H14 := Rge_le _ _ r); elim H14; intro.
-assumption.
-elim H11; symmetry  in |- *; assumption.
-unfold primitive in |- *; case (Rle_dec a (b + h0));
- case (Rle_dec (b + h0) b); intros;
- [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14))
- | unfold f_b in |- *; reflexivity
- | elim n; left; apply Rlt_trans with b; assumption
- | elim n0; left; apply Rlt_trans with b; assumption ].
-unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *;
- case (Rle_dec a b); case (Rle_dec b b); intros;
- [ apply RiemannInt_P5
- | elim n; right; reflexivity
- | elim n; left; assumption
- | elim n; right; reflexivity ].
+  forall (f:R -> R) (a b x:R) (h:a <= b)
+    (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+    a <= x <= b -> derivable_pt_lim (primitive h (FTC_P1 h C0)) x (f x).
+Proof.
+  intro f; intros; elim h; intro.
+  elim H; clear H; intros; elim H; intro.
+  elim H1; intro.
+  apply RiemannInt_P27; split; assumption.
+  set
+    (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b)));
+    rewrite H3.
+  assert (H4 : derivable_pt_lim f_b b (f b)).
+  unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+  change
+    (derivable_pt_lim
+      ((fct_cte (f b) * (id - fct_cte b))%F +
+        fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
+          f b + 0)) in |- *. 
+  apply derivable_pt_lim_plus.
+  pattern (f b) at 2 in |- *;
+    replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_const.
+  replace 1 with (1 - 0); [ idtac | ring ].
+  apply derivable_pt_lim_minus.
+  apply derivable_pt_lim_id.
+  apply derivable_pt_lim_const.
+  unfold fct_cte in |- *; ring.
+  apply derivable_pt_lim_const.
+  ring.
+  unfold derivable_pt_lim in |- *; intros; elim (H4 _ H5); intros;
+    assert (H7 : continuity_pt f b).
+  apply C0; split; [ left; assumption | right; reflexivity ].
+  assert (H8 : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H7 _ H8); unfold D_x, no_cond, dist in |- *; simpl in |- *;
+    unfold R_dist in |- *; intros; set (del := Rmin x0 (Rmin x1 (b - a)));
+      assert (H10 : 0 < del).
+  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x1 (b - a)); intros.
+  case (Rle_dec x0 x1); intro;
+    [ apply (cond_pos x0) | elim H9; intros; assumption ].
+  case (Rle_dec x0 (b - a)); intro;
+    [ apply (cond_pos x0) | apply Rlt_Rminus; assumption ].
+  split with (mkposreal _ H10); intros; case (Rcase_abs h0); intro.
+  assert (H14 : b + h0 < b).
+  pattern b at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    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 Rplus_le_reg_l 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 (Rabs h0).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  left; assumption.
+  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  replace (primitive h (FTC_P1 h C0) (b + h0) - primitive h (FTC_P1 h C0) b)
+    with (- RiemannInt H13).
+  replace (f b) with (- RiemannInt (RiemannInt_P14 (b + h0) b (f b)) / h0).
+  rewrite <- Rabs_Ropp; unfold Rminus in |- *; unfold Rdiv in |- *;
+    rewrite Ropp_mult_distr_l_reverse; rewrite Ropp_plus_distr;
+      repeat rewrite Ropp_involutive;
+        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 in |- *; rewrite Rabs_mult;
+    apply Rle_lt_trans with
+      (RiemannInt
+        (RiemannInt_P16
+          (RiemannInt_P10 (-1) H13 (RiemannInt_P14 (b + h0) b (f b)))) *
+        Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_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)) * Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  apply RiemannInt_P19.
+  left; assumption.
+  intros; replace (f x2 + -1 * fct_cte (f b) x2) with (f x2 - f b).
+  unfold fct_cte in |- *; case (Req_dec b x2); intro.
+  rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    left; assumption.
+  elim H9; intros; left; apply H18.
+  repeat split.
+  assumption.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
+  apply Rplus_lt_reg_r 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 in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_cancel;
+    rewrite Ropp_involutive; apply Rle_lt_trans with (Rabs h0).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  apply Rlt_le_trans with del;
+    [ assumption
+      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+        [ apply Rmin_r | apply Rmin_l ] ].
+  apply Rle_ge; left; apply Rlt_Rminus; elim H15; intros; assumption.
+  unfold fct_cte in |- *; ring.
+  rewrite RiemannInt_P15.
+  rewrite Rmult_assoc; replace ((b - (b + h0)) * Rabs (/ h0)) with 1.
+  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite Rabs_left.
+  apply Rmult_eq_reg_l with h0;
+    [ do 2 rewrite (Rmult_comm h0); rewrite Rmult_assoc;
+      rewrite Ropp_mult_distr_l_reverse; rewrite <- Rinv_l_sym;
+        [ ring | assumption ]
+      | assumption ].
+  apply Rinv_lt_0_compat; 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 in |- *; rewrite Rmult_plus_distr_r; ring.
+  rewrite RiemannInt_P15.
+  rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_eq_reg_l with h0;
+    [ repeat rewrite (Rmult_comm h0); unfold Rdiv in |- *;
+      repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym; 
+        [ ring | assumption ]
+      | assumption ].
+  cut (a <= b + h0).
+  cut (b + h0 <= b).
+  intros; unfold primitive in |- *; case (Rle_dec a (b + h0));
+    case (Rle_dec (b + h0) b); case (Rle_dec a b); case (Rle_dec b b); 
+    intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
+  rewrite <- (RiemannInt_P26 (FTC_P1 h C0 r3 r2) H13 (FTC_P1 h C0 r1 r0)); ring.
+  elim n; assumption.
+  left; assumption.
+  apply Rplus_le_reg_l 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 (Rabs h0).
+  rewrite <- Rabs_Ropp; apply RRle_abs.
+  left; assumption.
+  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  cut (primitive h (FTC_P1 h C0) b = f_b b).
+  intro; cut (primitive h (FTC_P1 h C0) (b + h0) = f_b (b + h0)).
+  intro; rewrite H13; rewrite H14; apply H6.
+  assumption.
+  apply Rlt_le_trans with del;
+    [ assumption | unfold del in |- *; apply Rmin_l ].
+  assert (H14 : b < b + h0).
+  pattern b at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  assert (H14 := Rge_le _ _ r); elim H14; intro.
+  assumption.
+  elim H11; symmetry  in |- *; assumption.
+  unfold primitive in |- *; case (Rle_dec a (b + h0));
+    case (Rle_dec (b + h0) b); intros;
+      [ elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H14))
+        | unfold f_b in |- *; reflexivity
+        | elim n; left; apply Rlt_trans with b; assumption
+        | elim n0; left; apply Rlt_trans with b; assumption ].
+  unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rmult_0_r; rewrite Rplus_0_l; unfold primitive in |- *;
+      case (Rle_dec a b); case (Rle_dec b b); intros;
+        [ apply RiemannInt_P5
+          | elim n; right; reflexivity
+          | elim n; left; assumption
+          | elim n; right; reflexivity ].
 (*****)
-set (f_a := fun x:R => f a * (x - a)); rewrite <- H2;
- assert (H3 : derivable_pt_lim f_a a (f a)).
-unfold f_a in |- *;
- change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
-  in |- *; pattern (f a) at 2 in |- *;
- replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_const.
-replace 1 with (1 - 0); [ idtac | ring ].
-apply derivable_pt_lim_minus.
-apply derivable_pt_lim_id.
-apply derivable_pt_lim_const.
-unfold fct_cte in |- *; ring.
-unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros.
-assert (H6 : continuity_pt f a).
-apply C0; split; [ right; reflexivity | left; assumption ].
-assert (H7 : 0 < eps / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *;
- unfold R_dist in |- *; intros.
-set (del := Rmin x0 (Rmin x1 (b - a))).
-assert (H9 : 0 < del).
-unfold del in |- *; unfold Rmin in |- *.
-case (Rle_dec x1 (b - a)); intros.
-case (Rle_dec x0 x1); intro.
-apply (cond_pos x0).
-elim H8; intros; assumption.
-case (Rle_dec x0 (b - a)); intro.
-apply (cond_pos x0).
-apply Rlt_Rminus; assumption.
-split with (mkposreal _ H9).
-intros; case (Rcase_abs h0); intro.
-assert (H12 : a + h0 < a).
-pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- assumption.
-unfold primitive in |- *.
-case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a);
- case (Rle_dec a b); intros;
- try (elim n; left; assumption) || (elim n; right; reflexivity).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)).
-elim n; left; apply Rlt_trans with a; assumption.
-rewrite RiemannInt_P9; replace 0 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 in |- *; apply Rmin_l ].
-unfold f_a in |- *; ring.
-unfold f_a in |- *; ring.
-elim n; left; apply Rlt_trans with a; assumption.
-assert (H12 : a < a + h0).
-pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
-assert (H12 := Rge_le _ _ r); elim H12; intro.
-assumption.
-elim H10; symmetry  in |- *; 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 Rplus_le_reg_l with (- b - h0).
-replace (- b - h0 + b) with (- h0); [ idtac | ring ].
-replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ].
-apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr;
- apply Rle_trans with del.
-apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ].
-unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
-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 in |- *; rewrite Rabs_mult;
- apply Rle_lt_trans with
-  (RiemannInt
-     (RiemannInt_P16
-        (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) *
-   Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_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)) * Rabs (/ h0)).
-do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
-apply Rabs_pos.
-apply RiemannInt_P19.
-left; assumption.
-intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a).
-unfold fct_cte in |- *; case (Req_dec a x2); intro.
-rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- left; assumption.
-elim H8; intros; left; apply H17; repeat split.
-assumption.
-rewrite Rabs_right.
-apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ].
-apply Rlt_le_trans with (a + h0).
-elim H14; intros; assumption.
-apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0).
-apply RRle_abs.
-apply Rlt_le_trans with del;
- [ assumption
- | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
-    [ apply Rmin_r | apply Rmin_l ] ].
-apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption.
-unfold fct_cte in |- *; ring.
-rewrite RiemannInt_P15.
-rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1.
-rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite Rabs_right.
-rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym;
- [ reflexivity | assumption ].
-apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r);
- elim H14; intro.
-assumption.
-elim H10; symmetry  in |- *; assumption.
-rewrite
- (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a))
-    (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))
- ; ring.
-unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
-rewrite RiemannInt_P15.
-rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *;
- rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ].
-cut (a <= a + h0).
-cut (a + h0 <= b).
-intros; unfold primitive in |- *; case (Rle_dec a (a + h0));
- case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); 
- intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
-rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply RiemannInt_P5.
-elim n; assumption.
-elim n; assumption.
-2: left; assumption.
-apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0;
- [ idtac | ring ].
-rewrite Rplus_comm; apply Rle_trans with del;
- [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]
- | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ].
+  set (f_a := fun x:R => f a * (x - a)); rewrite <- H2;
+    assert (H3 : derivable_pt_lim f_a a (f a)).
+  unfold f_a in |- *;
+    change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
+      in |- *; pattern (f a) at 2 in |- *;
+        replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_const.
+  replace 1 with (1 - 0); [ idtac | ring ].
+  apply derivable_pt_lim_minus.
+  apply derivable_pt_lim_id.
+  apply derivable_pt_lim_const.
+  unfold fct_cte in |- *; ring.
+  unfold derivable_pt_lim in |- *; intros; elim (H3 _ H4); intros.
+  assert (H6 : continuity_pt f a).
+  apply C0; split; [ right; reflexivity | left; assumption ].
+  assert (H7 : 0 < eps / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim (H6 _ H7); unfold D_x, no_cond, dist in |- *; simpl in |- *;
+    unfold R_dist in |- *; intros.
+  set (del := Rmin x0 (Rmin x1 (b - a))).
+  assert (H9 : 0 < del).
+  unfold del in |- *; unfold Rmin in |- *.
+  case (Rle_dec x1 (b - a)); intros.
+  case (Rle_dec x0 x1); intro.
+  apply (cond_pos x0).
+  elim H8; intros; assumption.
+  case (Rle_dec x0 (b - a)); intro.
+  apply (cond_pos x0).
+  apply Rlt_Rminus; assumption.
+  split with (mkposreal _ H9).
+  intros; case (Rcase_abs h0); intro.
+  assert (H12 : a + h0 < a).
+  pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    assumption.
+  unfold primitive in |- *.
+  case (Rle_dec a (a + h0)); case (Rle_dec (a + h0) b); case (Rle_dec a a);
+  case (Rle_dec a b); intros;
+    try (elim n; left; assumption) || (elim n; right; reflexivity).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H12)).
+  elim n; left; apply Rlt_trans with a; assumption.
+  rewrite RiemannInt_P9; replace 0 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 in |- *; apply Rmin_l ].
+  unfold f_a in |- *; ring.
+  unfold f_a in |- *; ring.
+  elim n; left; apply Rlt_trans with a; assumption.
+  assert (H12 : a < a + h0).
+  pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  assert (H12 := Rge_le _ _ r); elim H12; intro.
+  assumption.
+  elim H10; symmetry  in |- *; 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 Rplus_le_reg_l with (- b - h0).
+  replace (- b - h0 + b) with (- h0); [ idtac | ring ].
+  replace (- b - h0 + (a + h0)) with (a - b); [ idtac | ring ].
+  apply Ropp_le_cancel; rewrite Ropp_involutive; rewrite Ropp_minus_distr;
+    apply Rle_trans with del.
+  apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ].
+  unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r.
+  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 in |- *; rewrite Rabs_mult;
+    apply Rle_lt_trans with
+      (RiemannInt
+        (RiemannInt_P16
+          (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a)))) *
+        Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_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)) * Rabs (/ h0)).
+  do 2 rewrite <- (Rmult_comm (Rabs (/ h0))); apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  apply RiemannInt_P19.
+  left; assumption.
+  intros; replace (f x2 + -1 * fct_cte (f a) x2) with (f x2 - f a).
+  unfold fct_cte in |- *; case (Req_dec a x2); intro.
+  rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    left; assumption.
+  elim H8; intros; left; apply H17; repeat split.
+  assumption.
+  rewrite Rabs_right.
+  apply Rplus_lt_reg_r with a; replace (a + (x2 - a)) with x2; [ idtac | ring ].
+  apply Rlt_le_trans with (a + h0).
+  elim H14; intros; assumption.
+  apply Rplus_le_compat_l; left; apply Rle_lt_trans with (Rabs h0).
+  apply RRle_abs.
+  apply Rlt_le_trans with del;
+    [ assumption
+      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a));
+        [ apply Rmin_r | apply Rmin_l ] ].
+  apply Rle_ge; left; apply Rlt_Rminus; elim H14; intros; assumption.
+  unfold fct_cte in |- *; ring.
+  rewrite RiemannInt_P15.
+  rewrite Rmult_assoc; replace ((a + h0 - a) * Rabs (/ h0)) with 1.
+  rewrite Rmult_1_r; unfold Rdiv in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; pattern eps at 1 in |- *; rewrite <- Rplus_0_r;
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite Rabs_right.
+  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym;
+      [ reflexivity | assumption ].
+  apply Rle_ge; left; apply Rinv_0_lt_compat; assert (H14 := Rge_le _ _ r);
+    elim H14; intro.
+  assumption.
+  elim H10; symmetry  in |- *; assumption.
+  rewrite
+    (RiemannInt_P13 H13 (RiemannInt_P14 a (a + h0) (f a))
+      (RiemannInt_P10 (-1) H13 (RiemannInt_P14 a (a + h0) (f a))))
+    ; ring.
+  unfold Rdiv, Rminus in |- *; rewrite Rmult_plus_distr_r; ring.
+  rewrite RiemannInt_P15.
+  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; unfold Rdiv in |- *;
+      rewrite Rmult_assoc; rewrite <- Rinv_r_sym; [ ring | assumption ].
+  cut (a <= a + h0).
+  cut (a + h0 <= b).
+  intros; unfold primitive in |- *; case (Rle_dec a (a + h0));
+    case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); 
+    intros; try (elim n; right; reflexivity) || (elim n; left; assumption).
+  rewrite RiemannInt_P9; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply RiemannInt_P5.
+  elim n; assumption.
+  elim n; assumption.
+  2: left; assumption.
+  apply Rplus_le_reg_l with (- a); replace (- a + (a + h0)) with h0;
+    [ idtac | ring ].
+  rewrite Rplus_comm; apply Rle_trans with del;
+    [ apply Rle_trans with (Rabs h0); [ apply RRle_abs | left; assumption ]
+      | unfold del in |- *; apply Rle_trans with (Rmin x1 (b - a)); apply Rmin_r ].
 (*****)
-assert (H1 : x = a).
-rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption.
-set (f_a := fun x:R => f a * (x - a)).
-assert (H2 : derivable_pt_lim f_a a (f a)).
-unfold f_a in |- *;
- change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
-  in |- *; pattern (f a) at 2 in |- *;
- replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_const.
-replace 1 with (1 - 0); [ idtac | ring ].
-apply derivable_pt_lim_minus.
-apply derivable_pt_lim_id.
-apply derivable_pt_lim_const.
-unfold fct_cte in |- *; ring.
-set
- (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))).
-assert (H3 : derivable_pt_lim f_b b (f b)).
-unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
-change
-  (derivable_pt_lim
-     ((fct_cte (f b) * (id - fct_cte b))%F +
-      fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
-     f b + 0)) in |- *. 
-apply derivable_pt_lim_plus.
-pattern (f b) at 2 in |- *;
- replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
-apply derivable_pt_lim_mult.
-apply derivable_pt_lim_const.
-replace 1 with (1 - 0); [ idtac | ring ].
-apply derivable_pt_lim_minus.
-apply derivable_pt_lim_id.
-apply derivable_pt_lim_const.
-unfold fct_cte in |- *; ring.
-apply derivable_pt_lim_const.
-ring.
-unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros;
- elim (H3 _ H4); intros; set (del := Rmin x0 x1).
-assert (H7 : 0 < del).
-unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro.
-apply (cond_pos x0).
-apply (cond_pos x1).
-split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro.
-assert (H10 : a + h0 < a).
-pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- assumption.
-rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0));
- case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); 
- intros; try (elim n; right; assumption || reflexivity).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
-rewrite RiemannInt_P9; replace 0 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 in |- *; apply Rmin_l.
-unfold f_a in |- *; ring.
-unfold f_a in |- *; ring.
-elim n; rewrite <- H0; left; assumption.
-assert (H10 : a < a + h0).
-pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
-assert (H10 := Rge_le _ _ r); elim H10; intro.
-assumption.
-elim H8; symmetry  in |- *; assumption.
-rewrite H0 in H1; rewrite H1; unfold primitive in |- *;
- case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); 
- case (Rle_dec a b); case (Rle_dec b b); intros;
- try (elim n; right; assumption || reflexivity).
-rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
-repeat rewrite RiemannInt_P9.
-replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
-fold (f_b (b + h0)) in |- *.
-apply H6; try assumption.
-apply Rlt_le_trans with del; try assumption.
-unfold del in |- *; apply Rmin_r.
-unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5.
-elim n; rewrite <- H0; left; assumption.
-elim n0; rewrite <- H0; left; assumption.
+  assert (H1 : x = a).
+  rewrite <- H0 in H; elim H; intros; apply Rle_antisym; assumption.
+  set (f_a := fun x:R => f a * (x - a)).
+  assert (H2 : derivable_pt_lim f_a a (f a)).
+  unfold f_a in |- *;
+    change (derivable_pt_lim (fct_cte (f a) * (id - fct_cte a)%F) a (f a))
+      in |- *; pattern (f a) at 2 in |- *;
+        replace (f a) with (0 * (id - fct_cte a)%F a + fct_cte (f a) a * 1).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_const.
+  replace 1 with (1 - 0); [ idtac | ring ].
+  apply derivable_pt_lim_minus.
+  apply derivable_pt_lim_id.
+  apply derivable_pt_lim_const.
+  unfold fct_cte in |- *; ring.
+  set
+    (f_b := fun x:R => f b * (x - b) + RiemannInt (FTC_P1 h C0 h (Rle_refl b))).
+  assert (H3 : derivable_pt_lim f_b b (f b)).
+  unfold f_b in |- *; pattern (f b) at 2 in |- *; replace (f b) with (f b + 0).
+  change
+    (derivable_pt_lim
+      ((fct_cte (f b) * (id - fct_cte b))%F +
+        fct_cte (RiemannInt (FTC_P1 h C0 h (Rle_refl b)))) b (
+          f b + 0)) in |- *. 
+  apply derivable_pt_lim_plus.
+  pattern (f b) at 2 in |- *;
+    replace (f b) with (0 * (id - fct_cte b)%F b + fct_cte (f b) b * 1).
+  apply derivable_pt_lim_mult.
+  apply derivable_pt_lim_const.
+  replace 1 with (1 - 0); [ idtac | ring ].
+  apply derivable_pt_lim_minus.
+  apply derivable_pt_lim_id.
+  apply derivable_pt_lim_const.
+  unfold fct_cte in |- *; ring.
+  apply derivable_pt_lim_const.
+  ring.
+  unfold derivable_pt_lim in |- *; intros; elim (H2 _ H4); intros;
+    elim (H3 _ H4); intros; set (del := Rmin x0 x1).
+  assert (H7 : 0 < del).
+  unfold del in |- *; unfold Rmin in |- *; case (Rle_dec x0 x1); intro.
+  apply (cond_pos x0).
+  apply (cond_pos x1).
+  split with (mkposreal _ H7); intros; case (Rcase_abs h0); intro.
+  assert (H10 : a + h0 < a).
+  pattern a at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    assumption.
+  rewrite H1; unfold primitive in |- *; case (Rle_dec a (a + h0));
+    case (Rle_dec (a + h0) b); case (Rle_dec a a); case (Rle_dec a b); 
+    intros; try (elim n; right; assumption || reflexivity).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H10)).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
+  rewrite RiemannInt_P9; replace 0 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 in |- *; apply Rmin_l.
+  unfold f_a in |- *; ring.
+  unfold f_a in |- *; ring.
+  elim n; rewrite <- H0; left; assumption.
+  assert (H10 : a < a + h0).
+  pattern a at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  assert (H10 := Rge_le _ _ r); elim H10; intro.
+  assumption.
+  elim H8; symmetry  in |- *; assumption.
+  rewrite H0 in H1; rewrite H1; unfold primitive in |- *;
+    case (Rle_dec a (b + h0)); case (Rle_dec (b + h0) b); 
+    case (Rle_dec a b); case (Rle_dec b b); intros;
+      try (elim n; right; assumption || reflexivity).
+  rewrite H0 in H10; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r2 H10)).
+  repeat rewrite RiemannInt_P9.
+  replace (RiemannInt (FTC_P1 h C0 r1 r0)) with (f_b b).
+  fold (f_b (b + h0)) in |- *.
+  apply H6; try assumption.
+  apply Rlt_le_trans with del; try assumption.
+  unfold del in |- *; apply Rmin_r.
+  unfold f_b in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rmult_0_r; rewrite Rplus_0_l; apply RiemannInt_P5.
+  elim n; rewrite <- H0; left; assumption.
+  elim n0; rewrite <- H0; left; assumption.
 Qed.
 
 Lemma RiemannInt_P29 :
- forall (f:R -> R) a b (h:a <= b)
-   (C0:forall x:R, a <= x <= b -> continuity_pt f x),
-   antiderivative f (primitive h (FTC_P1 h C0)) a b.
-intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
- assert (H0 := RiemannInt_P28 h C0 H);
- assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x);
- [ unfold derivable_pt in |- *; split with (f x); apply H0
- | split with H1; symmetry  in |- *; apply derive_pt_eq_0; apply H0 ].
+  forall (f:R -> R) a b (h:a <= b)
+    (C0:forall x:R, a <= x <= b -> continuity_pt f x),
+    antiderivative f (primitive h (FTC_P1 h C0)) a b.
+Proof.
+  intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+    assert (H0 := RiemannInt_P28 h C0 H);
+      assert (H1 : derivable_pt (primitive h (FTC_P1 h C0)) x);
+        [ unfold derivable_pt in |- *; split with (f x); apply H0
+          | split with H1; symmetry  in |- *; apply derive_pt_eq_0; apply H0 ].
 Qed.
 
 Lemma RiemannInt_P30 :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall x:R, a <= x <= b -> continuity_pt f x) ->
-   sigT (fun g:R -> R => antiderivative f g a b).
-intros; split with (primitive H (FTC_P1 H H0)); apply RiemannInt_P29.
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall x:R, a <= x <= b -> continuity_pt f x) ->
+    sigT (fun g:R -> R => antiderivative f g a b).
+Proof.
+  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 :
- forall (f:C1_fun) (a b:R),
-   a <= b -> antiderivative (derive f (diff0 f)) f a b.
-intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
- split with (diff0 f x); reflexivity.
+  forall (f:C1_fun) (a b:R),
+    a <= b -> antiderivative (derive f (diff0 f)) f a b.
+Proof.
+  intro f; intros; unfold antiderivative in |- *; split; try assumption; intros;
+    split with (diff0 f x); reflexivity.
 Qed.
 
 Lemma RiemannInt_P32 :
- forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b.
-intro f; intros; case (Rle_dec 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) ] ].
+  forall (f:C1_fun) (a b:R), Riemann_integrable (derive f (diff0 f)) a b.
+Proof.
+  intro f; intros; case (Rle_dec 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 :
- forall (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 : forall 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 ] ].
+  forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b),
+    a <= b -> RiemannInt pr = f b - f a.
+Proof.
+  intro f; intros;
+    assert
+      (H0 : forall 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 :
- forall (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 (Rle_dec 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 ] ].
+  forall (f:C1_fun) (a b:R) (pr:Riemann_integrable (derive f (diff0 f)) a b),
+    RiemannInt pr = f b - f a.
+Proof.
+  intro f; intros; case (Rle_dec 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/theories/Reals/RiemannInt_SF.v b/theories/Reals/RiemannInt_SF.v
index b628de73..0f91d006 100644
--- a/theories/Reals/RiemannInt_SF.v
+++ b/theories/Reals/RiemannInt_SF.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: RiemannInt_SF.v 8837 2006-05-22 08:41:18Z herbelin $ i*)
+
+(*i $Id: RiemannInt_SF.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -16,98 +16,100 @@ Open Local Scope R_scope.
 
 Set Implicit Arguments.
 
-(**************************************************)
-(* Each bounded subset of N has a maximal element *)
-(**************************************************)
+(*****************************************************)
+(** * Each bounded subset of N has a maximal element *)
+(*****************************************************)
 
 Definition Nbound (I:nat -> Prop) : Prop :=
-   exists n : nat, (forall i:nat, I i -> (i <= n)%nat).
+  exists n : nat, (forall i:nat, I i -> (i <= n)%nat).
 
 Lemma IZN_var : forall z:Z, (0 <= z)%Z -> {n : nat | z = Z_of_nat n}.
-intros; apply Z_of_nat_complete_inf; assumption.
+Proof.
+  intros; apply Z_of_nat_complete_inf; assumption.
 Qed.
 
 Lemma Nzorn :
- forall I:nat -> Prop,
-   (exists n : nat, I n) ->
-   Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)).
-intros I H H0; set (E := fun x:R =>  exists i : nat, I i /\ INR i = x);
- assert (H1 : bound E).
-unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *;
- exists (INR N); unfold is_upper_bound in |- *; intros; 
- unfold E in H2; elim H2; intros; elim H3; intros; 
- rewrite <- H5; apply le_INR; apply H1; assumption.
-assert (H2 :  exists x : R, E x).
-elim H; intros; exists (INR x); unfold E in |- *; exists x; split;
- [ assumption | reflexivity ].
-assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p;
- elim p; clear p; intros; unfold is_upper_bound in H4, H5;
- assert (H6 : 0 <= x).
-elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros;
- apply Rle_trans with x0;
- [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR;
-    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 Rplus_le_reg_l with 1;
- 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)%Z).
-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 Rplus_le_reg_l with (- x + 1);
-    replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x);
-    [ idtac | ring ]; replace (- x + 1 + x) with 1; 
-    [ assumption | ring ] ].
-assert (H11 : (0 <= up x)%Z).
-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 (forall y:R, E y -> y <= x - 1).
-intro; assert (H14 := H5 _ H13); cut (x - 1 < x).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)).
-apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ];
- rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1.
-intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13;
- intros; elim H16; intros; apply Rplus_le_reg_l with 1.
-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 1 with (INR 1);
- [ idtac | reflexivity ]; rewrite <- minus_INR.
-replace (x0 - 1)%nat with (pred x0);
- [ reflexivity
- | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ].
-induction  x0 as [| x0 Hrecx0];
- [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7;
-    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7))
- | 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 in |- *; split.
-assumption.
-intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros;
- rewrite H20; apply H4; unfold E in |- *; exists i; 
- split; [ assumption | reflexivity ].
+  forall I:nat -> Prop,
+    (exists n : nat, I n) ->
+    Nbound I -> sigT (fun n:nat => I n /\ (forall i:nat, I i -> (i <= n)%nat)).
+Proof.
+  intros I H H0; set (E := fun x:R =>  exists i : nat, I i /\ INR i = x);
+    assert (H1 : bound E).
+  unfold Nbound in H0; elim H0; intros N H1; unfold bound in |- *;
+    exists (INR N); unfold is_upper_bound in |- *; intros; 
+      unfold E in H2; elim H2; intros; elim H3; intros; 
+        rewrite <- H5; apply le_INR; apply H1; assumption.
+  assert (H2 :  exists x : R, E x).
+  elim H; intros; exists (INR x); unfold E in |- *; exists x; split;
+    [ assumption | reflexivity ].
+  assert (H3 := completeness E H1 H2); elim H3; intros; unfold is_lub in p;
+    elim p; clear p; intros; unfold is_upper_bound in H4, H5;
+      assert (H6 : 0 <= x).
+  elim H2; intros; unfold E in H6; elim H6; intros; elim H7; intros;
+    apply Rle_trans with x0;
+      [ rewrite <- H9; change (INR 0 <= INR x1) in |- *; apply le_INR;
+        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 Rplus_le_reg_l with 1;
+      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)%Z).
+  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 Rplus_le_reg_l with (- x + 1);
+        replace (- x + 1 + (IZR (up x) - 1)) with (IZR (up x) - x);
+        [ idtac | ring ]; replace (- x + 1 + x) with 1; 
+        [ assumption | ring ] ].
+  assert (H11 : (0 <= up x)%Z).
+  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 (forall y:R, E y -> y <= x - 1).
+  intro; assert (H14 := H5 _ H13); cut (x - 1 < x).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H14 H15)).
+  apply Rminus_lt; replace (x - 1 - x) with (-1); [ idtac | ring ];
+    rewrite <- Ropp_0; apply Ropp_lt_gt_contravar; apply Rlt_0_1.
+  intros; assert (H14 := H4 _ H13); elim H14; intro; unfold E in H13; elim H13;
+    intros; elim H16; intros; apply Rplus_le_reg_l with 1.
+  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 1 with (INR 1);
+    [ idtac | reflexivity ]; rewrite <- minus_INR.
+  replace (x0 - 1)%nat with (pred x0);
+  [ reflexivity
+    | case x0; [ reflexivity | intro; simpl in |- *; apply minus_n_O ] ].
+  induction  x0 as [| x0 Hrecx0];
+    [ rewrite p in H7; rewrite <- INR_IZR_INZ in H7; simpl in H7;
+      elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7))
+      | 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 in |- *; split.
+  assumption.
+  intros; apply INR_le; rewrite H15; rewrite <- H15; elim H12; intros;
+    rewrite H20; apply H4; unfold E in |- *; exists i; 
+      split; [ assumption | reflexivity ].
 Qed.
 
 (*******************************************)
-(*             Step functions              *)
+(** *          Step functions              *)
 (*******************************************)
 
 Definition open_interval (a b x:R) : Prop := a < x < b.
@@ -119,15 +121,15 @@ Definition adapted_couple (f:R -> R) (a b:R) (l lf:Rlist) : Prop :=
   pos_Rl l (pred (Rlength l)) = Rmax a b /\
   Rlength l = S (Rlength lf) /\
   (forall i:nat,
-     (i < pred (Rlength l))%nat ->
-     constant_D_eq f (open_interval (pos_Rl l i) (pos_Rl l (S i)))
-       (pos_Rl lf i)).
+    (i < pred (Rlength l))%nat ->
+    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 /\
   (forall i:nat,
-     (i < pred (Rlength lf))%nat ->
-     pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\
+    (i < pred (Rlength lf))%nat ->
+    pos_Rl lf i <> pos_Rl lf (S i) \/ f (pos_Rl l (S i)) <> pos_Rl lf i) /\
   (forall i:nat, (i < pred (Rlength l))%nat -> pos_Rl l i <> pos_Rl l (S i)).
 
 Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type :=
@@ -136,7 +138,7 @@ Definition is_subdivision (f:R -> R) (a b:R) (l:Rlist) : Type :=
 Definition IsStepFun (f:R -> R) (a b:R) : Type :=
   sigT (fun l:Rlist => is_subdivision f a b l).
 
-(* Class of step functions *)
+(** ** Class of step functions *)
 Record StepFun (a b:R) : Type := mkStepFun
   {fe :> R -> R; pre : IsStepFun fe a b}.
 
@@ -144,2477 +146,2521 @@ Definition subdivision (a b:R) (f:StepFun a b) : Rlist := projT1 (pre f).
 
 Definition subdivision_val (a b:R) (f:StepFun a b) : Rlist :=
   match projT2 (pre f) with
-  | existT a b => a
+    | existT a b => a
   end.
 
 Boxed Fixpoint Int_SF (l k:Rlist) {struct l} : R :=
   match l with
-  | nil => 0
-  | cons a l' =>
+    | nil => 0
+    | cons a l' =>
       match k with
-      | nil => 0
-      | cons x nil => 0
-      | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k')
+        | nil => 0
+        | cons x nil => 0
+        | cons x (cons y k') => a * (y - x) + Int_SF l' (cons y k')
       end
   end.
 
-(* Integral of step functions *)
+(** ** Integral of step functions *)
 Definition RiemannInt_SF (a b:R) (f:StepFun a b) : R :=
   match Rle_dec a b with
-  | left _ => Int_SF (subdivision_val f) (subdivision f)
-  | right _ => - Int_SF (subdivision_val f) (subdivision f)
+    | left _ => Int_SF (subdivision_val f) (subdivision f)
+    | right _ => - Int_SF (subdivision_val f) (subdivision f)
   end.
 
-(********************************)
-(* Properties of step functions *)
-(********************************)
+(************************************)
+(** ** Properties of step functions *)
+(************************************)
 
 Lemma StepFun_P1 :
- forall (a b:R) (f:StepFun a b),
-   adapted_couple f a b (subdivision f) (subdivision_val f).
-intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros;
- apply a0.
+  forall (a b:R) (f:StepFun a b),
+    adapted_couple f a b (subdivision f) (subdivision_val f).
+Proof. 
+  intros a b f; unfold subdivision_val in |- *; case (projT2 (pre f)); intros;
+    apply a0.
 Qed.
 
 Lemma StepFun_P2 :
- forall (a b:R) (f:R -> R) (l lf:Rlist),
-   adapted_couple f a b l lf -> adapted_couple f b a l lf.
-unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
- repeat split; try assumption.
-rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro;
- case (Rle_dec b a); intro; try reflexivity.
-apply Rle_antisym; assumption.
-apply Rle_antisym; auto with real.
-rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro;
- case (Rle_dec b a); intro; try reflexivity.
-apply Rle_antisym; assumption.
-apply Rle_antisym; auto with real.
+  forall (a b:R) (f:R -> R) (l lf:Rlist),
+    adapted_couple f a b l lf -> adapted_couple f b a l lf.
+Proof. 
+  unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+    repeat split; try assumption.
+  rewrite H2; unfold Rmin in |- *; case (Rle_dec a b); intro;
+    case (Rle_dec b a); intro; try reflexivity.
+  apply Rle_antisym; assumption.
+  apply Rle_antisym; auto with real.
+  rewrite H1; unfold Rmax in |- *; case (Rle_dec a b); intro;
+    case (Rle_dec b a); intro; try reflexivity.
+  apply Rle_antisym; assumption.
+  apply Rle_antisym; auto with real.
 Qed.
 
 Lemma StepFun_P3 :
- forall 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 in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0;
- [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ].
-simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-unfold constant_D_eq, open_interval in |- *; intros; simpl in H0;
- inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ].
+  forall a b c:R,
+    a <= b ->
+    adapted_couple (fct_cte c) a b (cons a (cons b nil)) (cons c nil).
+Proof. 
+  intros; unfold adapted_couple in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H0; inversion H0;
+    [ simpl in |- *; assumption | elim (le_Sn_O _ H2) ].
+  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold constant_D_eq, open_interval in |- *; intros; simpl in H0;
+    inversion H0; [ reflexivity | elim (le_Sn_O _ H3) ].
 Qed.
 
 Lemma StepFun_P4 : forall a b c:R, IsStepFun (fct_cte c) a b.
-intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro.
-apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *;
- apply existT with (cons c nil); apply (StepFun_P3 c r).
-apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *;
- apply existT with (cons c nil); apply StepFun_P2; 
- apply StepFun_P3; auto with real.
+Proof. 
+  intros; unfold IsStepFun in |- *; case (Rle_dec a b); intro.
+  apply existT with (cons a (cons b nil)); unfold is_subdivision in |- *;
+    apply existT with (cons c nil); apply (StepFun_P3 c r).
+  apply existT with (cons b (cons a nil)); unfold is_subdivision in |- *;
+    apply existT with (cons c nil); apply StepFun_P2; 
+      apply StepFun_P3; auto with real.
 Qed.
 
 Lemma StepFun_P5 :
- forall (a b:R) (f:R -> R) (l:Rlist),
-   is_subdivision f a b l -> is_subdivision f b a l.
-destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x;
-  repeat split; try assumption.
-rewrite H1; apply Rmin_comm.
-rewrite H2; apply Rmax_comm.
+  forall (a b:R) (f:R -> R) (l:Rlist),
+    is_subdivision f a b l -> is_subdivision f b a l.
+Proof. 
+  destruct 1 as (x,(H0,(H1,(H2,(H3,H4))))); exists x;
+    repeat split; try assumption.
+  rewrite H1; apply Rmin_comm.
+  rewrite H2; apply Rmax_comm.
 Qed.
 
 Lemma StepFun_P6 :
- forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a.
-unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x;
- apply StepFun_P5; assumption.
+  forall (f:R -> R) (a b:R), IsStepFun f a b -> IsStepFun f b a.
+Proof. 
+  unfold IsStepFun in |- *; intros; elim X; intros; apply existT with x;
+    apply StepFun_P5; assumption.
 Qed.
 
 Lemma StepFun_P7 :
- forall (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 in |- *; intros; decompose [and] H0; clear H0;
- assert (H5 : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-assert (H7 : r2 <= b).
-rewrite H5 in H2; rewrite <- H2; apply RList_P7;
- [ assumption | simpl in |- *; right; left; reflexivity ].
-repeat split.
-apply RList_P4 with r1; assumption.
-rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmax in |- *; case (Rle_dec r2 b); intro;
- [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ].
-simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1;
- do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; 
- rewrite H4; reflexivity.
-intros; unfold constant_D_eq, open_interval in |- *; intros;
- unfold constant_D_eq, open_interval in H6;
- assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat).
-simpl in |- *; simpl in H0; apply lt_n_S; assumption.
-assert (H10 := H6 _ H9); apply H10; assumption.
+  forall (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.
+Proof. 
+  unfold adapted_couple in |- *; intros; decompose [and] H0; clear H0;
+    assert (H5 : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  assert (H7 : r2 <= b).
+  rewrite H5 in H2; rewrite <- H2; apply RList_P7;
+    [ assumption | simpl in |- *; right; left; reflexivity ].
+  repeat split.
+  apply RList_P4 with r1; assumption.
+  rewrite H5 in H2; unfold Rmin in |- *; case (Rle_dec r2 b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmax in |- *; case (Rle_dec r2 b); intro;
+    [ rewrite H5 in H2; rewrite <- H2; reflexivity | elim n; assumption ].
+  simpl in H4; simpl in |- *; apply INR_eq; apply Rplus_eq_reg_l with 1;
+    do 2 rewrite (Rplus_comm 1); do 2 rewrite <- S_INR; 
+      rewrite H4; reflexivity.
+  intros; unfold constant_D_eq, open_interval in |- *; intros;
+    unfold constant_D_eq, open_interval in H6;
+      assert (H9 : (S i < pred (Rlength (cons r1 (cons r2 l))))%nat).
+  simpl in |- *; simpl in H0; apply lt_n_S; assumption.
+  assert (H10 := H6 _ H9); apply H10; assumption.
 Qed.
 
 Lemma StepFun_P8 :
- forall (f:R -> R) (l1 lf1:Rlist) (a b:R),
-   adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0.
-simple induction l1.
-intros; induction  lf1 as [| r lf1 Hreclf1]; reflexivity.
-simple induction r0.
-intros; induction  lf1 as [| r1 lf1 Hreclf1].
-reflexivity.
-unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5;
- discriminate.
-intros; induction  lf1 as [| r3 lf1 Hreclf1].
-reflexivity.
-simpl in |- *; cut (r = r1).
-intro; rewrite H3; rewrite (H0 lf1 r b).
-ring.
-rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ].
-clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1;
- intros; simpl in H4; rewrite H4; unfold Rmin in |- *; 
- case (Rle_dec a b); intro; [ assumption | reflexivity ].
-unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym.
-apply (H3 0%nat); simpl in |- *; apply lt_O_Sn.
-simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b);
- [ rewrite <- H4; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ]
- | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros;
-    try assumption || reflexivity ].
+  forall (f:R -> R) (l1 lf1:Rlist) (a b:R),
+    adapted_couple f a b l1 lf1 -> a = b -> Int_SF lf1 l1 = 0.
+Proof. 
+  simple induction l1.
+  intros; induction  lf1 as [| r lf1 Hreclf1]; reflexivity.
+  simple induction r0.
+  intros; induction  lf1 as [| r1 lf1 Hreclf1].
+  reflexivity.
+  unfold adapted_couple in H0; decompose [and] H0; clear H0; simpl in H5;
+    discriminate.
+  intros; induction  lf1 as [| r3 lf1 Hreclf1].
+  reflexivity.
+  simpl in |- *; cut (r = r1).
+  intro; rewrite H3; rewrite (H0 lf1 r b).
+  ring.
+  rewrite H3; apply StepFun_P7 with a r r3; [ right; assumption | assumption ].
+  clear H H0 Hreclf1 r0; unfold adapted_couple in H1; decompose [and] H1;
+    intros; simpl in H4; rewrite H4; unfold Rmin in |- *; 
+      case (Rle_dec a b); intro; [ assumption | reflexivity ].
+  unfold adapted_couple in H1; decompose [and] H1; intros; apply Rle_antisym.
+  apply (H3 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl in H5; rewrite H2 in H5; rewrite H5; replace (Rmin b b) with (Rmax a b);
+    [ rewrite <- H4; apply RList_P7;
+      [ assumption | simpl in |- *; right; left; reflexivity ]
+      | unfold Rmin, Rmax in |- *; case (Rle_dec b b); case (Rle_dec a b); intros;
+        try assumption || reflexivity ].
 Qed.
 
 Lemma StepFun_P9 :
- forall (a b:R) (f:R -> R) (l lf:Rlist),
-   adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat.
-intros; unfold adapted_couple in H; decompose [and] H; clear H;
- induction  l as [| r l Hrecl];
- [ simpl in H4; discriminate
- | induction  l as [| r0 l Hrecl0];
-    [ simpl in H3; simpl in H2; generalize H3; generalize H2;
-       unfold Rmin, Rmax in |- *; case (Rle_dec a b); 
-       intros; elim H0; rewrite <- H5; rewrite <- H7; 
-       reflexivity
-    | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ].
+  forall (a b:R) (f:R -> R) (l lf:Rlist),
+    adapted_couple f a b l lf -> a <> b -> (2 <= Rlength l)%nat.
+Proof. 
+  intros; unfold adapted_couple in H; decompose [and] H; clear H;
+    induction  l as [| r l Hrecl];
+      [ simpl in H4; discriminate
+        | induction  l as [| r0 l Hrecl0];
+          [ simpl in H3; simpl in H2; generalize H3; generalize H2;
+            unfold Rmin, Rmax in |- *; case (Rle_dec a b); 
+              intros; elim H0; rewrite <- H5; rewrite <- H7; 
+                reflexivity
+            | simpl in |- *; do 2 apply le_n_S; apply le_O_n ] ].
 Qed.
 
 Lemma StepFun_P10 :
- forall (f:R -> R) (l lf:Rlist) (a b:R),
-   a <= b ->
-   adapted_couple f a b l lf ->
+  forall (f:R -> R) (l lf:Rlist) (a b:R),
+    a <= b ->
+    adapted_couple f a b l lf ->
     exists l' : Rlist,
-     (exists lf' : Rlist, adapted_couple_opt f a b l' lf').
-simple induction l.
-intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4;
- discriminate.
-intros; case (Req_dec a b); intro.
-exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *;
- unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; 
- repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)).
-simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro;
- reflexivity.
-simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro;
- reflexivity.
-elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]];
- induction  lf as [| r1 lf Hreclf].
-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_dec 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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro.
-exists (cons a (cons b nil)); exists (cons r1 nil);
- unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
- repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
- [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
-simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-intros; simpl in H8; inversion H8.
-unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
- simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1;
- decompose [and] H1; apply (H16 0%nat).
-simpl in |- *; apply lt_O_Sn.
-unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13;
- rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); 
- intro; [ assumption | elim n; assumption ].
-elim (le_Sn_O _ H10).
-intros; simpl in H8; elim (lt_n_O _ H8).
-intros; simpl in H8; inversion H8;
- [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
-assert (Hyp_min : Rmin t2 b = t2).
-unfold Rmin in |- *; case (Rle_dec t2 b); intro;
- [ reflexivity | elim n; assumption ].
-unfold adapted_couple in H6; elim H6; clear H6; intros;
- elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]];
- induction  lf' as [| r2 lf' Hreclf'].
-unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13;
- simpl in H13; discriminate.
-clear Hreclf'; case (Req_dec r1 r2); intro.
-case (Req_dec (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 in |- *; unfold adapted_couple in |- *;
- repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H1;
- induction  i as [| i Hreci].
-simpl in |- *; apply Rle_trans with s1.
-replace s1 with t2.
-apply (H12 0%nat).
-simpl in |- *; apply lt_O_Sn.
-simpl in H19; rewrite H19; symmetry  in |- *; apply Hyp_min.
-apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
- apply (H16 (S i)); simpl in |- *; assumption.
-simpl in |- *; simpl in H14; rewrite H14; reflexivity.
-simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *;
- case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n;
- assumption.
-simpl in |- *; simpl in H20; apply H20.
-intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; simpl in H6; case (total_order_T x t2); intro.
-elim s; intro.
-apply (H17 0%nat);
- [ simpl in |- *; apply lt_O_Sn
- | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split;
-    assumption ].
-rewrite b0; assumption.
-rewrite H10; apply (H22 0%nat);
- [ simpl in |- *; apply lt_O_Sn
- | unfold open_interval in |- *; simpl in |- *; replace s1 with t2;
-    [ elim H6; intros; split; assumption
-    | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ].
-simpl in |- *; simpl in H6; apply (H22 (S i));
- [ simpl in |- *; assumption
- | unfold open_interval in |- *; simpl in |- *; apply H6 ].
-intros; simpl in H1; rewrite H10;
- change
-   (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/
-    f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i)
-  in |- *; rewrite <- H9; elim H8; intros; apply H6; 
- simpl in |- *; apply H1.
-intros; induction  i as [| i Hreci].
-simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-apply (H12 0%nat); simpl in |- *; apply lt_O_Sn.
-rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19;
- apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *;
- simpl in H1; apply H1.
-exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
- rewrite H3 in H1; unfold adapted_couple in H1, H6; 
- decompose [and] H6; decompose [and] H1; clear H6 H1;
- unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
- repeat split.
-rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
- induction  i as [| i Hreci].
-simpl in |- *; replace s1 with t2.
-apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
-change
-  (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
- in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; 
- assumption.
-simpl in |- *; simpl in H19; apply H19.
-rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *;
- case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
- assumption.
-rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity.
-intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat).
-simpl in |- *; apply lt_O_Sn.
-unfold open_interval in |- *; simpl in |- *.
-replace t2 with s1.
-assumption.
-simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
-change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i).
-simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
-rewrite H9 in H6; unfold open_interval in |- *; apply H6.
-intros; simpl in H1; induction  i as [| i Hreci].
-simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2.
-assumption.
-simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
-elim H8; intros; apply (H6 i).
-simpl in |- *; apply lt_S_n; apply H1.
-intros; rewrite H9; induction  i as [| i Hreci].
-simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
-rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right;
- reflexivity.
-elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1;
- simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
-exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
- rewrite H3 in H1; unfold adapted_couple in H1, H6; 
- decompose [and] H6; decompose [and] H1; clear H6 H1;
- unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
- repeat split.
-rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
- induction  i as [| i Hreci].
-simpl in |- *; replace s1 with t2.
-apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
-simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
-change
-  (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
- in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; 
- assumption.
-simpl in |- *; simpl in H18; apply H18.
-rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *;
- case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
- assumption.
-rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity.
-intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat).
-simpl in |- *; apply lt_O_Sn.
-unfold open_interval in |- *; simpl in |- *; replace t2 with s1.
-assumption.
-simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
-change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i).
-simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
-rewrite H9 in H6; unfold open_interval in |- *; apply H6.
-intros; simpl in H1; induction  i as [| i Hreci].
-simpl in |- *; left; assumption.
-elim H8; intros; apply (H6 i).
-simpl in |- *; apply lt_S_n; apply H1.
-intros; rewrite H9; induction  i as [| i Hreci].
-simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
-apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
-rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right;
- reflexivity.
-elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1;
- simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
-rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1;
- clear H1; clear H H7 H9; cut (Rmax a b = b);
- [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7;
-    [ assumption | simpl in |- *; right; left; reflexivity ]
- | unfold Rmax in |- *; case (Rle_dec a b); intro;
-    [ reflexivity | elim n; assumption ] ].
+      (exists lf' : Rlist, adapted_couple_opt f a b l' lf').
+Proof. 
+  simple induction l.
+  intros; unfold adapted_couple in H0; decompose [and] H0; simpl in H4;
+    discriminate.
+  intros; case (Req_dec a b); intro.
+  exists (cons a nil); exists nil; unfold adapted_couple_opt in |- *;
+    unfold adapted_couple in |- *; unfold ordered_Rlist in |- *; 
+      repeat split; try (intros; simpl in H3; elim (lt_n_O _ H3)).
+  simpl in |- *; rewrite <- H2; unfold Rmin in |- *; case (Rle_dec a a); intro;
+    reflexivity.
+  simpl in |- *; rewrite <- H2; unfold Rmax in |- *; case (Rle_dec a a); intro;
+    reflexivity.
+  elim (RList_P20 _ (StepFun_P9 H1 H2)); intros t1 [t2 [t3 H3]];
+    induction  lf as [| r1 lf Hreclf].
+  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_dec 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 in |- *; case (Rle_dec a b); intro;
+        [ reflexivity | elim n; assumption ].
+  elim H6; clear H6; intros l' [lf' H6]; case (Req_dec t2 b); intro.
+  exists (cons a (cons b nil)); exists (cons r1 nil);
+    unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+      repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
+    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  intros; simpl in H8; inversion H8.
+  unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+    simpl in H9; rewrite H3 in H1; unfold adapted_couple in H1;
+      decompose [and] H1; apply (H16 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  unfold open_interval in |- *; simpl in |- *; rewrite H7; simpl in H13;
+    rewrite H13; unfold Rmin in |- *; case (Rle_dec a b); 
+      intro; [ assumption | elim n; assumption ].
+  elim (le_Sn_O _ H10).
+  intros; simpl in H8; elim (lt_n_O _ H8).
+  intros; simpl in H8; inversion H8;
+    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+  assert (Hyp_min : Rmin t2 b = t2).
+  unfold Rmin in |- *; case (Rle_dec t2 b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold adapted_couple in H6; elim H6; clear H6; intros;
+    elim (RList_P20 _ (StepFun_P9 H6 H7)); intros s1 [s2 [s3 H9]];
+      induction  lf' as [| r2 lf' Hreclf'].
+  unfold adapted_couple in H6; decompose [and] H6; rewrite H9 in H13;
+    simpl in H13; discriminate.
+  clear Hreclf'; case (Req_dec r1 r2); intro.
+  case (Req_dec (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 in |- *; unfold adapted_couple in |- *;
+          repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H1;
+    induction  i as [| i Hreci].
+  simpl in |- *; apply Rle_trans with s1.
+  replace s1 with t2.
+  apply (H12 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  simpl in H19; rewrite H19; symmetry  in |- *; apply Hyp_min.
+  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
+    apply (H16 (S i)); simpl in |- *; assumption.
+  simpl in |- *; simpl in H14; rewrite H14; reflexivity.
+  simpl in |- *; simpl in H18; rewrite H18; unfold Rmax in |- *;
+    case (Rle_dec a b); case (Rle_dec t2 b); intros; reflexivity || elim n;
+      assumption.
+  simpl in |- *; simpl in H20; apply H20.
+  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; simpl in H6; case (total_order_T x t2); intro.
+  elim s; intro.
+  apply (H17 0%nat);
+    [ simpl in |- *; apply lt_O_Sn
+      | unfold open_interval in |- *; simpl in |- *; elim H6; intros; split;
+        assumption ].
+  rewrite b0; assumption.
+  rewrite H10; apply (H22 0%nat);
+    [ simpl in |- *; apply lt_O_Sn
+      | unfold open_interval in |- *; simpl in |- *; replace s1 with t2;
+        [ elim H6; intros; split; assumption
+          | simpl in H19; rewrite H19; rewrite Hyp_min; reflexivity ] ].
+  simpl in |- *; simpl in H6; apply (H22 (S i));
+    [ simpl in |- *; assumption
+      | unfold open_interval in |- *; simpl in |- *; apply H6 ].
+  intros; simpl in H1; rewrite H10;
+    change
+      (pos_Rl (cons r2 lf') i <> pos_Rl (cons r2 lf') (S i) \/
+        f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r2 lf') i)
+      in |- *; rewrite <- H9; elim H8; intros; apply H6; 
+        simpl in |- *; apply H1.
+  intros; induction  i as [| i Hreci].
+  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H12 0%nat); simpl in |- *; apply lt_O_Sn.
+  rewrite <- Hyp_min; rewrite H6; simpl in H19; rewrite <- H19;
+    apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  elim H8; intros; rewrite H9 in H21; apply (H21 (S i)); simpl in |- *;
+    simpl in H1; apply H1.
+  exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
+    rewrite H3 in H1; unfold adapted_couple in H1, H6; 
+      decompose [and] H6; decompose [and] H1; clear H6 H1;
+        unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+          repeat split.
+  rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+    induction  i as [| i Hreci].
+  simpl in |- *; replace s1 with t2.
+  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+  change
+    (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
+    in |- *; apply (H12 i); simpl in |- *; apply lt_S_n; 
+      assumption.
+  simpl in |- *; simpl in H19; apply H19.
+  rewrite H9; simpl in |- *; simpl in H13; rewrite H13; unfold Rmax in |- *;
+    case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
+      assumption.
+  rewrite H9; simpl in |- *; simpl in H15; rewrite H15; reflexivity.
+  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H22 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  unfold open_interval in |- *; simpl in |- *.
+  replace t2 with s1.
+  assumption.
+  simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+  change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H17 i).
+  simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+  rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+  intros; simpl in H1; induction  i as [| i Hreci].
+  simpl in |- *; rewrite H9; right; simpl in |- *; replace s1 with t2.
+  assumption.
+  simpl in H14; rewrite H14; rewrite Hyp_min; reflexivity.
+  elim H8; intros; apply (H6 i).
+  simpl in |- *; apply lt_S_n; apply H1.
+  intros; rewrite H9; induction  i as [| i Hreci].
+  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H16 0%nat); simpl in |- *; apply lt_O_Sn.
+  rewrite <- Hyp_min; rewrite H6; simpl in H14; rewrite <- H14; right;
+    reflexivity.
+  elim H8; intros; rewrite <- H9; apply (H21 i); rewrite H9; rewrite H9 in H1;
+    simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+  exists (cons t1 l'); exists (cons r1 (cons r2 lf')); rewrite H9 in H6;
+    rewrite H3 in H1; unfold adapted_couple in H1, H6; 
+      decompose [and] H6; decompose [and] H1; clear H6 H1;
+        unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *;
+          repeat split.
+  rewrite H9; unfold ordered_Rlist in |- *; intros; simpl in H1;
+    induction  i as [| i Hreci].
+  simpl in |- *; replace s1 with t2.
+  apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+  simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
+  change
+    (pos_Rl (cons s1 (cons s2 s3)) i <= pos_Rl (cons s1 (cons s2 s3)) (S i))
+    in |- *; apply (H11 i); simpl in |- *; apply lt_S_n; 
+      assumption.
+  simpl in |- *; simpl in H18; apply H18.
+  rewrite H9; simpl in |- *; simpl in H12; rewrite H12; unfold Rmax in |- *;
+    case (Rle_dec t2 b); case (Rle_dec a b); intros; reflexivity || elim n;
+      assumption.
+  rewrite H9; simpl in |- *; simpl in H14; rewrite H14; reflexivity.
+  intros; simpl in H1; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; rewrite H9 in H6; simpl in H6; apply (H21 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  unfold open_interval in |- *; simpl in |- *; replace t2 with s1.
+  assumption.
+  simpl in H13; rewrite H13; rewrite Hyp_min; reflexivity.
+  change (f x = pos_Rl (cons r2 lf') i) in |- *; clear Hreci; apply (H16 i).
+  simpl in |- *; rewrite H9 in H1; simpl in H1; apply lt_S_n; apply H1.
+  rewrite H9 in H6; unfold open_interval in |- *; apply H6.
+  intros; simpl in H1; induction  i as [| i Hreci].
+  simpl in |- *; left; assumption.
+  elim H8; intros; apply (H6 i).
+  simpl in |- *; apply lt_S_n; apply H1.
+  intros; rewrite H9; induction  i as [| i Hreci].
+  simpl in |- *; red in |- *; intro; elim Hyp_eq; apply Rle_antisym.
+  apply (H15 0%nat); simpl in |- *; apply lt_O_Sn.
+  rewrite <- Hyp_min; rewrite H6; simpl in H13; rewrite <- H13; right;
+    reflexivity.
+  elim H8; intros; rewrite <- H9; apply (H20 i); rewrite H9; rewrite H9 in H1;
+    simpl in |- *; simpl in H1; apply lt_S_n; apply H1.
+  rewrite H3 in H1; clear H4; unfold adapted_couple in H1; decompose [and] H1;
+    clear H1; clear H H7 H9; cut (Rmax a b = b);
+      [ intro; rewrite H in H5; rewrite <- H5; apply RList_P7;
+        [ assumption | simpl in |- *; right; left; reflexivity ]
+        | unfold Rmax in |- *; case (Rle_dec a b); intro;
+          [ reflexivity | elim n; assumption ] ].
 Qed.
 
 Lemma StepFun_P11 :
- forall (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 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro.
-assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro.
-rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption.
-assert (H16 : s2 < r1); auto with real.
-induction  s3 as [| r0 s3 Hrecs3].
-simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)).
-rewrite <- H4; apply RList_P7;
- [ assumption | simpl in |- *; right; left; reflexivity ].
-clear Hrecs3; induction  lf2 as [| r5 lf2 Hreclf2].
-simpl in H11; discriminate.
-clear Hreclf2; assert (H17 : r3 = r4).
-set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _));
- assert (H18 := H13 0%nat (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 in |- *; split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
-       apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-unfold x in |- *; split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rlt_trans with s2;
- [ apply Rmult_lt_reg_l with 2;
+  forall (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.
+Proof. 
+  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 0%nat (lt_O_Sn _)); simpl in H14; elim H14; intro.
+  assert (H15 := H7 0%nat (lt_O_Sn _)); simpl in H15; elim H15; intro.
+  rewrite <- H12 in H1; case (Rle_dec r1 s2); intro; try assumption.
+  assert (H16 : s2 < r1); auto with real.
+  induction  s3 as [| r0 s3 Hrecs3].
+  simpl in H9; rewrite H9 in H16; cut (r1 <= Rmax a b).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H17 H16)).
+  rewrite <- H4; apply RList_P7;
+    [ assumption | simpl in |- *; right; left; reflexivity ].
+  clear Hrecs3; induction  lf2 as [| r5 lf2 Hreclf2].
+  simpl in H11; discriminate.
+  clear Hreclf2; assert (H17 : r3 = r4).
+  set (x := (r + s2) / 2); assert (H17 := H8 0%nat (lt_O_Sn _));
+    assert (H18 := H13 0%nat (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 in |- *; split.
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
+            apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  unfold x in |- *; split.
+  apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-    | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
-       rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-       [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
-          apply Rplus_lt_compat_l; assumption
-       | discrR ] ]
- | assumption ].
-assert (H18 : f s2 = r3).
-apply (H8 0%nat);
- [ simpl in |- *; apply lt_O_Sn
- | unfold open_interval in |- *; simpl in |- *; split; assumption ].
-assert (H19 : r3 = r5).
-assert (H19 := H7 1%nat); simpl in H19;
- assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; 
- intro.
-set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat);
- assert (H23 := H13 1%nat); 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 in |- *; simpl in |- *; unfold x in |- *; split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
-       unfold Rmin in |- *; case (Rle_dec r1 r0); intro; 
-       assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double;
-       apply Rlt_le_trans with (r0 + Rmin r1 r0);
-       [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
-          assumption
-       | apply Rplus_le_compat_l; apply Rmin_r ]
-    | discrR ] ].
-unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
-apply Rlt_trans with s2;
- [ assumption
- | apply Rmult_lt_reg_l with 2;
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rlt_trans with s2;
+    [ apply Rmult_lt_reg_l with 2;
+      [ prove_sup0
+        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+          rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+            [ rewrite Rmult_1_l; rewrite (Rplus_comm r); rewrite double;
+              apply Rplus_lt_compat_l; assumption
+              | discrR ] ]
+      | assumption ].
+  assert (H18 : f s2 = r3).
+  apply (H8 0%nat);
+    [ simpl in |- *; apply lt_O_Sn
+      | unfold open_interval in |- *; simpl in |- *; split; assumption ].
+  assert (H19 : r3 = r5).
+  assert (H19 := H7 1%nat); simpl in H19;
+    assert (H20 := H19 (lt_n_S _ _ (lt_O_Sn _))); elim H20; 
+      intro.
+  set (x := (s2 + Rmin r1 r0) / 2); assert (H22 := H8 0%nat);
+    assert (H23 := H13 1%nat); 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 in |- *; simpl in |- *; unfold x in |- *; split.
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+            unfold Rmin in |- *; case (Rle_dec r1 r0); intro; 
+              assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double;
+            apply Rlt_le_trans with (r0 + Rmin r1 r0);
+              [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
+                assumption
+                | apply Rplus_le_compat_l; apply Rmin_r ]
+            | discrR ] ].
+  unfold open_interval in |- *; simpl in |- *; unfold x in |- *; split.
+  apply Rlt_trans with s2;
+    [ assumption
+      | apply Rmult_lt_reg_l with 2;
+        [ prove_sup0
+          | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+            rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+              [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+                unfold Rmin in |- *; case (Rle_dec r1 r0); 
+                  intro; assumption
+                | discrR ] ] ].
+  apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-    | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
-       rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-       [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
-          unfold Rmin in |- *; case (Rle_dec r1 r0); 
-          intro; assumption
-       | discrR ] ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double;
-       apply Rlt_le_trans with (r1 + Rmin r1 r0);
-       [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
-          assumption
-       | apply Rplus_le_compat_l; apply Rmin_l ]
-    | discrR ] ].
-elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23;
- assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; 
- assumption.
-elim H2; intros; assert (H22 := H20 0%nat); 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 0%nat); simpl in H17;
- elim (H17 (lt_O_Sn _)); assumption.
-rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn.
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double;
+            apply Rlt_le_trans with (r1 + Rmin r1 r0);
+              [ do 2 rewrite <- (Rplus_comm (Rmin r1 r0)); apply Rplus_lt_compat_l;
+                assumption
+                | apply Rplus_le_compat_l; apply Rmin_l ]
+            | discrR ] ].
+  elim H2; clear H2; intros; assert (H23 := H22 1%nat); simpl in H23;
+    assert (H24 := H23 (lt_n_S _ _ (lt_O_Sn _))); elim H24; 
+      assumption.
+  elim H2; intros; assert (H22 := H20 0%nat); 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 0%nat); simpl in H17;
+    elim (H17 (lt_O_Sn _)); assumption.
+  rewrite <- H0; rewrite H12; apply (H7 0%nat); simpl in |- *; apply lt_O_Sn.
 Qed.
 
 Lemma StepFun_P12 :
- forall (a b:R) (f:R -> R) (l lf:Rlist),
-   adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf.
-unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros;
- decompose [and] H; clear H; repeat split; try assumption.
-rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro;
- case (Rle_dec b a); intro; try reflexivity.
-apply Rle_antisym; assumption.
-apply Rle_antisym; auto with real.
-rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro;
- case (Rle_dec b a); intro; try reflexivity.
-apply Rle_antisym; assumption.
-apply Rle_antisym; auto with real.
+  forall (a b:R) (f:R -> R) (l lf:Rlist),
+    adapted_couple_opt f a b l lf -> adapted_couple_opt f b a l lf.
+Proof. 
+  unfold adapted_couple_opt in |- *; unfold adapted_couple in |- *; intros;
+    decompose [and] H; clear H; repeat split; try assumption.
+  rewrite H0; unfold Rmin in |- *; case (Rle_dec a b); intro;
+    case (Rle_dec b a); intro; try reflexivity.
+  apply Rle_antisym; assumption.
+  apply Rle_antisym; auto with real.
+  rewrite H3; unfold Rmax in |- *; case (Rle_dec a b); intro;
+    case (Rle_dec b a); intro; try reflexivity.
+  apply Rle_antisym; assumption.
+  apply Rle_antisym; auto with real.
 Qed.
 
 Lemma StepFun_P13 :
- forall (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 ].
+  forall (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.
+Proof. 
+  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 :
- forall (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.
-simple 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.
-simple induction r0.
-intros; case (Req_dec 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_dec a b); intro.
-rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity.
-assert (Hyp_min : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-assert (Hyp_max : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H;
- rewrite H5; induction  lf1 as [| r3 lf1 Hreclf1].
-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 as [| r4 lf2 Hreclf2].
-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_dec 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; set (x := (r + r1) / 2); assert (H18 := H14 0%nat);
- assert (H20 := H19 0%nat); 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 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro;
- [ idtac | elim H7; assumption ]; unfold x in |- *; 
- split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
-       apply Rplus_lt_compat_l; apply H
-    | discrR ] ].
-rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21;
- intro; [ idtac | elim H7; assumption ]; unfold x in |- *; 
- split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
-    | discrR ] ].
-apply Rlt_le_trans with r1;
- [ apply Rmult_lt_reg_l with 2;
+  forall (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.
+Proof. 
+  simple 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.
+  simple induction r0.
+  intros; case (Req_dec 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_dec a b); intro.
+  rewrite (StepFun_P8 H2 H4); rewrite (StepFun_P8 H H4); reflexivity.
+  assert (Hyp_min : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  assert (Hyp_max : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  elim (RList_P20 _ (StepFun_P9 H H4)); intros s1 [s2 [s3 H5]]; rewrite H5 in H;
+    rewrite H5; induction  lf1 as [| r3 lf1 Hreclf1].
+  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 as [| r4 lf2 Hreclf2].
+  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_dec 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; set (x := (r + r1) / 2); assert (H18 := H14 0%nat);
+      assert (H20 := H19 0%nat); 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 0%nat (lt_O_Sn _)); simpl in H21; elim H21; intro;
+    [ idtac | elim H7; assumption ]; unfold x in |- *; 
+      split.
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
     [ prove_sup0
-    | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
-       rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-       [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
-          apply Rplus_lt_compat_l; apply H
-       | discrR ] ]
- | assumption ].
-eapply StepFun_P13.
-apply H4.
-apply H2.
-unfold adapted_couple_opt in |- *; split.
-apply H.
-rewrite H5 in H3; apply H3.
-assert (H8 : r1 <= s2).
-eapply StepFun_P13.
-apply H4.
-apply H2.
-unfold adapted_couple_opt in |- *; split.
-apply H.
-rewrite H5 in H3; apply H3.
-elim H7; intro.
-simpl in |- *; elim H8; intro.
-replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1));
- [ idtac | rewrite H9; rewrite H6; ring ].
-rewrite Rplus_assoc; apply Rplus_eq_compat_l;
- change
-   (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3)))
-  in |- *; apply H0 with r1 b.
-unfold adapted_couple in H2; decompose [and] H2; clear H2;
- replace b with (Rmax a b).
-rewrite <- H12; apply RList_P7;
- [ assumption | simpl in |- *; right; left; reflexivity ].
-eapply StepFun_P7.
-apply H1.
-apply H2.
-unfold adapted_couple_opt in |- *; split.
-apply StepFun_P7 with a a r3.
-apply H1.
-unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
- clear H H2; assert (H20 : r = a).
-simpl in H13; rewrite H13; apply Hyp_min.
-unfold adapted_couple in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-simpl in |- *; rewrite <- H20; apply (H11 0%nat).
-simpl in |- *; apply lt_O_Sn.
-induction  i as [| i Hreci0].
-simpl in |- *; assumption.
-change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
- apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption.
-simpl in |- *; symmetry  in |- *; apply Hyp_min.
-rewrite <- H17; reflexivity.
-simpl in H19; simpl in |- *; rewrite H19; reflexivity.
-intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; apply (H16 0%nat).
-simpl in |- *; apply lt_O_Sn.
-simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
- simpl in |- *; apply H2.
-clear Hreci; induction  i as [| i Hreci].
-simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat).
-simpl in |- *; apply lt_O_Sn.
-unfold open_interval in |- *; simpl in |- *; elim H2; intros; split.
-apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat);
- simpl in |- *; apply lt_O_Sn.
-assumption.
-clear Hreci; simpl in |- *; apply (H21 (S i)).
-simpl in |- *; apply lt_S_n; assumption.
-unfold open_interval in |- *; apply H2.
-elim H3; clear H3; intros; split.
-rewrite H9;
- change
-   (forall i:nat,
-      (i < pred (Rlength (cons r4 lf2)))%nat ->
-      pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/
-      f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i)
-  in |- *; rewrite <- H5; apply H3.
-rewrite H5 in H11; intros; simpl in H12; induction  i as [| i Hreci].
-simpl in |- *; red in |- *; intro; rewrite H13 in H10;
- elim (Rlt_irrefl _ H10).
-clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12.
-rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10;
- apply H0 with r1 b.
-unfold adapted_couple in H2; decompose [and] H2; clear H2;
- replace b with (Rmax a b).
-rewrite <- H12; apply RList_P7;
- [ assumption | simpl in |- *; right; left; reflexivity ].
-eapply StepFun_P7.
-apply H1.
-apply H2.
-unfold adapted_couple_opt in |- *; split.
-apply StepFun_P7 with a a r3.
-apply H1.
-unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
- clear H H2; assert (H20 : r = a).
-simpl in H13; rewrite H13; apply Hyp_min.
-unfold adapted_couple in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *;
- apply lt_O_Sn.
-rewrite H10; apply (H15 (S i)); simpl in |- *; assumption.
-simpl in |- *; symmetry  in |- *; apply Hyp_min.
-rewrite <- H17; rewrite H10; reflexivity.
-simpl in H19; simpl in |- *; apply H19.
-intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; apply (H16 0%nat).
-simpl in |- *; apply lt_O_Sn.
-simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
- simpl in |- *; apply H2.
-clear Hreci; simpl in |- *; apply (H21 (S i)).
-simpl in |- *; assumption.
-rewrite <- H10; unfold open_interval in |- *; apply H2.
-elim H3; clear H3; intros; split.
-rewrite H5 in H3; intros; apply (H3 (S i)).
-simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))).
-apply lt_n_S; apply H12.
-symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
- intro; rewrite <- H13 in H12; elim (lt_n_O _ H12).
-intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i));
- simpl in |- *; apply lt_n_S; apply H12.
-simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rmult_0_r; rewrite Rplus_0_l;
- change
-   (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3)))
-  in |- *; eapply H0.
-apply H1.
-2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption.
-assert (H10 : r = a).
-unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12;
- rewrite H12; apply Hyp_min.
-rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3;
- [ apply H1
- | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9;
-    apply H2 ].
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
+            apply Rplus_lt_compat_l; apply H
+            | discrR ] ].
+  rewrite <- H6; assert (H21 := H13 0%nat (lt_O_Sn _)); simpl in H21; elim H21;
+    intro; [ idtac | elim H7; assumption ]; unfold x in |- *; 
+      split.
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; apply H
+            | discrR ] ].
+  apply Rlt_le_trans with r1;
+    [ apply Rmult_lt_reg_l with 2;
+      [ prove_sup0
+        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+          rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+            [ rewrite Rmult_1_l; rewrite <- (Rplus_comm r1); rewrite double;
+              apply Rplus_lt_compat_l; apply H
+              | discrR ] ]
+      | assumption ].
+  eapply StepFun_P13.
+  apply H4.
+  apply H2.
+  unfold adapted_couple_opt in |- *; split.
+  apply H.
+  rewrite H5 in H3; apply H3.
+  assert (H8 : r1 <= s2).
+  eapply StepFun_P13.
+  apply H4.
+  apply H2.
+  unfold adapted_couple_opt in |- *; split.
+  apply H.
+  rewrite H5 in H3; apply H3.
+  elim H7; intro.
+  simpl in |- *; elim H8; intro.
+  replace (r4 * (s2 - s1)) with (r3 * (r1 - r) + r3 * (s2 - r1));
+  [ idtac | rewrite H9; rewrite H6; ring ].
+  rewrite Rplus_assoc; apply Rplus_eq_compat_l;
+    change
+      (Int_SF lf1 (cons r1 r2) = Int_SF (cons r3 lf2) (cons r1 (cons s2 s3)))
+      in |- *; apply H0 with r1 b.
+  unfold adapted_couple in H2; decompose [and] H2; clear H2;
+    replace b with (Rmax a b).
+  rewrite <- H12; apply RList_P7;
+    [ assumption | simpl in |- *; right; left; reflexivity ].
+  eapply StepFun_P7.
+  apply H1.
+  apply H2.
+  unfold adapted_couple_opt in |- *; split.
+  apply StepFun_P7 with a a r3.
+  apply H1.
+  unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
+    clear H H2; assert (H20 : r = a).
+  simpl in H13; rewrite H13; apply Hyp_min.
+  unfold adapted_couple in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
+  simpl in |- *; rewrite <- H20; apply (H11 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  induction  i as [| i Hreci0].
+  simpl in |- *; assumption.
+  change (pos_Rl (cons s2 s3) i <= pos_Rl (cons s2 s3) (S i)) in |- *;
+    apply (H15 (S i)); simpl in |- *; apply lt_S_n; assumption.
+  simpl in |- *; symmetry  in |- *; apply Hyp_min.
+  rewrite <- H17; reflexivity.
+  simpl in H19; simpl in |- *; rewrite H19; reflexivity.
+  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; apply (H16 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
+    simpl in |- *; apply H2.
+  clear Hreci; induction  i as [| i Hreci].
+  simpl in |- *; simpl in H2; rewrite H9; apply (H21 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  unfold open_interval in |- *; simpl in |- *; elim H2; intros; split.
+  apply Rle_lt_trans with r1; try assumption; rewrite <- H6; apply (H11 0%nat);
+    simpl in |- *; apply lt_O_Sn.
+  assumption.
+  clear Hreci; simpl in |- *; apply (H21 (S i)).
+  simpl in |- *; apply lt_S_n; assumption.
+  unfold open_interval in |- *; apply H2.
+  elim H3; clear H3; intros; split.
+  rewrite H9;
+    change
+      (forall i:nat,
+        (i < pred (Rlength (cons r4 lf2)))%nat ->
+        pos_Rl (cons r4 lf2) i <> pos_Rl (cons r4 lf2) (S i) \/
+        f (pos_Rl (cons s1 (cons s2 s3)) (S i)) <> pos_Rl (cons r4 lf2) i)
+      in |- *; rewrite <- H5; apply H3.
+  rewrite H5 in H11; intros; simpl in H12; induction  i as [| i Hreci].
+  simpl in |- *; red in |- *; intro; rewrite H13 in H10;
+    elim (Rlt_irrefl _ H10).
+  clear Hreci; apply (H11 (S i)); simpl in |- *; apply H12.
+  rewrite H9; rewrite H10; rewrite H6; apply Rplus_eq_compat_l; rewrite <- H10;
+    apply H0 with r1 b.
+  unfold adapted_couple in H2; decompose [and] H2; clear H2;
+    replace b with (Rmax a b).
+  rewrite <- H12; apply RList_P7;
+    [ assumption | simpl in |- *; right; left; reflexivity ].
+  eapply StepFun_P7.
+  apply H1.
+  apply H2.
+  unfold adapted_couple_opt in |- *; split.
+  apply StepFun_P7 with a a r3.
+  apply H1.
+  unfold adapted_couple in H2, H; decompose [and] H2; decompose [and] H;
+    clear H H2; assert (H20 : r = a).
+  simpl in H13; rewrite H13; apply Hyp_min.
+  unfold adapted_couple in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
+  simpl in |- *; rewrite <- H20; apply (H11 0%nat); simpl in |- *;
+    apply lt_O_Sn.
+  rewrite H10; apply (H15 (S i)); simpl in |- *; assumption.
+  simpl in |- *; symmetry  in |- *; apply Hyp_min.
+  rewrite <- H17; rewrite H10; reflexivity.
+  simpl in H19; simpl in |- *; apply H19.
+  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; apply (H16 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  simpl in H2; rewrite <- H20 in H2; unfold open_interval in |- *;
+    simpl in |- *; apply H2.
+  clear Hreci; simpl in |- *; apply (H21 (S i)).
+  simpl in |- *; assumption.
+  rewrite <- H10; unfold open_interval in |- *; apply H2.
+  elim H3; clear H3; intros; split.
+  rewrite H5 in H3; intros; apply (H3 (S i)).
+  simpl in |- *; replace (Rlength lf2) with (S (pred (Rlength lf2))).
+  apply lt_n_S; apply H12.
+  symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+    intro; rewrite <- H13 in H12; elim (lt_n_O _ H12).
+  intros; simpl in H12; rewrite H10; rewrite H5 in H11; apply (H11 (S i));
+    simpl in |- *; apply lt_n_S; apply H12.
+  simpl in |- *; rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rmult_0_r; rewrite Rplus_0_l;
+      change
+        (Int_SF lf1 (cons r1 r2) = Int_SF (cons r4 lf2) (cons s1 (cons s2 s3)))
+        in |- *; eapply H0.
+  apply H1.
+  2: rewrite H5 in H3; unfold adapted_couple_opt in |- *; split; assumption.
+  assert (H10 : r = a).
+  unfold adapted_couple in H2; decompose [and] H2; clear H2; simpl in H12;
+    rewrite H12; apply Hyp_min.
+  rewrite <- H9; rewrite H10; apply StepFun_P7 with a r r3;
+    [ apply H1
+      | pattern a at 2 in |- *; rewrite <- H10; pattern r at 2 in |- *; rewrite H9;
+        apply H2 ].
 Qed.
 
 Lemma StepFun_P15 :
- forall (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 (Rle_dec 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 ] ] ].
+  forall (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.
+Proof. 
+  intros; case (Rle_dec 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 :
- forall (f:R -> R) (l lf:Rlist) (a b:R),
-   adapted_couple f a b l lf ->
+  forall (f:R -> R) (l lf:Rlist) (a b:R),
+    adapted_couple f a b l lf ->
     exists l' : Rlist,
-     (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). 
-intros; case (Rle_dec 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 ] ].
+      (exists lf' : Rlist, adapted_couple_opt f a b l' lf'). 
+Proof. 
+  intros; case (Rle_dec 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 :
- forall (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.
+  forall (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.
+Proof. 
+  intros; elim (StepFun_P16 H); intros l' [lf' H1]; rewrite (StepFun_P15 H H1);
+    rewrite (StepFun_P15 H0 H1); reflexivity.
 Qed.
 
 Lemma StepFun_P18 :
- forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a).
-intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
-replace
- (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
+  forall a b c:R, RiemannInt_SF (mkStepFun (StepFun_P4 a b c)) = c * (b - a).
+Proof. 
+  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  replace
+  (Int_SF (subdivision_val (mkStepFun (StepFun_P4 a b c)))
     (subdivision (mkStepFun (StepFun_P4 a b c)))) with
- (Int_SF (cons c nil) (cons a (cons b nil)));
- [ simpl in |- *; ring
- | 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)))
+  (Int_SF (cons c nil) (cons a (cons b nil)));
+  [ simpl in |- *; 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 in |- *; 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))) ] ].
+  (Int_SF (cons c nil) (cons b (cons a nil)));
+  [ simpl in |- *; 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 :
- forall (l1:Rlist) (f g:R -> R) (l:R),
-   Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 =
-   Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1.
-intros; induction  l1 as [| r l1 Hrecl1];
- [ simpl in |- *; ring
- | induction  l1 as [| r0 l1 Hrecl0]; simpl in |- *;
-    [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ].
+  forall (l1:Rlist) (f g:R -> R) (l:R),
+    Int_SF (FF l1 (fun x:R => f x + l * g x)) l1 =
+    Int_SF (FF l1 f) l1 + l * Int_SF (FF l1 g) l1.
+Proof. 
+  intros; induction  l1 as [| r l1 Hrecl1];
+    [ simpl in |- *; ring
+      | induction  l1 as [| r0 l1 Hrecl0]; simpl in |- *;
+        [ ring | simpl in Hrecl1; rewrite Hrecl1; ring ] ].
 Qed.
 
 Lemma StepFun_P20 :
- forall (l:Rlist) (f:R -> R),
-   (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)).
-intros l f H; induction l;
- [ elim (lt_irrefl _ H)
- | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ].
+  forall (l:Rlist) (f:R -> R),
+    (0 < Rlength l)%nat -> Rlength l = S (Rlength (FF l f)).
+Proof. 
+  intros l f H; induction l;
+    [ elim (lt_irrefl _ H)
+      | simpl in |- *; rewrite RList_P18; rewrite RList_P14; reflexivity ].
 Qed.
 
 Lemma StepFun_P21 :
- forall (a b:R) (f:R -> R) (l:Rlist),
-   is_subdivision f a b l -> adapted_couple f a b l (FF l f).
-intros; unfold adapted_couple in |- *; unfold is_subdivision in X;
- unfold adapted_couple in X; elim X; clear X; intros; 
- decompose [and] p; clear p; repeat split; try assumption.
-apply StepFun_P20; rewrite H2; apply lt_O_Sn.
-intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5;
- unfold constant_D_eq, open_interval in |- *; intros;
- induction  l as [| r l Hrecl].
-discriminate.
-unfold FF in |- *; rewrite RList_P12.
-simpl in |- *;
- change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *;
- rewrite RList_P13; try assumption; rewrite (H5 x0 H6); 
- rewrite H5.
-reflexivity.
-split.
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6;
-       intros; apply Rlt_trans with x0; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double;
-       rewrite (Rplus_comm (pos_Rl (cons r l) i)); 
-       apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0;
-       assumption
-    | discrR ] ].
-rewrite RList_P14; simpl in H3; apply H3.
+  forall (a b:R) (f:R -> R) (l:Rlist),
+    is_subdivision f a b l -> adapted_couple f a b l (FF l f).
+Proof. 
+  intros; unfold adapted_couple in |- *; unfold is_subdivision in X;
+    unfold adapted_couple in X; elim X; clear X; intros; 
+      decompose [and] p; clear p; repeat split; try assumption.
+  apply StepFun_P20; rewrite H2; apply lt_O_Sn.
+  intros; assert (H5 := H4 _ H3); unfold constant_D_eq, open_interval in H5;
+    unfold constant_D_eq, open_interval in |- *; intros;
+      induction  l as [| r l Hrecl].
+  discriminate.
+  unfold FF in |- *; rewrite RList_P12.
+  simpl in |- *;
+    change (f x0 = f (pos_Rl (mid_Rlist (cons r l) r) (S i))) in |- *;
+      rewrite RList_P13; try assumption; rewrite (H5 x0 H6); 
+        rewrite H5.
+  reflexivity.
+  split.
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; elim H6;
+            intros; apply Rlt_trans with x0; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double;
+            rewrite (Rplus_comm (pos_Rl (cons r l) i)); 
+              apply Rplus_lt_compat_l; elim H6; intros; apply Rlt_trans with x0;
+                assumption
+            | discrR ] ].
+  rewrite RList_P14; simpl in H3; apply H3.
 Qed.
 
 Lemma StepFun_P22 :
- forall (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 in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
- clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-assert (Hyp_max : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0;
- decompose [and] p; decompose [and] p0; clear p p0; 
- rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0;
- rewrite Hyp_max in H5; unfold adapted_couple in |- *; 
- repeat split.
-apply RList_P2; assumption.
-rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
-induction  lf as [| r lf Hreclf].
-simpl in |- *; right; symmetry  in |- *; 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 0%nat; split;
- [ reflexivity | rewrite RList_P11; simpl in |- *; 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 as [| r lf Hreclf].
-simpl in |- *; right; assumption.
-assert (H8 : In a (cons_ORlist (cons r lf) lg)).
-elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
- elim (RList_P3 (cons r lf) a); intros; apply H12; 
- exists 0%nat; split;
- [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
-apply RList_P5; [ apply RList_P2; assumption | assumption ].
-rewrite Hyp_max; apply Rle_antisym.
-induction  lf as [| r lf Hreclf].
-simpl in |- *; 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 in |- *; 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 in |- *; simpl in H14; apply lt_n_Sm_le; assumption
- | simpl in |- *; 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 0%nat; apply neq_O_lt; red in |- *; intro;
- rewrite <- H17 in H16; elim (lt_n_O _ H16).
-rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
- [ assumption
- | rewrite H17 in H16; apply lt_n_Sm_le; assumption
- | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
-induction  lf as [| r lf Hreclf].
-simpl in |- *; right; symmetry  in |- *; assumption.
-assert (H8 : In b (cons_ORlist (cons r lf) lg)).
-elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
- elim (RList_P3 (cons r lf) b); intros; apply H12;
- exists (pred (Rlength (cons r lf))); split;
- [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
-apply RList_P7; [ apply RList_P2; assumption | assumption ].
-apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *;
- apply lt_O_Sn.
-intros; unfold constant_D_eq, open_interval in |- *; intros;
- cut
-  (exists l : R,
-     constant_D_eq f
-       (open_interval (pos_Rl (cons_ORlist lf lg) i)
+  forall (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).
+Proof. 
+  unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+    clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  assert (Hyp_max : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  apply existT with (FF (cons_ORlist lf lg) f); unfold adapted_couple in p, p0;
+    decompose [and] p; decompose [and] p0; clear p p0; 
+      rewrite Hyp_min in H6; rewrite Hyp_min in H1; rewrite Hyp_max in H0;
+        rewrite Hyp_max in H5; unfold adapted_couple in |- *; 
+          repeat split.
+  apply RList_P2; assumption.
+  rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; right; symmetry  in |- *; 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 0%nat; split;
+      [ reflexivity | rewrite RList_P11; simpl in |- *; 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 as [| r lf Hreclf].
+  simpl in |- *; right; assumption.
+  assert (H8 : In a (cons_ORlist (cons r lf) lg)).
+  elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
+    elim (RList_P3 (cons r lf) a); intros; apply H12; 
+      exists 0%nat; split;
+        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+  apply RList_P5; [ apply RList_P2; assumption | assumption ].
+  rewrite Hyp_max; apply Rle_antisym.
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; 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 in |- *; 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 in |- *; simpl in H14; apply lt_n_Sm_le; assumption
+            | simpl in |- *; 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 0%nat; apply neq_O_lt; red in |- *; intro;
+    rewrite <- H17 in H16; elim (lt_n_O _ H16).
+  rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
+    [ assumption
+      | rewrite H17 in H16; apply lt_n_Sm_le; assumption
+      | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; right; symmetry  in |- *; assumption.
+  assert (H8 : In b (cons_ORlist (cons r lf) lg)).
+  elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
+    elim (RList_P3 (cons r lf) b); intros; apply H12;
+      exists (pred (Rlength (cons r lf))); split;
+        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+  apply RList_P7; [ apply RList_P2; assumption | assumption ].
+  apply StepFun_P20; rewrite RList_P11; rewrite H2; rewrite H7; simpl in |- *;
+    apply lt_O_Sn.
+  intros; unfold constant_D_eq, open_interval in |- *; intros;
+    cut
+      (exists 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 :
-    exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
-apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
-elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
- unfold FF in |- *; rewrite RList_P12.
-change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
- 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 Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double;
-       rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
-       apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite (H11 _ H15); reflexivity.
-elim H10; intros; rewrite H14 in H15;
- elim (Rlt_irrefl _ (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 in |- *; 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 in |- *; intro; rewrite <- H13 in H8;
- elim (lt_n_O _ H8).
-rewrite H0; assumption.
-set
- (I :=
-  fun j:nat =>
-    pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat);
- assert (H12 : Nbound I).
-unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12;
- intros; apply lt_le_weak; assumption.
-assert (H13 :  exists n : nat, I n).
-exists 0%nat; unfold I in |- *; split.
-apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
-right; symmetry  in |- *.
-apply RList_P15; try assumption; rewrite H1; assumption.
-elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13.
-apply RList_P2; assumption.
-apply le_O_n.
-apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
-assumption.
-apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8;
- elim (lt_n_O _ H8).
-apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5;
- rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11).
-assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
- exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; 
- intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat).
-elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
- apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf).
-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_irrefl _ (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 in |- *; intro; rewrite <- H23 in H8;
- elim (lt_n_O _ H8).
-right; apply RList_P16; try assumption; rewrite H0; assumption.
-rewrite <- H20; reflexivity.
-apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
- 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 : (S x0 < Rlength lf)%nat).
-replace (Rlength lf) with (S (pred (Rlength lf)));
- [ apply lt_n_S; assumption
- | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
-    intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ].
-elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
-assert (H23 : (S x0 <= x0)%nat).
-apply H20; unfold I in |- *; split; assumption.
-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 ].
+  intros; elim H11; clear H11; intros; assert (H12 := H11);
+    assert
+      (Hyp_cons :
+        exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
+  apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+  elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
+    unfold FF in |- *; rewrite RList_P12.
+  change (f x = f (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+    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 Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double;
+            rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
+              apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite (H11 _ H15); reflexivity.
+  elim H10; intros; rewrite H14 in H15;
+    elim (Rlt_irrefl _ (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 in |- *; 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 in |- *; intro; rewrite <- H13 in H8;
+    elim (lt_n_O _ H8).
+  rewrite H0; assumption.
+  set
+    (I :=
+      fun j:nat =>
+        pos_Rl lf j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lf)%nat);
+    assert (H12 : Nbound I).
+  unfold Nbound in |- *; exists (Rlength lf); intros; unfold I in H12; elim H12;
+    intros; apply lt_le_weak; assumption.
+  assert (H13 :  exists n : nat, I n).
+  exists 0%nat; unfold I in |- *; split.
+  apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
+  right; symmetry  in |- *.
+  apply RList_P15; try assumption; rewrite H1; assumption.
+  elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13.
+  apply RList_P2; assumption.
+  apply le_O_n.
+  apply lt_trans with (pred (Rlength (cons_ORlist lf lg))).
+  assumption.
+  apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro; rewrite <- H15 in H8;
+    elim (lt_n_O _ H8).
+  apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H5;
+    rewrite <- H6 in H11; rewrite <- H5 in H11; elim (Rlt_irrefl _ H11).
+  assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
+    exists (pos_Rl lf0 x0); unfold constant_D_eq, open_interval in |- *; 
+      intros; assert (H16 := H9 x0); assert (H17 : (x0 < pred (Rlength lf))%nat).
+  elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
+    apply lt_S_n; replace (S (pred (Rlength lf))) with (Rlength lf).
+  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_irrefl _ (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 in |- *; intro; rewrite <- H23 in H8;
+    elim (lt_n_O _ H8).
+  right; apply RList_P16; try assumption; rewrite H0; assumption.
+  rewrite <- H20; reflexivity.
+  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+    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 : (S x0 < Rlength lf)%nat).
+  replace (Rlength lf) with (S (pred (Rlength lf)));
+  [ apply lt_n_S; assumption
+    | symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+      intro; rewrite <- H22 in H21; elim (lt_n_O _ H21) ].
+  elim (Rle_dec (pos_Rl lf (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+  assert (H23 : (S x0 <= x0)%nat).
+  apply H20; unfold I in |- *; split; assumption.
+  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 :
- forall (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 (Rle_dec 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 ] ].
+  forall (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).
+Proof. 
+  intros; case (Rle_dec 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 :
- forall (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 in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
- clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-assert (Hyp_max : Rmax a b = b).
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0;
- decompose [and] p; decompose [and] p0; clear p p0; 
- rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0;
- rewrite Hyp_max in H5; unfold adapted_couple in |- *; 
- repeat split.
-apply RList_P2; assumption.
-rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
-induction  lf as [| r lf Hreclf].
-simpl in |- *; right; symmetry  in |- *; 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 0%nat; split;
- [ reflexivity | rewrite RList_P11; simpl in |- *; 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 as [| r lf Hreclf].
-simpl in |- *; right; assumption.
-assert (H8 : In a (cons_ORlist (cons r lf) lg)).
-elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
- elim (RList_P3 (cons r lf) a); intros; apply H12; 
- exists 0%nat; split;
- [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
-apply RList_P5; [ apply RList_P2; assumption | assumption ].
-rewrite Hyp_max; apply Rle_antisym.
-induction  lf as [| r lf Hreclf].
-simpl in |- *; 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 in |- *; 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 in |- *; simpl in H14; apply lt_n_Sm_le; assumption
- | simpl in |- *; 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 0%nat; apply neq_O_lt; red in |- *; intro;
- rewrite <- H17 in H16; elim (lt_n_O _ H16).
-rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
- [ assumption
- | rewrite H17 in H16; apply lt_n_Sm_le; assumption
- | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
-induction  lf as [| r lf Hreclf].
-simpl in |- *; right; symmetry  in |- *; assumption.
-assert (H8 : In b (cons_ORlist (cons r lf) lg)).
-elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
- elim (RList_P3 (cons r lf) b); intros; apply H12;
- exists (pred (Rlength (cons r lf))); split;
- [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
-apply RList_P7; [ apply RList_P2; assumption | assumption ].
-apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *;
- apply lt_O_Sn.
-unfold constant_D_eq, open_interval in |- *; intros;
- cut
-  (exists l : R,
-     constant_D_eq g
-       (open_interval (pos_Rl (cons_ORlist lf lg) i)
+  forall (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).
+Proof. 
+  unfold is_subdivision in |- *; intros a b f g lf lg Hyp X X0; elim X; elim X0;
+    clear X X0; intros lg0 p lf0 p0; assert (Hyp_min : Rmin a b = a).
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  assert (Hyp_max : Rmax a b = b).
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  apply existT with (FF (cons_ORlist lf lg) g); unfold adapted_couple in p, p0;
+    decompose [and] p; decompose [and] p0; clear p p0; 
+      rewrite Hyp_min in H1; rewrite Hyp_min in H6; rewrite Hyp_max in H0;
+        rewrite Hyp_max in H5; unfold adapted_couple in |- *; 
+          repeat split.
+  apply RList_P2; assumption.
+  rewrite Hyp_min; symmetry  in |- *; apply Rle_antisym.
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; right; symmetry  in |- *; 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 0%nat; split;
+      [ reflexivity | rewrite RList_P11; simpl in |- *; 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 as [| r lf Hreclf].
+  simpl in |- *; right; assumption.
+  assert (H8 : In a (cons_ORlist (cons r lf) lg)).
+  elim (RList_P9 (cons r lf) lg a); intros; apply H10; left;
+    elim (RList_P3 (cons r lf) a); intros; apply H12; 
+      exists 0%nat; split;
+        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_O_Sn ].
+  apply RList_P5; [ apply RList_P2; assumption | assumption ].
+  rewrite Hyp_max; apply Rle_antisym.
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; 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 in |- *; 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 in |- *; simpl in H14; apply lt_n_Sm_le; assumption
+            | simpl in |- *; 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 0%nat; apply neq_O_lt; red in |- *; intro;
+    rewrite <- H17 in H16; elim (lt_n_O _ H16).
+  rewrite <- H0; elim (RList_P6 lg); intros; apply H18;
+    [ assumption
+      | rewrite H17 in H16; apply lt_n_Sm_le; assumption
+      | apply lt_pred_n_n; rewrite H17; apply lt_O_Sn ].
+  induction  lf as [| r lf Hreclf].
+  simpl in |- *; right; symmetry  in |- *; assumption.
+  assert (H8 : In b (cons_ORlist (cons r lf) lg)).
+  elim (RList_P9 (cons r lf) lg b); intros; apply H10; left;
+    elim (RList_P3 (cons r lf) b); intros; apply H12;
+      exists (pred (Rlength (cons r lf))); split;
+        [ symmetry  in |- *; assumption | simpl in |- *; apply lt_n_Sn ].
+  apply RList_P7; [ apply RList_P2; assumption | assumption ].
+  apply StepFun_P20; rewrite RList_P11; rewrite H7; rewrite H2; simpl in |- *;
+    apply lt_O_Sn.
+  unfold constant_D_eq, open_interval in |- *; intros;
+    cut
+      (exists 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 :
-    exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
-apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
-elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
- unfold FF in |- *; rewrite RList_P12.
-change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
- 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 Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double;
-       rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
-       apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite (H11 _ H15); reflexivity.
-elim H10; intros; rewrite H14 in H15;
- elim (Rlt_irrefl _ (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 in |- *; 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 in |- *; intro; rewrite <- H13 in H8;
- elim (lt_n_O _ H8).
-rewrite H0; assumption.
-set
- (I :=
-  fun j:nat =>
-    pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat);
- assert (H12 : Nbound I).
-unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12;
- intros; apply lt_le_weak; assumption.
-assert (H13 :  exists n : nat, I n).
-exists 0%nat; unfold I in |- *; split.
-apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
-right; symmetry  in |- *; 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)));
+  intros; elim H11; clear H11; intros; assert (H12 := H11);
+    assert
+      (Hyp_cons :
+        exists r : R, (exists r0 : Rlist, cons_ORlist lf lg = cons r r0)).
+  apply RList_P19; red in |- *; intro; rewrite H13 in H8; elim (lt_n_O _ H8).
+  elim Hyp_cons; clear Hyp_cons; intros r [r0 Hyp_cons]; rewrite Hyp_cons;
+    unfold FF in |- *; rewrite RList_P12.
+  change (g x = g (pos_Rl (mid_Rlist (cons r r0) r) (S i))) in |- *;
+    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 Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double;
+            rewrite (Rplus_comm (pos_Rl (cons_ORlist lf lg) i));
+              apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite (H11 _ H15); reflexivity.
+  elim H10; intros; rewrite H14 in H15;
+    elim (Rlt_irrefl _ (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 in |- *; intro;
-       rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ].
-apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0;
- rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11).
-assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
- exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; 
- intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat).
-elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
- apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg).
-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_irrefl _ (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 in |- *; intro; rewrite <- H23 in H8;
- elim (lt_n_O _ H8).
-right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption.
-rewrite H0; assumption.
-rewrite <- H20; reflexivity.
-apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
- 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 : (S x0 < Rlength lg)%nat).
-replace (Rlength lg) with (S (pred (Rlength lg))).
-apply lt_n_S; assumption.
-symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
- intro; rewrite <- H22 in H21; elim (lt_n_O _ H21).
-elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
-assert (H23 : (S x0 <= x0)%nat);
- [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ].
-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 ] ].
+      | apply lt_pred_n_n; apply neq_O_lt; red in |- *; 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 in |- *; intro; rewrite <- H13 in H8;
+    elim (lt_n_O _ H8).
+  rewrite H0; assumption.
+  set
+    (I :=
+      fun j:nat =>
+        pos_Rl lg j <= pos_Rl (cons_ORlist lf lg) i /\ (j < Rlength lg)%nat);
+    assert (H12 : Nbound I).
+  unfold Nbound in |- *; exists (Rlength lg); intros; unfold I in H12; elim H12;
+    intros; apply lt_le_weak; assumption.
+  assert (H13 :  exists n : nat, I n).
+  exists 0%nat; unfold I in |- *; split.
+  apply Rle_trans with (pos_Rl (cons_ORlist lf lg) 0).
+  right; symmetry  in |- *; rewrite H1; rewrite <- H6; apply RList_P15;
+    try assumption; rewrite H1; assumption.
+  elim (RList_P6 (cons_ORlist lf lg)); intros; apply H13;
+    [ apply RList_P2; assumption
+      | apply le_O_n
+      | apply lt_trans with (pred (Rlength (cons_ORlist lf lg)));
+        [ assumption
+          | apply lt_pred_n_n; apply neq_O_lt; red in |- *; intro;
+            rewrite <- H15 in H8; elim (lt_n_O _ H8) ] ].
+  apply neq_O_lt; red in |- *; intro; rewrite <- H13 in H0;
+    rewrite <- H1 in H11; rewrite <- H0 in H11; elim (Rlt_irrefl _ H11).
+  assert (H14 := Nzorn H13 H12); elim H14; clear H14; intros x0 H14;
+    exists (pos_Rl lg0 x0); unfold constant_D_eq, open_interval in |- *; 
+      intros; assert (H16 := H4 x0); assert (H17 : (x0 < pred (Rlength lg))%nat).
+  elim H14; clear H14; intros; unfold I in H14; elim H14; clear H14; intros;
+    apply lt_S_n; replace (S (pred (Rlength lg))) with (Rlength lg).
+  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_irrefl _ (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 in |- *; intro; rewrite <- H23 in H8;
+    elim (lt_n_O _ H8).
+  right; rewrite H0; rewrite <- H5; apply RList_P16; try assumption.
+  rewrite H0; assumption.
+  rewrite <- H20; reflexivity.
+  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+    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 : (S x0 < Rlength lg)%nat).
+  replace (Rlength lg) with (S (pred (Rlength lg))).
+  apply lt_n_S; assumption.
+  symmetry  in |- *; apply S_pred with 0%nat; apply neq_O_lt; red in |- *;
+    intro; rewrite <- H22 in H21; elim (lt_n_O _ H21).
+  elim (Rle_dec (pos_Rl lg (S x0)) (pos_Rl (cons_ORlist lf lg) i)); intro.
+  assert (H23 : (S x0 <= x0)%nat);
+    [ apply H20; unfold I in |- *; split; assumption | elim (le_Sn_n _ H23) ].
+  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 :
- forall (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 (Rle_dec 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 ] ].
+  forall (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).
+Proof. 
+  intros a b f g lf lg H H0; case (Rle_dec 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 :
- forall (a b l:R) (f g:R -> R) (l1:Rlist),
-   is_subdivision f a b l1 ->
-   is_subdivision g a b l1 ->
-   is_subdivision (fun x:R => f x + l * g x) a b l1.
+  forall (a b l:R) (f g:R -> R) (l1:Rlist),
+    is_subdivision f a b l1 ->
+    is_subdivision g a b l1 ->
+    is_subdivision (fun x:R => f x + l * g x) a b l1.
 Proof.
-intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) 
-                    (x,(_,(_,(_,(_,H9))))).
- exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption.
-apply StepFun_P20; rewrite H3; auto with arith.
-intros i H8 x1 H10; unfold open_interval in H10, H9, H4; 
- rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); 
- assert (H11 : l1 <> nil).
-red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8).
-destruct (RList_P19 _ H11) as (r,(r0,H12));
- rewrite H12; unfold FF in |- *;
- change
-   (pos_Rl x0 i + l * pos_Rl x i =
-    pos_Rl
-      (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2))
-      (S i)) in |- *; rewrite RList_P12.
-rewrite RList_P13.
-rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8);
- reflexivity ||
-   (elim H10; clear H10; intros; split;
-     [ apply Rmult_lt_reg_l with 2;
-        [ prove_sup0
-        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
-           rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-           [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
-              apply Rlt_trans with x1; assumption
-           | discrR ] ]
-     | apply Rmult_lt_reg_l with 2;
-        [ prove_sup0
-        | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
-           rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
-           [ rewrite Rmult_1_l; rewrite double;
-              rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l;
-              apply Rlt_trans with x1; assumption
-           | discrR ] ] ]).
-rewrite <- H12; assumption.
-rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8;
- apply lt_n_S; apply H8.
+  intros a b l f g l1 (x0,(H0,(H1,(H2,(H3,H4))))) 
+    (x,(_,(_,(_,(_,H9))))).
+  exists (FF l1 (fun x:R => f x + l * g x)); repeat split; try assumption.
+  apply StepFun_P20; rewrite H3; auto with arith.
+  intros i H8 x1 H10; unfold open_interval in H10, H9, H4; 
+    rewrite (H9 _ H8 _ H10); rewrite (H4 _ H8 _ H10); 
+      assert (H11 : l1 <> nil).
+  red in |- *; intro H11; rewrite H11 in H8; elim (lt_n_O _ H8).
+  destruct (RList_P19 _ H11) as (r,(r0,H12));
+    rewrite H12; unfold FF in |- *;
+      change
+        (pos_Rl x0 i + l * pos_Rl x i =
+          pos_Rl
+          (app_Rlist (mid_Rlist (cons r r0) r) (fun x2:R => f x2 + l * g x2))
+          (S i)) in |- *; rewrite RList_P12.
+  rewrite RList_P13.
+  rewrite <- H12; rewrite (H9 _ H8); try rewrite (H4 _ H8);
+    reflexivity ||
+      (elim H10; clear H10; intros; split;
+        [ apply Rmult_lt_reg_l with 2;
+          [ prove_sup0
+            | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+              rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+                [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l;
+                  apply Rlt_trans with x1; assumption
+                  | discrR ] ]
+          | apply Rmult_lt_reg_l with 2;
+            [ prove_sup0
+              | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2));
+                rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym;
+                  [ rewrite Rmult_1_l; rewrite double;
+                    rewrite (Rplus_comm (pos_Rl l1 i)); apply Rplus_lt_compat_l;
+                      apply Rlt_trans with x1; assumption
+                    | discrR ] ] ]).
+  rewrite <- H12; assumption.
+  rewrite RList_P14; simpl in |- *; rewrite H12 in H8; simpl in H8;
+    apply lt_n_S; apply H8.
 Qed.
 
 Lemma StepFun_P27 :
- forall (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 (fun 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 ].
+  forall (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 (fun x:R => f x + l * g x) a b (cons_ORlist lf lg).
+Proof. 
+  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 *)
+(** The set of step functions on [a,b] is a vectorial space *)
 Lemma StepFun_P28 :
- forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b.
-intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f);
- assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; 
- elim H0; intros; apply existT with (cons_ORlist x0 x); 
- apply StepFun_P27; assumption.
+  forall (a b l:R) (f g:StepFun a b), IsStepFun (fun x:R => f x + l * g x) a b.
+Proof. 
+  intros a b l f g; unfold IsStepFun in |- *; assert (H := pre f);
+    assert (H0 := pre g); unfold IsStepFun in H, H0; elim H; 
+      elim H0; intros; apply existT with (cons_ORlist x0 x); 
+        apply StepFun_P27; assumption.
 Qed.
 
 Lemma StepFun_P29 :
- forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f).
-intros a b f; unfold is_subdivision in |- *;
- apply existT with (subdivision_val f); apply StepFun_P1.
+  forall (a b:R) (f:StepFun a b), is_subdivision f a b (subdivision f).
+Proof. 
+  intros a b f; unfold is_subdivision in |- *;
+    apply existT with (subdivision_val f); apply StepFun_P1.
 Qed.
 
 Lemma StepFun_P30 :
- forall (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 in |- *; case (Rle_dec 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))
-          (fun x:R => f x + l * g x))
-       (cons_ORlist (subdivision f) (subdivision g)));
-   [ rewrite StepFun_P19;
+  forall (a b l:R) (f g:StepFun a b),
+    RiemannInt_SF (mkStepFun (StepFun_P28 l f g)) =
+    RiemannInt_SF f + l * RiemannInt_SF g.
+Proof. 
+  intros a b l f g; unfold RiemannInt_SF in |- *; case (Rle_dec a b);
+    (intro;
       replace
-       (Int_SF (FF (cons_ORlist (subdivision f) (subdivision g)) f)
+      (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))
+          (fun 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)
+        (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;
+          (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_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 (fun 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))) ] ]).
+              | apply StepFun_P21; apply StepFun_P23 with (fe g);
+                apply StepFun_P29 ] ]
+        | apply StepFun_P17 with (fun 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 :
- forall (a b:R) (f:R -> R) (l lf:Rlist),
-   adapted_couple f a b l lf ->
-   adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs).
-unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
- repeat split; try assumption.
-symmetry  in |- *; rewrite H3; rewrite RList_P18; reflexivity.
-intros; unfold constant_D_eq, open_interval in |- *;
- 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 ].
+  forall (a b:R) (f:R -> R) (l lf:Rlist),
+    adapted_couple f a b l lf ->
+    adapted_couple (fun x:R => Rabs (f x)) a b l (app_Rlist lf Rabs).
+Proof. 
+  unfold adapted_couple in |- *; intros; decompose [and] H; clear H;
+    repeat split; try assumption.
+  symmetry  in |- *; rewrite H3; rewrite RList_P18; reflexivity.
+  intros; unfold constant_D_eq, open_interval in |- *;
+    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 :
- forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b.
-intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f);
- unfold is_subdivision in |- *;
- apply existT with (app_Rlist (subdivision_val f) Rabs); 
- apply StepFun_P31; apply StepFun_P1.
+  forall (a b:R) (f:StepFun a b), IsStepFun (fun x:R => Rabs (f x)) a b.
+Proof. 
+  intros a b f; unfold IsStepFun in |- *; apply existT with (subdivision f);
+    unfold is_subdivision in |- *;
+      apply existT with (app_Rlist (subdivision_val f) Rabs); 
+        apply StepFun_P31; apply StepFun_P1.
 Qed.
 
 Lemma StepFun_P33 :
- forall l2 l1:Rlist,
-   ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1.
-simple induction l2; intros.
-simpl in |- *; rewrite Rabs_R0; right; reflexivity.
-simpl in |- *; induction  l1 as [| r1 l1 Hrecl1].
-rewrite Rabs_R0; right; reflexivity.
-induction  l1 as [| r2 l1 Hrecl0].
-rewrite Rabs_R0; right; reflexivity.
-apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))).
-apply Rabs_triang.
-rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1));
- [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption
- | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
-    apply lt_O_Sn ].
+  forall l2 l1:Rlist,
+    ordered_Rlist l1 -> Rabs (Int_SF l2 l1) <= Int_SF (app_Rlist l2 Rabs) l1.
+Proof. 
+  simple induction l2; intros.
+  simpl in |- *; rewrite Rabs_R0; right; reflexivity.
+  simpl in |- *; induction  l1 as [| r1 l1 Hrecl1].
+  rewrite Rabs_R0; right; reflexivity.
+  induction  l1 as [| r2 l1 Hrecl0].
+  rewrite Rabs_R0; right; reflexivity.
+  apply Rle_trans with (Rabs (r * (r2 - r1)) + Rabs (Int_SF r0 (cons r2 l1))).
+  apply Rabs_triang.
+  rewrite Rabs_mult; rewrite (Rabs_right (r2 - r1));
+    [ apply Rplus_le_compat_l; apply H; apply RList_P4 with r1; assumption
+      | apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+        apply lt_O_Sn ].
 Qed.
 
 Lemma StepFun_P34 :
- forall (a b:R) (f:StepFun a b),
-   a <= b ->
-   Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)).
-intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
-replace
- (Int_SF (subdivision_val (mkStepFun (StepFun_P32 f)))
+  forall (a b:R) (f:StepFun a b),
+    a <= b ->
+    Rabs (RiemannInt_SF f) <= RiemannInt_SF (mkStepFun (StepFun_P32 f)).
+Proof. 
+  intros; unfold RiemannInt_SF in |- *; case (Rle_dec 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) Rabs) (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 (fun x:R => Rabs (f x)) a b;
- [ apply StepFun_P31; apply StepFun_P1
- | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ].
-elim n; assumption.
+  (Int_SF (app_Rlist (subdivision_val f) Rabs) (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 (fun x:R => Rabs (f x)) a b;
+    [ apply StepFun_P31; apply StepFun_P1
+      | apply (StepFun_P1 (mkStepFun (StepFun_P32 f))) ].
+  elim n; assumption.
 Qed.
 
 Lemma StepFun_P35 :
- forall (l:Rlist) (a b:R) (f g:R -> R),
-   ordered_Rlist l ->
-   pos_Rl l 0 = a ->
-   pos_Rl l (pred (Rlength l)) = b ->
-   (forall x:R, a < x < b -> f x <= g x) ->
-   Int_SF (FF l f) l <= Int_SF (FF l g) l.
-simple induction l; intros.
-right; reflexivity.
-simpl in |- *; induction  r0 as [| r0 r1 Hrecr0].
-right; reflexivity.
-simpl in |- *; apply Rplus_le_compat.
-case (Req_dec r r0); intro.
-rewrite H4; right; ring.
-do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l.
-apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
- apply lt_O_Sn.
-apply H3; split.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-assert (H5 : r = a).
-apply H1.
-rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l.
-assert (H6 := H0 0%nat (lt_O_Sn _)).
-simpl in H6.
-elim H6; intro.
-rewrite H5 in H7; apply H7.
-elim H4; assumption.
-discrR.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; 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)) 1).
-elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5.
-assumption.
-simpl in |- *; apply le_n_S.
-apply le_O_n.
-simpl in |- *; apply lt_n_Sn.
-reflexivity.
-apply Rle_lt_trans with (r + b).
-apply Rplus_le_compat_l; assumption.
-rewrite (Rplus_comm r); apply Rplus_lt_compat_l.
-apply Rlt_le_trans with r0.
-assert (H6 := H0 0%nat (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 in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn.
+  forall (l:Rlist) (a b:R) (f g:R -> R),
+    ordered_Rlist l ->
+    pos_Rl l 0 = a ->
+    pos_Rl l (pred (Rlength l)) = b ->
+    (forall x:R, a < x < b -> f x <= g x) ->
+    Int_SF (FF l f) l <= Int_SF (FF l g) l.
+Proof. 
+  simple induction l; intros.
+  right; reflexivity.
+  simpl in |- *; induction  r0 as [| r0 r1 Hrecr0].
+  right; reflexivity.
+  simpl in |- *; apply Rplus_le_compat.
+  case (Req_dec r r0); intro.
+  rewrite H4; right; ring.
+  do 2 rewrite <- (Rmult_comm (r0 - r)); apply Rmult_le_compat_l.
+  apply Rge_le; apply Rge_minus; apply Rle_ge; apply (H0 0%nat); simpl in |- *;
+    apply lt_O_Sn.
+  apply H3; split.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  assert (H5 : r = a).
+  apply H1.
+  rewrite H5; rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l.
+  assert (H6 := H0 0%nat (lt_O_Sn _)).
+  simpl in H6.
+  elim H6; intro.
+  rewrite H5 in H7; apply H7.
+  elim H4; assumption.
+  discrR.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; 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)) 1).
+  elim (RList_P6 (cons r (cons r0 r1))); intros; apply H5.
+  assumption.
+  simpl in |- *; apply le_n_S.
+  apply le_O_n.
+  simpl in |- *; apply lt_n_Sn.
+  reflexivity.
+  apply Rle_lt_trans with (r + b).
+  apply Rplus_le_compat_l; assumption.
+  rewrite (Rplus_comm r); apply Rplus_lt_compat_l.
+  apply Rlt_le_trans with r0.
+  assert (H6 := H0 0%nat (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 in |- *; apply (H0 0%nat); simpl in |- *; apply lt_O_Sn.
 Qed.
 
 Lemma StepFun_P36 :
- forall (a b:R) (f g:StepFun a b) (l:Rlist),
-   a <= b ->
-   is_subdivision f a b l ->
-   is_subdivision g a b l ->
-   (forall x:R, a < x < b -> f x <= g x) ->
-   RiemannInt_SF f <= RiemannInt_SF g.
-intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
-replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
-replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
-unfold is_subdivision in X; elim X; clear X; intros;
- unfold adapted_couple in p; decompose [and] p; clear p;
- assert (H5 : Rmin a b = a);
- [ unfold Rmin in |- *; case (Rle_dec a b); intro;
-    [ reflexivity | elim n; assumption ]
- | assert (H7 : Rmax a b = b);
-    [ unfold Rmax in |- *; case (Rle_dec a b); intro;
-       [ reflexivity | elim n; assumption ]
-    | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b;
-       assumption ] ].
-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.
+  forall (a b:R) (f g:StepFun a b) (l:Rlist),
+    a <= b ->
+    is_subdivision f a b l ->
+    is_subdivision g a b l ->
+    (forall x:R, a < x < b -> f x <= g x) ->
+    RiemannInt_SF f <= RiemannInt_SF g.
+Proof. 
+  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  replace (Int_SF (subdivision_val f) (subdivision f)) with (Int_SF (FF l f) l).
+  replace (Int_SF (subdivision_val g) (subdivision g)) with (Int_SF (FF l g) l).
+  unfold is_subdivision in X; elim X; clear X; intros;
+    unfold adapted_couple in p; decompose [and] p; clear p;
+      assert (H5 : Rmin a b = a);
+        [ unfold Rmin in |- *; case (Rle_dec a b); intro;
+          [ reflexivity | elim n; assumption ]
+          | assert (H7 : Rmax a b = b);
+            [ unfold Rmax in |- *; case (Rle_dec a b); intro;
+              [ reflexivity | elim n; assumption ]
+              | rewrite H5 in H3; rewrite H7 in H2; eapply StepFun_P35 with a b;
+                assumption ] ].
+  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 :
- forall (a b:R) (f g:StepFun a b),
-   a <= b ->
-   (forall 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.
+  forall (a b:R) (f g:StepFun a b),
+    a <= b ->
+    (forall x:R, a < x < b -> f x <= g x) ->
+    RiemannInt_SF f <= RiemannInt_SF g.
+Proof. 
+  intros; eapply StepFun_P36; try assumption.
+  eapply StepFun_P25; apply StepFun_P29.
+  eapply StepFun_P23; apply StepFun_P29.
 Qed.
 
 Lemma StepFun_P38 :
- forall (l:Rlist) (a b:R) (f:R -> R),
-   ordered_Rlist l ->
-   pos_Rl l 0 = a ->
-   pos_Rl l (pred (Rlength l)) = b ->
-   sigT
-     (fun g:StepFun a b =>
-        g b = f b /\
-        (forall i:nat,
-           (i < pred (Rlength l))%nat ->
-           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; induction 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; destruct 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) 0 = 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].
-set
- (g' :=
-  fun x:R => match Rle_dec r1 x with
-             | left _ => g x
-             | right _ => f a
-             end).
-assert (H7 : r1 <= b).
-rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ].
-assert (H8 : IsStepFun g' a b).
-unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8;
- elim H8; intros lg H9; unfold is_subdivision in H9; 
- elim H9; clear H9; intros lg2 H9; split with (cons a lg);
- unfold is_subdivision in |- *; split with (cons (f a) lg2);
- unfold adapted_couple in H9; decompose [and] H9; clear H9;
- unfold adapted_couple in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H9;
- induction  i as [| i Hreci].
-simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1.
-simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn.
-unfold Rmin in |- *; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n; assumption ].
-apply (H10 i); apply lt_S_n.
-replace (S (pred (Rlength lg))) with (Rlength lg).
-apply H9.
-apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9;
- elim (lt_n_O _ H9).
-simpl in |- *; assert (H14 : a <= b).
-rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
- [ assumption | left; reflexivity ].
-unfold Rmin in |- *; case (Rle_dec 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 as [| r0 lg Hreclg].
-simpl in H13; discriminate.
-reflexivity.
-unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros;
- reflexivity || elim n; assumption.
-simpl in |- *; rewrite H13; reflexivity.
-intros; simpl in H9; induction  i as [| i Hreci].
-unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros;
- assert (H16 : Rmin r1 b = r1).
-unfold Rmin in |- *; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n; assumption ].
-rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14;
- unfold g' in |- *; case (Rle_dec r1 x); intro r3.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)).
-reflexivity.
-change
-  (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i)))
-     (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i);
- assert (H17 : (i < pred (Rlength lg))%nat).
-apply lt_S_n.
-replace (S (pred (Rlength lg))) with (Rlength lg).
-assumption.
-apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
- rewrite <- H14 in H9; elim (lt_n_O _ H9).
-assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
- unfold constant_D_eq, open_interval in |- *; intros;
- assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *;
- case (Rle_dec 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 in |- *; intro; rewrite <- H22 in H17;
- elim (lt_n_O _ H17).
-unfold Rmin in |- *; case (Rle_dec r1 b); intro;
- [ reflexivity | elim n0; assumption ].
-exists (mkStepFun H8); split.
-simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro.
-assumption.
-elim n; assumption.
-intros; simpl in H9; induction  i as [| i Hreci].
-unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0;
- rewrite H0; elim H10; clear H10; intros; unfold g' in |- *;
- case (Rle_dec r1 x); intro r3.
-elim (Rlt_irrefl _ (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))) in |- *; assert (H10 := H6 i);
- assert (H11 : (i < pred (Rlength (cons r1 l)))%nat).
-simpl in |- *; apply lt_S_n; assumption.
-assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12;
- unfold constant_D_eq, co_interval in |- *; intros; 
- rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *;
- case (Rle_dec r1 x); intro.
-reflexivity.
-elim n; elim H13; clear H13; intros;
- apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption;
- change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *;
- elim (RList_P6 (cons r1 l)); intros; apply H15;
- [ assumption
- | apply le_O_n
- | simpl in |- *; apply lt_trans with (Rlength l);
-    [ apply lt_S_n; assumption | apply lt_n_Sn ] ].
+  forall (l:Rlist) (a b:R) (f:R -> R),
+    ordered_Rlist l ->
+    pos_Rl l 0 = a ->
+    pos_Rl l (pred (Rlength l)) = b ->
+    sigT
+    (fun g:StepFun a b =>
+      g b = f b /\
+      (forall i:nat,
+        (i < pred (Rlength l))%nat ->
+        constant_D_eq g (co_interval (pos_Rl l i) (pos_Rl l (S i)))
+        (f (pos_Rl l i)))).
+Proof. 
+  intros l a b f; generalize a; clear a; induction 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; destruct 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) 0 = 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].
+  set
+    (g' :=
+      fun x:R => match Rle_dec r1 x with
+                   | left _ => g x
+                   | right _ => f a
+                 end).
+  assert (H7 : r1 <= b).
+  rewrite <- H4; apply RList_P7; [ assumption | left; reflexivity ].
+  assert (H8 : IsStepFun g' a b).
+  unfold IsStepFun in |- *; assert (H8 := pre g); unfold IsStepFun in H8;
+    elim H8; intros lg H9; unfold is_subdivision in H9; 
+      elim H9; clear H9; intros lg2 H9; split with (cons a lg);
+        unfold is_subdivision in |- *; split with (cons (f a) lg2);
+          unfold adapted_couple in H9; decompose [and] H9; clear H9;
+            unfold adapted_couple in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H9;
+    induction  i as [| i Hreci].
+  simpl in |- *; rewrite H12; replace (Rmin r1 b) with r1.
+  simpl in H0; rewrite <- H0; apply (H 0%nat); simpl in |- *; apply lt_O_Sn.
+  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+    [ reflexivity | elim n; assumption ].
+  apply (H10 i); apply lt_S_n.
+  replace (S (pred (Rlength lg))) with (Rlength lg).
+  apply H9.
+  apply S_pred with 0%nat; apply neq_O_lt; intro; rewrite <- H14 in H9;
+    elim (lt_n_O _ H9).
+  simpl in |- *; assert (H14 : a <= b).
+  rewrite <- H1; simpl in H0; rewrite <- H0; apply RList_P7;
+    [ assumption | left; reflexivity ].
+  unfold Rmin in |- *; case (Rle_dec 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 as [| r0 lg Hreclg].
+  simpl in H13; discriminate.
+  reflexivity.
+  unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec r1 b); intros;
+    reflexivity || elim n; assumption.
+  simpl in |- *; rewrite H13; reflexivity.
+  intros; simpl in H9; induction  i as [| i Hreci].
+  unfold constant_D_eq, open_interval in |- *; simpl in |- *; intros;
+    assert (H16 : Rmin r1 b = r1).
+  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+    [ reflexivity | elim n; assumption ].
+  rewrite H16 in H12; rewrite H12 in H14; elim H14; clear H14; intros _ H14;
+    unfold g' in |- *; case (Rle_dec r1 x); intro r3.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r3 H14)).
+  reflexivity.
+  change
+    (constant_D_eq g' (open_interval (pos_Rl lg i) (pos_Rl lg (S i)))
+      (pos_Rl lg2 i)) in |- *; clear Hreci; assert (H16 := H15 i);
+    assert (H17 : (i < pred (Rlength lg))%nat).
+  apply lt_S_n.
+  replace (S (pred (Rlength lg))) with (Rlength lg).
+  assumption.
+  apply S_pred with 0%nat; apply neq_O_lt; red in |- *; intro;
+    rewrite <- H14 in H9; elim (lt_n_O _ H9).
+  assert (H18 := H16 H17); unfold constant_D_eq, open_interval in H18;
+    unfold constant_D_eq, open_interval in |- *; intros;
+      assert (H19 := H18 _ H14); rewrite <- H19; unfold g' in |- *;
+        case (Rle_dec 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 in |- *; intro; rewrite <- H22 in H17;
+    elim (lt_n_O _ H17).
+  unfold Rmin in |- *; case (Rle_dec r1 b); intro;
+    [ reflexivity | elim n0; assumption ].
+  exists (mkStepFun H8); split.
+  simpl in |- *; unfold g' in |- *; case (Rle_dec r1 b); intro.
+  assumption.
+  elim n; assumption.
+  intros; simpl in H9; induction  i as [| i Hreci].
+  unfold constant_D_eq, co_interval in |- *; simpl in |- *; intros; simpl in H0;
+    rewrite H0; elim H10; clear H10; intros; unfold g' in |- *;
+      case (Rle_dec r1 x); intro r3.
+  elim (Rlt_irrefl _ (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))) in |- *; assert (H10 := H6 i);
+      assert (H11 : (i < pred (Rlength (cons r1 l)))%nat).
+  simpl in |- *; apply lt_S_n; assumption.
+  assert (H12 := H10 H11); unfold constant_D_eq, co_interval in H12;
+    unfold constant_D_eq, co_interval in |- *; intros; 
+      rewrite <- (H12 _ H13); simpl in |- *; unfold g' in |- *;
+        case (Rle_dec r1 x); intro.
+  reflexivity.
+  elim n; elim H13; clear H13; intros;
+    apply Rle_trans with (pos_Rl (cons r1 l) i); try assumption;
+      change (pos_Rl (cons r1 l) 0 <= pos_Rl (cons r1 l) i) in |- *;
+        elim (RList_P6 (cons r1 l)); intros; apply H15;
+          [ assumption
+            | apply le_O_n
+            | simpl in |- *; apply lt_trans with (Rlength l);
+              [ apply lt_S_n; assumption | apply lt_n_Sn ] ].
 Qed.
 
 Lemma StepFun_P39 :
- forall (a b:R) (f:StepFun a b),
-   RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))).
-intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a);
- intros.
-assert (H : adapted_couple f a b (subdivision f) (subdivision_val f));
- [ apply StepFun_P1
- | assert
-    (H0 :
-     adapted_couple (mkStepFun (StepFun_P6 (pre f))) b a
-       (subdivision (mkStepFun (StepFun_P6 (pre f))))
-       (subdivision_val (mkStepFun (StepFun_P6 (pre f)))));
+  forall (a b:R) (f:StepFun a b),
+    RiemannInt_SF f = - RiemannInt_SF (mkStepFun (StepFun_P6 (pre f))).
+Proof. 
+  intros; unfold RiemannInt_SF in |- *; case (Rle_dec a b); case (Rle_dec b a);
+    intros.
+  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  in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ].
+  rewrite Ropp_involutive; eapply StepFun_P17;
+    [ apply StepFun_P1
+      | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
+        elim H; intros; unfold is_subdivision in |- *; 
+          elim p; intros; apply p0 ].
+  apply Ropp_eq_compat; eapply StepFun_P17;
     [ apply StepFun_P1
-    | assert (H1 : a = b);
-       [ apply Rle_antisym; assumption
-       | rewrite (StepFun_P8 H H1); assert (H2 : b = a);
-          [ symmetry  in |- *; apply H1 | rewrite (StepFun_P8 H0 H2); ring ] ] ] ].
-rewrite Ropp_involutive; eapply StepFun_P17;
- [ apply StepFun_P1
- | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
-    elim H; intros; unfold is_subdivision in |- *; 
-    elim p; intros; apply p0 ].
-apply Ropp_eq_compat; eapply StepFun_P17;
- [ apply StepFun_P1
- | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
-    elim H; intros; unfold is_subdivision in |- *; 
-    elim p; intros; apply p0 ].
-assert (H : a < b);
- [ auto with real
- | assert (H0 : b < a);
-    [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ].
+      | apply StepFun_P2; set (H := StepFun_P6 (pre f)); unfold IsStepFun in H;
+        elim H; intros; unfold is_subdivision in |- *; 
+          elim p; intros; apply p0 ].
+  assert (H : a < b);
+    [ auto with real
+      | assert (H0 : b < a);
+        [ auto with real | elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H0)) ] ].
 Qed.
 
 Lemma StepFun_P40 :
- forall (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 in |- *; decompose [and] H1; 
- decompose [and] H2; clear H1 H2; repeat split.
-apply RList_P25; try assumption.
-rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b);
- case (Rle_dec b c); intros;
- (right; reflexivity) || (elim n; left; assumption).
-rewrite RList_P22.
-rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c);
- intros;
- [ reflexivity
- | elim n; apply Rle_trans with b; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
-red in |- *; intro; rewrite H1 in H6; discriminate.
-rewrite RList_P24.
-rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c);
- intros;
- [ reflexivity
- | elim n; apply Rle_trans with b; left; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
-red in |- *; intro; rewrite H1 in H11; discriminate.
-apply StepFun_P20.
-rewrite RList_P23; apply neq_O_lt; red in |- *; intro.
-assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat).
-symmetry  in |- *; apply H1.
-elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate.
-unfold constant_D_eq, open_interval in |- *; 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 : (2 <= Rlength l1)%nat).
-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)
-  in |- *; rewrite RList_P12.
-induction  i as [| i Hreci].
-simpl in |- *; assert (H18 := H8 0%nat);
- unfold constant_D_eq, open_interval in H18;
- assert (H19 : (0 < pred (Rlength l1))%nat).
-rewrite H17; simpl in |- *; apply lt_O_Sn.
-assert (H20 := H18 H19); repeat rewrite H20.
-reflexivity.
-assert (H21 : r1 <= r2).
-rewrite H17 in H3; apply (H3 0%nat).
-simpl in |- *; apply lt_O_Sn.
-elim H21; intro.
-split.
-rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double;
-       apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24;
- simpl in H23; rewrite H22 in H23;
- elim (Rlt_irrefl _ (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 : (S i < pred (Rlength l1))%nat).
-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 Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i)));
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-elim H2; intros; rewrite H22 in H23;
- elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)).
-assumption.
-simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption.
-rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1.
-inversion H12.
-assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b).
-rewrite RList_P29.
-rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *;
- case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ].
-rewrite H15; apply le_n.
-induction  l1 as [| r l1 Hrecl1].
-simpl in H15; discriminate.
-clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
-assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b).
-rewrite RList_P26.
-replace i with (pred (Rlength l1));
- [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro;
+  forall (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).
+Proof. 
+  intros f a b c l1 l2 lf1 lf2 H H0 H1 H2; unfold adapted_couple in H1, H2;
+    unfold adapted_couple in |- *; decompose [and] H1; 
+      decompose [and] H2; clear H1 H2; repeat split.
+  apply RList_P25; try assumption.
+  rewrite H10; rewrite H4; unfold Rmin, Rmax in |- *; case (Rle_dec a b);
+    case (Rle_dec b c); intros;
+      (right; reflexivity) || (elim n; left; assumption).
+  rewrite RList_P22.
+  rewrite H5; unfold Rmin, Rmax in |- *; case (Rle_dec a b); case (Rle_dec a c);
+    intros;
+      [ reflexivity
+        | elim n; apply Rle_trans with b; left; assumption
+        | elim n; left; assumption
+        | elim n0; left; assumption ].
+  red in |- *; intro; rewrite H1 in H6; discriminate.
+  rewrite RList_P24.
+  rewrite H9; unfold Rmin, Rmax in |- *; case (Rle_dec b c); case (Rle_dec a c);
+    intros;
+      [ reflexivity
+        | elim n; apply Rle_trans with b; left; assumption
+        | elim n; left; assumption
+        | elim n0; left; assumption ].
+  red in |- *; intro; rewrite H1 in H11; discriminate.
+  apply StepFun_P20.
+  rewrite RList_P23; apply neq_O_lt; red in |- *; intro.
+  assert (H2 : (Rlength l1 + Rlength l2)%nat = 0%nat).
+  symmetry  in |- *; apply H1.
+  elim (plus_is_O _ _ H2); intros; rewrite H12 in H6; discriminate.
+  unfold constant_D_eq, open_interval in |- *; 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 : (2 <= Rlength l1)%nat).
+  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)
+      in |- *; rewrite RList_P12.
+  induction  i as [| i Hreci].
+  simpl in |- *; assert (H18 := H8 0%nat);
+    unfold constant_D_eq, open_interval in H18;
+      assert (H19 : (0 < pred (Rlength l1))%nat).
+  rewrite H17; simpl in |- *; apply lt_O_Sn.
+  assert (H20 := H18 H19); repeat rewrite H20.
+  reflexivity.
+  assert (H21 : r1 <= r2).
+  rewrite H17 in H3; apply (H3 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  elim H21; intro.
+  split.
+  rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  rewrite H17; simpl in |- *; apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite (Rplus_comm r1); rewrite double;
+            apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  elim H2; intros; rewrite H17 in H23; rewrite H17 in H24; simpl in H24;
+    simpl in H23; rewrite H22 in H23;
+      elim (Rlt_irrefl _ (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 : (S i < pred (Rlength l1))%nat).
+  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 Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l1 (S i)));
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  elim H2; intros; rewrite H22 in H23;
+    elim (Rlt_irrefl _ (Rlt_trans _ _ _ H23 H24)).
+  assumption.
+  simpl in |- *; rewrite H17 in H1; simpl in H1; apply lt_S_n; assumption.
+  rewrite RList_P14; rewrite H17 in H1; simpl in H1; apply H1.
+  inversion H12.
+  assert (H16 : pos_Rl (cons_Rlist l1 l2) (S i) = b).
+  rewrite RList_P29.
+  rewrite H15; rewrite <- minus_n_n; rewrite H10; unfold Rmin in |- *;
+    case (Rle_dec b c); intro; [ reflexivity | elim n; left; assumption ].
+  rewrite H15; apply le_n.
+  induction  l1 as [| r l1 Hrecl1].
+  simpl in H15; discriminate.
+  clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
+  assert (H17 : pos_Rl (cons_Rlist l1 l2) i = b).
+  rewrite RList_P26.
+  replace i with (pred (Rlength l1));
+  [ rewrite H4; unfold Rmax in |- *; case (Rle_dec a b); intro;
     [ 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_irrefl _ (Rlt_trans _ _ _ H14 H18)).
-assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (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 (i - Rlength l1))).
-replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat.
-apply RList_P29.
-apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ].
-induction  l1 as [| r l1 Hrecl1].
-simpl in H6; discriminate.
-clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
-symmetry  in |- *; apply minus_Sn_m; apply le_S_n; assumption.
-assert (H18 : (2 <= Rlength l1)%nat).
-clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17;
- induction  l1 as [| r l1 Hrecl1].
-discriminate.
-clear Hrecl1; induction  l1 as [| r0 l1 Hrecl1].
-simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b).
-unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro;
- [ assumption | elim n; left; assumption ].
-rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0).
-clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n.
-elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19;
- change
-   (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
-  in |- *; rewrite RList_P12.
-induction  i as [| i Hreci].
-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 (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 (S i - Rlength (cons r1 (cons r2 r3))))) 
-  in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat);
- unfold constant_D_eq, open_interval in H20;
- assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat).
-apply lt_pred; rewrite minus_Sn_m.
-apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
-rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
- rewrite 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 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))).
-apply H7; apply lt_pred.
-rewrite minus_Sn_m.
-apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
-rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
- rewrite 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 Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
-    | discrR ] ].
-apply Rmult_lt_reg_l with 2;
- [ prove_sup0
- | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
-    rewrite <- Rinv_r_sym;
-    [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1)));
-       rewrite double; apply Rplus_lt_compat_l; assumption
-    | 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_irrefl _ (Rlt_trans _ _ _ H25 H26)).
-assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)).
-rewrite H19; simpl in |- *; simpl in H16; apply H16.
-assert
- (H24 :
-  pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))).
-rewrite H19; simpl in |- *; simpl in H17; apply H17.
-rewrite <- H23; rewrite <- H24; assumption.
-simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption.
-rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1.
+    | rewrite H15; reflexivity ].
+  rewrite H15; apply lt_n_Sn.
+  rewrite H16 in H2; rewrite H17 in H2; elim H2; intros;
+    elim (Rlt_irrefl _ (Rlt_trans _ _ _ H14 H18)).
+  assert (H16 : pos_Rl (cons_Rlist l1 l2) i = pos_Rl l2 (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 (i - Rlength l1))).
+  replace (S (i - Rlength l1)) with (S i - Rlength l1)%nat.
+  apply RList_P29.
+  apply le_S_n; apply le_trans with (S i); [ assumption | apply le_n_Sn ].
+  induction  l1 as [| r l1 Hrecl1].
+  simpl in H6; discriminate.
+  clear Hrecl1; simpl in H1; simpl in |- *; apply lt_n_S; assumption.
+  symmetry  in |- *; apply minus_Sn_m; apply le_S_n; assumption.
+  assert (H18 : (2 <= Rlength l1)%nat).
+  clear f c l2 lf2 H0 H3 H8 H7 H10 H9 H11 H13 i H1 x H2 H12 m H14 H15 H16 H17;
+    induction  l1 as [| r l1 Hrecl1].
+  discriminate.
+  clear Hrecl1; induction  l1 as [| r0 l1 Hrecl1].
+  simpl in H5; simpl in H4; assert (H0 : Rmin a b < Rmax a b).
+  unfold Rmin, Rmax in |- *; case (Rle_dec a b); intro;
+    [ assumption | elim n; left; assumption ].
+  rewrite <- H5 in H0; rewrite <- H4 in H0; elim (Rlt_irrefl _ H0).
+  clear Hrecl1; simpl in |- *; repeat apply le_n_S; apply le_O_n.
+  elim (RList_P20 _ H18); intros r1 [r2 [r3 H19]]; rewrite H19;
+    change
+      (f x = pos_Rl (app_Rlist (mid_Rlist (cons_Rlist (cons r2 r3) l2) r1) f) i)
+      in |- *; rewrite RList_P12.
+  induction  i as [| i Hreci].
+  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 (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 (S i - Rlength (cons r1 (cons r2 r3))))) 
+          in H17; rewrite H17; assert (H20 := H13 (S i - Rlength l1)%nat);
+            unfold constant_D_eq, open_interval in H20;
+              assert (H21 : (S i - Rlength l1 < pred (Rlength l2))%nat).
+  apply lt_pred; rewrite minus_Sn_m.
+  apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
+  rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+    rewrite 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 (S i - Rlength l1) <= pos_Rl l2 (S (S i - Rlength l1))).
+  apply H7; apply lt_pred.
+  rewrite minus_Sn_m.
+  apply plus_lt_reg_l with (Rlength l1); rewrite <- le_plus_minus.
+  rewrite H19 in H1; simpl in H1; rewrite H19; simpl in |- *;
+    rewrite 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 Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite double; apply Rplus_lt_compat_l; assumption
+            | discrR ] ].
+  apply Rmult_lt_reg_l with 2;
+    [ prove_sup0
+      | unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+        rewrite <- Rinv_r_sym;
+          [ rewrite Rmult_1_l; rewrite (Rplus_comm (pos_Rl l2 (S i - Rlength l1)));
+            rewrite double; apply Rplus_lt_compat_l; assumption
+            | 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_irrefl _ (Rlt_trans _ _ _ H25 H26)).
+  assert (H23 : pos_Rl (cons_Rlist l1 l2) (S i) = pos_Rl l2 (S i - Rlength l1)).
+  rewrite H19; simpl in |- *; simpl in H16; apply H16.
+  assert
+    (H24 :
+      pos_Rl (cons_Rlist l1 l2) (S (S i)) = pos_Rl l2 (S (S i - Rlength l1))).
+  rewrite H19; simpl in |- *; simpl in H17; apply H17.
+  rewrite <- H23; rewrite <- H24; assumption.
+  simpl in |- *; rewrite H19 in H1; simpl in H1; apply lt_S_n; assumption.
+  rewrite RList_P14; rewrite H19 in H1; simpl in H1; simpl in |- *; apply H1.
 Qed.
 
 Lemma StepFun_P41 :
- forall (f:R -> R) (a b c:R),
-   a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
+  forall (f:R -> R) (a b c:R),
+    a <= b -> b <= c -> IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
 Proof.
-intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2));
- destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab].
- destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc].
-exists (cons_Rlist l1 l2); exists (FF (cons_Rlist l1 l2) f);
- apply StepFun_P40 with b lf1 lf2; assumption.
-exists l1; exists lf1; rewrite Hbc in H1; assumption.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)).
-exists l2; exists lf2; rewrite <- Hab in H2; assumption.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)).
+  intros f a b c H H0 (l1,(lf1,H1)) (l2,(lf2,H2));
+    destruct (total_order_T a b) as [[Hltab|Hab]|Hgtab].
+  destruct (total_order_T b c) as [[Hltbc|Hbc]|Hgtbc].
+  exists (cons_Rlist l1 l2); exists (FF (cons_Rlist l1 l2) f);
+    apply StepFun_P40 with b lf1 lf2; assumption.
+  exists l1; exists lf1; rewrite Hbc in H1; assumption.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H0 Hgtbc)).
+  exists l2; exists lf2; rewrite <- Hab in H2; assumption.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H Hgtab)).
 Qed.
 
 Lemma StepFun_P42 :
- forall (l1 l2:Rlist) (f:R -> R),
-   pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 ->
-   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; induction l1 as [| r l1 IHl1]; intros H;
- [ simpl in |- *; ring
- | destruct l1 as [| r0 r1];
-    [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1];
-       [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ]
-    | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1;
-       rewrite <- H; reflexivity ] ].
+  forall (l1 l2:Rlist) (f:R -> R),
+    pos_Rl l1 (pred (Rlength l1)) = pos_Rl l2 0 ->
+    Int_SF (FF (cons_Rlist l1 l2) f) (cons_Rlist l1 l2) =
+    Int_SF (FF l1 f) l1 + Int_SF (FF l2 f) l2.
+Proof. 
+  intros l1 l2 f; induction l1 as [| r l1 IHl1]; intros H;
+    [ simpl in |- *; ring
+      | destruct l1 as [| r0 r1];
+        [ simpl in H; simpl in |- *; destruct l2 as [| r0 r1];
+          [ simpl in |- *; ring | simpl in |- *; simpl in H; rewrite H; ring ]
+          | simpl in |- *; rewrite Rplus_assoc; apply Rplus_eq_compat_l; apply IHl1;
+            rewrite <- H; reflexivity ] ].
 Qed.
 
 Lemma StepFun_P43 :
- forall (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 (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))).
-apply pr1.
-assert
- (H2 :
-  sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))).
-apply pr2.
-assert
- (H3 :
-  sigT (fun l:Rlist => sigT (fun 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
- match Rle_dec a b with
- | left _ => Int_SF lf1 l1
- | right _ => - Int_SF lf1 l1
- end.
-replace (RiemannInt_SF (mkStepFun pr2)) with
- match Rle_dec b c with
- | left _ => Int_SF lf2 l2
- | right _ => - Int_SF lf2 l2
- end.
-replace (RiemannInt_SF (mkStepFun pr3)) with
- match Rle_dec a c with
- | left _ => Int_SF lf3 l3
- | right _ => - Int_SF lf3 l3
- end.
-case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec 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  in |- *; apply StepFun_P42.
-unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2;
- clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
- case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n;
- assumption.
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2;
-    assumption
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
- | assumption ].
-eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ].
-replace (Int_SF lf2 l2) with 0.
-rewrite Rplus_0_r; eapply StepFun_P17;
- [ apply H1 | rewrite <- H0 in H3; apply H3 ].
-symmetry  in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
-replace (Int_SF lf1 l1) with 0.
-rewrite Rplus_0_l; eapply StepFun_P17;
- [ apply H2 | rewrite H in H3; apply H3 ].
-symmetry  in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
-elim n; apply Rle_trans with b; assumption.
-apply Rplus_eq_reg_l with (Int_SF lf2 l2);
- replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with
-  (Int_SF lf1 l1); [ idtac | ring ].
-assert (H : c < b).
-auto with real.
-elim r; intro.
-rewrite Rplus_comm;
- 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 in |- *;
- case (Rle_dec a c); case (Rle_dec b c); intros;
- [ elim n; assumption
- | reflexivity
- | elim n0; assumption
- | elim n1; assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
- | assumption ].
-eapply StepFun_P17;
- [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ].
-replace (Int_SF lf3 l3) with 0.
-rewrite Rplus_0_r; eapply StepFun_P17;
- [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ].
-symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
-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  in |- *; apply StepFun_P42.
-unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
- clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *;
- case (Rle_dec a c); case (Rle_dec a b); intros;
- [ elim n; assumption
- | elim n1; assumption
- | reflexivity
- | elim n1; assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
-rewrite Rplus_0_r; eapply StepFun_P17;
- [ apply H3 | rewrite <- H in H2; apply H2 ].
-symmetry  in |- *; 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_comm; 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  in |- *; apply StepFun_P42.
-unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
- clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
- case (Rle_dec a c); case (Rle_dec a b); intros;
- [ elim n; assumption
- | reflexivity
- | elim n0; assumption
- | elim n1; assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
-rewrite Rplus_0_r; eapply StepFun_P17;
- [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ].
-symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
-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  in |- *; apply StepFun_P42.
-unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
- clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
- case (Rle_dec a c); case (Rle_dec b c); intros;
- [ elim n; assumption
- | elim n1; assumption
- | reflexivity
- | elim n1; assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
-rewrite Rplus_0_l; eapply StepFun_P17;
- [ apply H3 | rewrite H0 in H1; apply H1 ].
-symmetry  in |- *; 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  in |- *; apply StepFun_P42.
-unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1;
- clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
- case (Rle_dec a b); case (Rle_dec b c); intros;
- [ elim n1; assumption
- | elim n1; assumption
- | elim n0; assumption
- | reflexivity ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
- | assumption ].
-eapply StepFun_P17;
- [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
- | assumption ].
-eapply StepFun_P17.
-apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
-apply StepFun_P2; apply H3.
-unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro.
-eapply StepFun_P17.
-apply H3.
-change
-  (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
-     (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
-apply Ropp_eq_compat; eapply StepFun_P17.
-apply H3.
-change
-  (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
-     (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
-unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro.
-eapply StepFun_P17.
-apply H2.
-change
-  (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
-     (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
-apply Ropp_eq_compat; eapply StepFun_P17.
-apply H2.
-change
-  (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
-     (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
-unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
-eapply StepFun_P17.
-apply H1.
-change
-  (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
-     (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
-apply Ropp_eq_compat; eapply StepFun_P17.
-apply H1.
-change
-  (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
-     (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
+  forall (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).
+Proof. 
+  intros f; intros;
+    assert
+      (H1 :
+        sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a b l l0))).
+  apply pr1.
+  assert
+    (H2 :
+      sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f b c l l0))).
+  apply pr2.
+  assert
+    (H3 :
+      sigT (fun l:Rlist => sigT (fun 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
+  match Rle_dec a b with
+    | left _ => Int_SF lf1 l1
+    | right _ => - Int_SF lf1 l1
+  end.
+  replace (RiemannInt_SF (mkStepFun pr2)) with
+  match Rle_dec b c with
+    | left _ => Int_SF lf2 l2
+    | right _ => - Int_SF lf2 l2
+  end.
+  replace (RiemannInt_SF (mkStepFun pr3)) with
+  match Rle_dec a c with
+    | left _ => Int_SF lf3 l3
+    | right _ => - Int_SF lf3 l3
+  end.
+  case (Rle_dec a b); case (Rle_dec b c); case (Rle_dec 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  in |- *; apply StepFun_P42.
+  unfold adapted_couple in H1, H2; decompose [and] H1; decompose [and] H2;
+    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+      case (Rle_dec a b); case (Rle_dec b c); intros; reflexivity || elim n;
+        assumption.
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2;
+      assumption
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+      | assumption ].
+  eapply StepFun_P17; [ apply (StepFun_P40 H H0 H1 H2) | apply H3 ].
+  replace (Int_SF lf2 l2) with 0.
+  rewrite Rplus_0_r; eapply StepFun_P17;
+    [ apply H1 | rewrite <- H0 in H3; apply H3 ].
+  symmetry  in |- *; eapply StepFun_P8; [ apply H2 | assumption ].
+  replace (Int_SF lf1 l1) with 0.
+  rewrite Rplus_0_l; eapply StepFun_P17;
+    [ apply H2 | rewrite H in H3; apply H3 ].
+  symmetry  in |- *; eapply StepFun_P8; [ apply H1 | assumption ].
+  elim n; apply Rle_trans with b; assumption.
+  apply Rplus_eq_reg_l with (Int_SF lf2 l2);
+    replace (Int_SF lf2 l2 + (Int_SF lf1 l1 + - Int_SF lf2 l2)) with
+    (Int_SF lf1 l1); [ idtac | ring ].
+  assert (H : c < b).
+  auto with real.
+  elim r; intro.
+  rewrite Rplus_comm;
+    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 in |- *;
+      case (Rle_dec a c); case (Rle_dec b c); intros;
+        [ elim n; assumption
+          | reflexivity
+          | elim n0; assumption
+          | elim n1; assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf3; apply H3
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply (StepFun_P40 H0 H H3 (StepFun_P2 H2)) | apply H1 ].
+  replace (Int_SF lf3 l3) with 0.
+  rewrite Rplus_0_r; eapply StepFun_P17;
+    [ apply H1 | apply StepFun_P2; rewrite <- H0 in H2; apply H2 ].
+  symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+  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  in |- *; apply StepFun_P42.
+  unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
+    clear H3 H1; rewrite H9; rewrite H5; unfold Rmax, Rmin in |- *;
+      case (Rle_dec a c); case (Rle_dec a b); intros;
+        [ elim n; assumption
+          | elim n1; assumption
+          | reflexivity
+          | elim n1; assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
+  rewrite Rplus_0_r; eapply StepFun_P17;
+    [ apply H3 | rewrite <- H in H2; apply H2 ].
+  symmetry  in |- *; 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_comm; 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  in |- *; apply StepFun_P42.
+  unfold adapted_couple in H1, H3; decompose [and] H1; decompose [and] H3;
+    clear H3 H1; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+      case (Rle_dec a c); case (Rle_dec a b); intros;
+        [ elim n; assumption
+          | reflexivity
+          | elim n0; assumption
+          | elim n1; assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
+  rewrite Rplus_0_r; eapply StepFun_P17;
+    [ apply H1 | rewrite <- H0 in H2; apply StepFun_P2; apply H2 ].
+  symmetry  in |- *; eapply StepFun_P8; [ apply H3 | assumption ].
+  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  in |- *; apply StepFun_P42.
+  unfold adapted_couple in H2, H3; decompose [and] H2; decompose [and] H3;
+    clear H3 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+      case (Rle_dec a c); case (Rle_dec b c); intros;
+        [ elim n; assumption
+          | elim n1; assumption
+          | reflexivity
+          | elim n1; assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; 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 0.
+  rewrite Rplus_0_l; eapply StepFun_P17;
+    [ apply H3 | rewrite H0 in H1; apply H1 ].
+  symmetry  in |- *; 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  in |- *; apply StepFun_P42.
+  unfold adapted_couple in H2, H1; decompose [and] H2; decompose [and] H1;
+    clear H1 H2; rewrite H11; rewrite H5; unfold Rmax, Rmin in |- *;
+      case (Rle_dec a b); case (Rle_dec b c); intros;
+        [ elim n1; assumption
+          | elim n1; assumption
+          | elim n0; assumption
+          | reflexivity ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf2; apply H2
+      | assumption ].
+  eapply StepFun_P17;
+    [ apply StepFun_P21; unfold is_subdivision in |- *; split with lf1; apply H1
+      | assumption ].
+  eapply StepFun_P17.
+  apply (StepFun_P40 H H0 (StepFun_P2 H2) (StepFun_P2 H1)).
+  apply StepFun_P2; apply H3.
+  unfold RiemannInt_SF in |- *; case (Rle_dec a c); intro.
+  eapply StepFun_P17.
+  apply H3.
+  change
+    (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
+      (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
+  apply Ropp_eq_compat; eapply StepFun_P17.
+  apply H3.
+  change
+    (adapted_couple (mkStepFun pr3) a c (subdivision (mkStepFun pr3))
+      (subdivision_val (mkStepFun pr3))) in |- *; apply StepFun_P1.
+  unfold RiemannInt_SF in |- *; case (Rle_dec b c); intro.
+  eapply StepFun_P17.
+  apply H2.
+  change
+    (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
+      (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
+  apply Ropp_eq_compat; eapply StepFun_P17.
+  apply H2.
+  change
+    (adapted_couple (mkStepFun pr2) b c (subdivision (mkStepFun pr2))
+      (subdivision_val (mkStepFun pr2))) in |- *; apply StepFun_P1.
+  unfold RiemannInt_SF in |- *; case (Rle_dec a b); intro.
+  eapply StepFun_P17.
+  apply H1.
+  change
+    (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
+      (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
+  apply Ropp_eq_compat; eapply StepFun_P17.
+  apply H1.
+  change
+    (adapted_couple (mkStepFun pr1) a b (subdivision (mkStepFun pr1))
+      (subdivision_val (mkStepFun pr1))) in |- *; apply StepFun_P1.
 Qed.
 
 Lemma StepFun_P44 :
- forall (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
-  (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
-     adapted_couple f a b l1 lf1 ->
-     a <= c <= b ->
-     sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))).
-intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X.
-apply H2.
-split; assumption.
-clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
-intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
- discriminate.
-simple induction r0.
-intros X lf1 a b c f H H0; 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 b at 2 in |- *; replace b with (Rmax a b).
-rewrite <- H2; rewrite H3; reflexivity.
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-split with (cons r nil); split with lf1; assert (H2 : c = b).
-rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
-rewrite H2; assumption.
-intros r1 r2 _ X0 lf1 a b c f H H0; induction  lf1 as [| r3 lf1 Hreclf1].
-unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
- discriminate.
-clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
-case (Rle_dec 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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity
- | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
-elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split.
-rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
- [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
-simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ assumption | elim n; assumption ].
-simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro;
- [ reflexivity | elim n; assumption ].
-unfold constant_D_eq, open_interval in |- *; intros; simpl in H8;
- inversion H8.
-simpl in |- *; assert (H10 := H7 0%nat);
- assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
-simpl in |- *; apply lt_O_Sn.
-apply (H10 H12); unfold open_interval in |- *; simpl in |- *;
- 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 in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-induction  l1' as [| r4 l1' Hrecl1'].
-simpl in H13; discriminate.
-clear Hrecl1'; unfold adapted_couple in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-simpl in |- *; replace r4 with r1.
-apply (H5 0%nat).
-simpl in |- *; apply lt_O_Sn.
-simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
- [ reflexivity | elim n; left; assumption ].
-apply (H9 i); simpl in |- *; apply lt_S_n; assumption.
-simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
- [ assumption | elim n; elim H0; intros; assumption ].
-replace (Rmax a c) with (Rmax r1 c).
-rewrite <- H11; reflexivity.
-unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros;
- [ reflexivity
- | elim n; elim H0; intros; assumption
- | elim n; left; assumption
- | elim n0; left; assumption ].
-simpl in |- *; simpl in H13; rewrite H13; reflexivity.
-intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
- induction  i as [| i Hreci].
-simpl in |- *; assert (H17 := H10 0%nat);
- assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
-simpl in |- *; apply lt_O_Sn.
-apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4;
- elim H4; clear H4; intros; split; try assumption; 
- replace r1 with r4.
-assumption.
-simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
- [ reflexivity | elim n; left; assumption ].
-clear Hreci; simpl in |- *; apply H15.
-simpl in |- *; apply lt_S_n; assumption.
-unfold open_interval in |- *; 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 ].
+  forall (f:R -> R) (a b c:R),
+    IsStepFun f a b -> a <= c <= b -> IsStepFun f a c.
+Proof. 
+  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
+        (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
+          adapted_couple f a b l1 lf1 ->
+          a <= c <= b ->
+          sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f a c l l0))).
+  intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X.
+  apply H2.
+  split; assumption.
+  clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
+  intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+    discriminate.
+  simple induction r0.
+  intros X lf1 a b c f H H0; 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 b at 2 in |- *; replace b with (Rmax a b).
+  rewrite <- H2; rewrite H3; reflexivity.
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  split with (cons r nil); split with lf1; assert (H2 : c = b).
+  rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
+  rewrite H2; assumption.
+  intros r1 r2 _ X0 lf1 a b c f H H0; induction  lf1 as [| r3 lf1 Hreclf1].
+  unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+    discriminate.
+  clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
+  case (Rle_dec 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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity
+      | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+  elim H0; clear H0; intros; unfold adapted_couple in |- *; repeat split.
+  rewrite H6; unfold ordered_Rlist in |- *; intros; simpl in H8; inversion H8;
+    [ simpl in |- *; assumption | elim (le_Sn_O _ H10) ].
+  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ assumption | elim n; assumption ].
+  simpl in |- *; unfold Rmax in |- *; case (Rle_dec a c); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold constant_D_eq, open_interval in |- *; intros; simpl in H8;
+    inversion H8.
+  simpl in |- *; assert (H10 := H7 0%nat);
+    assert (H12 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
+  simpl in |- *; apply lt_O_Sn.
+  apply (H10 H12); unfold open_interval in |- *; simpl in |- *;
+    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 in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  induction  l1' as [| r4 l1' Hrecl1'].
+  simpl in H13; discriminate.
+  clear Hrecl1'; unfold adapted_couple in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
+  simpl in |- *; replace r4 with r1.
+  apply (H5 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+    [ reflexivity | elim n; left; assumption ].
+  apply (H9 i); simpl in |- *; apply lt_S_n; assumption.
+  simpl in |- *; unfold Rmin in |- *; case (Rle_dec a c); intro;
+    [ assumption | elim n; elim H0; intros; assumption ].
+  replace (Rmax a c) with (Rmax r1 c).
+  rewrite <- H11; reflexivity.
+  unfold Rmax in |- *; case (Rle_dec r1 c); case (Rle_dec a c); intros;
+    [ reflexivity
+      | elim n; elim H0; intros; assumption
+      | elim n; left; assumption
+      | elim n0; left; assumption ].
+  simpl in |- *; simpl in H13; rewrite H13; reflexivity.
+  intros; simpl in H; unfold constant_D_eq, open_interval in |- *; intros;
+    induction  i as [| i Hreci].
+  simpl in |- *; assert (H17 := H10 0%nat);
+    assert (H18 : (0 < pred (Rlength (cons r (cons r1 r2))))%nat).
+  simpl in |- *; apply lt_O_Sn.
+  apply (H17 H18); unfold open_interval in |- *; simpl in |- *; simpl in H4;
+    elim H4; clear H4; intros; split; try assumption; 
+      replace r1 with r4.
+  assumption.
+  simpl in H12; rewrite H12; unfold Rmin in |- *; case (Rle_dec r1 c); intro;
+    [ reflexivity | elim n; left; assumption ].
+  clear Hreci; simpl in |- *; apply H15.
+  simpl in |- *; apply lt_S_n; assumption.
+  unfold open_interval in |- *; 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 :
- forall (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
-  (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
-     adapted_couple f a b l1 lf1 ->
-     a <= c <= b ->
-     sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))).
-intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X;
- [ apply H2 | split; assumption ].
-clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
-intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
- discriminate.
-simple induction r0.
-intros X lf1 a b c f H H0; 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 b at 2 in |- *; replace b with (Rmax a b).
-rewrite <- H2; rewrite H3; reflexivity.
-unfold Rmax in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-unfold Rmin in |- *; case (Rle_dec a b); intro;
- [ reflexivity | elim n; assumption ].
-split with (cons r nil); split with lf1; assert (H2 : c = b).
-rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
-rewrite <- H2 in H1; rewrite <- H1; assumption.
-intros r1 r2 _ X0 lf1 a b c f H H0; induction  lf1 as [| r3 lf1 Hreclf1].
-unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
- discriminate.
-clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
-case (Rle_dec 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 in |- *; repeat split.
-unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
-simpl in |- *; assumption.
-clear Hreci; apply (H2 (S i)); simpl in |- *; assumption.
-simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro;
- [ reflexivity | elim n; elim H0; intros; assumption ].
-replace (Rmax c b) with (Rmax a b).
-rewrite <- H3; reflexivity.
-unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros;
- [ reflexivity
- | elim n; elim H0; intros; assumption
- | elim n; elim H0; intros; apply Rle_trans with c; assumption
- | elim n0; elim H0; intros; apply Rle_trans with c; assumption ].
-simpl in |- *; simpl in H5; apply H5.
-intros; simpl in H; induction  i as [| i Hreci].
-unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
- apply (H7 0%nat).
-simpl in |- *; apply lt_O_Sn.
-unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6;
- intros; split; try assumption; apply Rle_lt_trans with c; 
- try assumption; replace r with a.
-elim H0; intros; assumption.
-simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros;
- [ reflexivity
- | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
-clear Hreci; apply (H7 (S i)); simpl in |- *; 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 ].
+  forall (f:R -> R) (a b c:R),
+    IsStepFun f a b -> a <= c <= b -> IsStepFun f c b.
+Proof. 
+  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
+        (forall (l1 lf1:Rlist) (a b c:R) (f:R -> R),
+          adapted_couple f a b l1 lf1 ->
+          a <= c <= b ->
+          sigT (fun l:Rlist => sigT (fun l0:Rlist => adapted_couple f c b l l0))).
+  intro X; unfold IsStepFun in |- *; unfold is_subdivision in |- *; eapply X;
+    [ apply H2 | split; assumption ].
+  clear f a b c H0 H H1 H2 l1 lf1; simple induction l1.
+  intros; unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+    discriminate.
+  simple induction r0.
+  intros X lf1 a b c f H H0; 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 b at 2 in |- *; replace b with (Rmax a b).
+  rewrite <- H2; rewrite H3; reflexivity.
+  unfold Rmax in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  unfold Rmin in |- *; case (Rle_dec a b); intro;
+    [ reflexivity | elim n; assumption ].
+  split with (cons r nil); split with lf1; assert (H2 : c = b).
+  rewrite H1 in H0; elim H0; intros; apply Rle_antisym; assumption.
+  rewrite <- H2 in H1; rewrite <- H1; assumption.
+  intros r1 r2 _ X0 lf1 a b c f H H0; induction  lf1 as [| r3 lf1 Hreclf1].
+  unfold adapted_couple in H; decompose [and] H; clear H; simpl in H4;
+    discriminate.
+  clear Hreclf1; assert (H1 : {c <= r1} + {r1 < c}).
+  case (Rle_dec 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 in |- *; repeat split.
+  unfold ordered_Rlist in |- *; intros; simpl in H; induction  i as [| i Hreci].
+  simpl in |- *; assumption.
+  clear Hreci; apply (H2 (S i)); simpl in |- *; assumption.
+  simpl in |- *; unfold Rmin in |- *; case (Rle_dec c b); intro;
+    [ reflexivity | elim n; elim H0; intros; assumption ].
+  replace (Rmax c b) with (Rmax a b).
+  rewrite <- H3; reflexivity.
+  unfold Rmax in |- *; case (Rle_dec a b); case (Rle_dec c b); intros;
+    [ reflexivity
+      | elim n; elim H0; intros; assumption
+      | elim n; elim H0; intros; apply Rle_trans with c; assumption
+      | elim n0; elim H0; intros; apply Rle_trans with c; assumption ].
+  simpl in |- *; simpl in H5; apply H5.
+  intros; simpl in H; induction  i as [| i Hreci].
+  unfold constant_D_eq, open_interval in |- *; intros; simpl in |- *;
+    apply (H7 0%nat).
+  simpl in |- *; apply lt_O_Sn.
+  unfold open_interval in |- *; simpl in |- *; simpl in H6; elim H6; clear H6;
+    intros; split; try assumption; apply Rle_lt_trans with c; 
+      try assumption; replace r with a.
+  elim H0; intros; assumption.
+  simpl in H4; rewrite H4; unfold Rmin in |- *; case (Rle_dec a b); intros;
+    [ reflexivity
+      | elim n; elim H0; intros; apply Rle_trans with c; assumption ].
+  clear Hreci; apply (H7 (S i)); simpl in |- *; 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 :
- forall (f:R -> R) (a b c:R),
-   IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
-intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros.
-apply StepFun_P41 with b; assumption.
-case (Rle_dec 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 (Rle_dec 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 || apply StepFun_P6; assumption.
+  forall (f:R -> R) (a b c:R),
+    IsStepFun f a b -> IsStepFun f b c -> IsStepFun f a c.
+Proof. 
+  intros f; intros; case (Rle_dec a b); case (Rle_dec b c); intros.
+  apply StepFun_P41 with b; assumption.
+  case (Rle_dec 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 (Rle_dec 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 || apply StepFun_P6; assumption.
 Qed.
diff --git a/theories/Reals/Rlimit.v b/theories/Reals/Rlimit.v
index b8d304b1..76579ccb 100644
--- a/theories/Reals/Rlimit.v
+++ b/theories/Reals/Rlimit.v
@@ -6,10 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rlimit.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rlimit.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (*********************************************************)
-(*           Definition of the limit                     *)
+(**          Definition of the limit                     *)
 (*                                                       *)
 (*********************************************************)
 
@@ -19,76 +19,82 @@ Require Import Classical_Prop.
 Require Import Fourier. Open Local Scope R_scope.
 
 (*******************************)
-(*      Calculus               *)
+(** *   Calculus               *)
 (*******************************)
 (*********)
 Lemma eps2_Rgt_R0 : forall eps:R, eps > 0 -> eps * / 2 > 0.
-intros; fourier.
+Proof.
+  intros; fourier.
 Qed.
 
 (*********)
 Lemma eps2 : forall eps:R, eps * / 2 + eps * / 2 = eps.
-intro esp.
-assert (H := double_var esp).
-unfold Rdiv in H.
-symmetry  in |- *; exact H.
+Proof.
+  intro esp.
+  assert (H := double_var esp).
+  unfold Rdiv in H.
+  symmetry  in |- *; exact H.
 Qed.
 
 (*********)
 Lemma eps4 : forall eps:R, eps * / (2 + 2) + eps * / (2 + 2) = eps * / 2.
-intro eps.
-replace (2 + 2) with 4.
-pattern eps at 3 in |- *; rewrite double_var.
-rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)).
-unfold Rdiv in |- *.
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_mult_distr.
-reflexivity.
-discrR.
-discrR.
-ring.
+Proof.
+  intro eps.
+  replace (2 + 2) with 4.
+  pattern eps at 3 in |- *; rewrite double_var.
+  rewrite (Rmult_plus_distr_r (eps / 2) (eps / 2) (/ 2)).
+  unfold Rdiv in |- *.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  reflexivity.
+  discrR.
+  discrR.
+  ring.
 Qed.
 
 (*********)
 Lemma Rlt_eps2_eps : forall eps:R, eps > 0 -> eps * / 2 < eps.
-intros.
-pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
-repeat rewrite (Rmult_comm eps).
-apply Rmult_lt_compat_r.
-exact H.
-apply Rmult_lt_reg_l with 2.
-fourier.
-rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
-fourier.
-discrR.
+Proof.
+  intros.
+  pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+  repeat rewrite (Rmult_comm eps).
+  apply Rmult_lt_compat_r.
+  exact H.
+  apply Rmult_lt_reg_l with 2.
+  fourier.
+  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+  fourier.
+  discrR.
 Qed.
 
 (*********)
 Lemma Rlt_eps4_eps : forall eps:R, eps > 0 -> eps * / (2 + 2) < eps.
-intros.
-replace (2 + 2) with 4.
-pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
-repeat rewrite (Rmult_comm eps).
-apply Rmult_lt_compat_r.
-exact H.
-apply Rmult_lt_reg_l with 4.
-replace 4 with 4.
-apply Rmult_lt_0_compat; fourier.
-ring.
-rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
-fourier.
-discrR.
-ring.
+Proof.
+  intros.
+  replace (2 + 2) with 4.
+  pattern eps at 2 in |- *; rewrite <- Rmult_1_r.
+  repeat rewrite (Rmult_comm eps).
+  apply Rmult_lt_compat_r.
+  exact H.
+  apply Rmult_lt_reg_l with 4.
+  replace 4 with 4.
+  apply Rmult_lt_0_compat; fourier.
+  ring.
+  rewrite Rmult_1_r; rewrite <- Rinv_r_sym.
+  fourier.
+  discrR.
+  ring.
 Qed. 
 
 (*********)
 Lemma prop_eps : forall r:R, (forall eps:R, eps > 0 -> r < eps) -> r <= 0.
-intros; elim (Rtotal_order r 0); intro.
-apply Rlt_le; assumption.
-elim H0; intro.
-apply Req_le; assumption.
-clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro;
- elimtype False; auto.
+Proof.
+  intros; elim (Rtotal_order r 0); intro.
+  apply Rlt_le; assumption.
+  elim H0; intro.
+  apply Req_le; assumption.
+  clear H0; generalize (H r H1); intro; generalize (Rlt_irrefl r); intro;
+    elimtype False; auto.
 Qed.
 
 (*********)
@@ -96,59 +102,61 @@ Definition mul_factor (l l':R) := / (1 + (Rabs l + Rabs l')).
 
 (*********)
 Lemma mul_factor_wd : forall l l':R, 1 + (Rabs l + Rabs l') <> 0.
-intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus.
-cut (Rabs (l + l') <= Rabs l + Rabs l').
-cut (0 <= Rabs (l + l')).
-exact (Rle_trans _ _ _).
-exact (Rabs_pos (l + l')).
-exact (Rabs_triang _ _).
-exact Rlt_0_1.
+Proof.
+  intros; rewrite (Rplus_comm 1 (Rabs l + Rabs l')); apply tech_Rplus.
+  cut (Rabs (l + l') <= Rabs l + Rabs l').
+  cut (0 <= Rabs (l + l')).
+  exact (Rle_trans _ _ _).
+  exact (Rabs_pos (l + l')).
+  exact (Rabs_triang _ _).
+  exact Rlt_0_1.
 Qed.
 
 (*********)
 Lemma mul_factor_gt : forall eps l l':R, eps > 0 -> eps * mul_factor l l' > 0.
-intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps);
- apply Rmult_lt_compat_l.
-assumption.
-unfold mul_factor in |- *; apply Rinv_0_lt_compat;
- cut (1 <= 1 + (Rabs l + Rabs l')).
-cut (0 < 1).
-exact (Rlt_le_trans _ _ _).
-exact Rlt_0_1.
-replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')).
-apply Rplus_le_compat_l.
-cut (Rabs (l + l') <= Rabs l + Rabs l').
-cut (0 <= Rabs (l + l')).
-exact (Rle_trans _ _ _).
-exact (Rabs_pos _).
-exact (Rabs_triang _ _).
-rewrite (proj1 (Rplus_ne 1)); trivial.
+Proof.
+  intros; unfold Rgt in |- *; rewrite <- (Rmult_0_r eps);
+    apply Rmult_lt_compat_l.
+  assumption.
+  unfold mul_factor in |- *; apply Rinv_0_lt_compat;
+    cut (1 <= 1 + (Rabs l + Rabs l')).
+  cut (0 < 1).
+  exact (Rlt_le_trans _ _ _).
+  exact Rlt_0_1.
+  replace (1 <= 1 + (Rabs l + Rabs l')) with (1 + 0 <= 1 + (Rabs l + Rabs l')).
+  apply Rplus_le_compat_l.
+  cut (Rabs (l + l') <= Rabs l + Rabs l').
+  cut (0 <= Rabs (l + l')).
+  exact (Rle_trans _ _ _).
+  exact (Rabs_pos _).
+  exact (Rabs_triang _ _).
+  rewrite (proj1 (Rplus_ne 1)); trivial.
 Qed.
 
 (*********)
 Lemma mul_factor_gt_f :
- forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0.
-intros; apply Rmin_Rgt_r; split.
-exact Rlt_0_1.
-exact (mul_factor_gt eps l l' H).
+  forall eps l l':R, eps > 0 -> Rmin 1 (eps * mul_factor l l') > 0.
+  intros; apply Rmin_Rgt_r; split.
+  exact Rlt_0_1.
+  exact (mul_factor_gt eps l l' H).
 Qed.
 
 
 (*******************************)
-(*      Metric space           *)
+(** *   Metric space           *)
 (*******************************)
 
 (*********)
 Record Metric_Space : Type := 
   {Base : Type;
-   dist : Base -> Base -> R;
-   dist_pos : forall x y:Base, dist x y >= 0;
-   dist_sym : forall x y:Base, dist x y = dist y x;
-   dist_refl : forall x y:Base, dist x y = 0 <-> x = y;
-   dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}.
+    dist : Base -> Base -> R;
+    dist_pos : forall x y:Base, dist x y >= 0;
+    dist_sym : forall x y:Base, dist x y = dist y x;
+    dist_refl : forall x y:Base, dist x y = 0 <-> x = y;
+    dist_tri : forall x y z:Base, dist x y <= dist x z + dist z y}.
 
 (*******************************)
-(*     Limit in Metric space   *)
+(** ** Limit in Metric space   *)
 (*******************************)
 
 (*********)
@@ -156,12 +164,12 @@ Definition limit_in (X X':Metric_Space) (f:Base X -> Base X')
   (D:Base X -> Prop) (x0:Base X) (l:Base X') :=
   forall eps:R,
     eps > 0 ->
-     exists alp : R,
+    exists alp : R,
       alp > 0 /\
       (forall x:Base X, D x /\ dist X x x0 < alp -> dist X' (f x) l < eps). 
 
 (*******************************)
-(*    R is a metric space      *)
+(** **  R is a metric space    *)
 (*******************************)
 
 (*********)
@@ -169,7 +177,7 @@ 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         *)
+(** *      Limit 1 arg         *)
 (*******************************)
 (*********)
 Definition Dgf (Df Dg:R -> Prop) (f:R -> R) (x:R) := Df x /\ Dg (f x).
@@ -180,145 +188,153 @@ Definition limit1_in (f:R -> R) (D:R -> Prop) (l x0:R) : Prop :=
 
 (*********)
 Lemma tech_limit :
- forall (f:R -> R) (D:R -> Prop) (l x0:R),
-   D x0 -> limit1_in f D l x0 -> l = f x0.
-intros f D l x0 H H0.
-case (Rabs_pos (f x0 - l)); intros H1.
-absurd (dist R_met (f x0) l < dist R_met (f x0) l).
-apply Rlt_irrefl.
-case (H0 (dist R_met (f x0) l)); auto.
-intros alpha1 [H2 H3]; apply H3; auto; split; auto.
-case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto.
-case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto.
+  forall (f:R -> R) (D:R -> Prop) (l x0:R),
+    D x0 -> limit1_in f D l x0 -> l = f x0.
+Proof.
+  intros f D l x0 H H0.
+  case (Rabs_pos (f x0 - l)); intros H1.
+  absurd (dist R_met (f x0) l < dist R_met (f x0) l).
+  apply Rlt_irrefl.
+  case (H0 (dist R_met (f x0) l)); auto.
+  intros alpha1 [H2 H3]; apply H3; auto; split; auto.
+  case (dist_refl R_met x0 x0); intros Hr1 Hr2; rewrite Hr2; auto.
+  case (dist_refl R_met (f x0) l); intros Hr1 Hr2; apply sym_eq; auto.
 Qed.
 
 (*********)
 Lemma tech_limit_contr :
- forall (f:R -> R) (D:R -> Prop) (l x0:R),
-   D x0 -> l <> f x0 -> ~ limit1_in f D l x0.
-intros; generalize (tech_limit f D l x0); tauto.
+  forall (f:R -> R) (D:R -> Prop) (l x0:R),
+    D x0 -> l <> f x0 -> ~ limit1_in f D l x0.
+Proof.
+  intros; generalize (tech_limit f D l x0); tauto.
 Qed.
 
 (*********)
 Lemma lim_x : forall (D:R -> Prop) (x0:R), limit1_in (fun x:R => x) D x0 x0.
-unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
- split with eps; split; auto; intros; elim H0; intros; 
- auto.
+Proof.
+  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+    split with eps; split; auto; intros; elim H0; intros; 
+      auto.
 Qed.
 
 (*********)
 Lemma limit_plus :
- forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
-   limit1_in f D l x0 ->
-   limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0.
-intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
- intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1));
- elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; 
- clear H H0; intros; elim H; elim H0; clear H H0; intros;
- split with (Rmin x1 x); split.
-exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
-intros; elim H4; clear H4; intros;
- cut (R_dist (f x2) l + R_dist (g x2) l' < eps).
- cut (R_dist (f x2 + g x2) (l + l') <= 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 H4 H6)); generalize (H0 x2 (conj H4 H5)); intros;
- replace eps with (eps * / 2 + eps * / 2).
-exact (Rplus_lt_compat _ _ _ _ H7 H8).
-exact (eps2 eps).
+  forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+    limit1_in f D l x0 ->
+    limit1_in g D l' x0 -> limit1_in (fun x:R => f x + g x) D (l + l') x0.
+Proof.
+  intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+    intros; elim (H (eps * / 2) (eps2_Rgt_R0 eps H1));
+      elim (H0 (eps * / 2) (eps2_Rgt_R0 eps H1)); simpl in |- *; 
+        clear H H0; intros; elim H; elim H0; clear H H0; intros;
+          split with (Rmin x1 x); split.
+  exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
+  intros; elim H4; clear H4; intros;
+    cut (R_dist (f x2) l + R_dist (g x2) l' < eps).
+  cut (R_dist (f x2 + g x2) (l + l') <= 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 H4 H6)); generalize (H0 x2 (conj H4 H5)); intros;
+    replace eps with (eps * / 2 + eps * / 2).
+  exact (Rplus_lt_compat _ _ _ _ H7 H8).
+  exact (eps2 eps).
 Qed.
 
 (*********)
 Lemma limit_Ropp :
- forall (f:R -> R) (D:R -> Prop) (l x0:R),
-   limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0.
-unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
- elim (H eps H0); clear H; intros; elim H; clear H; 
- intros; split with x; split; auto; intros; generalize (H1 x1 H2); 
- clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *;
- rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l);
- fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; 
- rewrite R_dist_sym; assumption.
+  forall (f:R -> R) (D:R -> Prop) (l x0:R),
+    limit1_in f D l x0 -> limit1_in (fun x:R => - f x) D (- l) x0.
+Proof.
+  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+    elim (H eps H0); clear H; intros; elim H; clear H; 
+      intros; split with x; split; auto; intros; generalize (H1 x1 H2); 
+        clear H1; intro; unfold R_dist in |- *; unfold Rminus in |- *;
+          rewrite (Ropp_involutive l); rewrite (Rplus_comm (- f x1) l);
+            fold (l - f x1) in |- *; fold (R_dist l (f x1)) in |- *; 
+              rewrite R_dist_sym; assumption.
 Qed.
 
 (*********)
 Lemma limit_minus :
- forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
-   limit1_in f D l x0 ->
-   limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0.
-intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro;
- exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1).
+  forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+    limit1_in f D l x0 ->
+    limit1_in g D l' x0 -> limit1_in (fun x:R => f x - g x) D (l - l') x0.
+Proof.
+  intros; unfold Rminus in |- *; generalize (limit_Ropp g D l' x0 H0); intro;
+    exact (limit_plus f (fun x:R => - g x) D l (- l') x0 H H1).
 Qed.
 
 (*********)
 Lemma limit_free :
- forall (f:R -> R) (D:R -> Prop) (x x0:R),
-   limit1_in (fun h:R => f x) D (f x) x0.
-unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
- split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x));
- intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; 
- assumption.
+  forall (f:R -> R) (D:R -> Prop) (x x0:R),
+    limit1_in (fun h:R => f x) D (f x) x0.
+Proof.
+  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *; intros;
+    split with eps; split; auto; intros; elim (R_dist_refl (f x) (f x));
+      intros a b; rewrite (b (refl_equal (f x))); unfold Rgt in H; 
+        assumption.
 Qed.
 
 (*********)
 Lemma limit_mul :
- forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
-   limit1_in f D l x0 ->
-   limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0.
-intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
- intros;
- elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1));
- elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); 
- clear H H0; simpl in |- *; intros; elim H; elim H0; 
- clear H H0; intros; split with (Rmin x1 x); split.
-exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
-intros; elim H4; clear H4; intros; unfold R_dist in |- *;
- replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)).
-cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). 
-cut
- (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <=
-  Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))).
-exact (Rle_lt_trans _ _ _).
-exact (Rabs_triang _ _).
-rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l));
- cut
-  ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <=
-   eps).
-cut
- (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) <
-  (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (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 H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7);
- intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat.
-apply Rmult_ge_0_gt_0_lt_compat.
-apply Rle_ge.
-exact (Rabs_pos (g x2 - l')).
-rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1;
- exact (Rabs_pos l).
-unfold R_dist in H9;
- apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
-rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l));
- rewrite (Rplus_comm (- Rabs l) 1);
- rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l));
- rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2)));
- generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)).
-exact (Rle_lt_trans _ _ _).
-exact (Rabs_triang_inv _ _).
-generalize (H3 x2 (conj H4 H6)); trivial.
-apply Rmult_le_compat_l.
-exact (Rabs_pos l').
-unfold Rle in |- *; left; assumption.
-rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l'));
- rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l'));
- rewrite <-
-  (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l'))
-  ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l'));
- rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *;
- rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l'));
- rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial.
-ring.
+  forall (f g:R -> R) (D:R -> Prop) (l l' x0:R),
+    limit1_in f D l x0 ->
+    limit1_in g D l' x0 -> limit1_in (fun x:R => f x * g x) D (l * l') x0.
+Proof.
+  intros; unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+    intros;
+      elim (H (Rmin 1 (eps * mul_factor l l')) (mul_factor_gt_f eps l l' H1));
+        elim (H0 (eps * mul_factor l l') (mul_factor_gt eps l l' H1)); 
+          clear H H0; simpl in |- *; intros; elim H; elim H0; 
+            clear H H0; intros; split with (Rmin x1 x); split.
+  exact (Rmin_Rgt_r x1 x 0 (conj H H2)).
+  intros; elim H4; clear H4; intros; unfold R_dist in |- *;
+    replace (f x2 * g x2 - l * l') with (f x2 * (g x2 - l') + l' * (f x2 - l)).
+  cut (Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l)) < eps). 
+  cut
+    (Rabs (f x2 * (g x2 - l') + l' * (f x2 - l)) <=
+      Rabs (f x2 * (g x2 - l')) + Rabs (l' * (f x2 - l))).
+  exact (Rle_lt_trans _ _ _).
+  exact (Rabs_triang _ _).
+  rewrite (Rabs_mult (f x2) (g x2 - l')); rewrite (Rabs_mult l' (f x2 - l));
+    cut
+      ((1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (eps * mul_factor l l') <=
+        eps).
+  cut
+    (Rabs (f x2) * Rabs (g x2 - l') + Rabs l' * Rabs (f x2 - l) <
+      (1 + Rabs l) * (eps * mul_factor l l') + Rabs l' * (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 H4 H5)); intro; generalize (Rmin_Rgt_l _ _ _ H7);
+      intro; elim H8; intros; clear H0 H8; apply Rplus_lt_le_compat.
+  apply Rmult_ge_0_gt_0_lt_compat.
+  apply Rle_ge.
+  exact (Rabs_pos (g x2 - l')).
+  rewrite (Rplus_comm 1 (Rabs l)); unfold Rgt in |- *; apply Rle_lt_0_plus_1;
+    exact (Rabs_pos l).
+  unfold R_dist in H9;
+    apply (Rplus_lt_reg_r (- Rabs l) (Rabs (f x2)) (1 + Rabs l)).
+  rewrite <- (Rplus_assoc (- Rabs l) 1 (Rabs l));
+    rewrite (Rplus_comm (- Rabs l) 1);
+      rewrite (Rplus_assoc 1 (- Rabs l) (Rabs l)); rewrite (Rplus_opp_l (Rabs l));
+        rewrite (proj1 (Rplus_ne 1)); rewrite (Rplus_comm (- Rabs l) (Rabs (f x2)));
+          generalize H9; cut (Rabs (f x2) - Rabs l <= Rabs (f x2 - l)).
+  exact (Rle_lt_trans _ _ _).
+  exact (Rabs_triang_inv _ _).
+  generalize (H3 x2 (conj H4 H6)); trivial.
+  apply Rmult_le_compat_l.
+  exact (Rabs_pos l').
+  unfold Rle in |- *; left; assumption.
+  rewrite (Rmult_comm (1 + Rabs l) (eps * mul_factor l l'));
+    rewrite (Rmult_comm (Rabs l') (eps * mul_factor l l'));
+      rewrite <-
+        (Rmult_plus_distr_l (eps * mul_factor l l') (1 + Rabs l) (Rabs l'))
+        ; rewrite (Rmult_assoc eps (mul_factor l l') (1 + Rabs l + Rabs l'));
+          rewrite (Rplus_assoc 1 (Rabs l) (Rabs l')); unfold mul_factor in |- *;
+            rewrite (Rinv_l (1 + (Rabs l + Rabs l')) (mul_factor_wd l l'));
+              rewrite (proj1 (Rmult_ne eps)); apply Req_le; trivial.
+  ring.
 Qed.
 
 (*********)
@@ -327,231 +343,234 @@ Definition adhDa (D:R -> Prop) (a:R) : Prop :=
 
 (*********)
 Lemma single_limit :
- forall (f:R -> R) (D:R -> Prop) (l l' x0:R),
-   adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'.
-unfold limit1_in in |- *; unfold limit_in in |- *; intros.
-cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps).
-clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *;
- unfold Rabs in |- *; case (Rcase_abs (l - l')); intros.
-cut (forall eps:R, eps > 0 -> - (l - l') < eps).
-intro; generalize (prop_eps (- (l - l')) H1); intro;
- generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; 
- unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); 
- intro; elimtype False; auto.
-intros; cut (eps * / 2 > 0).
-intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
- rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
-elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
-apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
- unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); 
- intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; 
- clear a b; apply (Rlt_trans 0 1 2 H3 H4).
-unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
- rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); 
- auto.
-apply (Rinv_0_lt_compat 2); cut (1 < 2).
-intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
-generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b;
- rewrite a; clear a b; trivial.
+  forall (f:R -> R) (D:R -> Prop) (l l' x0:R),
+    adhDa D x0 -> limit1_in f D l x0 -> limit1_in f D l' x0 -> l = l'.
+Proof.
+  unfold limit1_in in |- *; unfold limit_in in |- *; intros.
+  cut (forall eps:R, eps > 0 -> dist R_met l l' < 2 * eps).
+  clear H0 H1; unfold dist in |- *; unfold R_met in |- *; unfold R_dist in |- *;
+    unfold Rabs in |- *; case (Rcase_abs (l - l')); intros.
+  cut (forall eps:R, eps > 0 -> - (l - l') < eps).
+  intro; generalize (prop_eps (- (l - l')) H1); intro;
+    generalize (Ropp_gt_lt_0_contravar (l - l') r); intro; 
+      unfold Rgt in H3; generalize (Rgt_not_le (- (l - l')) 0 H3); 
+        intro; elimtype False; auto.
+  intros; cut (eps * / 2 > 0).
+  intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
+    rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
+  elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
+  apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
+    unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); 
+      intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; 
+        clear a b; apply (Rlt_trans 0 1 2 H3 H4).
+  unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+    rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); 
+      auto.
+  apply (Rinv_0_lt_compat 2); cut (1 < 2).
+  intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
+  generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b;
+    rewrite a; clear a b; trivial.
 (**)
-cut (forall eps:R, eps > 0 -> l - l' < eps).
-intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0);
- intros a b; clear b; apply (Rminus_diag_uniq l l'); 
- apply a; split.
-assumption.
-apply (Rge_le (l - l') 0 r).
-intros; cut (eps * / 2 > 0).
-intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
- rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
-elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
-apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
- unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); 
- intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; 
- clear a b; apply (Rlt_trans 0 1 2 H3 H4).
-unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
- rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); 
- auto.
-apply (Rinv_0_lt_compat 2); cut (1 < 2).
-intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
-generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); intros a b;
- rewrite a; clear a b; trivial.
+  cut (forall eps:R, eps > 0 -> l - l' < eps).
+  intro; generalize (prop_eps (l - l') H1); intro; elim (Rle_le_eq (l - l') 0);
+    intros a b; clear b; apply (Rminus_diag_uniq l l'); 
+      apply a; split.
+  assumption.
+  apply (Rge_le (l - l') 0 r).
+  intros; cut (eps * / 2 > 0).
+  intro; generalize (H0 (eps * / 2) H2); rewrite (Rmult_comm eps (/ 2));
+    rewrite <- (Rmult_assoc 2 (/ 2) eps); rewrite (Rinv_r 2).
+  elim (Rmult_ne eps); intros a b; rewrite b; clear a b; trivial.
+  apply (Rlt_dichotomy_converse 2 0); right; generalize Rlt_0_1; intro;
+    unfold Rgt in |- *; generalize (Rplus_lt_compat_l 1 0 1 H3); 
+      intro; elim (Rplus_ne 1); intros a b; rewrite a in H4; 
+        clear a b; apply (Rlt_trans 0 1 2 H3 H4).
+  unfold Rgt in |- *; unfold Rgt in H1; rewrite (Rmult_comm eps (/ 2));
+    rewrite <- (Rmult_0_r (/ 2)); apply (Rmult_lt_compat_l (/ 2) 0 eps); 
+      auto.
+  apply (Rinv_0_lt_compat 2); cut (1 < 2).
+  intro; apply (Rlt_trans 0 1 2 Rlt_0_1 H2).
+  generalize (Rplus_lt_compat_l 1 0 1 Rlt_0_1); elim (Rplus_ne 1); 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 in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); 
- intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0)));
- intros; elim H5; intros; clear H5 H H6 H7;
- generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; 
- elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); 
- intros; clear H5 H9; generalize (H1 x2 (conj H8 H6));
- generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; 
- intros;
- generalize
-  (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0);
- unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
- rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1);
- elim (Rmult_ne eps); intros a b; rewrite a; clear a b;
- generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; 
- intros;
- apply
-  (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l'))
-     (eps + eps) H3 H1).
+  intros; unfold adhDa in H; elim (H0 eps H2); intros; elim (H1 eps H2); intros;
+    clear H0 H1; elim H3; elim H4; clear H3 H4; intros; 
+      simpl in |- *; simpl in H1, H4; generalize (Rmin_Rgt x x1 0); 
+        intro; elim H5; intros; clear H5; elim (H (Rmin x x1) (H7 (conj H3 H0)));
+          intros; elim H5; intros; clear H5 H H6 H7;
+            generalize (Rmin_Rgt x x1 (R_dist x2 x0)); intro; 
+              elim H; intros; clear H H6; unfold Rgt in H5; elim (H5 H9); 
+                intros; clear H5 H9; generalize (H1 x2 (conj H8 H6));
+                  generalize (H4 x2 (conj H8 H)); clear H8 H H6 H1 H4 H0 H3; 
+                    intros;
+                      generalize
+                        (Rplus_lt_compat (R_dist (f x2) l) eps (R_dist (f x2) l') eps H H0);
+                        unfold R_dist in |- *; intros; rewrite (Rabs_minus_sym (f x2) l) in H1;
+                          rewrite (Rmult_comm 2 eps); rewrite (Rmult_plus_distr_l eps 1 1);
+                            elim (Rmult_ne eps); intros a b; rewrite a; clear a b;
+                              generalize (R_dist_tri l l' (f x2)); unfold R_dist in |- *; 
+                                intros;
+                                  apply
+                                    (Rle_lt_trans (Rabs (l - l')) (Rabs (l - f x2) + Rabs (f x2 - l'))
+                                      (eps + eps) H3 H1).
 Qed.
 
 (*********)
 Lemma limit_comp :
- forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R),
-   limit1_in f Df l x0 ->
-   limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0.
-unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *.
-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.
+  forall (f g:R -> R) (Df Dg:R -> Prop) (l l' x0:R),
+    limit1_in f Df l x0 ->
+    limit1_in g Dg l' l -> limit1_in (fun x:R => g (f x)) (Dgf Df Dg f) l' x0.
+Proof.
+  unfold limit1_in, limit_in, Dgf in |- *; simpl in |- *.
+  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 :
- forall (f:R -> R) (D:R -> Prop) (l x0:R),
-   limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0.
-unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
- unfold R_dist in |- *; intros; elim (H (Rabs l / 2)).
-intros delta1 H2; elim (H (eps * (Rsqr l / 2))).
-intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2);
- split.
-unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption.
-intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7;
- intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1).
-cut (D x /\ Rabs (x - x0) < delta2).
-intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12);
- clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); 
- intro; rewrite Rabs_minus_sym in H7;
- generalize
-  (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7);
- intro;
- generalize
-  (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x))
-     (Rabs l / 2) H14);
- replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2).
-unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_r; intro; cut (f x <> 0).
-intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)).
-rewrite Rabs_mult; rewrite Rabs_Rinv.
-cut (/ Rabs (l * f x) < 2 / Rsqr l).
-intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)).
-intro;
- generalize
-  (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2))
-     (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17);
- replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps.
-intro; assumption.
-unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm l).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm l).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; reflexivity.
-discrR.
-exact H0.
-exact H0.
-exact H0.
-exact H0.
-left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0;
- assumption.
-rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr.
-rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *;
- rewrite Rinv_mult_distr.
-repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2).
-repeat apply Rmult_lt_0_compat.
-apply Rabs_pos_lt; assumption.
-apply Rabs_pos_lt; assumption.
-apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
- [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
-    intro H18; assumption
- | discriminate ].
-replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2).
-replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)).
-assumption.
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm (Rabs l)).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; reflexivity.
-discrR.
-apply Rabs_no_R0.
-assumption.
-unfold Rdiv in |- *.
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm (Rabs (f x))).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-reflexivity.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; assumption.
-apply prod_neq_R0; assumption.
-rewrite (Rinv_mult_distr _ _ H0 H16).
-unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
-rewrite <- Rmult_assoc.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l.
-rewrite Ropp_mult_distr_l_reverse.
-rewrite (Rmult_comm (f x)).
-rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-reflexivity.
-assumption.
-assumption.
-red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15;
- cut (0 < Rabs l / 2).
-intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rabs_pos_lt; assumption.
-apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
- [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
-    intro; assumption
- | discriminate ].
-pattern (Rabs l) at 3 in |- *; 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)) in |- *; unfold Rdiv in |- *;
- repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat.
-assumption.
-apply Rsqr_pos_lt; assumption.
-apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
- [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
-    intro; assumption
- | discriminate ].
-change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply Rabs_pos_lt; assumption
- | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+  forall (f:R -> R) (D:R -> Prop) (l x0:R),
+    limit1_in f D l x0 -> l <> 0 -> limit1_in (fun x:R => / f x) D (/ l) x0.
+Proof.
+  unfold limit1_in in |- *; unfold limit_in in |- *; simpl in |- *;
+    unfold R_dist in |- *; intros; elim (H (Rabs l / 2)).
+  intros delta1 H2; elim (H (eps * (Rsqr l / 2))).
+  intros delta2 H3; elim H2; elim H3; intros; exists (Rmin delta1 delta2);
+    split.
+  unfold Rmin in |- *; case (Rle_dec delta1 delta2); intro; assumption.
+  intro; generalize (H5 x); clear H5; intro H5; generalize (H7 x); clear H7;
+    intro H7; intro H10; elim H10; intros; cut (D x /\ Rabs (x - x0) < delta1).
+  cut (D x /\ Rabs (x - x0) < delta2).
+  intros; generalize (H5 H11); clear H5; intro H5; generalize (H7 H12);
+    clear H7; intro H7; generalize (Rabs_triang_inv l (f x)); 
+      intro; rewrite Rabs_minus_sym in H7;
+        generalize
+          (Rle_lt_trans (Rabs l - Rabs (f x)) (Rabs (l - f x)) (Rabs l / 2) H13 H7);
+          intro;
+            generalize
+              (Rplus_lt_compat_l (Rabs (f x) - Rabs l / 2) (Rabs l - Rabs (f x))
+                (Rabs l / 2) H14);
+              replace (Rabs (f x) - Rabs l / 2 + (Rabs l - Rabs (f x))) with (Rabs l / 2).
+  unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+    rewrite Rplus_0_r; intro; cut (f x <> 0).
+  intro; replace (/ f x + - / l) with ((l - f x) * / (l * f x)).
+  rewrite Rabs_mult; rewrite Rabs_Rinv.
+  cut (/ Rabs (l * f x) < 2 / Rsqr l).
+  intro; rewrite Rabs_minus_sym in H5; cut (0 <= / Rabs (l * f x)).
+  intro;
+    generalize
+      (Rmult_le_0_lt_compat (Rabs (l - f x)) (eps * (Rsqr l / 2))
+        (/ Rabs (l * f x)) (2 / Rsqr l) (Rabs_pos (l - f x)) H18 H5 H17);
+      replace (eps * (Rsqr l / 2) * (2 / Rsqr l)) with eps.
+  intro; assumption.
+  unfold Rdiv in |- *; unfold Rsqr in |- *; rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm l).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm l).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; reflexivity.
+  discrR.
+  exact H0.
+  exact H0.
+  exact H0.
+  exact H0.
+  left; apply Rinv_0_lt_compat; apply Rabs_pos_lt; apply prod_neq_R0;
+    assumption.
+  rewrite Rmult_comm; rewrite Rabs_mult; rewrite Rinv_mult_distr.
+  rewrite (Rsqr_abs l); unfold Rsqr in |- *; unfold Rdiv in |- *;
+    rewrite Rinv_mult_distr.
+  repeat rewrite <- Rmult_assoc; apply Rmult_lt_compat_r.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  apply Rmult_lt_reg_l with (Rabs (f x) * Rabs l * / 2).
+  repeat apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt; assumption.
+  apply Rabs_pos_lt; assumption.
+  apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+      intro H18; assumption
+      | discriminate ].
+  replace (Rabs (f x) * Rabs l * / 2 * / Rabs (f x)) with (Rabs l / 2).
+  replace (Rabs (f x) * Rabs l * / 2 * (2 * / Rabs l)) with (Rabs (f x)).
+  assumption.
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (Rabs l)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; reflexivity.
+  discrR.
+  apply Rabs_no_R0.
+  assumption.
+  unfold Rdiv in |- *.
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (Rabs (f x))).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  reflexivity.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; assumption.
+  apply prod_neq_R0; assumption.
+  rewrite (Rinv_mult_distr _ _ H0 H16).
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_r.
+  rewrite <- Rmult_assoc.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l.
+  rewrite Ropp_mult_distr_l_reverse.
+  rewrite (Rmult_comm (f x)).
+  rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  reflexivity.
+  assumption.
+  assumption.
+  red in |- *; intro; rewrite H16 in H15; rewrite Rabs_R0 in H15;
+    cut (0 < Rabs l / 2).
+  intro; elim (Rlt_irrefl 0 (Rlt_trans 0 (Rabs l / 2) 0 H17 H15)).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt; assumption.
+  apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+    [ intro H17; generalize (lt_INR_0 2 (neq_O_lt 2 H17)); unfold INR in |- *;
+      intro; assumption
+      | discriminate ].
+  pattern (Rabs l) at 3 in |- *; 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)) in |- *; unfold Rdiv in |- *;
+    repeat rewrite Rmult_assoc; repeat apply Rmult_lt_0_compat.
+  assumption.
+  apply Rsqr_pos_lt; assumption.
+  apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
     [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
-       intro; assumption
-    | discriminate ] ].
+      intro; assumption
+      | discriminate ].
+  change (0 < Rabs l / 2) in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply Rabs_pos_lt; assumption
+      | apply Rinv_0_lt_compat; cut (0%nat <> 2%nat);
+        [ intro H3; generalize (lt_INR_0 2 (neq_O_lt 2 H3)); unfold INR in |- *;
+          intro; assumption
+          | discriminate ] ].
 Qed.
diff --git a/theories/Reals/Rpower.v b/theories/Reals/Rpower.v
index aa9e9887..cb6c59d5 100644
--- a/theories/Reals/Rpower.v
+++ b/theories/Reals/Rpower.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rpower.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
+
+(*i $Id: Rpower.v 9245 2006-10-17 12:53:34Z notin $ i*)
 (*i Due to L.Thery i*) 
 
 (************************************************************)
@@ -25,637 +25,674 @@ Require Import MVT.
 Require Import Ranalysis4. Open Local Scope R_scope.
 
 Lemma P_Rmin : forall (P:R -> Prop) (x y:R), P x -> P y -> P (Rmin x y).
-intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro;
- assumption.
+Proof.
+  intros P x y H1 H2; unfold Rmin in |- *; case (Rle_dec x y); intro;
+    assumption.
 Qed.
 
 Lemma exp_le_3 : exp 1 <= 3.
-assert (exp_1 : exp 1 <> 0).
-assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0;
- elim (Rlt_irrefl _ H0).
-apply Rmult_le_reg_l with (/ exp 1).
-apply Rinv_0_lt_compat; apply exp_pos.
-rewrite <- Rinv_l_sym.
-apply Rmult_le_reg_l with (/ 3).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)).
-unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *;
- unfold exp_in in e;
- assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1).
-cut
- (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <=
-  sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)).
-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_1; repeat rewrite Rmult_1_r;
- rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
- rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r;
- rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6.
-rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6.
-rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; replace 6 with 6.
-do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-ring.
-discrR.
-discrR.
-ring.
-discrR.
-ring.
-discrR.
-apply H.
-unfold Un_decreasing in |- *; intros;
- apply Rmult_le_reg_l with (INR (fact n)).
-apply INR_fact_lt_0.
-apply Rmult_le_reg_l with (INR (fact (S n))).
-apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn.
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0;
- intros; elim (H0 _ H1); intros; exists x0; intros; 
- unfold R_dist in H2; unfold R_dist in |- *;
- replace (/ INR (fact n)) with (1 ^ n / INR (fact n)).
-apply (H2 _ H3).
-unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity.
-unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0);
- intros; exists x0; intros;
- replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with
-  (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n).
-apply (H1 _ H2).
-apply sum_eq; intros; apply Rmult_comm.
-apply Rmult_eq_reg_l with (exp 1).
-rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0;
- rewrite <- Rinv_r_sym.
-reflexivity.
-assumption.
-assumption.
-discrR.
-assumption.
+Proof.
+  assert (exp_1 : exp 1 <> 0).
+  assert (H0 := exp_pos 1); red in |- *; intro; rewrite H in H0;
+    elim (Rlt_irrefl _ H0).
+  apply Rmult_le_reg_l with (/ exp 1).
+  apply Rinv_0_lt_compat; apply exp_pos.
+  rewrite <- Rinv_l_sym.
+  apply Rmult_le_reg_l with (/ 3).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite Rmult_1_r; rewrite <- (Rmult_comm 3); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; replace (/ exp 1) with (exp (-1)).
+  unfold exp in |- *; case (exist_exp (-1)); intros; simpl in |- *;
+    unfold exp_in in e;
+      assert (H := alternated_series_ineq (fun i:nat => / INR (fact i)) x 1).
+  cut
+    (sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (S (2 * 1)) <= x <=
+      sum_f_R0 (tg_alt (fun i:nat => / INR (fact i))) (2 * 1)).
+  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_1; repeat rewrite Rmult_1_r;
+    rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
+      rewrite Ropp_involutive; rewrite Rplus_opp_r; rewrite Rmult_1_r;
+        rewrite Rplus_0_l; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 6.
+  rewrite Rmult_plus_distr_l; replace (2 + 1 + 1 + 1 + 1) with 6.
+  rewrite <- (Rmult_comm (/ 6)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; replace 6 with 6.
+  do 2 rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; rewrite (Rmult_comm 3); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  ring.
+  discrR.
+  discrR.
+  ring.
+  discrR.
+  ring.
+  discrR.
+  apply H.
+  unfold Un_decreasing in |- *; intros;
+    apply Rmult_le_reg_l with (INR (fact n)).
+  apply INR_fact_lt_0.
+  apply Rmult_le_reg_l with (INR (fact (S n))).
+  apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; apply le_INR; apply fact_le; apply le_n_Sn.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  assert (H0 := cv_speed_pow_fact 1); unfold Un_cv in |- *; unfold Un_cv in H0;
+    intros; elim (H0 _ H1); intros; exists x0; intros; 
+      unfold R_dist in H2; unfold R_dist in |- *;
+        replace (/ INR (fact n)) with (1 ^ n / INR (fact n)).
+  apply (H2 _ H3).
+  unfold Rdiv in |- *; rewrite pow1; rewrite Rmult_1_l; reflexivity.
+  unfold infinit_sum in e; unfold Un_cv, tg_alt in |- *; intros; elim (e _ H0);
+    intros; exists x0; intros;
+      replace (sum_f_R0 (fun i:nat => (-1) ^ i * / INR (fact i)) n) with
+      (sum_f_R0 (fun i:nat => / INR (fact i) * (-1) ^ i) n).
+  apply (H1 _ H2).
+  apply sum_eq; intros; apply Rmult_comm.
+  apply Rmult_eq_reg_l with (exp 1).
+  rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0;
+    rewrite <- Rinv_r_sym.
+  reflexivity.
+  assumption.
+  assumption.
+  discrR.
+  assumption.
 Qed.
 
 (******************************************************************)
-(*                        Properties of  Exp                      *)
+(** *                     Properties of  Exp                      *)
 (******************************************************************)
 
 Theorem exp_increasing : forall 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  in |- *; apply derive_pt_eq_0.
-apply (derivable_pt_lim_exp x0).
-apply H.
-Qed.
- 
+Proof.
+  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  in |- *; apply derive_pt_eq_0.
+  apply (derivable_pt_lim_exp x0).
+  apply H.
+Qed.
+
 Theorem exp_lt_inv : forall x y:R, exp x < exp y -> x < y.
-intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ].
-assumption.
-rewrite H1 in H; elim (Rlt_irrefl _ H).
-assert (H2 := exp_increasing _ _ H1).
-elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)).
+Proof.
+  intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ].
+  assumption.
+  rewrite H1 in H; elim (Rlt_irrefl _ H).
+  assert (H2 := exp_increasing _ _ H1).
+  elim (Rlt_irrefl _ (Rlt_trans _ _ _ H H2)).
 Qed.
- 
+
 Lemma exp_ineq1 : forall x:R, 0 < x -> 1 + x < exp x.
-intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x));
- assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; 
- intros; elim H1; intros; unfold Rminus in H2; rewrite H2; 
- rewrite Ropp_0; rewrite Rplus_0_r;
- replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
-rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
- pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0));
- apply Rmult_lt_compat_l.
-apply H.
-rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption.
-symmetry  in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp.
+Proof.
+  intros; apply Rplus_lt_reg_r with (- exp 0); rewrite <- (Rplus_comm (exp x));
+    assert (H0 := MVT_cor1 exp 0 x derivable_exp H); elim H0; 
+      intros; elim H1; intros; unfold Rminus in H2; rewrite H2; 
+        rewrite Ropp_0; rewrite Rplus_0_r;
+          replace (derive_pt exp x0 (derivable_exp x0)) with (exp x0).
+  rewrite exp_0; rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+    pattern x at 1 in |- *; rewrite <- Rmult_1_r; rewrite (Rmult_comm (exp x0));
+      apply Rmult_lt_compat_l.
+  apply H.
+  rewrite <- exp_0; apply exp_increasing; elim H3; intros; assumption.
+  symmetry  in |- *; apply derive_pt_eq_0; apply derivable_pt_lim_exp.
 Qed.
 
 Lemma ln_exists1 : forall y:R, 0 < y -> 1 <= y -> sigT (fun z:R => y = exp z).
-intros; set (f := fun 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 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5;
- apply existT with t; elim H5; intros; unfold f in H7;
- apply Rminus_diag_uniq_sym; exact H7.
-pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y));
- rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; 
- assumption.
-unfold f in |- *; apply Rplus_le_reg_l with y; left;
- apply Rlt_trans with (1 + y).
-rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1.
-replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ].
-unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *;
- apply continuity_minus;
- [ apply derivable_continuous; apply derivable_exp
- | apply derivable_continuous; apply derivable_const ].
-unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y;
- rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ].
+Proof.
+  intros; set (f := fun 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 0 y H2 (Rlt_le _ _ H) H4); elim X; intros t H5;
+    apply existT with t; elim H5; intros; unfold f in H7;
+      apply Rminus_diag_uniq_sym; exact H7.
+  pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y));
+    rewrite (Rmult_comm (f 0)); apply Rmult_le_compat_l; 
+      assumption.
+  unfold f in |- *; apply Rplus_le_reg_l with y; left;
+    apply Rlt_trans with (1 + y).
+  rewrite <- (Rplus_comm y); apply Rplus_lt_compat_l; apply Rlt_0_1.
+  replace (y + (exp y - y)) with (exp y); [ apply (exp_ineq1 y H) | ring ].
+  unfold f in |- *; change (continuity (exp - fct_cte y)) in |- *;
+    apply continuity_minus;
+      [ apply derivable_continuous; apply derivable_exp
+        | apply derivable_continuous; apply derivable_const ].
+  unfold f in |- *; rewrite exp_0; apply Rplus_le_reg_l with y;
+    rewrite Rplus_0_r; replace (y + (1 - y)) with 1; [ apply H0 | ring ].
 Qed.
 
 (**********)
 Lemma ln_exists : forall y:R, 0 < y -> sigT (fun z:R => y = exp z).
-intros; case (Rle_dec 1 y); intro.
-apply (ln_exists1 _ H r).
-assert (H0 : 1 <= / y).
-apply Rmult_le_reg_l with y.
-apply H.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n).
-red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
-assert (H1 : 0 < / y).
-apply Rinv_0_lt_compat; apply H.
-assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x);
- apply Rmult_eq_reg_l with (exp x / y).
-unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc;
- rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; 
- rewrite Rmult_1_r; symmetry  in |- *; apply p.
-red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
-unfold Rdiv in |- *; apply prod_neq_R0.
-assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3;
- elim (Rlt_irrefl _ H3).
-apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H;
- elim (Rlt_irrefl _ H).
+Proof.
+  intros; case (Rle_dec 1 y); intro.
+  apply (ln_exists1 _ H r).
+  assert (H0 : 1 <= / y).
+  apply Rmult_le_reg_l with y.
+  apply H.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; left; apply (Rnot_le_lt _ _ n).
+  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  assert (H1 : 0 < / y).
+  apply Rinv_0_lt_compat; apply H.
+  assert (H2 := ln_exists1 _ H1 H0); elim H2; intros; apply existT with (- x);
+    apply Rmult_eq_reg_l with (exp x / y).
+  unfold Rdiv in |- *; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite <- (Rmult_comm (/ y)); rewrite Rmult_assoc;
+    rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0; 
+      rewrite Rmult_1_r; symmetry  in |- *; apply p.
+  red in |- *; intro; rewrite H3 in H; elim (Rlt_irrefl _ H).
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  assert (H3 := exp_pos x); red in |- *; intro; rewrite H4 in H3;
+    elim (Rlt_irrefl _ H3).
+  apply Rinv_neq_0_compat; red in |- *; intro; rewrite H3 in H;
+    elim (Rlt_irrefl _ H).
 Qed.
 
 (* Definition of log R+* -> R *)
 Definition Rln (y:posreal) : R :=
   match ln_exists (pos y) (cond_pos y) with
-  | existT a b => a
+    | existT a b => a
   end.
 
 (* Extension on R *)
 Definition ln (x:R) : R :=
   match Rlt_dec 0 x with
-  | left a => Rln (mkposreal x a)
-  | right a => 0
+    | left a => Rln (mkposreal x a)
+    | right a => 0
   end.
 
 Lemma exp_ln : forall x:R, 0 < x -> exp (ln x) = x.
-intros; unfold ln in |- *; case (Rlt_dec 0 x); intro.
-unfold Rln in |- *;
- case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); 
- intros.
-simpl in e; symmetry  in |- *; apply e.
-elim n; apply H.
+Proof.
+  intros; unfold ln in |- *; case (Rlt_dec 0 x); intro.
+  unfold Rln in |- *;
+    case (ln_exists (mkposreal x r) (cond_pos (mkposreal x r))); 
+    intros.
+  simpl in e; symmetry  in |- *; apply e.
+  elim n; apply H.
 Qed.
 
 Theorem exp_inv : forall x y:R, exp x = exp y -> x = y.
-intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto;
- assert (H2 := exp_increasing _ _ H1); rewrite H in H2;
- elim (Rlt_irrefl _ H2).
+Proof.
+  intros x y H; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ]; auto;
+    assert (H2 := exp_increasing _ _ H1); rewrite H in H2;
+      elim (Rlt_irrefl _ H2).
 Qed.
- 
+
 Theorem exp_Ropp : forall x:R, exp (- x) = / exp x.
-intros x; assert (H : exp x <> 0).
-assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H;
- elim (Rlt_irrefl _ H).
-apply Rmult_eq_reg_l with (r := exp x).
-rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0.
-apply Rinv_r_sym.
-apply H.
-apply H.
-Qed.
- 
+Proof.
+  intros x; assert (H : exp x <> 0).
+  assert (H := exp_pos x); red in |- *; intro; rewrite H0 in H;
+    elim (Rlt_irrefl _ H).
+  apply Rmult_eq_reg_l with (r := exp x).
+  rewrite <- exp_plus; rewrite Rplus_opp_r; rewrite exp_0.
+  apply Rinv_r_sym.
+  apply H.
+  apply H.
+Qed.
+
 (******************************************************************)
-(*                        Properties of  Ln                       *)
+(** *                     Properties of  Ln                       *)
 (******************************************************************)
 
 Theorem ln_increasing : forall 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.
+Proof.
+  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 : forall x:R, ln (exp x) = x.
-intros x; apply exp_inv.
-apply exp_ln.
-apply exp_pos.
+Proof.
+  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.
+Proof.
+  rewrite <- exp_0; rewrite ln_exp; reflexivity.
 Qed.
- 
+
 Theorem ln_lt_inv : forall 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.
+Proof.
+  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 : forall x y:R, 0 < x -> 0 < y -> ln x = ln y -> x = y.
-intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ];
- auto.
-assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2;
- elim (Rlt_irrefl _ H2).
-assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2;
- elim (Rlt_irrefl _ H2).
-Qed.
- 
+Proof.
+  intros x y H H0 H'0; case (Rtotal_order x y); [ intros H1 | intros [H1| H1] ];
+    auto.
+  assert (H2 := ln_increasing _ _ H H1); rewrite H'0 in H2;
+    elim (Rlt_irrefl _ H2).
+  assert (H2 := ln_increasing _ _ H0 H1); rewrite H'0 in H2;
+    elim (Rlt_irrefl _ H2).
+Qed.
+
 Theorem ln_mult : forall 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_0_compat; assumption.
+Proof.
+  intros x y H H0; apply exp_inv.
+  rewrite exp_plus.
+  repeat rewrite exp_ln.
+  reflexivity.
+  assumption.
+  assumption.
+  apply Rmult_lt_0_compat; assumption.
 Qed.
 
 Theorem ln_Rinv : forall x:R, 0 < x -> ln (/ x) = - ln x.
-intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp.
-reflexivity.
-assumption. 
-apply Rinv_0_lt_compat; assumption.
+Proof.
+  intros x H; apply exp_inv; repeat rewrite exp_ln || rewrite exp_Ropp.
+  reflexivity.
+  assumption. 
+  apply Rinv_0_lt_compat; assumption.
 Qed.
 
 Theorem ln_continue :
- forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y.
-intros y H.
-unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps.
-cut (1 < exp eps); [ intros H1 | idtac ].
-cut (exp (- eps) < 1); [ intros H2 | idtac ].
-exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split.
-red in |- *; apply P_Rmin.
-apply Rmult_lt_0_compat.
-assumption.
-apply Rplus_lt_reg_r with 1.
-rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps);
- [ apply H1 | ring ].
-apply Rmult_lt_0_compat.
-assumption.
-apply Rplus_lt_reg_r with (exp (- eps)).
-rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1;
- [ apply H2 | ring ].
-unfold dist, R_met, R_dist in |- *; simpl in |- *.
-intros x [[H3 H4] H5].
-cut (y * (x * / y) = x).
-intro Hxyy. 
-replace (ln x - ln y) with (ln (x * / y)).
-case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ].
-rewrite Rabs_left.
-apply Ropp_lt_cancel; rewrite Ropp_involutive.
-apply exp_lt_inv.
-rewrite exp_ln.
-apply Rmult_lt_reg_l with (r := y).
-apply H.
-rewrite Hxyy.
-apply Ropp_lt_cancel.
-apply Rplus_lt_reg_r with (r := y).
-replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps)));
- [ idtac | ring ].
-replace (y + - x) with (Rabs (x - y)); [ idtac | ring ].
-apply Rlt_le_trans with (1 := H5); apply Rmin_r.
-rewrite Rabs_left; [ ring | idtac ].
-apply (Rlt_minus _ _ Hxy).
-apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
-rewrite <- ln_1.
-apply ln_increasing.
-apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
-apply Rmult_lt_reg_l with (r := y).
-apply H.
-rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
-rewrite Hxy; rewrite Rinv_r.
-rewrite ln_1; rewrite Rabs_R0; apply Heps.
-red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
-rewrite Rabs_right.
-apply exp_lt_inv.
-rewrite exp_ln.
-apply Rmult_lt_reg_l with (r := y).
-apply H.
-rewrite Hxyy.
-apply Rplus_lt_reg_r with (r := - y).
-replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ].
-replace (- y + x) with (Rabs (x - y)); [ idtac | ring ].
-apply Rlt_le_trans with (1 := H5); apply Rmin_l.
-rewrite Rabs_right; [ ring | idtac ].
-left; apply (Rgt_minus _ _ Hxy).
-apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
-rewrite <- ln_1.
-apply Rgt_ge; red in |- *; apply ln_increasing.
-apply Rlt_0_1.
-apply Rmult_lt_reg_l with (r := y).
-apply H.
-rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
-rewrite ln_mult.
-rewrite ln_Rinv.
-ring.
-assumption.
-assumption.
-apply Rinv_0_lt_compat; assumption.
-rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-ring.
-red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
-apply Rmult_lt_reg_l with (exp eps).
-apply exp_pos.
-rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0;
- apply H1.
-rewrite <- exp_0.
-apply exp_increasing; apply Heps.
+  forall y:R, 0 < y -> continue_in ln (fun x:R => 0 < x) y.
+Proof.
+  intros y H.
+  unfold continue_in, limit1_in, limit_in in |- *; intros eps Heps.
+  cut (1 < exp eps); [ intros H1 | idtac ].
+  cut (exp (- eps) < 1); [ intros H2 | idtac ].
+  exists (Rmin (y * (exp eps - 1)) (y * (1 - exp (- eps)))); split.
+  red in |- *; apply P_Rmin.
+  apply Rmult_lt_0_compat.
+  assumption.
+  apply Rplus_lt_reg_r with 1.
+  rewrite Rplus_0_r; replace (1 + (exp eps - 1)) with (exp eps);
+    [ apply H1 | ring ].
+  apply Rmult_lt_0_compat.
+  assumption.
+  apply Rplus_lt_reg_r with (exp (- eps)).
+  rewrite Rplus_0_r; replace (exp (- eps) + (1 - exp (- eps))) with 1;
+    [ apply H2 | ring ].
+  unfold dist, R_met, R_dist in |- *; simpl in |- *.
+  intros x [[H3 H4] H5].
+  cut (y * (x * / y) = x).
+  intro Hxyy. 
+  replace (ln x - ln y) with (ln (x * / y)).
+  case (Rtotal_order x y); [ intros Hxy | intros [Hxy| Hxy] ].
+  rewrite Rabs_left.
+  apply Ropp_lt_cancel; rewrite Ropp_involutive.
+  apply exp_lt_inv.
+  rewrite exp_ln.
+  apply Rmult_lt_reg_l with (r := y).
+  apply H.
+  rewrite Hxyy.
+  apply Ropp_lt_cancel.
+  apply Rplus_lt_reg_r with (r := y).
+  replace (y + - (y * exp (- eps))) with (y * (1 - exp (- eps)));
+  [ idtac | ring ].
+  replace (y + - x) with (Rabs (x - y)).
+  apply Rlt_le_trans with (1 := H5); apply Rmin_r.
+  rewrite Rabs_left; [ ring | idtac ].
+  apply (Rlt_minus _ _ Hxy).
+  apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+  rewrite <- ln_1.
+  apply ln_increasing.
+  apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+  apply Rmult_lt_reg_l with (r := y).
+  apply H.
+  rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
+  rewrite Hxy; rewrite Rinv_r.
+  rewrite ln_1; rewrite Rabs_R0; apply Heps.
+  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  rewrite Rabs_right.
+  apply exp_lt_inv.
+  rewrite exp_ln.
+  apply Rmult_lt_reg_l with (r := y).
+  apply H.
+  rewrite Hxyy.
+  apply Rplus_lt_reg_r with (r := - y).
+  replace (- y + y * exp eps) with (y * (exp eps - 1)); [ idtac | ring ].
+  replace (- y + x) with (Rabs (x - y)).
+  apply Rlt_le_trans with (1 := H5); apply Rmin_l.
+  rewrite Rabs_right; [ ring | idtac ].
+  left; apply (Rgt_minus _ _ Hxy).
+  apply Rmult_lt_0_compat; [ apply H3 | apply (Rinv_0_lt_compat _ H) ].
+  rewrite <- ln_1.
+  apply Rgt_ge; red in |- *; apply ln_increasing.
+  apply Rlt_0_1.
+  apply Rmult_lt_reg_l with (r := y).
+  apply H.
+  rewrite Hxyy; rewrite Rmult_1_r; apply Hxy.
+  rewrite ln_mult.
+  rewrite ln_Rinv.
+  ring.
+  assumption.
+  assumption.
+  apply Rinv_0_lt_compat; assumption.
+  rewrite (Rmult_comm x); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  ring.
+  red in |- *; intro; rewrite H0 in H; elim (Rlt_irrefl _ H).
+  apply Rmult_lt_reg_l with (exp eps).
+  apply exp_pos.
+  rewrite <- exp_plus; rewrite Rmult_1_r; rewrite Rplus_opp_r; rewrite exp_0;
+    apply H1.
+  rewrite <- exp_0.
+  apply exp_increasing; apply Heps.
 Qed.
 
 (******************************************************************)
-(*                        Definition of  Rpower                   *)
+(** *                     Definition of  Rpower                   *)
 (******************************************************************)
- 
+
 Definition Rpower (x y:R) := exp (y * ln x).
 
 Infix Local "^R" := Rpower (at level 30, right associativity) : R_scope.
 
 (******************************************************************)
-(*                        Properties of  Rpower                   *)
+(** *                     Properties of  Rpower                   *)
 (******************************************************************)
- 
+
 Theorem Rpower_plus : forall x y z:R, z ^R (x + y) = z ^R x * z ^R y.
-intros x y z; unfold Rpower in |- *.
-rewrite Rmult_plus_distr_r; rewrite exp_plus; auto.
+Proof.
+  intros x y z; unfold Rpower in |- *.
+  rewrite Rmult_plus_distr_r; rewrite exp_plus; auto.
 Qed.
- 
+
 Theorem Rpower_mult : forall x y z:R, (x ^R y) ^R z = x ^R (y * z).
-intros x y z; unfold Rpower in |- *.
-rewrite ln_exp.
-replace (z * (y * ln x)) with (y * z * ln x).
-reflexivity.
-ring.
+Proof.
+  intros x y z; unfold Rpower in |- *.
+  rewrite ln_exp.
+  replace (z * (y * ln x)) with (y * z * ln x).
+  reflexivity.
+  ring.
 Qed.
- 
+
 Theorem Rpower_O : forall x:R, 0 < x -> x ^R 0 = 1.
-intros x H; unfold Rpower in |- *.
-rewrite Rmult_0_l; apply exp_0.
+Proof.
+  intros x H; unfold Rpower in |- *.
+  rewrite Rmult_0_l; apply exp_0.
 Qed.
- 
+
 Theorem Rpower_1 : forall x:R, 0 < x -> x ^R 1 = x.
-intros x H; unfold Rpower in |- *.
-rewrite Rmult_1_l; apply exp_ln; apply H.
+Proof.
+  intros x H; unfold Rpower in |- *.
+  rewrite Rmult_1_l; apply exp_ln; apply H.
 Qed.
- 
+
 Theorem Rpower_pow : forall (n:nat) (x:R), 0 < x -> x ^R INR n = x ^ n.
-intros n; elim n; simpl in |- *; auto; fold INR in |- *.
-intros x H; apply Rpower_O; auto.
-intros n1; case n1.
-intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto.
-intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1;
- try apply Rmult_comm || assumption.
-Qed.
- 
+Proof.
+  intros n; elim n; simpl in |- *; auto; fold INR in |- *.
+  intros x H; apply Rpower_O; auto.
+  intros n1; case n1.
+  intros H x H0; simpl in |- *; rewrite Rmult_1_r; apply Rpower_1; auto.
+  intros n0 H x H0; rewrite Rpower_plus; rewrite H; try rewrite Rpower_1;
+    try apply Rmult_comm || assumption.
+Qed.
+
 Theorem Rpower_lt :
- forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z.
-intros x y z H H0 H1.
-unfold Rpower in |- *.
-apply exp_increasing.
-apply Rmult_lt_compat_r.
-rewrite <- ln_1; apply ln_increasing.
-apply Rlt_0_1.
-apply H.
-apply H1.
-Qed.
- 
+  forall x y z:R, 1 < x -> 0 <= y -> y < z -> x ^R y < x ^R z.
+Proof.
+  intros x y z H H0 H1.
+  unfold Rpower in |- *.
+  apply exp_increasing.
+  apply Rmult_lt_compat_r.
+  rewrite <- ln_1; apply ln_increasing.
+  apply Rlt_0_1.
+  apply H.
+  apply H1.
+Qed.
+
 Theorem Rpower_sqrt : forall x:R, 0 < x -> x ^R (/ 2) = sqrt x.
-intros x H.
-apply ln_inv.
-unfold Rpower in |- *; apply exp_pos.
-apply sqrt_lt_R0; apply H.
-apply Rmult_eq_reg_l with (INR 2).
-apply exp_inv.
-fold Rpower in |- *.
-cut ((x ^R (/ 2)) ^R INR 2 = sqrt x ^R INR 2).
-unfold Rpower in |- *; auto.
-rewrite Rpower_mult.
-rewrite Rinv_l.
-replace 1 with (INR 1); auto.
-repeat rewrite Rpower_pow; simpl in |- *.
-pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
-ring.
-apply sqrt_lt_R0; apply H.
-apply H.
-apply not_O_INR; discriminate.
-apply not_O_INR; discriminate.
-Qed.
- 
+Proof.
+  intros x H.
+  apply ln_inv.
+  unfold Rpower in |- *; apply exp_pos.
+  apply sqrt_lt_R0; apply H.
+  apply Rmult_eq_reg_l with (INR 2).
+  apply exp_inv.
+  fold Rpower in |- *.
+  cut ((x ^R (/ 2)) ^R INR 2 = sqrt x ^R INR 2).
+  unfold Rpower in |- *; auto.
+  rewrite Rpower_mult.
+  rewrite Rinv_l.
+  replace 1 with (INR 1); auto.
+  repeat rewrite Rpower_pow; simpl in |- *.
+  pattern x at 1 in |- *; rewrite <- (sqrt_sqrt x (Rlt_le _ _ H)).
+  ring.
+  apply sqrt_lt_R0; apply H.
+  apply H.
+  apply not_O_INR; discriminate.
+  apply not_O_INR; discriminate.
+Qed.
+
 Theorem Rpower_Ropp : forall x y:R, x ^R (- y) = / x ^R y.
-unfold Rpower in |- *.
-intros x y; rewrite Ropp_mult_distr_l_reverse.
-apply exp_Ropp.
+Proof.
+  unfold Rpower in |- *.
+  intros x y; rewrite Ropp_mult_distr_l_reverse.
+  apply exp_Ropp.
 Qed.
- 
+
 Theorem Rle_Rpower :
- forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m.
-intros e n m H H0 H1; case H1.
-intros H2; left; apply Rpower_lt; assumption.
-intros H2; rewrite H2; right; reflexivity.
+  forall e n m:R, 1 < e -> 0 <= n -> n <= m -> e ^R n <= e ^R m.
+Proof.
+  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 Rmult_lt_reg_l with (r := 2).
-prove_sup0.
-rewrite Rinv_r.
-apply exp_lt_inv.
-apply Rle_lt_trans with (1 := exp_le_3).
-change (3 < 2 ^R 2) in |- *.
-repeat rewrite Rpower_plus; repeat rewrite Rpower_1.
-repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
- repeat rewrite Rmult_1_l.
-pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
- [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ].
-prove_sup0.
-discrR.
-Qed.
-
-(**************************************)
-(* Differentiability of Ln and Rpower *)
-(**************************************)
+Proof.
+  apply Rmult_lt_reg_l with (r := 2).
+  prove_sup0.
+  rewrite Rinv_r.
+  apply exp_lt_inv.
+  apply Rle_lt_trans with (1 := exp_le_3).
+  change (3 < 2 ^R 2) in |- *.
+  repeat rewrite Rpower_plus; repeat rewrite Rpower_1.
+  repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+    repeat rewrite Rmult_1_l.
+  pattern 3 at 1 in |- *; rewrite <- Rplus_0_r; replace (2 + 2) with (3 + 1);
+    [ apply Rplus_lt_compat_l; apply Rlt_0_1 | ring ].
+  prove_sup0.
+  discrR.
+Qed.
+
+(*****************************************)
+(** * Differentiability of Ln and Rpower *)
+(*****************************************)
 
 Theorem limit1_ext :
- forall (f g:R -> R) (D:R -> Prop) (l x:R),
-   (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x.
-intros f g D l x H; unfold limit1_in, limit_in in |- *.
-intros H0 eps H1; case (H0 eps); auto.
-intros x0 [H2 H3]; exists x0; split; auto.
-intros x1 [H4 H5]; rewrite <- H; auto.
+  forall (f g:R -> R) (D:R -> Prop) (l x:R),
+    (forall x:R, D x -> f x = g x) -> limit1_in f D l x -> limit1_in g D l x.
+Proof.
+  intros f g D l x H; unfold limit1_in, limit_in in |- *.
+  intros 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 :
- forall (f:R -> R) (D D1:R -> Prop) (l x:R),
-   (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x.
-intros f D D1 l x H; unfold limit1_in, limit_in 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.
+  forall (f:R -> R) (D D1:R -> Prop) (l x:R),
+    (forall x:R, D1 x -> D x) -> limit1_in f D l x -> limit1_in f D1 l x.
+Proof.
+  intros f D D1 l x H; unfold limit1_in, limit_in in |- *.
+  intros 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 : forall x y:R, x <> 0 -> y <> 0 -> / (x / y) = y / x.
-intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-apply Rmult_comm.
-assumption.
-assumption.
-apply Rinv_neq_0_compat; assumption.
+Proof.
+  intros x y H1 H2; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  apply Rmult_comm.
+  assumption.
+  assumption.
+  apply Rinv_neq_0_compat; assumption.
 Qed.
 
 Theorem Dln : forall y:R, 0 < y -> D_in ln Rinv (fun x:R => 0 < x) y.
-intros y Hy; unfold D_in in |- *.
-apply limit1_ext with
- (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))).
-intros x [HD1 HD2]; repeat rewrite exp_ln.
-unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-apply Rmult_comm.
-apply Rminus_eq_contra.
-red in |- *; intros H2; case HD2.
-symmetry  in |- *; apply (ln_inv _ _ HD1 Hy H2).
-apply Rminus_eq_contra; apply (sym_not_eq HD2).
-apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2;
- case HD2; apply ln_inv; auto.
-assumption.
-assumption.
-apply limit_inv with
- (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)).
-apply limit1_imp with
- (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x))
- (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln).
-intros x [H1 H2]; split.
-split; auto.
-split; auto.
-red in |- *; intros H3; case H2; apply ln_inv; auto.
-apply limit_comp with
- (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln).
-apply ln_continue; auto.
-assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); 
- intros; exists (pos x); split.
-apply (cond_pos x).
-intros; pattern y at 3 in |- *; rewrite <- exp_ln.
-pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y));
- [ idtac | ring ].
-apply H1.
-elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3;
- apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); 
- apply H3.
-elim H2; clear H2; intros _ H2; apply H2.
-assumption.
-red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy).
+Proof.
+  intros y Hy; unfold D_in in |- *.
+  apply limit1_ext with
+    (f := fun x:R => / ((exp (ln x) - exp (ln y)) / (ln x - ln y))).
+  intros x [HD1 HD2]; repeat rewrite exp_ln.
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  apply Rmult_comm.
+  apply Rminus_eq_contra.
+  red in |- *; intros H2; case HD2.
+  symmetry  in |- *; apply (ln_inv _ _ HD1 Hy H2).
+  apply Rminus_eq_contra; apply (sym_not_eq HD2).
+  apply Rinv_neq_0_compat; apply Rminus_eq_contra; red in |- *; intros H2;
+    case HD2; apply ln_inv; auto.
+  assumption.
+  assumption.
+  apply limit_inv with
+    (f := fun x:R => (exp (ln x) - exp (ln y)) / (ln x - ln y)).
+  apply limit1_imp with
+    (f := fun x:R => (fun x:R => (exp x - exp (ln y)) / (x - ln y)) (ln x))
+    (D := Dgf (D_x (fun x:R => 0 < x) y) (D_x (fun x:R => True) (ln y)) ln).
+  intros x [H1 H2]; split.
+  split; auto.
+  split; auto.
+  red in |- *; intros H3; case H2; apply ln_inv; auto.
+  apply limit_comp with
+    (l := ln y) (g := fun x:R => (exp x - exp (ln y)) / (x - ln y)) (f := ln).
+  apply ln_continue; auto.
+  assert (H0 := derivable_pt_lim_exp (ln y)); unfold derivable_pt_lim in H0;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros; elim (H0 _ H); 
+        intros; exists (pos x); split.
+  apply (cond_pos x).
+  intros; pattern y at 3 in |- *; rewrite <- exp_ln.
+  pattern x0 at 1 in |- *; replace x0 with (ln y + (x0 - ln y));
+    [ idtac | ring ].
+  apply H1.
+  elim H2; intros H3 _; unfold D_x in H3; elim H3; clear H3; intros _ H3;
+    apply Rminus_eq_contra; apply (sym_not_eq (A:=R)); 
+      apply H3.
+  elim H2; clear H2; intros _ H2; apply H2.
+  assumption.
+  red in |- *; intro; rewrite H in Hy; elim (Rlt_irrefl _ Hy).
 Qed.
 
 Lemma derivable_pt_lim_ln : forall x:R, 0 < x -> derivable_pt_lim ln x (/ x).
-intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0;
- unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
- unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); 
- intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2));
- assert (H4 : 0 < alp).
-unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro.
-apply H2.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-exists (mkposreal _ H4); intros; pattern h at 2 in |- *;
- replace h with (x + h - x); [ idtac | ring ].
-apply H3; split.
-unfold D_x in |- *; split.
-case (Rcase_abs h); intro.
-assert (H7 : Rabs h < x / 2).
-apply Rlt_le_trans with alp.
-apply H6.
-unfold alp in |- *; apply Rmin_r.
-apply Rlt_trans with (x / 2).
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
-rewrite Rabs_left in H7.
-apply Rplus_lt_reg_r with (- h - x / 2).
-replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ].
-pattern x at 2 in |- *; rewrite double_var.
-replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ].
-apply r.
-apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ].
-apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
- [ apply H5 | ring ].
-replace (x + h - x) with h;
- [ apply Rlt_le_trans with alp;
+Proof.
+  intros; assert (H0 := Dln x H); unfold D_in in H0; unfold limit1_in in H0;
+    unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
+      unfold derivable_pt_lim in |- *; intros; elim (H0 _ H1); 
+        intros; elim H2; clear H2; intros; set (alp := Rmin x0 (x / 2));
+          assert (H4 : 0 < alp).
+  unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec x0 (x / 2)); intro.
+  apply H2.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  exists (mkposreal _ H4); intros; pattern h at 2 in |- *;
+    replace h with (x + h - x); [ idtac | ring ].
+  apply H3; split.
+  unfold D_x in |- *; split.
+  case (Rcase_abs h); intro.
+  assert (H7 : Rabs h < x / 2).
+  apply Rlt_le_trans with alp.
+  apply H6.
+  unfold alp in |- *; apply Rmin_r.
+  apply Rlt_trans with (x / 2).
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+  rewrite Rabs_left in H7.
+  apply Rplus_lt_reg_r with (- h - x / 2).
+  replace (- h - x / 2 + x / 2) with (- h); [ idtac | ring ].
+  pattern x at 2 in |- *; rewrite double_var.
+  replace (- h - x / 2 + (x / 2 + x / 2 + h)) with (x / 2); [ apply H7 | ring ].
+  apply r.
+  apply Rplus_lt_le_0_compat; [ assumption | apply Rge_le; apply r ].
+  apply (sym_not_eq (A:=R)); apply Rminus_not_eq; replace (x + h - x) with h;
+    [ apply H5 | ring ].
+  replace (x + h - x) with h;
+  [ apply Rlt_le_trans with alp;
     [ apply H6 | unfold alp in |- *; apply Rmin_l ]
- | ring ].
+    | ring ].
 Qed.
 
 Theorem D_in_imp :
- forall (f g:R -> R) (D D1:R -> Prop) (x:R),
-   (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x.
-intros f g D D1 x H; unfold D_in in |- *.
-intros H0; apply limit1_imp with (D := D_x D x); auto.
-intros x1 [H1 H2]; split; auto.
+  forall (f g:R -> R) (D D1:R -> Prop) (x:R),
+    (forall x:R, D1 x -> D x) -> D_in f g D x -> D_in f g D1 x.
+Proof.
+  intros f g D D1 x H; unfold D_in in |- *.
+  intros H0; apply limit1_imp with (D := D_x D x); auto.
+  intros x1 [H1 H2]; split; auto.
 Qed.
 
 Theorem D_in_ext :
- forall (f g h:R -> R) (D:R -> Prop) (x:R),
-   f x = g x -> D_in h f D x -> D_in h g D x.
-intros f g h D x H; unfold D_in in |- *.
-rewrite H; auto.
+  forall (f g h:R -> R) (D:R -> Prop) (x:R),
+    f x = g x -> D_in h f D x -> D_in h g D x.
+Proof.
+  intros f g h D x H; unfold D_in in |- *.
+  rewrite H; auto.
 Qed.
 
 Theorem Dpower :
- forall y z:R,
-   0 < y ->
-   D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) (
-     fun x:R => 0 < x) y.
-intros y z H;
- apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln).
-intros x H0; repeat split.
-assumption.
-apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))).
-unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp;
- rewrite (Rpower_1 _ H); ring.
-apply Dcomp with
- (f := ln)
- (g := fun x:R => exp (z * x))
- (df := Rinv)
- (dg := fun x:R => z * exp (z * x)).
-apply (Dln _ H).
-apply D_in_imp with
- (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)).
-intros x H1; repeat split; auto.
-apply
- (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp
-    (fun x:R => z * x) exp); simpl in |- *.
-apply D_in_ext with (f := fun x:R => z * 1).
-apply Rmult_1_r.
-apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx.
-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.
+  forall y z:R,
+    0 < y ->
+    D_in (fun x:R => x ^R z) (fun x:R => z * x ^R (z - 1)) (
+      fun x:R => 0 < x) y.
+Proof.
+  intros y z H;
+    apply D_in_imp with (D := Dgf (fun x:R => 0 < x) (fun x:R => True) ln).
+  intros x H0; repeat split.
+  assumption.
+  apply D_in_ext with (f := fun x:R => / x * (z * exp (z * ln x))).
+  unfold Rminus in |- *; rewrite Rpower_plus; rewrite Rpower_Ropp;
+    rewrite (Rpower_1 _ H); unfold Rpower; ring.
+  apply Dcomp with
+    (f := ln)
+    (g := fun x:R => exp (z * x))
+    (df := Rinv)
+    (dg := fun x:R => z * exp (z * x)).
+  apply (Dln _ H).
+  apply D_in_imp with
+    (D := Dgf (fun x:R => True) (fun x:R => True) (fun x:R => z * x)).
+  intros x H1; repeat split; auto.
+  apply
+    (Dcomp (fun _:R => True) (fun _:R => True) (fun x => z) exp
+      (fun x:R => z * x) exp); simpl in |- *.
+  apply D_in_ext with (f := fun x:R => z * 1).
+  apply Rmult_1_r.
+  apply (Dmult_const (fun x => True) (fun x => x) (fun x => 1)); apply Dx.
+  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 :
- forall x y:R,
-   0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)).
-intros x y H.
-unfold Rminus in |- *; rewrite Rpower_plus.
-rewrite Rpower_Ropp.
-rewrite Rpower_1; auto.
-rewrite <- Rmult_assoc.
-unfold Rpower in |- *.
-apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)).
-apply derivable_pt_lim_ln; assumption.
-rewrite (Rmult_comm y).
-apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp).
-pattern y at 2 in |- *; replace y with (0 * ln x + y * 1).
-apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x).
-apply derivable_pt_lim_const with (a := y).
-apply derivable_pt_lim_id.
-ring.
-apply derivable_pt_lim_exp.
+  forall x y:R,
+    0 < x -> derivable_pt_lim (fun x => x ^R y) x (y * x ^R (y - 1)).
+Proof.
+  intros x y H.
+  unfold Rminus in |- *; rewrite Rpower_plus.
+  rewrite Rpower_Ropp.
+  rewrite Rpower_1; auto.
+  rewrite <- Rmult_assoc.
+  unfold Rpower in |- *.
+  apply derivable_pt_lim_comp with (f1 := ln) (f2 := fun x => exp (y * x)).
+  apply derivable_pt_lim_ln; assumption.
+  rewrite (Rmult_comm y).
+  apply derivable_pt_lim_comp with (f1 := fun x => y * x) (f2 := exp).
+  pattern y at 2 in |- *; replace y with (0 * ln x + y * 1).
+  apply derivable_pt_lim_mult with (f1 := fun x:R => y) (f2 := fun x:R => x).
+  apply derivable_pt_lim_const with (a := y).
+  apply derivable_pt_lim_id.
+  ring.
+  apply derivable_pt_lim_exp.
 Qed.
diff --git a/theories/Reals/Rprod.v b/theories/Reals/Rprod.v
index ec738996..a84d5149 100644
--- a/theories/Reals/Rprod.v
+++ b/theories/Reals/Rprod.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rprod.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
+
+(*i $Id: Rprod.v 9298 2006-10-27 13:05:29Z notin $ i*)
 
 Require Import Compare.
 Require Import Rbase.
@@ -16,176 +16,156 @@ Require Import PartSum.
 Require Import Binomial.
 Open Local Scope R_scope.
 
-(* TT Ak; 1<=k<=N *)
+(** TT Ak; 1<=k<=N *)
 Boxed Fixpoint prod_f_SO (An:nat -> R) (N:nat) {struct N} : R :=
   match N with
-  | O => 1
-  | S p => prod_f_SO An p * An (S p)
+    | O => 1
+    | S p => prod_f_SO An p * An (S p)
   end.
 
 (**********)
 Lemma prod_SO_split :
- forall (An:nat -> R) (n k:nat),
-   (k <= n)%nat ->
-   prod_f_SO An n =
-   prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k).
-intros; induction  n as [| n Hrecn].
-cut (k = 0%nat);
- [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ].
-cut (k = S n \/ (k <= n)%nat).
-intro; elim H0; intro.
-rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring.
-replace (S n - k)%nat with (S (n - k)).
-simpl in |- *; replace (k + S (n - k))%nat 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 ].
+  forall (An:nat -> R) (n k:nat),
+    (k <= n)%nat ->
+    prod_f_SO An n =
+    prod_f_SO An k * prod_f_SO (fun l:nat => An (k + l)%nat) (n - k).
+Proof.
+  intros; induction  n as [| n Hrecn].
+  cut (k = 0%nat);
+    [ intro; rewrite H0; simpl in |- *; ring | inversion H; reflexivity ].
+  cut (k = S n \/ (k <= n)%nat).
+  intro; elim H0; intro.
+  rewrite H1; simpl in |- *; rewrite <- minus_n_n; simpl in |- *; ring.
+  replace (S n - k)%nat with (S (n - k)).
+  simpl in |- *; replace (k + S (n - k))%nat with (S n).
+  rewrite Hrecn; [ ring | assumption ].
+  omega.
+  omega.
+  omega.
 Qed.
 
 (**********)
 Lemma prod_SO_pos :
- forall (An:nat -> R) (N:nat),
-   (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N.
-intros; induction  N as [| N HrecN].
-simpl in |- *; left; apply Rlt_0_1.
-simpl in |- *; apply Rmult_le_pos.
-apply HrecN; intros; apply H; apply le_trans with N;
- [ assumption | apply le_n_Sn ].
-apply H; apply le_n.
+  forall (An:nat -> R) (N:nat),
+    (forall n:nat, (n <= N)%nat -> 0 <= An n) -> 0 <= prod_f_SO An N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  simpl in |- *; left; apply Rlt_0_1.
+  simpl in |- *; 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 :
- forall (An Bn:nat -> R) (N:nat),
-   (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) ->
-   prod_f_SO An N <= prod_f_SO Bn N.
-intros; induction  N as [| N HrecN].
-right; reflexivity.
-simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)).
-apply Rmult_le_compat_l.
-apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros;
- assumption.
-elim (H (S N) (le_n (S N))); intros; assumption.
-do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l.
-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.
+  forall (An Bn:nat -> R) (N:nat),
+    (forall n:nat, (n <= N)%nat -> 0 <= An n <= Bn n) ->
+    prod_f_SO An N <= prod_f_SO Bn N.
+Proof.
+  intros; induction  N as [| N HrecN].
+  right; reflexivity.
+  simpl in |- *; apply Rle_trans with (prod_f_SO An N * Bn (S N)).
+  apply Rmult_le_compat_l.
+  apply prod_SO_pos; intros; elim (H n (le_trans _ _ _ H0 (le_n_Sn N))); intros;
+    assumption.
+  elim (H (S N) (le_n (S N))); intros; assumption.
+  do 2 rewrite <- (Rmult_comm (Bn (S N))); apply Rmult_le_compat_l.
+  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 *)
+(** Application to factorial *)
 Lemma fact_prodSO :
- forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n.
-intro; induction  n as [| n Hrecn].
-reflexivity.
-change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *.
-rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity.
+  forall n:nat, INR (fact n) = prod_f_SO (fun k:nat => INR k) n.
+Proof.
+  intro; induction  n as [| n Hrecn].
+  reflexivity.
+  change (INR (S n * fact n) = prod_f_SO (fun k:nat => INR k) (S n)) in |- *.
+  rewrite mult_INR; rewrite Rmult_comm; rewrite Hrecn; reflexivity.
 Qed.
 
 Lemma le_n_2n : forall n:nat, (n <= 2 * n)%nat.
-simple induction n.
-replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ].
-intros; replace (2 * S n0)%nat with (S (S (2 * n0))).
-apply le_n_S; apply le_S; assumption.
-replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ].
-replace (S n0) with (n0 + 1)%nat; [ idtac | ring ].
-ring.
+Proof.
+  simple induction n.
+  replace (2 * 0)%nat with 0%nat; [ apply le_n | ring ].
+  intros; replace (2 * S n0)%nat with (S (S (2 * n0))).
+  apply le_n_S; apply le_S; assumption.
+  replace (S (S (2 * n0))) with (2 * n0 + 2)%nat; [ idtac | ring ].
+  replace (S n0) with (n0 + 1)%nat; [ idtac | ring ].
+  ring.
 Qed. 
 
-(* We prove that (N!)²<=(2N-k)!*k! forall k in [|O;2N|] *)
+(** We prove that (N!)^2<=(2N-k)!*k! forall k in [|O;2N|] *)
 Lemma RfactN_fact2N_factk :
- forall N k:nat,
-   (k <= 2 * N)%nat ->
-   Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k).
-intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO.
-cut ((k <= N)%nat \/ (N <= k)%nat).
-intro; elim H0; intro.
-rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N).
-rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply prod_SO_pos; intros; apply pos_INR.
-replace (2 * N - k - N)%nat with (N - k)%nat.
-rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k).
-apply Rmult_le_compat_l.
-apply prod_SO_pos; intros; apply pos_INR.
-apply prod_SO_Rle; intros; split.
-apply pos_INR.
-apply le_INR; apply plus_le_compat_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 (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
-apply plus_le_compat_r; assumption.
-assumption.
-assumption.
-apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ].
-apply plus_le_compat_r; assumption.
-assumption.
-rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k));
- rewrite (prod_SO_split (fun l:nat => INR l) k N).
-rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply prod_SO_pos; intros; apply pos_INR.
-rewrite Rmult_comm;
- rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)).
-apply Rmult_le_compat_l.
-apply prod_SO_pos; intros; apply pos_INR.
-replace (N - (2 * N - k))%nat with (k - N)%nat.
-apply prod_SO_Rle; intros; split.
-apply pos_INR.
-apply le_INR; apply plus_le_compat_r.
-apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
- apply plus_le_compat_r; assumption.
-assumption.
-apply INR_eq; repeat rewrite minus_INR.
-rewrite mult_INR; do 2 rewrite S_INR; ring.
-assumption.
-apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
- apply plus_le_compat_r; assumption.
-assumption.
-assumption.
-apply (fun p n m:nat => plus_le_reg_l n m p) with k; rewrite <- le_plus_minus.
-replace (2 * N)%nat with (N + N)%nat; [ idtac | ring ];
- apply plus_le_compat_r; assumption.
-assumption.
-assumption.
-elim (le_dec k N); intro; [ left; assumption | right; assumption ].
+  forall N k:nat,
+    (k <= 2 * N)%nat ->
+    Rsqr (INR (fact N)) <= INR (fact (2 * N - k)) * INR (fact k).
+Proof.
+  intros; unfold Rsqr in |- *; repeat rewrite fact_prodSO.
+  cut ((k <= N)%nat \/ (N <= k)%nat).
+  intro; elim H0; intro.
+  rewrite (prod_SO_split (fun l:nat => INR l) (2 * N - k) N).
+  rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply prod_SO_pos; intros; apply pos_INR.
+  replace (2 * N - k - N)%nat with (N - k)%nat.
+  rewrite Rmult_comm; rewrite (prod_SO_split (fun l:nat => INR l) N k).
+  apply Rmult_le_compat_l.
+  apply prod_SO_pos; intros; apply pos_INR.
+  apply prod_SO_Rle; intros; split.
+  apply pos_INR.
+  apply le_INR; apply plus_le_compat_r; assumption.
+  assumption.
+  omega.
+  omega.
+  rewrite <- (Rmult_comm (prod_f_SO (fun l:nat => INR l) k));
+    rewrite (prod_SO_split (fun l:nat => INR l) k N).
+  rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply prod_SO_pos; intros; apply pos_INR.
+  rewrite Rmult_comm;
+    rewrite (prod_SO_split (fun l:nat => INR l) N (2 * N - k)).
+  apply Rmult_le_compat_l.
+  apply prod_SO_pos; intros; apply pos_INR.
+  replace (N - (2 * N - k))%nat with (k - N)%nat.
+  apply prod_SO_Rle; intros; split.
+  apply pos_INR.
+  apply le_INR; apply plus_le_compat_r.
+  omega.
+  omega.
+  omega.
+  assumption.
+  omega.
 Qed.
 
 (**********)
 Lemma INR_fact_lt_0 : forall n:nat, 0 < INR (fact n).
-intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
- elim (fact_neq_0 n); symmetry  in |- *; assumption.
+Proof.
+  intro; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+    elim (fact_neq_0 n); symmetry  in |- *; assumption.
 Qed.
 
-(* We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *)
+(** We have the following inequality : (C 2N k) <= (C 2N N) forall k in [|O;2N|] *)
 Lemma C_maj : forall N k:nat, (k <= 2 * N)%nat -> C (2 * N) k <= C (2 * N) N.
-intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l.
-apply pos_INR.
-replace (2 * N - N)%nat with N.
-apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)).
-apply Rmult_lt_0_compat; apply INR_fact_lt_0.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_comm;
- apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))).
-apply Rmult_lt_0_compat; apply INR_fact_lt_0.
-rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (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 ].
+Proof.
+  intros; unfold C in |- *; unfold Rdiv in |- *; apply Rmult_le_compat_l.
+  apply pos_INR.
+  replace (2 * N - N)%nat with N.
+  apply Rmult_le_reg_l with (INR (fact N) * INR (fact N)).
+  apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_comm;
+    apply Rmult_le_reg_l with (INR (fact k) * INR (fact (2 * N - k))).
+  apply Rmult_lt_0_compat; apply INR_fact_lt_0.
+  rewrite Rmult_1_r; rewrite <- mult_INR; rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite mult_INR; rewrite (Rmult_comm (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.
+  omega.
 Qed.
diff --git a/theories/Reals/Rseries.v b/theories/Reals/Rseries.v
index aa3a0316..38c39bae 100644
--- a/theories/Reals/Rseries.v
+++ b/theories/Reals/Rseries.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rseries.v 6338 2004-11-22 09:10:51Z gregoire $ i*)
+(*i $Id: Rseries.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -18,258 +18,266 @@ Implicit Type r : R.
 
 (* classical is needed for [Un_cv_crit] *)
 (*********************************************************)
-(*           Definition of sequence and properties       *)
+(** *        Definition of sequence and properties       *)
 (*                                                       *)
 (*********************************************************)
 
 Section sequence.
 
 (*********)
-Variable Un : nat -> R.
+  Variable Un : nat -> R.
 
 (*********)
-Boxed Fixpoint Rmax_N (N:nat) : R :=
-  match N with
-  | O => Un 0
-  | S n => Rmax (Un (S n)) (Rmax_N n)
-  end.
+  Boxed Fixpoint Rmax_N (N:nat) : R :=
+    match N with
+      | O => Un 0
+      | S n => Rmax (Un (S n)) (Rmax_N n)
+    end.
 
 (*********)
-Definition EUn r : Prop :=  exists i : nat, r = Un i.
+  Definition EUn r : Prop :=  exists i : nat, r = Un i.
 
 (*********)
-Definition Un_cv (l:R) : Prop :=
-  forall eps:R,
-    eps > 0 ->
-     exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps).
+  Definition Un_cv (l:R) : Prop :=
+    forall eps:R,
+      eps > 0 ->
+      exists N : nat, (forall n:nat, (n >= N)%nat -> R_dist (Un n) l < eps).
 
 (*********)
-Definition Cauchy_crit : Prop :=
-  forall eps:R,
-    eps > 0 ->
-     exists N : nat,
-      (forall n m:nat,
-         (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps).
+  Definition Cauchy_crit : Prop :=
+    forall eps:R,
+      eps > 0 ->
+      exists N : nat,
+        (forall n m:nat,
+          (n >= N)%nat -> (m >= N)%nat -> R_dist (Un n) (Un m) < eps).
 
 (*********)
-Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n).
+  Definition Un_growing : Prop := forall n:nat, Un n <= Un (S n).
 
 (*********)
-Lemma EUn_noempty :  exists r : R, EUn r.
-unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial.
-Qed.
+  Lemma EUn_noempty :  exists r : R, EUn r.
+  Proof.
+    unfold EUn in |- *; split with (Un 0); split with 0%nat; trivial.
+  Qed.
 
 (*********)
-Lemma Un_in_EUn : forall n:nat, EUn (Un n).
-intro; unfold EUn in |- *; split with n; trivial.
-Qed.
+  Lemma Un_in_EUn : forall n:nat, EUn (Un n).
+  Proof.
+    intro; unfold EUn in |- *; split with n; trivial.
+  Qed.
 
 (*********)
-Lemma Un_bound_imp :
- forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x.
-intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0;
- clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; 
- trivial.
-Qed.
+  Lemma Un_bound_imp :
+    forall x:R, (forall n:nat, Un n <= x) -> is_upper_bound EUn x.
+  Proof.
+    intros; unfold is_upper_bound in |- *; intros; unfold EUn in H0; elim H0;
+      clear H0; intros; generalize (H x1); intro; rewrite <- H0 in H1; 
+        trivial.
+  Qed.
 
 (*********)
-Lemma growing_prop :
- forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m.
-double induction n m; intros.
-unfold Rge in |- *; right; trivial.
-elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto.
-cut (n0 >= 0)%nat.
-generalize H0; intros; unfold Un_growing in H0;
- apply
-  (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0))
-     (H 0%nat 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 in |- *; 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_ge (Un n1) (Un (S n1)) (H1 n1)) H3).
-Qed.
+  Lemma growing_prop :
+    forall n m:nat, Un_growing -> (n >= m)%nat -> Un n >= Un m.
+  Proof.
+    double induction n m; intros.
+    unfold Rge in |- *; right; trivial.
+    elimtype False; unfold ge in H1; generalize (le_Sn_O n0); intro; auto.
+    cut (n0 >= 0)%nat.
+    generalize H0; intros; unfold Un_growing in H0;
+      apply
+        (Rge_trans (Un (S n0)) (Un n0) (Un 0) (Rle_ge (Un n0) (Un (S n0)) (H0 n0))
+          (H 0%nat 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 in |- *; 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_ge (Un n1) (Un (S n1)) (H1 n1)) H3).
+  Qed.
 
 
-(* classical is needed: [not_all_not_ex] *)
+(** classical is needed: [not_all_not_ex] *)
 (*********)
-Lemma Un_cv_crit : Un_growing -> bound EUn ->  exists l : R, Un_cv l.
-unfold Un_growing, Un_cv in |- *; intros;
- generalize (completeness_weak EUn H0 EUn_noempty); 
- intro; elim H1; clear H1; intros; split with x; intros; 
- unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1;
- elim H0; clear H0; intros; elim H1; clear H1; intros; 
- generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); 
- intro.
-cut (exists N : nat, x - eps < Un N).
-intro; elim H6; clear H6; intros; split with x1.
-intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
-unfold Rgt in H2;
- apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2).
-fold Un_growing in H; generalize (growing_prop n x1 H H7); intro;
- generalize
-  (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8));
- intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
- unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
- rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
- rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
- trivial.
-cut (~ (forall N:nat, x - eps >= Un N)).
-intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *;
- intro; red in H6; elim H6; clear H6; intro;
- apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)).
-red in |- *; intro; cut (forall N:nat, Un N <= x - eps).
-intro; generalize (Un_bound_imp (x - eps) H7); intro;
- unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); 
- intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *;
- rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
- rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); 
- rewrite Ropp_involutive; intro; unfold Rgt in H2;
- generalize (Rgt_not_le eps 0 H2); intro; auto.
-intro; elim (H6 N); intro; unfold Rle in |- *.
-left; unfold Rgt in H7; assumption.
-right; auto.
-apply (H1 (Un n) (Un_in_EUn n)).
-Qed.
+  Lemma Un_cv_crit : Un_growing -> bound EUn ->  exists l : R, Un_cv l.
+  Proof.
+    unfold Un_growing, Un_cv in |- *; intros;
+      generalize (completeness_weak EUn H0 EUn_noempty); 
+        intro; elim H1; clear H1; intros; split with x; intros; 
+          unfold is_lub in H1; unfold bound in H0; unfold is_upper_bound in H0, H1;
+            elim H0; clear H0; intros; elim H1; clear H1; intros; 
+              generalize (H3 x0 H0); intro; cut (forall n:nat, Un n <= x); 
+                intro.
+    cut (exists N : nat, x - eps < Un N).
+    intro; elim H6; clear H6; intros; split with x1.
+    intros; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
+    unfold Rgt in H2;
+      apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H2).
+    fold Un_growing in H; generalize (growing_prop n x1 H H7); intro;
+      generalize
+        (Rlt_le_trans (x - eps) (Un x1) (Un n) H6 (Rge_le (Un n) (Un x1) H8));
+        intro; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
+          unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
+            rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
+              rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
+                trivial.
+    cut (~ (forall N:nat, x - eps >= Un N)).
+    intro; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)); red in |- *;
+      intro; red in H6; elim H6; clear H6; intro;
+        apply (Rnot_lt_ge (x - eps) (Un N) (H7 N)).
+    red in |- *; intro; cut (forall N:nat, Un N <= x - eps).
+    intro; generalize (Un_bound_imp (x - eps) H7); intro;
+      unfold is_upper_bound in H8; generalize (H3 (x - eps) H8); 
+        intro; generalize (Rle_minus x (x - eps) H9); unfold Rminus in |- *;
+          rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+            rewrite (let (H1, H2) := Rplus_ne (- - eps) in H2); 
+              rewrite Ropp_involutive; intro; unfold Rgt in H2;
+                generalize (Rgt_not_le eps 0 H2); intro; auto.
+    intro; elim (H6 N); intro; unfold Rle in |- *.
+    left; unfold Rgt in H7; assumption.
+    right; auto.
+    apply (H1 (Un n) (Un_in_EUn n)).
+  Qed.
 
 (*********)
-Lemma finite_greater :
- forall N:nat,  exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M).
-intro; induction  N as [| N HrecN].
-split with (Un 0); intros; rewrite (le_n_O_eq n H);
- apply (Req_le (Un n) (Un n) (refl_equal (Un n))).
-elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros;
- elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; 
- inversion H0.
-rewrite <- H1; rewrite <- H1 in H2;
- apply
-  (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))).
-apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))).
-Qed.
+  Lemma finite_greater :
+    forall N:nat,  exists M : R, (forall n:nat, (n <= N)%nat -> Un n <= M).
+  Proof.
+    intro; induction  N as [| N HrecN].
+    split with (Un 0); intros; rewrite (le_n_O_eq n H);
+      apply (Req_le (Un n) (Un n) (refl_equal (Un n))).
+    elim HrecN; clear HrecN; intros; split with (Rmax (Un (S N)) x); intros;
+      elim (Rmax_Rle (Un (S N)) x (Un n)); intros; clear H1; 
+        inversion H0.
+    rewrite <- H1; rewrite <- H1 in H2;
+      apply
+        (H2 (or_introl (Un n <= x) (Req_le (Un n) (Un n) (refl_equal (Un n))))).
+    apply (H2 (or_intror (Un n <= Un (S N)) (H n H3))).
+  Qed.
 
 (*********)
-Lemma cauchy_bound : Cauchy_crit -> bound EUn.
-unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *;
- unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; 
- generalize (H x); intro; generalize (le_dec x); intro;
- elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); 
- 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 (Rabs_def2 (Un x - x1) 1 H0);
- clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); 
- intros; apply H4; clear H3 H4; right; clear H H0 y;
- apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1);
- clear H1; intro; apply (Rminus_lt x1 (Un x + 1));
- cut (-1 - (Un x - x1) = x1 - (Un x + 1));
- [ intro; rewrite H0 in H; assumption | ring ].
-generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0;
- elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; 
- apply H2; left; assumption.
-Qed.
+  Lemma cauchy_bound : Cauchy_crit -> bound EUn.
+  Proof.
+    unfold Cauchy_crit, bound in |- *; intros; unfold is_upper_bound in |- *;
+      unfold Rgt in H; elim (H 1 Rlt_0_1); clear H; intros; 
+        generalize (H x); intro; generalize (le_dec x); intro;
+          elim (finite_greater x); intros; split with (Rmax x0 (Un x + 1)); 
+            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 (Rabs_def2 (Un x - x1) 1 H0);
+        clear H0; intros; elim (Rmax_Rle x0 (Un x + 1) x1); 
+          intros; apply H4; clear H3 H4; right; clear H H0 y;
+            apply (Rlt_le x1 (Un x + 1)); generalize (Rlt_minus (-1) (Un x - x1) H1);
+              clear H1; intro; apply (Rminus_lt x1 (Un x + 1));
+                cut (-1 - (Un x - x1) = x1 - (Un x + 1));
+                  [ intro; rewrite H0 in H; assumption | ring ].
+    generalize (H2 x2 y); clear H2 H0; intro; rewrite <- H in H0;
+      elim (Rmax_Rle x0 (Un x + 1) x1); intros; clear H1; 
+        apply H2; left; assumption.
+  Qed.
 
 End sequence.
 
 (*****************************************************************)
-(*           Definition of Power Series and properties           *)
+(**  *       Definition of Power Series and properties           *)
 (*                                                               *)
 (*****************************************************************)
 
 Section Isequence.
 
 (*********)
-Variable An : nat -> R.
+  Variable An : nat -> R.
 
 (*********)
-Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l.
+  Definition Pser (x l:R) : Prop := infinit_sum (fun n:nat => An n * x ^ n) l.
 
 End Isequence.
 
 Lemma GP_infinite :
- forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)).
-intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros;
- elim (Req_dec x 0).
-intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1;
- cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1).
-intros; rewrite H3; rewrite R_dist_eq; auto.
-elim n; simpl in |- *.
-ring.
-intros; rewrite H3; ring.
-intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))).
-intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2);
- intro N; intros; exists N; intros;
- cut
-  (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n).
-intros; rewrite H5;
- apply
-  (Rmult_lt_reg_l (Rabs (1 - x))
-     (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps).
-apply Rabs_pos_lt.
-apply Rminus_eq_contra.
-apply Rlt_dichotomy_converse.
-right; unfold Rgt in |- *.
-apply (Rle_lt_trans x (Rabs x) 1).
-apply RRle_abs.
-assumption.
-unfold R_dist in |- *; rewrite <- Rabs_mult.
-rewrite Rmult_minus_distr_l.
-cut
- ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n =
-  - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))).
-intro; rewrite H6.
-rewrite GP_finite.
-rewrite Rinv_r.
-cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)).
-intro; rewrite H7.
-rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto.
-intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult;
- apply
-  (Rlt_le_trans (Rabs x * Rabs (x ^ n))
-     (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) (
-     Rabs (1 - x) * eps)).
-apply Rmult_lt_compat_l.
-apply Rabs_pos_lt.
-assumption.
-auto.
-cut
- (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) =
-  Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))).
-clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r.  
-rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps).
-intros; rewrite H9; unfold Rle in |- *; right; reflexivity.
-ring.
-assumption.
-ring.
-ring.
-ring.
-apply Rminus_eq_contra.
-apply Rlt_dichotomy_converse.
-right; unfold Rgt in |- *.
-apply (Rle_lt_trans x (Rabs x) 1).
-apply RRle_abs.
-assumption.
-ring; ring.
-elim n; simpl in |- *.
-ring.
-intros; rewrite H5.
-ring.
-apply Rmult_lt_0_compat.
-auto.
-apply Rmult_lt_0_compat.
-apply Rabs_pos_lt.
-apply Rminus_eq_contra.
-apply Rlt_dichotomy_converse.
-right; unfold Rgt in |- *.
-apply (Rle_lt_trans x (Rabs x) 1).
-apply RRle_abs.
-assumption.
-apply Rabs_pos_lt.
-apply Rinv_neq_0_compat.
-assumption.
+  forall x:R, Rabs x < 1 -> Pser (fun n:nat => 1) x (/ (1 - x)).
+Proof.
+  intros; unfold Pser in |- *; unfold infinit_sum in |- *; intros;
+    elim (Req_dec x 0).
+  intros; exists 0%nat; intros; rewrite H1; rewrite Rminus_0_r; rewrite Rinv_1;
+    cut (sum_f_R0 (fun n0:nat => 1 * 0 ^ n0) n = 1).
+  intros; rewrite H3; rewrite R_dist_eq; auto.
+  elim n; simpl in |- *.
+  ring.
+  intros; rewrite H3; ring.
+  intro; cut (0 < eps * (Rabs (1 - x) * Rabs (/ x))).
+  intro; elim (pow_lt_1_zero x H (eps * (Rabs (1 - x) * Rabs (/ x))) H2);
+    intro N; intros; exists N; intros;
+      cut
+        (sum_f_R0 (fun n0:nat => 1 * x ^ n0) n = sum_f_R0 (fun n0:nat => x ^ n0) n).
+  intros; rewrite H5;
+    apply
+      (Rmult_lt_reg_l (Rabs (1 - x))
+        (R_dist (sum_f_R0 (fun n0:nat => x ^ n0) n) (/ (1 - x))) eps).
+  apply Rabs_pos_lt.
+  apply Rminus_eq_contra.
+  apply Rlt_dichotomy_converse.
+  right; unfold Rgt in |- *.
+  apply (Rle_lt_trans x (Rabs x) 1).
+  apply RRle_abs.
+  assumption.
+  unfold R_dist in |- *; rewrite <- Rabs_mult.
+  rewrite Rmult_minus_distr_l.
+  cut
+    ((1 - x) * sum_f_R0 (fun n0:nat => x ^ n0) n =
+      - (sum_f_R0 (fun n0:nat => x ^ n0) n * (x - 1))).
+  intro; rewrite H6.
+  rewrite GP_finite.
+  rewrite Rinv_r.
+  cut (- (x ^ (n + 1) - 1) - 1 = - x ^ (n + 1)).
+  intro; rewrite H7.
+  rewrite Rabs_Ropp; cut ((n + 1)%nat = S n); auto.
+  intro H8; rewrite H8; simpl in |- *; rewrite Rabs_mult;
+    apply
+      (Rlt_le_trans (Rabs x * Rabs (x ^ n))
+        (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x)))) (
+          Rabs (1 - x) * eps)).
+  apply Rmult_lt_compat_l.
+  apply Rabs_pos_lt.
+  assumption.
+  auto.
+  cut
+    (Rabs x * (eps * (Rabs (1 - x) * Rabs (/ x))) =
+      Rabs x * Rabs (/ x) * (eps * Rabs (1 - x))).
+  clear H8; intros; rewrite H8; rewrite <- Rabs_mult; rewrite Rinv_r.  
+  rewrite Rabs_R1; cut (1 * (eps * Rabs (1 - x)) = Rabs (1 - x) * eps).
+  intros; rewrite H9; unfold Rle in |- *; right; reflexivity.
+  ring.
+  assumption.
+  ring.
+  ring.
+  ring.
+  apply Rminus_eq_contra.
+  apply Rlt_dichotomy_converse.
+  right; unfold Rgt in |- *.
+  apply (Rle_lt_trans x (Rabs x) 1).
+  apply RRle_abs.
+  assumption.
+  ring; ring.
+  elim n; simpl in |- *.
+  ring.
+  intros; rewrite H5.
+  ring.
+  apply Rmult_lt_0_compat.
+  auto.
+  apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt.
+  apply Rminus_eq_contra.
+  apply Rlt_dichotomy_converse.
+  right; unfold Rgt in |- *.
+  apply (Rle_lt_trans x (Rabs x) 1).
+  apply RRle_abs.
+  assumption.
+  apply Rabs_pos_lt.
+  apply Rinv_neq_0_compat.
+  assumption.
 Qed.
diff --git a/theories/Reals/Rsigma.v b/theories/Reals/Rsigma.v
index 1e69a8f5..690c420f 100644
--- a/theories/Reals/Rsigma.v
+++ b/theories/Reals/Rsigma.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rsigma.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rsigma.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -18,123 +18,117 @@ Set Implicit Arguments.
 
 Section Sigma.
 
-Variable f : nat -> R.
+  Variable f : nat -> R.
 
-Definition sigma (low high:nat) : R :=
-  sum_f_R0 (fun k:nat => f (low + k)) (high - low).
+  Definition sigma (low high:nat) : R :=
+    sum_f_R0 (fun k:nat => f (low + k)) (high - low).
 
-Theorem sigma_split :
- forall low high k:nat,
-   (low <= k)%nat ->
-   (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high.
-intros; induction  k as [| k Hreck].
-cut (low = 0%nat).
-intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n;
- rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high).
-apply (decomp_sum (fun k:nat => f k)).
-assumption.
-apply pred_of_minus.
-inversion H; reflexivity.
-cut ((low <= k)%nat \/ 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 in |- *; replace (high - S (S k))%nat with (pred (high - S k)).
-pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat;
- [ idtac | ring ].
-replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with
- (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))).
-apply (decomp_sum (fun i:nat => f (S k + i))).
-apply lt_minus_O_lt; assumption.
-apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat.
-reflexivity.
-apply INR_eq; do 2 rewrite plus_INR; do 3 rewrite S_INR; ring.
-replace (high - S (S k))%nat with (high - S k - 1)%nat.
-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 in |- *; replace (S k - low)%nat with (S (k - low)).
-pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat.
-symmetry  in |- *; apply (tech5 (fun i:nat => f (low + i))).
-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 in |- *; rewrite <- minus_n_n; simpl in |- *;
- replace (high - S low)%nat with (pred (high - low)).
-replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with
- (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))).
-apply (decomp_sum (fun k0:nat => f (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 (low + i)) with (low + S i)%nat.
-reflexivity.
-apply INR_eq; rewrite plus_INR; do 2 rewrite S_INR; rewrite plus_INR; ring.
-replace (high - S low)%nat with (high - low - 1)%nat.
-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_split :
+    forall low high k:nat,
+      (low <= k)%nat ->
+      (k < high)%nat -> sigma low high = sigma low k + sigma (S k) high.
+  Proof.
+    intros; induction  k as [| k Hreck].
+    cut (low = 0%nat).
+    intro; rewrite H1; unfold sigma in |- *; rewrite <- minus_n_n;
+      rewrite <- minus_n_O; simpl in |- *; replace (high - 1)%nat with (pred high).
+    apply (decomp_sum (fun k:nat => f k)).
+    assumption.
+    apply pred_of_minus.
+    inversion H; reflexivity.
+    cut ((low <= k)%nat \/ 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 in |- *; replace (high - S (S k))%nat with (pred (high - S k)).
+    pattern (S k) at 3 in |- *; replace (S k) with (S k + 0)%nat;
+      [ idtac | ring ].
+    replace (sum_f_R0 (fun k0:nat => f (S (S k) + k0)) (pred (high - S k))) with
+    (sum_f_R0 (fun k0:nat => f (S k + S k0)) (pred (high - S k))).
+    apply (decomp_sum (fun i:nat => f (S k + i))).
+    apply lt_minus_O_lt; assumption.
+    apply sum_eq; intros; replace (S k + S i)%nat with (S (S k) + i)%nat.
+    reflexivity.
+    ring_nat.
+    replace (high - S (S k))%nat with (high - S k - 1)%nat.
+    apply pred_of_minus.
+    omega.
+    unfold sigma in |- *; replace (S k - low)%nat with (S (k - low)).
+    pattern (S k) at 1 in |- *; replace (S k) with (low + S (k - low))%nat.
+    symmetry  in |- *; apply (tech5 (fun i:nat => f (low + i))).
+    omega.
+    omega.
+    rewrite <- H2; unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+      replace (high - S low)%nat with (pred (high - low)).
+    replace (sum_f_R0 (fun k0:nat => f (S (low + k0))) (pred (high - low))) with
+    (sum_f_R0 (fun k0:nat => f (low + S k0)) (pred (high - low))).
+    apply (decomp_sum (fun k0:nat => f (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 (low + i)) with (low + S i)%nat.
+    reflexivity.
+    ring_nat.
+    omega.
+    inversion H; [ right; reflexivity | left; assumption ].
+  Qed.
 
-Theorem sigma_diff :
- forall low high k:nat,
-   (low <= k)%nat ->
-   (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high.
-intros low high k H1 H2; symmetry  in |- *; rewrite (sigma_split H1 H2); ring.
-Qed.
+  Theorem sigma_diff :
+    forall low high k:nat,
+      (low <= k)%nat ->
+      (k < high)%nat -> sigma low high - sigma low k = sigma (S k) high.
+  Proof.
+    intros low high k H1 H2; symmetry  in |- *; rewrite (sigma_split H1 H2); ring.
+  Qed.
 
-Theorem sigma_diff_neg :
- forall low high k:nat,
-   (low <= k)%nat ->
-   (k < high)%nat -> 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_diff_neg :
+    forall low high k:nat,
+      (low <= k)%nat ->
+      (k < high)%nat -> sigma low k - sigma low high = - sigma (S k) high.
+  Proof.
+    intros low high k H1 H2; rewrite (sigma_split H1 H2); ring.
+  Qed.
 
-Theorem sigma_first :
- forall low high:nat,
-   (low < high)%nat -> 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 in |- *; rewrite <- minus_n_n.
-simpl in |- *.
-replace (low + 0)%nat with low; [ reflexivity | ring ].
-Qed.
+  Theorem sigma_first :
+    forall low high:nat,
+      (low < high)%nat -> sigma low high = f low + sigma (S low) high.
+  Proof.
+    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 in |- *; rewrite <- minus_n_n.
+    simpl in |- *.
+    replace (low + 0)%nat with low; [ reflexivity | ring ].
+  Qed.
 
-Theorem sigma_last :
- forall low high:nat,
-   (low < high)%nat -> 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_comm; cut (high = S (pred high)).
-intro; pattern high at 3 in |- *; rewrite H.
-apply sigma_split.
-apply le_S_n; rewrite <- H; apply lt_le_S; assumption.
-apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ].
-apply S_pred with 0%nat; apply le_lt_trans with low;
- [ apply le_O_n | assumption ].
-unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
- replace (high + 0)%nat with high; [ reflexivity | ring ].
-Qed.
+  Theorem sigma_last :
+    forall low high:nat,
+      (low < high)%nat -> sigma low high = f high + sigma low (pred high).
+  Proof.
+    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_comm; cut (high = S (pred high)).
+    intro; pattern high at 3 in |- *; rewrite H.
+    apply sigma_split.
+    apply le_S_n; rewrite <- H; apply lt_le_S; assumption.
+    apply lt_pred_n_n; apply le_lt_trans with low; [ apply le_O_n | assumption ].
+    apply S_pred with 0%nat; apply le_lt_trans with low;
+      [ apply le_O_n | assumption ].
+    unfold sigma in |- *; rewrite <- minus_n_n; simpl in |- *;
+      replace (high + 0)%nat with high; [ reflexivity | ring ].
+  Qed.
 
-Theorem sigma_eq_arg : forall low:nat, sigma low low = f low.
-intro; unfold sigma in |- *; rewrite <- minus_n_n.
-simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ].
-Qed.
+  Theorem sigma_eq_arg : forall low:nat, sigma low low = f low.
+  Proof.
+    intro; unfold sigma in |- *; rewrite <- minus_n_n.
+    simpl in |- *; replace (low + 0)%nat with low; [ reflexivity | ring ].
+  Qed.
 
-End Sigma.
\ No newline at end of file
+End Sigma.
diff --git a/theories/Reals/Rsqrt_def.v b/theories/Reals/Rsqrt_def.v
index de3422e8..92284e7d 100644
--- a/theories/Reals/Rsqrt_def.v
+++ b/theories/Reals/Rsqrt_def.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rsqrt_def.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: Rsqrt_def.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Sumbool.
 Require Import Rbase.
@@ -17,746 +17,769 @@ Open Local Scope R_scope.
 
 Boxed Fixpoint Dichotomy_lb (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
   match N with
-  | O => x
-  | S n =>
+    | 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
+        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) {struct N} : R :=
-  match N with
-  | 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.
+  
+  with Dichotomy_ub (x y:R) (P:R -> bool) (N:nat) {struct N} : R :=
+    match N with
+      | 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) (N:nat) : R := Dichotomy_lb x y P N.
 Definition dicho_up (x y:R) (P:R -> bool) (N:nat) : R := Dichotomy_ub x y P N.
 
 (**********)
 Lemma dicho_comp :
- forall (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 as [| n Hrecn].
-simpl in |- *; assumption.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 1 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
-rewrite Rmult_1_r.
-rewrite double.
-apply Rplus_le_compat_l.
-assumption.
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 3 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
-rewrite Rmult_1_r.
-rewrite double.
-rewrite <- (Rplus_comm (Dichotomy_ub x y P n)).
-apply Rplus_le_compat_l.
-assumption.
+  forall (x y:R) (P:R -> bool) (n:nat),
+    x <= y -> dicho_lb x y P n <= dicho_up x y P n.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *; assumption.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+  rewrite Rmult_1_r.
+  rewrite double.
+  apply Rplus_le_compat_l.
+  assumption.
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+  rewrite Rmult_1_r.
+  rewrite double.
+  rewrite <- (Rplus_comm (Dichotomy_ub x y P n)).
+  apply Rplus_le_compat_l.
+  assumption.
 Qed.
 
 Lemma dicho_lb_growing :
- forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P).
-intros.
-unfold Un_growing in |- *.
-intro.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-right; reflexivity.
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 1 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
-rewrite Rmult_1_r.
-rewrite double.
-apply Rplus_le_compat_l.
-replace (Dichotomy_ub x y P n) with (dicho_up x y P n);
- [ apply dicho_comp; assumption | reflexivity ].
+  forall (x y:R) (P:R -> bool), x <= y -> Un_growing (dicho_lb x y P).
+Proof.
+  intros.
+  unfold Un_growing in |- *.
+  intro.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  right; reflexivity.
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+  rewrite Rmult_1_r.
+  rewrite double.
+  apply Rplus_le_compat_l.
+  replace (Dichotomy_ub x y P n) with (dicho_up x y P n);
+  [ apply dicho_comp; assumption | reflexivity ].
 Qed.
 
 Lemma dicho_up_decreasing :
- forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P).
-intros.
-unfold Un_decreasing in |- *.
-intro.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 3 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
-rewrite Rmult_1_r.
-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_comm (dicho_up x y P n)).
-apply Rplus_le_compat_l.
-apply dicho_comp; assumption.
-right; reflexivity.
+  forall (x y:R) (P:R -> bool), x <= y -> Un_decreasing (dicho_up x y P).
+Proof.
+  intros.
+  unfold Un_decreasing in |- *.
+  intro.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ idtac | discrR ].
+  rewrite Rmult_1_r.
+  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_comm (dicho_up x y P n)).
+  apply Rplus_le_compat_l.
+  apply dicho_comp; assumption.
+  right; reflexivity.
 Qed.
 
 Lemma dicho_lb_maj_y :
- forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y.
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *; assumption.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-assumption.
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 3 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
-rewrite double; apply Rplus_le_compat.
-assumption.
-pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0);
- [ idtac | reflexivity ].
-apply decreasing_prop.
-assert (H0 := dicho_up_decreasing x y P H).
-assumption.
-apply le_O_n.
+  forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, dicho_lb x y P n <= y.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *; assumption.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  assumption.
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 3 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
+  rewrite double; apply Rplus_le_compat.
+  assumption.
+  pattern y at 2 in |- *; replace y with (Dichotomy_ub x y P 0);
+    [ idtac | reflexivity ].
+  apply decreasing_prop.
+  assert (H0 := dicho_up_decreasing x y P H).
+  assumption.
+  apply le_O_n.
 Qed.
 
 Lemma dicho_lb_maj :
- forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P).
-intros.
-cut (forall n:nat, dicho_lb x y P n <= y).
-intro.
-unfold has_ub in |- *.
-unfold bound in |- *.
-exists y.
-unfold is_upper_bound in |- *.
-intros.
-elim H1; intros.
-rewrite H2; apply H0.
-apply dicho_lb_maj_y; assumption.
+  forall (x y:R) (P:R -> bool), x <= y -> has_ub (dicho_lb x y P).
+Proof.
+  intros.
+  cut (forall n:nat, dicho_lb x y P n <= y).
+  intro.
+  unfold has_ub in |- *.
+  unfold bound in |- *.
+  exists y.
+  unfold is_upper_bound in |- *.
+  intros.
+  elim H1; intros.
+  rewrite H2; apply H0.
+  apply dicho_lb_maj_y; assumption.
 Qed.
 
 Lemma dicho_up_min_x :
- forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n.
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *; assumption.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-pattern 2 at 1 in |- *; rewrite Rmult_comm.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
-rewrite double; apply Rplus_le_compat.
-pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0);
- [ idtac | reflexivity ].
-apply tech9.
-assert (H0 := dicho_lb_growing x y P H).
-assumption.
-apply le_O_n.
-assumption.
-assumption.
+  forall (x y:R) (P:R -> bool), x <= y -> forall n:nat, x <= dicho_up x y P n.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *; assumption.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  pattern 2 at 1 in |- *; rewrite Rmult_comm.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym; [ rewrite Rmult_1_r | discrR ].
+  rewrite double; apply Rplus_le_compat.
+  pattern x at 1 in |- *; replace x with (Dichotomy_lb x y P 0);
+    [ 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 :
- forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P).
-intros.
-cut (forall n:nat, x <= dicho_up x y P n).
-intro.
-unfold has_lb in |- *.
-unfold bound in |- *.
-exists (- x).
-unfold is_upper_bound in |- *.
-intros.
-elim H1; intros.
-rewrite H2.
-unfold opp_seq in |- *.
-apply Ropp_le_contravar.
-apply H0.
-apply dicho_up_min_x; assumption.
+  forall (x y:R) (P:R -> bool), x <= y -> has_lb (dicho_up x y P).
+Proof.
+  intros.
+  cut (forall n:nat, x <= dicho_up x y P n).
+  intro.
+  unfold has_lb in |- *.
+  unfold bound in |- *.
+  exists (- x).
+  unfold is_upper_bound in |- *.
+  intros.
+  elim H1; intros.
+  rewrite H2.
+  unfold opp_seq in |- *.
+  apply Ropp_le_contravar.
+  apply H0.
+  apply dicho_up_min_x; assumption.
 Qed.
 
 Lemma dicho_lb_cv :
- forall (x y:R) (P:R -> bool),
-   x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l).
-intros.
-apply growing_cv.
-apply dicho_lb_growing; assumption.
-apply dicho_lb_maj; assumption.
+  forall (x y:R) (P:R -> bool),
+    x <= y -> sigT (fun l:R => Un_cv (dicho_lb x y P) l).
+Proof.
+  intros.
+  apply growing_cv.
+  apply dicho_lb_growing; assumption.
+  apply dicho_lb_maj; assumption.
 Qed.
 
 Lemma dicho_up_cv :
- forall (x y:R) (P:R -> bool),
-   x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l).
-intros.
-apply decreasing_cv.
-apply dicho_up_decreasing; assumption.
-apply dicho_up_min; assumption.
+  forall (x y:R) (P:R -> bool),
+    x <= y -> sigT (fun l:R => Un_cv (dicho_up x y P) l).
+Proof.
+  intros.
+  apply decreasing_cv.
+  apply dicho_up_decreasing; assumption.
+  apply dicho_up_min; assumption.
 Qed.
 
 Lemma dicho_lb_dicho_up :
- forall (x y:R) (P:R -> bool) (n:nat),
-   x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n.
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *.
-unfold Rdiv in |- *; rewrite Rinv_1; ring.
-simpl in |- *.
-case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
-unfold Rdiv in |- *.
-replace
- ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n)
- with ((dicho_up x y P n - dicho_lb x y P n) / 2).
-unfold Rdiv in |- *; rewrite Hrecn.
-unfold Rdiv in |- *.
-rewrite Rinv_mult_distr.
-ring.
-discrR.
-apply pow_nonzero; discrR.
-pattern (Dichotomy_lb x y P n) at 2 in |- *;
- rewrite (double_var (Dichotomy_lb x y P n));
- unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
-replace
- (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)
- with ((dicho_up x y P n - dicho_lb x y P n) / 2).
-unfold Rdiv in |- *; rewrite Hrecn.
-unfold Rdiv in |- *.
-rewrite Rinv_mult_distr.
-ring.
-discrR.
-apply pow_nonzero; discrR.
-pattern (Dichotomy_ub x y P n) at 1 in |- *;
- rewrite (double_var (Dichotomy_ub x y P n));
- unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
+  forall (x y:R) (P:R -> bool) (n:nat),
+    x <= y -> dicho_up x y P n - dicho_lb x y P n = (y - x) / 2 ^ n.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *.
+  unfold Rdiv in |- *; rewrite Rinv_1; ring.
+  simpl in |- *.
+  case (P ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)).
+  unfold Rdiv in |- *.
+  replace
+  ((Dichotomy_lb x y P n + Dichotomy_ub x y P n) * / 2 - Dichotomy_lb x y P n)
+    with ((dicho_up x y P n - dicho_lb x y P n) / 2).
+  unfold Rdiv in |- *; rewrite Hrecn.
+  unfold Rdiv in |- *.
+  rewrite Rinv_mult_distr.
+  ring.
+  discrR.
+  apply pow_nonzero; discrR.
+  pattern (Dichotomy_lb x y P n) at 2 in |- *;
+    rewrite (double_var (Dichotomy_lb x y P n));
+      unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
+  replace
+  (Dichotomy_ub x y P n - (Dichotomy_lb x y P n + Dichotomy_ub x y P n) / 2)
+    with ((dicho_up x y P n - dicho_lb x y P n) / 2).
+  unfold Rdiv in |- *; rewrite Hrecn.
+  unfold Rdiv in |- *.
+  rewrite Rinv_mult_distr.
+  ring.
+  discrR.
+  apply pow_nonzero; discrR.
+  pattern (Dichotomy_ub x y P n) at 1 in |- *;
+    rewrite (double_var (Dichotomy_ub x y P n));
+      unfold dicho_up, dicho_lb, Rminus, Rdiv in |- *; ring.
 Qed.
 
 Definition pow_2_n (n:nat) := 2 ^ n.
 
 Lemma pow_2_n_neq_R0 : forall n:nat, pow_2_n n <> 0.
-intro.
-unfold pow_2_n in |- *.
-apply pow_nonzero.
-discrR.
+Proof.
+  intro.
+  unfold pow_2_n in |- *.
+  apply pow_nonzero.
+  discrR.
 Qed.
 
 Lemma pow_2_n_growing : Un_growing pow_2_n.
-unfold Un_growing in |- *.
-intro.
-replace (S n) with (n + 1)%nat;
- [ unfold pow_2_n in |- *; rewrite pow_add | ring ].
-pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r.
-apply Rmult_le_compat_l.
-left; apply pow_lt; prove_sup0.
-simpl in |- *.
-rewrite Rmult_1_r.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- apply Rlt_0_1.
+Proof.
+  unfold Un_growing in |- *.
+  intro.
+  replace (S n) with (n + 1)%nat;
+  [ unfold pow_2_n in |- *; rewrite pow_add | ring ].
+  pattern (2 ^ n) at 1 in |- *; rewrite <- Rmult_1_r.
+  apply Rmult_le_compat_l.
+  left; apply pow_lt; prove_sup0.
+  simpl in |- *.
+  rewrite Rmult_1_r.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    apply Rlt_0_1.
 Qed.
 
 Lemma pow_2_n_infty : cv_infty pow_2_n.
-cut (forall N:nat, INR N <= 2 ^ N).
-intros.
-unfold cv_infty in |- *.
-intro.
-case (total_order_T 0 M); intro.
-elim s; intro.
-set (N := up M).
-cut (0 <= N)%Z.
-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 in |- *.
-assert (H3 := archimed M).
-elim H3; intros; assumption.
-apply Rle_trans with (pow_2_n N0).
-unfold pow_2_n in |- *; apply H.
-apply Rge_le.
-apply growing_prop.
-apply pow_2_n_growing.
-assumption.
-apply le_IZR.
-unfold N in |- *.
-simpl in |- *.
-assert (H0 := archimed M); elim H0; intros.
-left; apply Rlt_trans with M; assumption.
-exists 0%nat; intros.
-rewrite <- b.
-unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
-exists 0%nat; intros.
-apply Rlt_trans with 0.
-assumption.
-unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
-simple induction N.
-simpl in |- *.
-left; apply Rlt_0_1.
-intros.
-pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite S_INR; rewrite pow_add.
-simpl in |- *.
-rewrite Rmult_1_r.
-apply Rle_trans with (2 ^ n).
-rewrite <- (Rplus_comm 1).
-rewrite <- (Rmult_1_r (INR n)).
-apply (poly n 1).
-apply Rlt_0_1.
-pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r.
-rewrite <- (Rmult_comm 2).
-rewrite double.
-apply Rplus_le_compat_l.
-left; apply pow_lt; prove_sup0.
+Proof.
+  cut (forall N:nat, INR N <= 2 ^ N).
+  intros.
+  unfold cv_infty in |- *.
+  intro.
+  case (total_order_T 0 M); intro.
+  elim s; intro.
+  set (N := up M).
+  cut (0 <= N)%Z.
+  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 in |- *.
+  assert (H3 := archimed M).
+  elim H3; intros; assumption.
+  apply Rle_trans with (pow_2_n N0).
+  unfold pow_2_n in |- *; apply H.
+  apply Rge_le.
+  apply growing_prop.
+  apply pow_2_n_growing.
+  assumption.
+  apply le_IZR.
+  unfold N in |- *.
+  simpl in |- *.
+  assert (H0 := archimed M); elim H0; intros.
+  left; apply Rlt_trans with M; assumption.
+  exists 0%nat; intros.
+  rewrite <- b.
+  unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+  exists 0%nat; intros.
+  apply Rlt_trans with 0.
+  assumption.
+  unfold pow_2_n in |- *; apply pow_lt; prove_sup0.
+  simple induction N.
+  simpl in |- *.
+  left; apply Rlt_0_1.
+  intros.
+  pattern (S n) at 2 in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite S_INR; rewrite pow_add.
+  simpl in |- *.
+  rewrite Rmult_1_r.
+  apply Rle_trans with (2 ^ n).
+  rewrite <- (Rplus_comm 1).
+  rewrite <- (Rmult_1_r (INR n)).
+  apply (poly n 1).
+  apply Rlt_0_1.
+  pattern (2 ^ n) at 1 in |- *; rewrite <- Rplus_0_r.
+  rewrite <- (Rmult_comm 2).
+  rewrite double.
+  apply Rplus_le_compat_l.
+  left; apply pow_lt; prove_sup0.
 Qed.
 
 Lemma cv_dicho :
- forall (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 (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0).
-intro.
-assert (H4 := UL_sequence _ _ _ H2 H3).
-symmetry  in |- *; apply Rminus_diag_uniq_sym; assumption.
-unfold Un_cv in |- *; unfold R_dist in |- *.
-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 <- Rabs_Ropp.
-rewrite Ropp_minus_distr'.
-rewrite dicho_lb_dicho_up.
-unfold Rdiv in |- *; rewrite Rabs_mult.
-rewrite (Rabs_right (y - x)).
-apply Rmult_lt_reg_l with (/ (y - x)).
-apply Rinv_0_lt_compat; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (/ 2 ^ n) with (/ 2 ^ n - 0);
- [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6;
+  forall (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.
+Proof.
+  intros.
+  assert (H2 := CV_minus _ _ _ _ H0 H1).
+  cut (Un_cv (fun i:nat => dicho_lb x y P i - dicho_up x y P i) 0).
+  intro.
+  assert (H4 := UL_sequence _ _ _ H2 H3).
+  symmetry  in |- *; apply Rminus_diag_uniq_sym; assumption.
+  unfold Un_cv in |- *; unfold R_dist in |- *.
+  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 <- Rabs_Ropp.
+  rewrite Ropp_minus_distr'.
+  rewrite dicho_lb_dicho_up.
+  unfold Rdiv in |- *; rewrite Rabs_mult.
+  rewrite (Rabs_right (y - x)).
+  apply Rmult_lt_reg_l with (/ (y - x)).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (/ 2 ^ n) with (/ 2 ^ n - 0);
+  [ unfold pow_2_n, Rdiv in H6; rewrite <- (Rmult_comm eps); apply H6;
     assumption
- | ring ].
-red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp).
-apply Rle_ge.
-apply Rplus_le_reg_l with x; rewrite Rplus_0_r.
-replace (x + (y - x)) with y; [ assumption | ring ].
-assumption.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; assumption ].
-apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
-replace (x + (y - x)) with y; [ assumption | ring ].
-exists 0%nat; 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 <- Rabs_Ropp.
-rewrite Ropp_minus_distr'.
-rewrite dicho_lb_dicho_up.
-rewrite b.
-unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l;
- rewrite Rabs_R0; assumption.
-assumption.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
+    | ring ].
+  red in |- *; intro; rewrite H8 in Hyp; elim (Rlt_irrefl _ Hyp).
+  apply Rle_ge.
+  apply Rplus_le_reg_l with x; rewrite Rplus_0_r.
+  replace (x + (y - x)) with y; [ assumption | ring ].
+  assumption.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; assumption ].
+  apply Rplus_lt_reg_r with x; rewrite Rplus_0_r.
+  replace (x + (y - x)) with y; [ assumption | ring ].
+  exists 0%nat; 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 <- Rabs_Ropp.
+  rewrite Ropp_minus_distr'.
+  rewrite dicho_lb_dicho_up.
+  rewrite b.
+  unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; rewrite Rmult_0_l;
+    rewrite Rabs_R0; assumption.
+  assumption.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H r)).
 Qed.
 
 Definition cond_positivity (x:R) : bool :=
   match Rle_dec 0 x with
-  | left _ => true
-  | right _ => false
+    | left _ => true
+    | right _ => false
   end.
 
-(* Sequential caracterisation of continuity *)
+(** Sequential caracterisation of continuity *)
 Lemma continuity_seq :
- forall (f:R -> R) (Un:nat -> R) (l:R),
-   continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l).
-unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *.
-unfold limit1_in in |- *.
-unfold limit_in in |- *.
-unfold dist in |- *.
-simpl in |- *.
-unfold R_dist in |- *.
-intros.
-elim (H eps H1); intros alp H2.
-elim H2; intros.
-elim (H0 alp H3); intros N H5.
-exists N; intros.
-case (Req_dec (Un n) l); intro.
-rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- assumption.
-apply H4.
-split.
-unfold D_x, no_cond in |- *.
-split.
-trivial.
-apply (sym_not_eq (A:=R)); assumption.
-apply H5; assumption.
+  forall (f:R -> R) (Un:nat -> R) (l:R),
+    continuity_pt f l -> Un_cv Un l -> Un_cv (fun i:nat => f (Un i)) (f l).
+Proof.
+  unfold continuity_pt, Un_cv in |- *; unfold continue_in in |- *.
+  unfold limit1_in in |- *.
+  unfold limit_in in |- *.
+  unfold dist in |- *.
+  simpl in |- *.
+  unfold R_dist in |- *.
+  intros.
+  elim (H eps H1); intros alp H2.
+  elim H2; intros.
+  elim (H0 alp H3); intros N H5.
+  exists N; intros.
+  case (Req_dec (Un n) l); intro.
+  rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    assumption.
+  apply H4.
+  split.
+  unfold D_x, no_cond in |- *.
+  split.
+  trivial.
+  apply (sym_not_eq (A:=R)); assumption.
+  apply H5; assumption.
 Qed.
 
 Lemma dicho_lb_car :
- forall (x y:R) (P:R -> bool) (n:nat),
-   P x = false -> P (dicho_lb x y P n) = false.
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *.
-assumption.
-simpl in |- *.
-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.
+  forall (x y:R) (P:R -> bool) (n:nat),
+    P x = false -> P (dicho_lb x y P n) = false.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *.
+  assumption.
+  simpl in |- *.
+  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 :
- forall (x y:R) (P:R -> bool) (n:nat),
-   P y = true -> P (dicho_up x y P n) = true.
-intros.
-induction  n as [| n Hrecn].
-simpl in |- *.
-assumption.
-simpl in |- *.
-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.
+  forall (x y:R) (P:R -> bool) (n:nat),
+    P y = true -> P (dicho_up x y P n) = true.
+Proof.
+  intros.
+  induction  n as [| n Hrecn].
+  simpl in |- *.
+  assumption.
+  simpl in |- *.
+  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 *)
+(** Intermediate Value Theorem *)
 Lemma IVT :
- forall (f:R -> R) (x y:R),
-   continuity f ->
-   x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0).
-intros.
-cut (x <= y).
-intro.
-generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). 
-generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). 
-intros X X0.
-elim X; intros.
-elim X0; intros.
-assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
-rewrite H4 in p0.
-apply existT with x0.
-split.
-split.
-apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
-simpl in |- *.
-right; reflexivity.
-apply growing_ineq.
-apply dicho_lb_growing; assumption.
-assumption.
-apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
-apply decreasing_ineq.
-apply dicho_up_decreasing; assumption.
-assumption.
-right; reflexivity.
-2: left; assumption.
-set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
-set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
-cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
-cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
-intros.
-cut (forall n:nat, f (Vn n) <= 0).
-cut (forall n:nat, 0 <= f (Wn n)).
-intros.
-assert (H9 := H6 H8).
-assert (H10 := H5 H7).
-apply Rle_antisym; assumption.
-intro.
-unfold Wn in |- *.
-cut (forall z:R, cond_positivity z = true <-> 0 <= z).
-intro.
-assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
-elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
-apply H9.
-apply H8.
-elim (H7 (f y)); intros.
-apply H12.
-left; assumption.
-intro.
-unfold cond_positivity in |- *.
-case (Rle_dec 0 z); intro.
-split.
-intro; assumption.
-intro; reflexivity.
-split.
-intro; elim diff_false_true; assumption.
-intro.
-elim n0; assumption.
-unfold Vn in |- *.
-cut (forall z:R, cond_positivity z = false <-> z < 0).
-intros.
-assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
-left.
-elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
-apply H9.
-apply H8.
-elim (H7 (f x)); intros.
-apply H12.
-assumption.
-intro.
-unfold cond_positivity in |- *.
-case (Rle_dec 0 z); intro.
-split.
-intro; elim diff_true_false; assumption.
-intro; elim (Rlt_irrefl _ (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 0 (f x0)); intro.
-elim s; intro.
-left; assumption.
-rewrite <- b; right; reflexivity.
-unfold Un_cv in H7; unfold R_dist in H7.
-cut (0 < - f x0).
-intro.
-elim (H7 (- f x0) H8); intros.
-cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
-assert (H11 := H9 x2 H10).
-rewrite Rabs_right in H11.
-pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
-unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
-assert (H12 := Rplus_lt_reg_r _ _ _ H11).
-assert (H13 := H6 x2).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
-apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
-apply H6.
-exact H8.
-apply Ropp_0_gt_lt_contravar; assumption.
-unfold Wn in |- *; assumption.
-cut (Un_cv Vn x0).
-intros.
-assert (H7 := continuity_seq f Vn x0 (H x0) H5).
-case (total_order_T 0 (f x0)); intro.
-elim s; intro.
-unfold Un_cv in H7; unfold R_dist in H7.
-elim (H7 (f x0) a); intros.
-cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
-assert (H10 := H8 x2 H9).
-rewrite Rabs_left in H10.
-pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
-rewrite Ropp_minus_distr' in H10.
-unfold Rminus in H10.
-assert (H11 := Rplus_lt_reg_r _ _ _ H10).
-assert (H12 := H6 x2).
-cut (0 < f (Vn x2)).
-intro.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
-rewrite <- (Ropp_involutive (f (Vn x2))).
-apply Ropp_0_gt_lt_contravar; assumption.
-apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
-rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
- [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
-assumption.
-apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
-right; rewrite <- b; reflexivity.
-left; assumption.
-unfold Vn in |- *; assumption.
+  forall (f:R -> R) (x y:R),
+    continuity f ->
+    x < y -> f x < 0 -> 0 < f y -> sigT (fun z:R => x <= z <= y /\ f z = 0).
+Proof.
+  intros.
+  cut (x <= y).
+  intro.
+  generalize (dicho_lb_cv x y (fun z:R => cond_positivity (f z)) H3). 
+  generalize (dicho_up_cv x y (fun z:R => cond_positivity (f z)) H3). 
+  intros X X0.
+  elim X; intros.
+  elim X0; intros.
+  assert (H4 := cv_dicho _ _ _ _ _ H3 p0 p).
+  rewrite H4 in p0.
+  apply existT with x0.
+  split.
+  split.
+  apply Rle_trans with (dicho_lb x y (fun z:R => cond_positivity (f z)) 0).
+  simpl in |- *.
+  right; reflexivity.
+  apply growing_ineq.
+  apply dicho_lb_growing; assumption.
+  assumption.
+  apply Rle_trans with (dicho_up x y (fun z:R => cond_positivity (f z)) 0).
+  apply decreasing_ineq.
+  apply dicho_up_decreasing; assumption.
+  assumption.
+  right; reflexivity.
+  2: left; assumption.
+  set (Vn := fun n:nat => dicho_lb x y (fun z:R => cond_positivity (f z)) n).
+  set (Wn := fun n:nat => dicho_up x y (fun z:R => cond_positivity (f z)) n).
+  cut ((forall n:nat, f (Vn n) <= 0) -> f x0 <= 0).
+  cut ((forall n:nat, 0 <= f (Wn n)) -> 0 <= f x0).
+  intros.
+  cut (forall n:nat, f (Vn n) <= 0).
+  cut (forall n:nat, 0 <= f (Wn n)).
+  intros.
+  assert (H9 := H6 H8).
+  assert (H10 := H5 H7).
+  apply Rle_antisym; assumption.
+  intro.
+  unfold Wn in |- *.
+  cut (forall z:R, cond_positivity z = true <-> 0 <= z).
+  intro.
+  assert (H8 := dicho_up_car x y (fun z:R => cond_positivity (f z)) n).
+  elim (H7 (f (dicho_up x y (fun z:R => cond_positivity (f z)) n))); intros.
+  apply H9.
+  apply H8.
+  elim (H7 (f y)); intros.
+  apply H12.
+  left; assumption.
+  intro.
+  unfold cond_positivity in |- *.
+  case (Rle_dec 0 z); intro.
+  split.
+  intro; assumption.
+  intro; reflexivity.
+  split.
+  intro; elim diff_false_true; assumption.
+  intro.
+  elim n0; assumption.
+  unfold Vn in |- *.
+  cut (forall z:R, cond_positivity z = false <-> z < 0).
+  intros.
+  assert (H8 := dicho_lb_car x y (fun z:R => cond_positivity (f z)) n).
+  left.
+  elim (H7 (f (dicho_lb x y (fun z:R => cond_positivity (f z)) n))); intros.
+  apply H9.
+  apply H8.
+  elim (H7 (f x)); intros.
+  apply H12.
+  assumption.
+  intro.
+  unfold cond_positivity in |- *.
+  case (Rle_dec 0 z); intro.
+  split.
+  intro; elim diff_true_false; assumption.
+  intro; elim (Rlt_irrefl _ (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 0 (f x0)); intro.
+  elim s; intro.
+  left; assumption.
+  rewrite <- b; right; reflexivity.
+  unfold Un_cv in H7; unfold R_dist in H7.
+  cut (0 < - f x0).
+  intro.
+  elim (H7 (- f x0) H8); intros.
+  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  assert (H11 := H9 x2 H10).
+  rewrite Rabs_right in H11.
+  pattern (- f x0) at 1 in H11; rewrite <- Rplus_0_r in H11.
+  unfold Rminus in H11; rewrite (Rplus_comm (f (Wn x2))) in H11.
+  assert (H12 := Rplus_lt_reg_r _ _ _ H11).
+  assert (H13 := H6 x2).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H12)).
+  apply Rle_ge; left; unfold Rminus in |- *; apply Rplus_le_lt_0_compat.
+  apply H6.
+  exact H8.
+  apply Ropp_0_gt_lt_contravar; assumption.
+  unfold Wn in |- *; assumption.
+  cut (Un_cv Vn x0).
+  intros.
+  assert (H7 := continuity_seq f Vn x0 (H x0) H5).
+  case (total_order_T 0 (f x0)); intro.
+  elim s; intro.
+  unfold Un_cv in H7; unfold R_dist in H7.
+  elim (H7 (f x0) a); intros.
+  cut (x2 >= x2)%nat; [ intro | unfold ge in |- *; apply le_n ].
+  assert (H10 := H8 x2 H9).
+  rewrite Rabs_left in H10.
+  pattern (f x0) at 2 in H10; rewrite <- Rplus_0_r in H10.
+  rewrite Ropp_minus_distr' in H10.
+  unfold Rminus in H10.
+  assert (H11 := Rplus_lt_reg_r _ _ _ H10).
+  assert (H12 := H6 x2).
+  cut (0 < f (Vn x2)).
+  intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H13 H12)).
+  rewrite <- (Ropp_involutive (f (Vn x2))).
+  apply Ropp_0_gt_lt_contravar; assumption.
+  apply Rplus_lt_reg_r with (f x0 - f (Vn x2)).
+  rewrite Rplus_0_r; replace (f x0 - f (Vn x2) + (f (Vn x2) - f x0)) with 0;
+    [ unfold Rminus in |- *; apply Rplus_lt_le_0_compat | ring ].
+  assumption.
+  apply Ropp_0_ge_le_contravar; apply Rle_ge; apply H6.
+  right; rewrite <- b; reflexivity.
+  left; assumption.
+  unfold Vn in |- *; assumption.
 Qed.
 
 Lemma IVT_cor :
- forall (f:R -> R) (x y:R),
-   continuity f ->
-   x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0).
-intros.
-case (total_order_T 0 (f x)); intro.
-case (total_order_T 0 (f y)); intro.
-elim s; intro.
-elim s0; intro.
-cut (0 < f x * f y);
- [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2))
- | apply Rmult_lt_0_compat; assumption ].
-exists y.
-split.
-split; [ assumption | right; reflexivity ].
-symmetry  in |- *; exact b.
-exists x.
-split.
-split; [ right; reflexivity | assumption ].
-symmetry  in |- *; exact b.
-elim s; intro.
-cut (x < y).
-intro.
-assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2).
-cut ((- f)%F x < 0).
-cut (0 < (- f)%F y).
-intros.
-elim (H3 H5 H4); intros.
-apply existT with x0.
-elim p; intros.
-split.
-assumption.
-unfold opp_fct in H7.
-rewrite <- (Ropp_involutive (f x0)).
-apply Ropp_eq_0_compat; assumption.
-unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption.
-unfold opp_fct in |- *.
-apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
- assumption.
-inversion H0.
-assumption.
-rewrite H2 in a.
-elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
-apply existT with x.
-split.
-split; [ right; reflexivity | assumption ].
-symmetry  in |- *; assumption.
-case (total_order_T 0 (f y)); intro.
-elim s; intro.
-cut (x < y).
-intro.
-apply IVT; assumption.
-inversion H0.
-assumption.
-rewrite H2 in r.
-elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
-apply existT with y.
-split.
-split; [ assumption | right; reflexivity ].
-symmetry  in |- *; assumption.
-cut (0 < f x * f y).
-intro.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)).
-rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat;
- apply Ropp_0_gt_lt_contravar; assumption.
+  forall (f:R -> R) (x y:R),
+    continuity f ->
+    x <= y -> f x * f y <= 0 -> sigT (fun z:R => x <= z <= y /\ f z = 0).
+Proof.
+  intros.
+  case (total_order_T 0 (f x)); intro.
+  case (total_order_T 0 (f y)); intro.
+  elim s; intro.
+  elim s0; intro.
+  cut (0 < f x * f y);
+    [ intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H1 H2))
+      | apply Rmult_lt_0_compat; assumption ].
+  exists y.
+  split.
+  split; [ assumption | right; reflexivity ].
+  symmetry  in |- *; exact b.
+  exists x.
+  split.
+  split; [ right; reflexivity | assumption ].
+  symmetry  in |- *; exact b.
+  elim s; intro.
+  cut (x < y).
+  intro.
+  assert (H3 := IVT (- f)%F x y (continuity_opp f H) H2).
+  cut ((- f)%F x < 0).
+  cut (0 < (- f)%F y).
+  intros.
+  elim (H3 H5 H4); intros.
+  apply existT with x0.
+  elim p; intros.
+  split.
+  assumption.
+  unfold opp_fct in H7.
+  rewrite <- (Ropp_involutive (f x0)).
+  apply Ropp_eq_0_compat; assumption.
+  unfold opp_fct in |- *; apply Ropp_0_gt_lt_contravar; assumption.
+  unfold opp_fct in |- *.
+  apply Rplus_lt_reg_r with (f x); rewrite Rplus_opp_r; rewrite Rplus_0_r;
+    assumption.
+  inversion H0.
+  assumption.
+  rewrite H2 in a.
+  elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+  apply existT with x.
+  split.
+  split; [ right; reflexivity | assumption ].
+  symmetry  in |- *; assumption.
+  case (total_order_T 0 (f y)); intro.
+  elim s; intro.
+  cut (x < y).
+  intro.
+  apply IVT; assumption.
+  inversion H0.
+  assumption.
+  rewrite H2 in r.
+  elim (Rlt_irrefl _ (Rlt_trans _ _ _ r a)).
+  apply existT with y.
+  split.
+  split; [ assumption | right; reflexivity ].
+  symmetry  in |- *; assumption.
+  cut (0 < f x * f y).
+  intro.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H2 H1)).
+  rewrite <- Rmult_opp_opp; apply Rmult_lt_0_compat;
+    apply Ropp_0_gt_lt_contravar; assumption.
 Qed.
 
-(* We can now define the square root function as the reciprocal transformation of the square root function *)
+(** We can now define the square root function as the reciprocal 
+   transformation of the square root function *)
 Lemma Rsqrt_exists :
- forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z).
-intros.
-set (f := fun x:R => Rsqr x - y).
-cut (f 0 <= 0).
-intro.
-cut (continuity f).
-intro.
-case (total_order_T y 1); intro.
-elim s; intro.
-cut (0 <= f 1).
-intro.
-cut (f 0 * f 1 <= 0).
-intro.
-assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3).
-elim X; intros t H4.
-apply existT with t.
-elim H4; intros.
-split.
-elim H5; intros; assumption.
-unfold f in H6.
-apply Rminus_diag_uniq_sym; exact H6.
-rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)).
-apply Rmult_le_compat_l; assumption.
-unfold f in |- *.
-rewrite Rsqr_1.
-apply Rplus_le_reg_l with y.
-rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
- left; assumption.
-apply existT with 1.
-split.
-left; apply Rlt_0_1.
-rewrite b; symmetry  in |- *; apply Rsqr_1.
-cut (0 <= f y).
-intro.
-cut (f 0 * f y <= 0).
-intro.
-assert (X := IVT_cor f 0 y H1 H H3).
-elim X; intros t H4.
-apply existT with t.
-elim H4; intros.
-split.
-elim H5; intros; assumption.
-unfold f in H6.
-apply Rminus_diag_uniq_sym; exact H6.
-rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)).
-apply Rmult_le_compat_l; assumption.
-unfold f in |- *.
-apply Rplus_le_reg_l with y.
-rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-pattern y at 1 in |- *; rewrite <- Rmult_1_r.
-unfold Rsqr in |- *; apply Rmult_le_compat_l.
-assumption.
-left; exact r.
-replace f with (Rsqr - fct_cte y)%F.
-apply continuity_minus.
-apply derivable_continuous; apply derivable_Rsqr.
-apply derivable_continuous; apply derivable_const.
-reflexivity.
-unfold f in |- *; rewrite Rsqr_0.
-unfold Rminus in |- *; rewrite Rplus_0_l.
-apply Rge_le.
-apply Ropp_0_le_ge_contravar; assumption.
+  forall y:R, 0 <= y -> sigT (fun z:R => 0 <= z /\ y = Rsqr z).
+Proof.
+  intros.
+  set (f := fun x:R => Rsqr x - y).
+  cut (f 0 <= 0).
+  intro.
+  cut (continuity f).
+  intro.
+  case (total_order_T y 1); intro.
+  elim s; intro.
+  cut (0 <= f 1).
+  intro.
+  cut (f 0 * f 1 <= 0).
+  intro.
+  assert (X := IVT_cor f 0 1 H1 (Rlt_le _ _ Rlt_0_1) H3).
+  elim X; intros t H4.
+  apply existT with t.
+  elim H4; intros.
+  split.
+  elim H5; intros; assumption.
+  unfold f in H6.
+  apply Rminus_diag_uniq_sym; exact H6.
+  rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f 1)).
+  apply Rmult_le_compat_l; assumption.
+  unfold f in |- *.
+  rewrite Rsqr_1.
+  apply Rplus_le_reg_l with y.
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
+      left; assumption.
+  apply existT with 1.
+  split.
+  left; apply Rlt_0_1.
+  rewrite b; symmetry  in |- *; apply Rsqr_1.
+  cut (0 <= f y).
+  intro.
+  cut (f 0 * f y <= 0).
+  intro.
+  assert (X := IVT_cor f 0 y H1 H H3).
+  elim X; intros t H4.
+  apply existT with t.
+  elim H4; intros.
+  split.
+  elim H5; intros; assumption.
+  unfold f in H6.
+  apply Rminus_diag_uniq_sym; exact H6.
+  rewrite Rmult_comm; pattern 0 at 2 in |- *; rewrite <- (Rmult_0_r (f y)).
+  apply Rmult_le_compat_l; assumption.
+  unfold f in |- *.
+  apply Rplus_le_reg_l with y.
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+  pattern y at 1 in |- *; rewrite <- Rmult_1_r.
+  unfold Rsqr in |- *; apply Rmult_le_compat_l.
+  assumption.
+  left; exact r.
+  replace f with (Rsqr - fct_cte y)%F.
+  apply continuity_minus.
+  apply derivable_continuous; apply derivable_Rsqr.
+  apply derivable_continuous; apply derivable_const.
+  reflexivity.
+  unfold f in |- *; rewrite Rsqr_0.
+  unfold Rminus in |- *; rewrite Rplus_0_l.
+  apply Rge_le.
+  apply Ropp_0_le_ge_contravar; assumption.
 Qed.
 
 (* Definition of the square root: R+->R *)
 Definition Rsqrt (y:nonnegreal) : R :=
   match Rsqrt_exists (nonneg y) (cond_nonneg y) with
-  | existT a b => a
+    | existT a b => a
   end.
 
 (**********)
 Lemma Rsqrt_positivity : forall 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 in |- *.
-case (Rsqrt_exists x (cond_nonneg x)).
-intros.
-elim p; elim a; intros.
-apply Rsqr_inj.
-assumption.
-assumption.
-rewrite <- H0; rewrite <- H2; reflexivity.
+Proof.
+  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 in |- *.
+  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 : forall 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 in |- *.
-case (Rsqrt_exists x (cond_nonneg x)).
-intros.
-elim p; elim a; intros.
-apply Rsqr_inj.
-assumption.
-assumption.
-rewrite <- H0; rewrite <- H2; reflexivity.
+Proof.
+  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 in |- *.
+  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/theories/Reals/Rtopology.v b/theories/Reals/Rtopology.v
index 84f3b081..aa47d72f 100644
--- a/theories/Reals/Rtopology.v
+++ b/theories/Reals/Rtopology.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rtopology.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: Rtopology.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -15,10 +15,13 @@ Require Import RList.
 Require Import Classical_Prop.
 Require Import Classical_Pred_Type. Open Local Scope R_scope.
 
+
+(** * General definitions and propositions *)
+
 Definition included (D1 D2:R -> Prop) : Prop := forall x:R, D1 x -> D2 x.
 Definition disc (x:R) (delta:posreal) (y:R) : Prop := Rabs (y - x) < delta.
 Definition neighbourhood (V:R -> Prop) (x:R) : Prop :=
-   exists delta : posreal, included (disc x delta) V.
+  exists delta : posreal, included (disc x delta) V.
 Definition open_set (D:R -> Prop) : Prop :=
   forall x:R, D x -> neighbourhood D x.
 Definition complementary (D:R -> Prop) (c:R) : Prop := ~ D c.
@@ -28,15 +31,17 @@ Definition union_domain (D1 D2:R -> Prop) (c:R) : Prop := D1 c \/ D2 c.
 Definition interior (D:R -> Prop) (x:R) : Prop := neighbourhood D x.
 
 Lemma interior_P1 : forall D:R -> Prop, included (interior D) D.
-intros; unfold included in |- *; unfold interior in |- *; intros;
- unfold neighbourhood in H; elim H; intros; unfold included in H0; 
- apply H0; unfold disc in |- *; unfold Rminus in |- *; 
- rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0).
+Proof.
+  intros; unfold included in |- *; unfold interior in |- *; intros;
+    unfold neighbourhood in H; elim H; intros; unfold included in H0; 
+      apply H0; unfold disc in |- *; unfold Rminus in |- *; 
+        rewrite Rplus_opp_r; rewrite Rabs_R0; apply (cond_pos x0).
 Qed.
 
 Lemma interior_P2 : forall D:R -> Prop, open_set D -> included D (interior D).
-intros; unfold open_set in H; unfold included in |- *; intros;
- assert (H1 := H _ H0); unfold interior in |- *; apply H1.
+Proof.
+  intros; unfold open_set in H; unfold included in |- *; intros;
+    assert (H1 := H _ H0); unfold interior in |- *; apply H1.
 Qed.
 
 Definition point_adherent (D:R -> Prop) (x:R) : Prop :=
@@ -45,94 +50,100 @@ Definition point_adherent (D:R -> Prop) (x:R) : Prop :=
 Definition adherence (D:R -> Prop) (x:R) : Prop := point_adherent D x.
 
 Lemma adherence_P1 : forall D:R -> Prop, included D (adherence D).
-intro; unfold included in |- *; intros; unfold adherence in |- *;
- unfold point_adherent in |- *; intros; exists x;
- unfold intersection_domain in |- *; split.
-unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1;
- unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply (cond_pos x0).
-apply H.
+Proof.
+  intro; unfold included in |- *; intros; unfold adherence in |- *;
+    unfold point_adherent in |- *; intros; exists x;
+      unfold intersection_domain in |- *; split.
+  unfold neighbourhood in H0; elim H0; intros; unfold included in H1; apply H1;
+    unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+      rewrite Rabs_R0; apply (cond_pos x0).
+  apply H.
 Qed.
 
 Lemma included_trans :
- forall D1 D2 D3:R -> Prop,
-   included D1 D2 -> included D2 D3 -> included D1 D3.
-unfold included in |- *; intros; apply H0; apply H; apply H1.
+  forall D1 D2 D3:R -> Prop,
+    included D1 D2 -> included D2 D3 -> included D1 D3.
+Proof.
+  unfold included in |- *; intros; apply H0; apply H; apply H1.
 Qed.
 
 Lemma interior_P3 : forall D:R -> Prop, open_set (interior D).
-intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *;
- intros; elim H; intros.
-exists x0; unfold included in |- *; intros.
-set (del := x0 - Rabs (x - x1)).
-cut (0 < del).
-intro; exists (mkposreal del H2); intros.
-cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
-intro; assert (H5 := included_trans _ _ _ H4 H0).
-apply H5; apply H3.
-unfold included in |- *; unfold disc in |- *; intros.
-apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)).
-replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
-replace (pos x0) with (del + Rabs (x1 - x)).
-do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
- apply H4.
-unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
- ring.
-unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1));
- rewrite Rplus_0_r;
- replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
- [ idtac | ring ].
-unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1.
+Proof.
+  intro; unfold open_set, interior in |- *; unfold neighbourhood in |- *;
+    intros; elim H; intros.
+  exists x0; unfold included in |- *; intros.
+  set (del := x0 - Rabs (x - x1)).
+  cut (0 < del).
+  intro; exists (mkposreal del H2); intros.
+  cut (included (disc x1 (mkposreal del H2)) (disc x x0)).
+  intro; assert (H5 := included_trans _ _ _ H4 H0).
+  apply H5; apply H3.
+  unfold included in |- *; unfold disc in |- *; intros.
+  apply Rle_lt_trans with (Rabs (x3 - x1) + Rabs (x1 - x)).
+  replace (x3 - x) with (x3 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
+  replace (pos x0) with (del + Rabs (x1 - x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
+    apply H4.
+  unfold del in |- *; rewrite <- (Rabs_Ropp (x - x1)); rewrite Ropp_minus_distr;
+    ring.
+  unfold del in |- *; apply Rplus_lt_reg_r with (Rabs (x - x1));
+    rewrite Rplus_0_r;
+      replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
+      [ idtac | ring ].
+  unfold disc in H1; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1.
 Qed.
 
 Lemma complementary_P1 :
- forall D:R -> Prop,
-   ~ (exists y : R, intersection_domain D (complementary D) y).
-intro; red in |- *; intro; elim H; intros;
- unfold intersection_domain, complementary in H0; elim H0; 
- intros; elim H2; assumption.
+  forall D:R -> Prop,
+    ~ (exists y : R, intersection_domain D (complementary D) y).
+Proof.
+  intro; red in |- *; intro; elim H; intros;
+    unfold intersection_domain, complementary in H0; elim H0; 
+      intros; elim H2; assumption.
 Qed.
 
 Lemma adherence_P2 :
- forall D:R -> Prop, closed_set D -> included (adherence D) D.
-unfold closed_set in |- *; unfold open_set, complementary in |- *; intros;
- unfold included, adherence in |- *; 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.
+  forall D:R -> Prop, closed_set D -> included (adherence D) D.
+Proof.
+  unfold closed_set in |- *; unfold open_set, complementary in |- *; intros;
+    unfold included, adherence in |- *; intros; assert (H1 := classic (D x));
+      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 : forall D:R -> Prop, closed_set (adherence D).
-intro; unfold closed_set, adherence in |- *;
- unfold open_set, complementary, point_adherent in |- *; 
- intros;
- set
-  (P :=
-   fun V:R -> Prop =>
-     neighbourhood V x ->  exists y : R, intersection_domain V D y);
- assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; 
- unfold P in H1; assert (H2 := imply_to_and _ _ H1);
- unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3;
- elim H3; intros; exists x0; unfold included in |- *; 
- intros; red in |- *; intro.
-assert (H8 := H7 V0);
- cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)).
-intro; assert (H10 := H8 H9); elim H4; assumption.
-cut (0 < x0 - Rabs (x - x1)).
-intro; set (del := mkposreal _ H9); exists del; intros;
- unfold included in H5; apply H5; unfold disc in |- *;
- apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)).
-replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
-replace (pos x0) with (del + Rabs (x1 - x)).
-do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
- apply H10.
-unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1));
- rewrite Ropp_minus_distr; ring.
-apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r;
- replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
- [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ].
+Proof.
+  intro; unfold closed_set, adherence in |- *;
+    unfold open_set, complementary, point_adherent in |- *; 
+      intros;
+        set
+          (P :=
+            fun V:R -> Prop =>
+              neighbourhood V x ->  exists y : R, intersection_domain V D y);
+          assert (H0 := not_all_ex_not _ P H); elim H0; intros V0 H1; 
+            unfold P in H1; assert (H2 := imply_to_and _ _ H1);
+              unfold neighbourhood in |- *; elim H2; intros; unfold neighbourhood in H3;
+                elim H3; intros; exists x0; unfold included in |- *; 
+                  intros; red in |- *; intro.
+  assert (H8 := H7 V0);
+    cut (exists delta : posreal, (forall x:R, disc x1 delta x -> V0 x)).
+  intro; assert (H10 := H8 H9); elim H4; assumption.
+  cut (0 < x0 - Rabs (x - x1)).
+  intro; set (del := mkposreal _ H9); exists del; intros;
+    unfold included in H5; apply H5; unfold disc in |- *;
+      apply Rle_lt_trans with (Rabs (x2 - x1) + Rabs (x1 - x)).
+  replace (x2 - x) with (x2 - x1 + (x1 - x)); [ apply Rabs_triang | ring ].
+  replace (pos x0) with (del + Rabs (x1 - x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (x1 - x))); apply Rplus_lt_compat_l;
+    apply H10.
+  unfold del in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x1));
+    rewrite Ropp_minus_distr; ring.
+  apply Rplus_lt_reg_r with (Rabs (x - x1)); rewrite Rplus_0_r;
+    replace (Rabs (x - x1) + (x0 - Rabs (x - x1))) with (pos x0);
+    [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H6 | ring ].
 Qed.
 
 Definition eq_Dom (D1 D2:R -> Prop) : Prop :=
@@ -141,231 +152,243 @@ Definition eq_Dom (D1 D2:R -> Prop) : Prop :=
 Infix "=_D" := eq_Dom (at level 70, no associativity).
 
 Lemma open_set_P1 : forall D:R -> Prop, open_set D <-> D =_D interior D.
-intro; split.
-intro; unfold eq_Dom in |- *; split.
-apply interior_P2; assumption.
-apply interior_P1.
-intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *;
- intros; unfold included, interior in H; unfold included in H0;
- apply (H _ H1).
+Proof.
+  intro; split.
+  intro; unfold eq_Dom in |- *; split.
+  apply interior_P2; assumption.
+  apply interior_P1.
+  intro; unfold eq_Dom in H; elim H; clear H; intros; unfold open_set in |- *;
+    intros; unfold included, interior in H; unfold included in H0;
+      apply (H _ H1).
 Qed.
 
 Lemma closed_set_P1 : forall D:R -> Prop, closed_set D <-> D =_D adherence D.
-intro; split.
-intro; unfold eq_Dom in |- *; split.
-apply adherence_P1.
-apply adherence_P2; assumption.
-unfold eq_Dom in |- *; unfold included in |- *; intros;
- assert (H0 := adherence_P3 D); unfold closed_set in H0;
- unfold closed_set in |- *; unfold open_set in |- *; 
- unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x).
-unfold complementary in |- *; unfold complementary in H1; red in |- *; intro;
- elim H; clear H; intros _ H; elim H1; apply (H _ H2).
-assert (H3 := H0 _ H2); unfold neighbourhood in |- *;
- unfold neighbourhood in H3; elim H3; intros; exists x0;
- unfold included in |- *; unfold included in H4; intros;
- assert (H6 := H4 _ H5); unfold complementary in H6;
- unfold complementary in |- *; red in |- *; intro; 
- elim H; clear H; intros H _; elim H6; apply (H _ H7).
+Proof.
+  intro; split.
+  intro; unfold eq_Dom in |- *; split.
+  apply adherence_P1.
+  apply adherence_P2; assumption.
+  unfold eq_Dom in |- *; unfold included in |- *; intros;
+    assert (H0 := adherence_P3 D); unfold closed_set in H0;
+      unfold closed_set in |- *; unfold open_set in |- *; 
+        unfold open_set in H0; intros; assert (H2 : complementary (adherence D) x).
+  unfold complementary in |- *; unfold complementary in H1; red in |- *; intro;
+    elim H; clear H; intros _ H; elim H1; apply (H _ H2).
+  assert (H3 := H0 _ H2); unfold neighbourhood in |- *;
+    unfold neighbourhood in H3; elim H3; intros; exists x0;
+      unfold included in |- *; unfold included in H4; intros;
+        assert (H6 := H4 _ H5); unfold complementary in H6;
+          unfold complementary in |- *; red in |- *; intro; 
+            elim H; clear H; intros H _; elim H6; apply (H _ H7).
 Qed.
 
 Lemma neighbourhood_P1 :
- forall (D1 D2:R -> Prop) (x:R),
-   included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x.
-unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0;
- intros; unfold included in |- *; unfold included in H1; 
- intros; apply (H _ (H1 _ H2)).
+  forall (D1 D2:R -> Prop) (x:R),
+    included D1 D2 -> neighbourhood D1 x -> neighbourhood D2 x.
+Proof.
+  unfold included, neighbourhood in |- *; intros; elim H0; intros; exists x0;
+    intros; unfold included in |- *; unfold included in H1; 
+      intros; apply (H _ (H1 _ H2)).
 Qed.
 
 Lemma open_set_P2 :
- forall D1 D2:R -> Prop,
-   open_set D1 -> open_set D2 -> open_set (union_domain D1 D2).
-unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro.
-apply neighbourhood_P1 with D1.
-unfold included, union_domain in |- *; tauto.
-apply H; assumption.
-apply neighbourhood_P1 with D2.
-unfold included, union_domain in |- *; tauto.
-apply H0; assumption.
+  forall D1 D2:R -> Prop,
+    open_set D1 -> open_set D2 -> open_set (union_domain D1 D2).
+Proof.
+  unfold open_set in |- *; intros; unfold union_domain in H1; elim H1; intro.
+  apply neighbourhood_P1 with D1.
+  unfold included, union_domain in |- *; tauto.
+  apply H; assumption.
+  apply neighbourhood_P1 with D2.
+  unfold included, union_domain in |- *; tauto.
+  apply H0; assumption.
 Qed.
 
 Lemma open_set_P3 :
- forall D1 D2:R -> Prop,
-   open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2).
-unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1;
- intros.
-assert (H4 := H _ H2); assert (H5 := H0 _ H3);
- unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; 
- elim H4; clear H; intros del1 H; elim H5; clear H0; 
- intros del2 H0; cut (0 < Rmin del1 del2).
-intro; set (del := mkposreal _ H6).
-exists del; unfold included in |- *; intros; unfold included in H, H0;
- unfold disc in H, H0, H7.
-split.
-apply H; apply Rlt_le_trans with (pos del).
-apply H7.
-unfold del in |- *; simpl in |- *; apply Rmin_l.
-apply H0; apply Rlt_le_trans with (pos del).
-apply H7.
-unfold del in |- *; simpl in |- *; apply Rmin_r.
-unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
-apply (cond_pos del1).
-apply (cond_pos del2).
+  forall D1 D2:R -> Prop,
+    open_set D1 -> open_set D2 -> open_set (intersection_domain D1 D2).
+Proof.
+  unfold open_set in |- *; intros; unfold intersection_domain in H1; elim H1;
+    intros.
+  assert (H4 := H _ H2); assert (H5 := H0 _ H3);
+    unfold intersection_domain in |- *; unfold neighbourhood in H4, H5; 
+      elim H4; clear H; intros del1 H; elim H5; clear H0; 
+        intros del2 H0; cut (0 < Rmin del1 del2).
+  intro; set (del := mkposreal _ H6).
+  exists del; unfold included in |- *; intros; unfold included in H, H0;
+    unfold disc in H, H0, H7.
+  split.
+  apply H; apply Rlt_le_trans with (pos del).
+  apply H7.
+  unfold del in |- *; simpl in |- *; apply Rmin_l.
+  apply H0; apply Rlt_le_trans with (pos del).
+  apply H7.
+  unfold del in |- *; simpl in |- *; apply Rmin_r.
+  unfold Rmin in |- *; case (Rle_dec del1 del2); intro.
+  apply (cond_pos del1).
+  apply (cond_pos del2).
 Qed.
 
 Lemma open_set_P4 : open_set (fun x:R => False).
-unfold open_set in |- *; intros; elim H.
+Proof.
+  unfold open_set in |- *; intros; elim H.
 Qed.
 
 Lemma open_set_P5 : open_set (fun x:R => True).
-unfold open_set in |- *; intros; unfold neighbourhood in |- *.
-exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial.
+Proof.
+  unfold open_set in |- *; intros; unfold neighbourhood in |- *.
+  exists (mkposreal 1 Rlt_0_1); unfold included in |- *; intros; trivial.
 Qed.
 
 Lemma disc_P1 : forall (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 in |- *; split.
-unfold included, interior, disc in |- *; intros;
- cut (0 < del - Rabs (x - x0)).
-intro; set (del2 := mkposreal _ H3).
-exists del2; unfold included in |- *; intros.
-apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)).
-replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
-replace (pos del) with (del2 + Rabs (x0 - x)).
-do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l.
-apply H4.
-unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0));
- rewrite Ropp_minus_distr; ring.
-apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r;
- replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del);
- [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ].
-apply interior_P1.
+Proof.
+  intros; assert (H := open_set_P1 (disc x del)).
+  elim H; intros; apply H1.
+  unfold eq_Dom in |- *; split.
+  unfold included, interior, disc in |- *; intros;
+    cut (0 < del - Rabs (x - x0)).
+  intro; set (del2 := mkposreal _ H3).
+  exists del2; unfold included in |- *; intros.
+  apply Rle_lt_trans with (Rabs (x1 - x0) + Rabs (x0 - x)).
+  replace (x1 - x) with (x1 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
+  replace (pos del) with (del2 + Rabs (x0 - x)).
+  do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l.
+  apply H4.
+  unfold del2 in |- *; simpl in |- *; rewrite <- (Rabs_Ropp (x - x0));
+    rewrite Ropp_minus_distr; ring.
+  apply Rplus_lt_reg_r with (Rabs (x - x0)); rewrite Rplus_0_r;
+    replace (Rabs (x - x0) + (del - Rabs (x - x0))) with (pos del);
+    [ rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2 | ring ].
+  apply interior_P1.
 Qed.
 
 Lemma continuity_P1 :
- forall (f:R -> R) (x:R),
-   continuity_pt f x <->
-   (forall W:R -> Prop,
+  forall (f:R -> R) (x:R),
+    continuity_pt f x <->
+    (forall W:R -> Prop,
       neighbourhood W (f x) ->
-       exists V : R -> Prop,
+      exists V : R -> Prop,
         neighbourhood V x /\ (forall 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 in |- *.
-exists (mkposreal del2 H4).
-unfold included in |- *; intros; assumption.
-intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro.
-rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply (cond_pos del1).
-apply H5; split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-apply (sym_not_eq (A:=R)); apply H7.
-unfold disc in H6; apply H6.
-intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- intros.
-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 in |- *;
- unfold R_dist in |- *; apply (H6 _ (H7 _ H10)).
-unfold neighbourhood, disc in |- *; exists (mkposreal eps H0);
- unfold included in |- *; intros; assumption.
+Proof.
+  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 in |- *.
+  exists (mkposreal del2 H4).
+  unfold included in |- *; intros; assumption.
+  intros; apply H1; unfold disc in |- *; case (Req_dec y x); intro.
+  rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply (cond_pos del1).
+  apply H5; split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  apply (sym_not_eq (A:=R)); apply H7.
+  unfold disc in H6; apply H6.
+  intros; unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      intros.
+  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 in |- *;
+    unfold R_dist in |- *; apply (H6 _ (H7 _ H10)).
+  unfold neighbourhood, disc in |- *; exists (mkposreal eps H0);
+    unfold included in |- *; intros; assumption.
 Qed.
 
 Definition image_rec (f:R -> R) (D:R -> Prop) (x:R) : Prop := D (f x).
 
 (**********)
 Lemma continuity_P2 :
- forall (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 in |- *; intros;
- assert (H2 := continuity_P1 f x); elim H2; intros H3 _;
- assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *;
- unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); 
- elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; 
- elim H7; intros del H9; exists del; unfold included in H9;
- unfold included in |- *; intros; apply (H8 _ (H9 _ H10)).
+  forall (f:R -> R) (D:R -> Prop),
+    continuity f -> open_set D -> open_set (image_rec f D).
+Proof.
+  intros; unfold open_set in H0; unfold open_set in |- *; intros;
+    assert (H2 := continuity_P1 f x); elim H2; intros H3 _;
+      assert (H4 := H3 (H x)); unfold neighbourhood, image_rec in |- *;
+        unfold image_rec in H1; assert (H5 := H4 D (H0 (f x) H1)); 
+          elim H5; intros V0 H6; elim H6; intros; unfold neighbourhood in H7; 
+            elim H7; intros del H9; exists del; unfold included in H9;
+              unfold included in |- *; intros; apply (H8 _ (H9 _ H10)).
 Qed.
 
 (**********)
 Lemma continuity_P3 :
- forall f:R -> R,
-   continuity f <->
-   (forall D:R -> Prop, open_set D -> open_set (image_rec f D)).
-intros; split.
-intros; apply continuity_P2; assumption.
-intros; unfold continuity in |- *; unfold continuity_pt in |- *;
- unfold continue_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros; 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 in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply H0.
-apply disc_P1.
+  forall f:R -> R,
+    continuity f <->
+    (forall D:R -> Prop, open_set D -> open_set (image_rec f D)).
+Proof.
+  intros; split.
+  intros; apply continuity_P2; assumption.
+  intros; unfold continuity in |- *; unfold continuity_pt in |- *;
+    unfold continue_in in |- *; unfold limit1_in in |- *;
+      unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
+        intros; 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 in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; apply H0.
+  apply disc_P1.
 Qed.
 
 (**********)
 Theorem Rsepare :
- forall x y:R,
-   x <> y ->
+  forall x y:R,
+    x <> y ->
     exists V : R -> Prop,
-     (exists W : R -> Prop,
+      (exists W : R -> Prop,
         neighbourhood V x /\
         neighbourhood W y /\ ~ (exists y : R, intersection_domain V W y)).
-intros x y Hsep; set (D := Rabs (x - y)).
-cut (0 < D / 2).
-intro; exists (disc x (mkposreal _ H)).
-exists (disc y (mkposreal _ H)); split.
-unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
- tauto.
-split.
-unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
- tauto.
-red in |- *; intro; elim H0; intros; unfold intersection_domain in H1;
- elim H1; intros.
-cut (D < D).
-intro; elim (Rlt_irrefl _ H4).
-change (Rabs (x - y) < D) in |- *;
- apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)).
-replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ].
-rewrite (double_var D); apply Rplus_lt_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2.
-apply H3.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep).
-apply Rinv_0_lt_compat; prove_sup0.
+Proof.
+  intros x y Hsep; set (D := Rabs (x - y)).
+  cut (0 < D / 2).
+  intro; exists (disc x (mkposreal _ H)).
+  exists (disc y (mkposreal _ H)); split.
+  unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+    tauto.
+  split.
+  unfold neighbourhood in |- *; exists (mkposreal _ H); unfold included in |- *;
+    tauto.
+  red in |- *; intro; elim H0; intros; unfold intersection_domain in H1;
+    elim H1; intros.
+  cut (D < D).
+  intro; elim (Rlt_irrefl _ H4).
+  change (Rabs (x - y) < D) in |- *;
+    apply Rle_lt_trans with (Rabs (x - x0) + Rabs (x0 - y)).
+  replace (x - y) with (x - x0 + (x0 - y)); [ apply Rabs_triang | ring ].
+  rewrite (double_var D); apply Rplus_lt_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H2.
+  apply H3.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  unfold D in |- *; apply Rabs_pos_lt; apply (Rminus_eq_contra _ _ Hsep).
+  apply Rinv_0_lt_compat; prove_sup0.
 Qed.
 
 Record family : Type := mkfamily
   {ind : R -> Prop;
-   f :> R -> R -> Prop;
-   cond_fam : forall x:R, (exists y : R, f x y) -> ind x}.
+    f :> R -> R -> Prop;
+    cond_fam : forall x:R, (exists y : R, f x y) -> ind x}.
 
 Definition family_open_set (f:family) : Prop := forall x:R, open_set (f x).
 
 Definition domain_finite (D:R -> Prop) : Prop :=
-   exists l : Rlist, (forall x:R, D x <-> In x l).
+  exists l : Rlist, (forall x:R, D x <-> In x l).
 
 Definition family_finite (f:family) : Prop := domain_finite (ind f).
 
@@ -379,897 +402,913 @@ Definition covering_finite (D:R -> Prop) (f:family) : Prop :=
   covering D f /\ family_finite f.
 
 Lemma restriction_family :
- forall (f:family) (D:R -> Prop) (x:R),
-   (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) ->
-   intersection_domain (ind f) D x.
-intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros;
- split.
-apply (cond_fam f0); exists x0; assumption.
-assumption.
+  forall (f:family) (D:R -> Prop) (x:R),
+    (exists y : R, (fun z1 z2:R => f z1 z2 /\ D z1) x y) ->
+    intersection_domain (ind f) D x.
+Proof.
+  intros; elim H; intros; unfold intersection_domain in |- *; elim H0; intros;
+    split.
+  apply (cond_fam f0); exists x0; assumption.
+  assumption.
 Qed.
 
 Definition subfamily (f:family) (D:R -> Prop) : family :=
   mkfamily (intersection_domain (ind f) D) (fun x y:R => f x y /\ D x)
-    (restriction_family f D).
+  (restriction_family f D).
 
 Definition compact (X:R -> Prop) : Prop :=
   forall f:family,
     covering_open_set X f ->
-     exists D : R -> Prop, covering_finite X (subfamily f D).
+    exists D : R -> Prop, covering_finite X (subfamily f D).
 
 (**********)
 Lemma family_P1 :
- forall (f:family) (D:R -> Prop),
-   family_open_set f -> family_open_set (subfamily f D).
-unfold family_open_set in |- *; intros; unfold subfamily in |- *;
- simpl in |- *; assert (H0 := classic (D x)).
-elim H0; intro.
-cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)).
-intro; apply H2; apply H.
-unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
- intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1;
- unfold included in |- *; intros; split.
-apply (H7 _ H8).
-assumption.
-cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)).
-intro; apply H2; apply open_set_P4.
-unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
- intros; elim H1; assumption.
+  forall (f:family) (D:R -> Prop),
+    family_open_set f -> family_open_set (subfamily f D).
+Proof.
+  unfold family_open_set in |- *; intros; unfold subfamily in |- *;
+    simpl in |- *; assert (H0 := classic (D x)).
+  elim H0; intro.
+  cut (open_set (f0 x) -> open_set (fun y:R => f0 x y /\ D x)).
+  intro; apply H2; apply H.
+  unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+    intros; assert (H6 := H2 _ H4); elim H6; intros; exists x1;
+      unfold included in |- *; intros; split.
+  apply (H7 _ H8).
+  assumption.
+  cut (open_set (fun y:R => False) -> open_set (fun y:R => f0 x y /\ D x)).
+  intro; apply H2; apply open_set_P4.
+  unfold open_set in |- *; unfold neighbourhood in |- *; intros; elim H3;
+    intros; elim H1; assumption.
 Qed.
 
 Definition bounded (D:R -> Prop) : Prop :=
-   exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)).
+  exists m : R, (exists M : R, (forall x:R, D x -> m <= x <= M)).
 
 Lemma open_set_P6 :
- forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2.
-unfold open_set in |- *; unfold neighbourhood in |- *; 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.
+  forall D1 D2:R -> Prop, open_set D1 -> D1 =_D D2 -> open_set D2.
+Proof.
+  unfold open_set in |- *; unfold neighbourhood in |- *; 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 : forall X:R -> Prop, compact X -> bounded X.
-intros; unfold compact in H; set (D := fun x:R => True);
- set (g := fun x y:R => Rabs y < x);
- cut (forall x:R, (exists y : _, g x y) -> True);
- [ intro | intro; trivial ].
-set (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 in |- *; set (r := MaxRlist l).
-exists (- r); exists r; intros.
-unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros;
- unfold subfamily in H10; simpl in H10; elim H10; intros;
- 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 (Rabs x < r).
-intro; assert (H19 := Rabs_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 (Rabs x).
-apply RRle_abs.
-apply Rle_trans with x0.
-left; apply H11.
-assumption.
-apply (MaxRlist_P1 l x0 H16).
-unfold intersection_domain, D in |- *; tauto.
-unfold covering_open_set in |- *; split.
-unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1);
- unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_lt_compat_l; apply Rlt_0_1.
-unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro.
-apply open_set_P6 with (disc 0 (mkposreal _ H2)).
-apply disc_P1.
-unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *;
- unfold g, disc in |- *; split.
-unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3;
- rewrite Rplus_0_r in H3; apply H3.
-unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; apply H3.
-apply open_set_P6 with (fun x:R => False).
-apply open_set_P4.
-unfold eq_Dom in |- *; split.
-unfold included in |- *; intros; elim H3.
-unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2;
- intro;
- [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0);
-    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3))
- | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4);
-    elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ].
+Proof.
+  intros; unfold compact in H; set (D := fun x:R => True);
+    set (g := fun x y:R => Rabs y < x);
+      cut (forall x:R, (exists y : _, g x y) -> True);
+        [ intro | intro; trivial ].
+  set (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 in |- *; set (r := MaxRlist l).
+  exists (- r); exists r; intros.
+  unfold covering in H5; assert (H9 := H5 _ H8); elim H9; intros;
+    unfold subfamily in H10; simpl in H10; elim H10; intros;
+      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 (Rabs x < r).
+  intro; assert (H19 := Rabs_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 (Rabs x).
+  apply RRle_abs.
+  apply Rle_trans with x0.
+  left; apply H11.
+  assumption.
+  apply (MaxRlist_P1 l x0 H16).
+  unfold intersection_domain, D in |- *; tauto.
+  unfold covering_open_set in |- *; split.
+  unfold covering in |- *; intros; simpl in |- *; exists (Rabs x + 1);
+    unfold g in |- *; pattern (Rabs x) at 1 in |- *; rewrite <- Rplus_0_r;
+      apply Rplus_lt_compat_l; apply Rlt_0_1.
+  unfold family_open_set in |- *; intro; case (Rtotal_order 0 x); intro.
+  apply open_set_P6 with (disc 0 (mkposreal _ H2)).
+  apply disc_P1.
+  unfold eq_Dom in |- *; unfold f0 in |- *; simpl in |- *;
+    unfold g, disc in |- *; split.
+  unfold included in |- *; intros; unfold Rminus in H3; rewrite Ropp_0 in H3;
+    rewrite Rplus_0_r in H3; apply H3.
+  unfold included in |- *; intros; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; apply H3.
+  apply open_set_P6 with (fun x:R => False).
+  apply open_set_P4.
+  unfold eq_Dom in |- *; split.
+  unfold included in |- *; intros; elim H3.
+  unfold included, f0 in |- *; simpl in |- *; unfold g in |- *; intros; elim H2;
+    intro;
+      [ rewrite <- H4 in H3; assert (H5 := Rabs_pos x0);
+        elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H5 H3))
+        | assert (H6 := Rabs_pos x0); assert (H7 := Rlt_trans _ _ _ H3 H4);
+          elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 H7)) ].
 Qed.
 
 (**********)
 Lemma compact_P2 : forall 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 in |- *; split.
-apply adherence_P1.
-unfold included in |- *; unfold adherence in |- *;
- unfold point_adherent in |- *; intros; unfold compact in H;
- assert (H1 := classic (X x)); elim H1; clear H1; intro.
-assumption.
-cut (forall y:R, X y -> 0 < Rabs (y - x) / 2).
-intro; set (D := X);
- set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y);
- cut (forall x:R, (exists y : _, g x y) -> D x).
-intro; set (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;
- set (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 <= Rabs (y0 - x) / 2).
-intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17);
- cut (Rabs (y0 - x) < Rabs (y0 - x)).
-intro; elim (Rlt_irrefl _ H19).
-apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)).
-replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ].
-rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption.
-apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1;
- elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *;
- split; assumption.
-assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11;
- apply H11.
-unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply H9.
-unfold alp in |- *; apply MinRlist_P2; intros;
- assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; 
- intros z H10; elim H10; clear H10; intros; rewrite H11; 
- apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10);
- unfold intersection_domain, D in H13; elim H13; clear H13; 
- intros; assumption.
-unfold covering_open_set in |- *; split.
-unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *;
- split.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- unfold Rminus in H2; apply (H2 _ H5).
-apply H5.
-unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *;
- elim (classic (D x0)); intro.
-apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))).
-apply disc_P1.
-unfold eq_Dom in |- *; split.
-unfold included, disc in |- *; simpl in |- *; intros; split.
-rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6.
-apply H5.
-unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros;
- rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; 
- apply H7.
-apply open_set_P6 with (fun z:R => False).
-apply open_set_P4.
-unfold eq_Dom in |- *; split.
-unfold included in |- *; intros; elim H6.
-unfold included in |- *; intros; elim H6; intros; elim H5; assumption.
-intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4;
- apply H4.
-intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro;
- rewrite H3 in H2; elim H1; apply H2.
-apply Rinv_0_lt_compat; prove_sup0.
+Proof.
+  intros; assert (H0 := closed_set_P1 X); elim H0; clear H0; intros _ H0;
+    apply H0; clear H0.
+  unfold eq_Dom in |- *; split.
+  apply adherence_P1.
+  unfold included in |- *; unfold adherence in |- *;
+    unfold point_adherent in |- *; intros; unfold compact in H;
+      assert (H1 := classic (X x)); elim H1; clear H1; intro.
+  assumption.
+  cut (forall y:R, X y -> 0 < Rabs (y - x) / 2).
+  intro; set (D := X);
+    set (g := fun y z:R => Rabs (y - z) < Rabs (y - x) / 2 /\ D y);
+      cut (forall x:R, (exists y : _, g x y) -> D x).
+  intro; set (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;
+          set (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 <= Rabs (y0 - x) / 2).
+  intro; assert (H18 := Rlt_le_trans _ _ _ H12 H17);
+    cut (Rabs (y0 - x) < Rabs (y0 - x)).
+  intro; elim (Rlt_irrefl _ H19).
+  apply Rle_lt_trans with (Rabs (y0 - y) + Rabs (y - x)).
+  replace (y0 - x) with (y0 - y + (y - x)); [ apply Rabs_triang | ring ].
+  rewrite (double_var (Rabs (y0 - x))); apply Rplus_lt_compat; assumption.
+  apply (MinRlist_P1 (AbsList l x) (Rabs (y0 - x) / 2)); apply AbsList_P1;
+    elim (H8 y0); clear H8; intros; apply H8; unfold intersection_domain in |- *;
+      split; assumption.
+  assert (H11 := disc_P1 x (mkposreal alp H9)); unfold open_set in H11;
+    apply H11.
+  unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; apply H9.
+  unfold alp in |- *; apply MinRlist_P2; intros;
+    assert (H10 := AbsList_P2 _ _ _ H9); elim H10; clear H10; 
+      intros z H10; elim H10; clear H10; intros; rewrite H11; 
+        apply H2; elim (H8 z); clear H8; intros; assert (H13 := H12 H10);
+          unfold intersection_domain, D in H13; elim H13; clear H13; 
+            intros; assumption.
+  unfold covering_open_set in |- *; split.
+  unfold covering in |- *; intros; exists x0; simpl in |- *; unfold g in |- *;
+    split.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    unfold Rminus in H2; apply (H2 _ H5).
+  apply H5.
+  unfold family_open_set in |- *; intro; simpl in |- *; unfold g in |- *;
+    elim (classic (D x0)); intro.
+  apply open_set_P6 with (disc x0 (mkposreal _ (H2 _ H5))).
+  apply disc_P1.
+  unfold eq_Dom in |- *; split.
+  unfold included, disc in |- *; simpl in |- *; intros; split.
+  rewrite <- (Rabs_Ropp (x0 - x1)); rewrite Ropp_minus_distr; apply H6.
+  apply H5.
+  unfold included, disc in |- *; simpl in |- *; intros; elim H6; intros;
+    rewrite <- (Rabs_Ropp (x1 - x0)); rewrite Ropp_minus_distr; 
+      apply H7.
+  apply open_set_P6 with (fun z:R => False).
+  apply open_set_P4.
+  unfold eq_Dom in |- *; split.
+  unfold included in |- *; intros; elim H6.
+  unfold included in |- *; intros; elim H6; intros; elim H5; assumption.
+  intros; elim H3; intros; unfold g in H4; elim H4; clear H4; intros _ H4;
+    apply H4.
+  intros; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt; apply Rminus_eq_contra; red in |- *; intro;
+    rewrite H3 in H2; elim H1; apply H2.
+  apply Rinv_0_lt_compat; prove_sup0.
 Qed.
 
 (**********)
 Lemma compact_EMP : compact (fun _:R => False).
-unfold compact in |- *; intros; exists (fun x:R => False);
- unfold covering_finite in |- *; split.
-unfold covering in |- *; intros; elim H0.
-unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro.
-split.
-simpl in |- *; unfold intersection_domain in |- *; intros; elim H0.
-elim H0; clear H0; intros _ H0; elim H0.
-simpl in |- *; intro; elim H0.
+Proof.
+  unfold compact in |- *; intros; exists (fun x:R => False);
+    unfold covering_finite in |- *; split.
+  unfold covering in |- *; intros; elim H0.
+  unfold family_finite in |- *; unfold domain_finite in |- *; exists nil; intro.
+  split.
+  simpl in |- *; unfold intersection_domain in |- *; intros; elim H0.
+  elim H0; clear H0; intros _ H0; elim H0.
+  simpl in |- *; intro; elim H0.
 Qed.
 
 Lemma compact_eqDom :
- forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2.
-unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0;
- unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0).
-unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1;
- clear H1; intros; split.
-unfold covering in H1; unfold covering in |- *; intros;
- apply (H1 _ (H0 _ H4)).
-apply H3.
-elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *;
- unfold covering_finite in H4; elim H4; intros; split.
-unfold covering in H5; unfold covering in |- *; intros;
- apply (H5 _ (H2 _ H7)).
-apply H6.
+  forall X1 X2:R -> Prop, compact X1 -> X1 =_D X2 -> compact X2.
+Proof.
+  unfold compact in |- *; intros; unfold eq_Dom in H0; elim H0; clear H0;
+    unfold included in |- *; intros; assert (H3 : covering_open_set X1 f0).
+  unfold covering_open_set in |- *; unfold covering_open_set in H1; elim H1;
+    clear H1; intros; split.
+  unfold covering in H1; unfold covering in |- *; intros;
+    apply (H1 _ (H0 _ H4)).
+  apply H3.
+  elim (H _ H3); intros D H4; exists D; unfold covering_finite in |- *;
+    unfold covering_finite in H4; elim H4; intros; split.
+  unfold covering in H5; unfold covering in |- *; intros;
+    apply (H5 _ (H2 _ H7)).
+  apply H6.
 Qed.
 
-(* Borel-Lebesgue's lemma *)
+(** Borel-Lebesgue's lemma *)
 Lemma compact_P3 : forall a b:R, compact (fun c:R => a <= c <= b).
-intros; case (Rle_dec a b); intro.
-unfold compact in |- *; intros;
- set
-  (A :=
-   fun x:R =>
-     a <= x <= b /\
-     (exists D : R -> Prop,
-        covering_finite (fun c:R => a <= c <= x) (subfamily f0 D)));
- cut (A a).
-intro; cut (bound A).
-intro; cut (exists a0 : R, A a0).
-intro; assert (H3 := completeness 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 (exists x : R, A x /\ m - eps < x <= m).
-intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros;
- case (Req_dec 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;
- set (Db := fun x:R => Dx x \/ x = y0); exists Db;
- unfold covering_finite in |- *; split.
-unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
- intros; unfold covering in H12; case (Rle_dec x0 x); 
- intro.
-cut (a <= x0 <= x).
-intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
- simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; 
- clear H16; intros; split; [ apply H16 | left; apply H17 ].
-split.
-elim H14; intros; assumption.
-assumption.
-exists y0; simpl in |- *; split.
-apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
- rewrite Rabs_right.
-apply Rlt_trans with (b - x).
-unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
- auto with real.
-elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps);
- replace (x - eps + (b - x)) with (b - eps);
- [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ].
-apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15.
-unfold Db in |- *; right; reflexivity.
-unfold family_finite in |- *; unfold domain_finite in |- *;
- unfold covering_finite in H12; elim H12; clear H12; 
- intros; unfold family_finite in H13; unfold domain_finite in H13; 
- elim H13; clear H13; intros l H13; exists (cons y0 l); 
- intro; split.
-intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
- clear H13; intros; case (Req_dec x0 y0); intro.
-simpl in |- *; left; apply H16.
-simpl in |- *; right; apply H13.
-simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14;
- decompose [and or] H14.
-split; assumption.
-elim H16; assumption.
-intro; simpl in H14; elim H14; intro; simpl in |- *;
- unfold intersection_domain in |- *.
-split.
-apply (cond_fam f0); rewrite H15; exists m; apply H6.
-unfold Db in |- *; right; assumption.
-simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0).
-intros _ H16; assert (H17 := H16 H15); simpl in H17;
- unfold intersection_domain in H17; split.
-elim H17; intros; assumption.
-unfold Db in |- *; left; elim H17; intros; assumption.
-set (m' := Rmin (m + eps / 2) b); cut (A m').
-intro; elim H3; intros; unfold is_upper_bound in H13;
- assert (H15 := H13 m' H12); cut (m < m').
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)).
-unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
-pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
-elim H4; intros.
-elim H17; intro.
-assumption.
-elim H11; assumption.
-unfold A in |- *; split.
-split.
-apply Rle_trans with m.
-elim H4; intros; assumption.
-unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
-pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
-elim H4; intros.
-elim H13; intro.
-assumption.
-elim H11; assumption.
-unfold m' in |- *; apply Rmin_r.
-unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12;
- set (Db := fun x:R => Dx x \/ x = y0); exists Db;
- unfold covering_finite in |- *; split.
-unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
- intros; unfold covering in H12; case (Rle_dec x0 x); 
- intro.
-cut (a <= x0 <= x).
-intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
- simpl in H16; simpl in |- *; unfold Db in |- *.
-elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ].
-elim H14; intros; split; assumption.
-exists y0; simpl in |- *; split.
-apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m));
- intro.
-rewrite Ropp_minus_distr; apply Rlt_trans with (m - x).
-unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
- auto with real.
-apply Rplus_lt_reg_r with (x - eps);
- replace (x - eps + (m - x)) with (m - eps).
-replace (x - eps + eps) with x.
-elim H10; intros; assumption.
-ring.
-ring.
-apply Rle_lt_trans with (m' - m).
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m));
- apply Rplus_le_compat_l; elim H14; intros; assumption.
-apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'.
-apply Rle_lt_trans with (m + eps / 2).
-unfold m' in |- *; apply Rmin_l.
-apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
- rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
-discrR.
-ring.
-unfold Db in |- *; right; reflexivity.
-unfold family_finite in |- *; unfold domain_finite in |- *;
- unfold covering_finite in H12; elim H12; clear H12; 
- intros; unfold family_finite in H13; unfold domain_finite in H13; 
- elim H13; clear H13; intros l H13; exists (cons y0 l); 
- intro; split.
-intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
- clear H13; intros; case (Req_dec x0 y0); intro.
-simpl in |- *; left; apply H16.
-simpl in |- *; right; apply H13; simpl in |- *;
- unfold intersection_domain in |- *; unfold Db in H14; 
- decompose [and or] H14.
-split; assumption.
-elim H16; assumption.
-intro; simpl in H14; elim H14; intro; simpl in |- *;
- unfold intersection_domain in |- *.
-split.
-apply (cond_fam f0); rewrite H15; exists m; apply H6.
-unfold Db in |- *; right; assumption.
-elim (H13 x0); intros _ H16.
-assert (H17 := H16 H15).
-simpl in H17.
-unfold intersection_domain in H17.
-split.
-elim H17; intros; assumption.
-unfold Db in |- *; left; elim H17; intros; assumption.
-elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro.
-assumption.
-elim H3; intros; cut (is_upper_bound A (m - eps)).
-intro; assert (H13 := H11 _ H12); cut (m - eps < m).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
-pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
- apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive;
- rewrite Ropp_0; apply (cond_pos eps).
-set (P := fun n:R => A n /\ m - eps < n <= m);
- assert (H12 := not_ex_all_not _ P H9); unfold P in H12;
- unfold is_upper_bound in |- *; intros;
- assert (H14 := not_and_or _ _ (H12 x)); elim H14; 
- intro.
-elim H15; apply H13.
-elim (not_and_or _ _ H15); intro.
-case (Rle_dec 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 in |- *; intros; unfold A in H5; elim H5;
- clear H5; intros H5 _; elim H5; clear H5; intros _ H5; 
- apply H5.
-exists a; apply H0.
-unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros;
- unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; 
- clear H1; intros _ H1; apply H1.
-unfold A in |- *; split.
-split; [ right; reflexivity | apply r ].
-unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H;
- cut (a <= a <= b).
-intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D';
- unfold covering_finite in |- *; split.
-unfold covering in |- *; simpl in |- *; intros; cut (x = a).
-intro; exists y0; split.
-rewrite H4; apply H2.
-unfold D' in |- *; reflexivity.
-elim H3; intros; apply Rle_antisym; assumption.
-unfold family_finite in |- *; unfold domain_finite in |- *;
- exists (cons y0 nil); intro; split.
-simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3;
- intros; unfold D' in H4; left; apply H4.
-simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro.
-split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ].
-elim H4.
-split; [ right; reflexivity | apply r ].
-apply compact_eqDom with (fun c:R => False).
-apply compact_EMP.
-unfold eq_Dom in |- *; split.
-unfold included in |- *; intros; elim H.
-unfold included in |- *; intros; elim H; clear H; intros;
- assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1.
+Proof.
+  intros; case (Rle_dec a b); intro.
+  unfold compact in |- *; intros;
+    set
+      (A :=
+        fun x:R =>
+          a <= x <= b /\
+          (exists D : R -> Prop,
+            covering_finite (fun c:R => a <= c <= x) (subfamily f0 D)));
+      cut (A a).
+  intro; cut (bound A).
+  intro; cut (exists a0 : R, A a0).
+  intro; assert (H3 := completeness 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 (exists x : R, A x /\ m - eps < x <= m).
+  intro; elim H9; clear H9; intros x H9; elim H9; clear H9; intros;
+    case (Req_dec 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;
+      set (Db := fun x:R => Dx x \/ x = y0); exists Db;
+        unfold covering_finite in |- *; split.
+  unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+    intros; unfold covering in H12; case (Rle_dec x0 x); 
+      intro.
+  cut (a <= x0 <= x).
+  intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
+    simpl in H16; simpl in |- *; unfold Db in |- *; elim H16; 
+      clear H16; intros; split; [ apply H16 | left; apply H17 ].
+  split.
+  elim H14; intros; assumption.
+  assumption.
+  exists y0; simpl in |- *; split.
+  apply H8; unfold disc in |- *; rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr;
+    rewrite Rabs_right.
+  apply Rlt_trans with (b - x).
+  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+    auto with real.
+  elim H10; intros H15 _; apply Rplus_lt_reg_r with (x - eps);
+    replace (x - eps + (b - x)) with (b - eps);
+    [ replace (x - eps + eps) with x; [ apply H15 | ring ] | ring ].
+  apply Rge_minus; apply Rle_ge; elim H14; intros _ H15; apply H15.
+  unfold Db in |- *; right; reflexivity.
+  unfold family_finite in |- *; unfold domain_finite in |- *;
+    unfold covering_finite in H12; elim H12; clear H12; 
+      intros; unfold family_finite in H13; unfold domain_finite in H13; 
+        elim H13; clear H13; intros l H13; exists (cons y0 l); 
+          intro; split.
+  intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
+    clear H13; intros; case (Req_dec x0 y0); intro.
+  simpl in |- *; left; apply H16.
+  simpl in |- *; right; apply H13.
+  simpl in |- *; unfold intersection_domain in |- *; unfold Db in H14;
+    decompose [and or] H14.
+  split; assumption.
+  elim H16; assumption.
+  intro; simpl in H14; elim H14; intro; simpl in |- *;
+    unfold intersection_domain in |- *.
+  split.
+  apply (cond_fam f0); rewrite H15; exists m; apply H6.
+  unfold Db in |- *; right; assumption.
+  simpl in |- *; unfold intersection_domain in |- *; elim (H13 x0).
+  intros _ H16; assert (H17 := H16 H15); simpl in H17;
+    unfold intersection_domain in H17; split.
+  elim H17; intros; assumption.
+  unfold Db in |- *; left; elim H17; intros; assumption.
+  set (m' := Rmin (m + eps / 2) b); cut (A m').
+  intro; elim H3; intros; unfold is_upper_bound in H13;
+    assert (H15 := H13 m' H12); cut (m < m').
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H15 H16)).
+  unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
+  pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim H4; intros.
+  elim H17; intro.
+  assumption.
+  elim H11; assumption.
+  unfold A in |- *; split.
+  split.
+  apply Rle_trans with m.
+  elim H4; intros; assumption.
+  unfold m' in |- *; unfold Rmin in |- *; case (Rle_dec (m + eps / 2) b); intro.
+  pattern m at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+      [ apply (cond_pos eps) | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim H4; intros.
+  elim H13; intro.
+  assumption.
+  elim H11; assumption.
+  unfold m' in |- *; apply Rmin_r.
+  unfold A in H9; elim H9; clear H9; intros; elim H12; clear H12; intros Dx H12;
+    set (Db := fun x:R => Dx x \/ x = y0); exists Db;
+      unfold covering_finite in |- *; split.
+  unfold covering in |- *; unfold covering_finite in H12; elim H12; clear H12;
+    intros; unfold covering in H12; case (Rle_dec x0 x); 
+      intro.
+  cut (a <= x0 <= x).
+  intro; assert (H16 := H12 x0 H15); elim H16; clear H16; intros; exists x1;
+    simpl in H16; simpl in |- *; unfold Db in |- *.
+  elim H16; clear H16; intros; split; [ apply H16 | left; apply H17 ].
+  elim H14; intros; split; assumption.
+  exists y0; simpl in |- *; split.
+  apply H8; unfold disc in |- *; unfold Rabs in |- *; case (Rcase_abs (x0 - m));
+    intro.
+  rewrite Ropp_minus_distr; apply Rlt_trans with (m - x).
+  unfold Rminus in |- *; apply Rplus_lt_compat_l; apply Ropp_lt_gt_contravar;
+    auto with real.
+  apply Rplus_lt_reg_r with (x - eps);
+    replace (x - eps + (m - x)) with (m - eps).
+  replace (x - eps + eps) with x.
+  elim H10; intros; assumption.
+  ring.
+  ring.
+  apply Rle_lt_trans with (m' - m).
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- m));
+    apply Rplus_le_compat_l; elim H14; intros; assumption.
+  apply Rplus_lt_reg_r with m; replace (m + (m' - m)) with m'.
+  apply Rle_lt_trans with (m + eps / 2).
+  unfold m' in |- *; apply Rmin_l.
+  apply Rplus_lt_compat_l; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (/ 2)); rewrite <- Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; pattern (pos eps) at 1 in |- *; rewrite <- Rplus_0_r;
+    rewrite double; apply Rplus_lt_compat_l; apply (cond_pos eps).
+  discrR.
+  ring.
+  unfold Db in |- *; right; reflexivity.
+  unfold family_finite in |- *; unfold domain_finite in |- *;
+    unfold covering_finite in H12; elim H12; clear H12; 
+      intros; unfold family_finite in H13; unfold domain_finite in H13; 
+        elim H13; clear H13; intros l H13; exists (cons y0 l); 
+          intro; split.
+  intro; simpl in H14; unfold intersection_domain in H14; elim (H13 x0);
+    clear H13; intros; case (Req_dec x0 y0); intro.
+  simpl in |- *; left; apply H16.
+  simpl in |- *; right; apply H13; simpl in |- *;
+    unfold intersection_domain in |- *; unfold Db in H14; 
+      decompose [and or] H14.
+  split; assumption.
+  elim H16; assumption.
+  intro; simpl in H14; elim H14; intro; simpl in |- *;
+    unfold intersection_domain in |- *.
+  split.
+  apply (cond_fam f0); rewrite H15; exists m; apply H6.
+  unfold Db in |- *; right; assumption.
+  elim (H13 x0); intros _ H16.
+  assert (H17 := H16 H15).
+  simpl in H17.
+  unfold intersection_domain in H17.
+  split.
+  elim H17; intros; assumption.
+  unfold Db in |- *; left; elim H17; intros; assumption.
+  elim (classic (exists x : R, A x /\ m - eps < x <= m)); intro.
+  assumption.
+  elim H3; intros; cut (is_upper_bound A (m - eps)).
+  intro; assert (H13 := H11 _ H12); cut (m - eps < m).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H13 H14)).
+  pattern m at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+    apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_involutive;
+      rewrite Ropp_0; apply (cond_pos eps).
+  set (P := fun n:R => A n /\ m - eps < n <= m);
+    assert (H12 := not_ex_all_not _ P H9); unfold P in H12;
+      unfold is_upper_bound in |- *; intros;
+        assert (H14 := not_and_or _ _ (H12 x)); elim H14; 
+          intro.
+  elim H15; apply H13.
+  elim (not_and_or _ _ H15); intro.
+  case (Rle_dec 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 in |- *; intros; unfold A in H5; elim H5;
+    clear H5; intros H5 _; elim H5; clear H5; intros _ H5; 
+      apply H5.
+  exists a; apply H0.
+  unfold bound in |- *; exists b; unfold is_upper_bound in |- *; intros;
+    unfold A in H1; elim H1; clear H1; intros H1 _; elim H1; 
+      clear H1; intros _ H1; apply H1.
+  unfold A in |- *; split.
+  split; [ right; reflexivity | apply r ].
+  unfold covering_open_set in H; elim H; clear H; intros; unfold covering in H;
+    cut (a <= a <= b).
+  intro; elim (H _ H1); intros y0 H2; set (D' := fun x:R => x = y0); exists D';
+    unfold covering_finite in |- *; split.
+  unfold covering in |- *; simpl in |- *; intros; cut (x = a).
+  intro; exists y0; split.
+  rewrite H4; apply H2.
+  unfold D' in |- *; reflexivity.
+  elim H3; intros; apply Rle_antisym; assumption.
+  unfold family_finite in |- *; unfold domain_finite in |- *;
+    exists (cons y0 nil); intro; split.
+  simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; clear H3;
+    intros; unfold D' in H4; left; apply H4.
+  simpl in |- *; unfold intersection_domain in |- *; intro; elim H3; intro.
+  split; [ rewrite H4; apply (cond_fam f0); exists a; apply H2 | apply H4 ].
+  elim H4.
+  split; [ right; reflexivity | apply r ].
+  apply compact_eqDom with (fun c:R => False).
+  apply compact_EMP.
+  unfold eq_Dom in |- *; split.
+  unfold included in |- *; intros; elim H.
+  unfold included in |- *; intros; elim H; clear H; intros;
+    assert (H1 := Rle_trans _ _ _ H H0); elim n; apply H1.
 Qed.
 
 Lemma compact_P4 :
- forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F.
-unfold compact in |- *; intros; elim (classic (exists z : R, F z));
- intro Hyp_F_NE.
-set (D := ind f0); set (g := f f0); unfold closed_set in H0.
-set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x).
-set (D' := D).
-cut (forall x:R, (exists y : R, g' x y) -> D' x).
-intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f').
-intro; elim (H _ H4); intros DX H5; exists DX.
-unfold covering_finite in |- *; unfold covering_finite in H5; elim H5;
- clear H5; intros.
-split.
-unfold covering in |- *; unfold covering in H5; intros.
-elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *;
- elim H8; clear H8; intros.
-split.
-unfold g' in H8; elim H8; intro.
-apply H10.
-elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7.
-apply H9.
-unfold family_finite in |- *; unfold domain_finite in |- *;
- unfold family_finite in H6; unfold domain_finite in H6; 
- elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x);
- elim H7; clear H7; intros.
-split.
-intro; apply H7; simpl in |- *; unfold intersection_domain in |- *;
- simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; 
- apply H9.
-intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10;
- simpl in |- *; unfold intersection_domain in |- *; 
- unfold D' in H10; apply H10.
-unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2;
- clear H2; intros.
-split.
-unfold covering in |- *; unfold covering in H2; intros.
-elim (classic (F x)); intro.
-elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *;
- left; assumption.
-cut (exists z : R, D z).
-intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *;
- unfold g' in |- *; right.
-split.
-unfold complementary in |- *; apply H6.
-apply H7.
-elim Hyp_F_NE; intros z0 H7.
-assert (H8 := H2 _ H7).
-elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0;
- apply H8.
-unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *;
- elim (classic (D x)); intro.
-apply open_set_P6 with (union_domain (f0 x) (complementary F)).
-apply open_set_P2.
-unfold family_open_set in H4; apply H4.
-apply H0.
-unfold eq_Dom in |- *; split.
-unfold included, union_domain, complementary in |- *; intros.
-elim H6; intro; [ left; apply H7 | right; split; assumption ].
-unfold included, union_domain, complementary in |- *; intros.
-elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ].
-apply open_set_P6 with (f0 x).
-unfold family_open_set in H4; apply H4.
-unfold eq_Dom in |- *; split.
-unfold included, complementary in |- *; intros; left; apply H6.
-unfold included, complementary in |- *; intros.
-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.
+  forall X F:R -> Prop, compact X -> closed_set F -> included F X -> compact F.
+Proof.
+  unfold compact in |- *; intros; elim (classic (exists z : R, F z));
+    intro Hyp_F_NE.
+  set (D := ind f0); set (g := f f0); unfold closed_set in H0.
+  set (g' := fun x y:R => f0 x y \/ complementary F y /\ D x).
+  set (D' := D).
+  cut (forall x:R, (exists y : R, g' x y) -> D' x).
+  intro; set (f' := mkfamily D' g' H3); cut (covering_open_set X f').
+  intro; elim (H _ H4); intros DX H5; exists DX.
+  unfold covering_finite in |- *; unfold covering_finite in H5; elim H5;
+    clear H5; intros.
+  split.
+  unfold covering in |- *; unfold covering in H5; intros.
+  elim (H5 _ (H1 _ H7)); intros y0 H8; exists y0; simpl in H8; simpl in |- *;
+    elim H8; clear H8; intros.
+  split.
+  unfold g' in H8; elim H8; intro.
+  apply H10.
+  elim H10; intros H11 _; unfold complementary in H11; elim H11; apply H7.
+  apply H9.
+  unfold family_finite in |- *; unfold domain_finite in |- *;
+    unfold family_finite in H6; unfold domain_finite in H6; 
+      elim H6; clear H6; intros l H6; exists l; intro; assert (H7 := H6 x);
+        elim H7; clear H7; intros.
+  split.
+  intro; apply H7; simpl in |- *; unfold intersection_domain in |- *;
+    simpl in H9; unfold intersection_domain in H9; unfold D' in |- *; 
+      apply H9.
+  intro; assert (H10 := H8 H9); simpl in H10; unfold intersection_domain in H10;
+    simpl in |- *; unfold intersection_domain in |- *; 
+      unfold D' in H10; apply H10.
+  unfold covering_open_set in |- *; unfold covering_open_set in H2; elim H2;
+    clear H2; intros.
+  split.
+  unfold covering in |- *; unfold covering in H2; intros.
+  elim (classic (F x)); intro.
+  elim (H2 _ H6); intros y0 H7; exists y0; simpl in |- *; unfold g' in |- *;
+    left; assumption.
+  cut (exists z : R, D z).
+  intro; elim H7; clear H7; intros x0 H7; exists x0; simpl in |- *;
+    unfold g' in |- *; right.
+  split.
+  unfold complementary in |- *; apply H6.
+  apply H7.
+  elim Hyp_F_NE; intros z0 H7.
+  assert (H8 := H2 _ H7).
+  elim H8; clear H8; intros t H8; exists t; apply (cond_fam f0); exists z0;
+    apply H8.
+  unfold family_open_set in |- *; intro; simpl in |- *; unfold g' in |- *;
+    elim (classic (D x)); intro.
+  apply open_set_P6 with (union_domain (f0 x) (complementary F)).
+  apply open_set_P2.
+  unfold family_open_set in H4; apply H4.
+  apply H0.
+  unfold eq_Dom in |- *; split.
+  unfold included, union_domain, complementary in |- *; intros.
+  elim H6; intro; [ left; apply H7 | right; split; assumption ].
+  unfold included, union_domain, complementary in |- *; intros.
+  elim H6; intro; [ left; apply H7 | right; elim H7; intros; apply H8 ].
+  apply open_set_P6 with (f0 x).
+  unfold family_open_set in H4; apply H4.
+  unfold eq_Dom in |- *; split.
+  unfold included, complementary in |- *; intros; left; apply H6.
+  unfold included, complementary in |- *; intros.
+  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 (fun _:R => False).
-apply compact_EMP.
-unfold eq_Dom in |- *; split.
-unfold included in |- *; intros; elim H3.
-assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros;
- elim (H3 x); apply H4.
+  cut (compact F).
+  intro; apply (H3 f0 H2).
+  apply compact_eqDom with (fun _:R => False).
+  apply compact_EMP.
+  unfold eq_Dom in |- *; split.
+  unfold included in |- *; intros; elim H3.
+  assert (H3 := not_ex_all_not _ _ Hyp_F_NE); unfold included in |- *; intros;
+    elim (H3 x); apply H4.
 Qed.
 
 (**********)
 Lemma compact_P5 : forall 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 (fun c:R => m <= c <= M) X H1 H H0).
+Proof.
+  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 (fun c:R => m <= c <= M) X H1 H H0).
 Qed.
 
 (**********)
 Lemma compact_carac :
- forall 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).
+  forall X:R -> Prop, compact X <-> closed_set X /\ bounded X.
+Proof.
+  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) (x:R) : Prop :=
-   exists y : R, x = f y /\ D y.
+  exists y : R, x = f y /\ D y.
 
 (**********)
 Lemma continuity_compact :
- forall (f:R -> R) (X:R -> Prop),
-   (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X).
-unfold compact in |- *; intros; unfold covering_open_set in H1.
-elim H1; clear H1; intros.
-set (D := ind f1).
-set (g := fun x y:R => image_rec f0 (f1 x) y).
-cut (forall x:R, (exists y : R, g x y) -> D x).
-intro; set (f' := mkfamily D g H3).
-cut (covering_open_set X f').
-intro; elim (H0 f' H4); intros D' H5; exists D'.
-unfold covering_finite in H5; elim H5; clear H5; intros;
- unfold covering_finite in |- *; split.
-unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5;
- intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10);
- simpl in H11; elim H11; intros z H12; exists z; unfold g in H12;
- unfold image_rec in H12; rewrite H9; apply H12.
-unfold family_finite in H6; unfold domain_finite in H6;
- unfold family_finite in |- *; unfold domain_finite in |- *; 
- elim H6; intros l H7; exists l; intro; elim (H7 x); 
- intros; split; intro.
-apply H8; simpl in H10; simpl in |- *; apply H10.
-apply (H9 H10).
-unfold covering_open_set in |- *; split.
-unfold covering in |- *; intros; simpl in |- *; unfold covering in H1;
- unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; 
- apply H1.
-exists x; split; [ reflexivity | apply H4 ].
-unfold family_open_set in |- *; unfold family_open_set in H2; intro;
- simpl in |- *; unfold g in |- *;
- cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)).
-intro; rewrite H4.
-apply (continuity_P2 f0 (f1 x) H (H2 x)).
-reflexivity.
-intros; apply (cond_fam f1); unfold g in H3; unfold image_rec in H3; elim H3;
- intros; exists (f0 x0); apply H4.
+  forall (f:R -> R) (X:R -> Prop),
+    (forall x:R, continuity_pt f x) -> compact X -> compact (image_dir f X).
+Proof.
+  unfold compact in |- *; intros; unfold covering_open_set in H1.
+  elim H1; clear H1; intros.
+  set (D := ind f1).
+  set (g := fun x y:R => image_rec f0 (f1 x) y).
+  cut (forall x:R, (exists y : R, g x y) -> D x).
+  intro; set (f' := mkfamily D g H3).
+  cut (covering_open_set X f').
+  intro; elim (H0 f' H4); intros D' H5; exists D'.
+  unfold covering_finite in H5; elim H5; clear H5; intros;
+    unfold covering_finite in |- *; split.
+  unfold covering, image_dir in |- *; simpl in |- *; unfold covering in H5;
+    intros; elim H7; intros y H8; elim H8; intros; assert (H11 := H5 _ H10);
+      simpl in H11; elim H11; intros z H12; exists z; unfold g in H12;
+        unfold image_rec in H12; rewrite H9; apply H12.
+  unfold family_finite in H6; unfold domain_finite in H6;
+    unfold family_finite in |- *; unfold domain_finite in |- *; 
+      elim H6; intros l H7; exists l; intro; elim (H7 x); 
+        intros; split; intro.
+  apply H8; simpl in H10; simpl in |- *; apply H10.
+  apply (H9 H10).
+  unfold covering_open_set in |- *; split.
+  unfold covering in |- *; intros; simpl in |- *; unfold covering in H1;
+    unfold image_dir in H1; unfold g in |- *; unfold image_rec in |- *; 
+      apply H1.
+  exists x; split; [ reflexivity | apply H4 ].
+  unfold family_open_set in |- *; unfold family_open_set in H2; intro;
+    simpl in |- *; unfold g in |- *;
+      cut ((fun y:R => image_rec f0 (f1 x) y) = image_rec f0 (f1 x)).
+  intro; rewrite H4.
+  apply (continuity_P2 f0 (f1 x) H (H2 x)).
+  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 : forall a b:R, a < b -> 0 < b - a.
-intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r;
- replace (a + (b - a)) with b; [ assumption | ring ].
+Proof.
+  intros; apply Rplus_lt_reg_r with a; rewrite Rplus_0_r;
+    replace (a + (b - a)) with b; [ assumption | ring ].
 Qed.
 
 Lemma prolongement_C0 :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall c:R, a <= c <= b -> continuity_pt f c) ->
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall c:R, a <= c <= b -> continuity_pt f c) ->
     exists g : R -> R,
-     continuity g /\ (forall c:R, a <= c <= b -> g c = f c).
-intros; elim H; intro.
-set
- (h :=
-  fun x:R =>
-    match Rle_dec x a with
-    | left _ => f0 a
-    | right _ =>
-        match Rle_dec x b with
-        | left _ => f0 x
-        | right _ => f0 b
-        end
-    end).
-assert (H2 : 0 < b - a).
-apply Rlt_Rminus; assumption.
-exists h; split.
-unfold continuity in |- *; intro; case (Rtotal_order x a); intro.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); 
- split.
-change (0 < a - x) in |- *; apply Rlt_Rminus; assumption.
-intros; elim H5; clear H5; intros _ H5; unfold h in |- *.
-case (Rle_dec x a); intro.
-case (Rle_dec x0 a); intro.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-elim n; left; apply Rplus_lt_reg_r with (- x);
- do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)).
-apply RRle_abs.
-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 in |- *;
- unfold continue_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); 
- split.
-unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
-elim H8; intros; assumption.
-change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
-intros; elim H9; clear H9; intros _ H9; cut (x1 < b).
-intro; unfold h in |- *; case (Rle_dec x a); intro.
-case (Rle_dec x1 a); intro.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-case (Rle_dec x1 b); intro.
-elim H8; intros; apply H12; split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-red in |- *; intro; elim n; right; symmetry  in |- *; 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 Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a));
- rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)).
-apply RRle_abs.
-apply Rlt_le_trans with (Rmin x0 (b - a)).
-assumption.
-apply Rmin_r.
-case (Rtotal_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 in |- *;
- unfold continue_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
- 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 in |- *; case (Rle_dec (x - a) (b - x)); intro.
-case (Rle_dec x0 (x - a)); intro.
-assumption.
-assumption.
-case (Rle_dec x0 (b - x)); intro.
-assumption.
-assumption.
-intros; elim H13; clear H13; intros; cut (a < x1 < b).
-intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a);
- intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
-case (Rle_dec x b); intro.
-case (Rle_dec x1 a); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)).
-case (Rle_dec 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_lt_cancel; apply Rplus_lt_reg_r with x;
- apply Rle_lt_trans with (Rabs (x1 - x)).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
-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 Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x));
- apply Rle_lt_trans with (Rabs (x1 - x)).
-apply RRle_abs.
-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 in |- *;
- unfold continue_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); 
- split.
-unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
-elim H10; intros; assumption.
-change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
-intros; elim H11; clear H11; intros _ H11; cut (a < x1).
-intro; unfold h in |- *; case (Rle_dec x a); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
-case (Rle_dec x1 a); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)).
-case (Rle_dec x b); intro.
-case (Rle_dec x1 b); intro.
-rewrite H6; elim H10; intros; elim r0; intro.
-apply H14; split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15).
-rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)).
-apply H11.
-apply Rmin_l.
-rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- assumption.
-rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- assumption.
-elim n1; right; assumption.
-rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b;
- apply Rle_lt_trans with (Rabs (x1 - b)).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
-apply Rlt_le_trans with (Rmin x0 (b - a)).
-assumption.
-apply Rmin_r.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); 
- split.
-change (0 < x - b) in |- *; apply Rlt_Rminus; assumption.
-intros; elim H8; clear H8; intros.
-assert (H10 : b < x0).
-apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
- apply Rle_lt_trans with (Rabs (x0 - x)).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
-assumption.
-unfold h in |- *; case (Rle_dec x a); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
-case (Rle_dec x b); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)).
-case (Rle_dec x0 a); intro.
-elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))).
-case (Rle_dec x0 b); intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)).
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro.
-elim r; intro.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)).
-rewrite H6; reflexivity.
-case (Rle_dec c b); intro.
-reflexivity.
-elim n0; assumption.
-exists (fun _: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.
+      continuity g /\ (forall c:R, a <= c <= b -> g c = f c).
+Proof.
+  intros; elim H; intro.
+  set
+    (h :=
+      fun x:R =>
+        match Rle_dec x a with
+          | left _ => f0 a
+          | right _ =>
+            match Rle_dec x b with
+              | left _ => f0 x
+              | right _ => f0 b
+            end
+        end).
+  assert (H2 : 0 < b - a).
+  apply Rlt_Rminus; assumption.
+  exists h; split.
+  unfold continuity in |- *; intro; case (Rtotal_order x a); intro.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros; exists (a - x); 
+        split.
+  change (0 < a - x) in |- *; apply Rlt_Rminus; assumption.
+  intros; elim H5; clear H5; intros _ H5; unfold h in |- *.
+  case (Rle_dec x a); intro.
+  case (Rle_dec x0 a); intro.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  elim n; left; apply Rplus_lt_reg_r with (- x);
+    do 2 rewrite (Rplus_comm (- x)); apply Rle_lt_trans with (Rabs (x0 - x)).
+  apply RRle_abs.
+  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 in |- *;
+        unfold continue_in in |- *; unfold limit1_in in |- *;
+          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
+            intros; elim (H6 _ H7); intros; exists (Rmin x0 (b - a)); 
+              split.
+  unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+  elim H8; intros; assumption.
+  change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+  intros; elim H9; clear H9; intros _ H9; cut (x1 < b).
+  intro; unfold h in |- *; case (Rle_dec x a); intro.
+  case (Rle_dec x1 a); intro.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  case (Rle_dec x1 b); intro.
+  elim H8; intros; apply H12; split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  red in |- *; intro; elim n; right; symmetry  in |- *; 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 Rplus_lt_reg_r with (- a); do 2 rewrite (Rplus_comm (- a));
+    rewrite H4 in H9; apply Rle_lt_trans with (Rabs (x1 - a)).
+  apply RRle_abs.
+  apply Rlt_le_trans with (Rmin x0 (b - a)).
+  assumption.
+  apply Rmin_r.
+  case (Rtotal_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 in |- *;
+        unfold continue_in in |- *; unfold limit1_in in |- *;
+          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
+            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 in |- *; case (Rle_dec (x - a) (b - x)); intro.
+  case (Rle_dec x0 (x - a)); intro.
+  assumption.
+  assumption.
+  case (Rle_dec x0 (b - x)); intro.
+  assumption.
+  assumption.
+  intros; elim H13; clear H13; intros; cut (a < x1 < b).
+  intro; elim H15; clear H15; intros; unfold h in |- *; case (Rle_dec x a);
+    intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+  case (Rle_dec x b); intro.
+  case (Rle_dec x1 a); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r0 H15)).
+  case (Rle_dec 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_lt_cancel; apply Rplus_lt_reg_r with x;
+    apply Rle_lt_trans with (Rabs (x1 - x)).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+  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 Rplus_lt_reg_r with (- x); do 2 rewrite (Rplus_comm (- x));
+    apply Rle_lt_trans with (Rabs (x1 - x)).
+  apply RRle_abs.
+  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 in |- *;
+        unfold continue_in in |- *; unfold limit1_in in |- *;
+          unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
+            intros; elim (H8 _ H9); intros; exists (Rmin x0 (b - a)); 
+              split.
+  unfold Rmin in |- *; case (Rle_dec x0 (b - a)); intro.
+  elim H10; intros; assumption.
+  change (0 < b - a) in |- *; apply Rlt_Rminus; assumption.
+  intros; elim H11; clear H11; intros _ H11; cut (a < x1).
+  intro; unfold h in |- *; case (Rle_dec x a); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+  case (Rle_dec x1 a); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H12)).
+  case (Rle_dec x b); intro.
+  case (Rle_dec x1 b); intro.
+  rewrite H6; elim H10; intros; elim r0; intro.
+  apply H14; split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  red in |- *; intro; rewrite <- H16 in H15; elim (Rlt_irrefl _ H15).
+  rewrite H6 in H11; apply Rlt_le_trans with (Rmin x0 (b - a)).
+  apply H11.
+  apply Rmin_l.
+  rewrite H15; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    assumption.
+  rewrite H6; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    assumption.
+  elim n1; right; assumption.
+  rewrite H6 in H11; apply Ropp_lt_cancel; apply Rplus_lt_reg_r with b;
+    apply Rle_lt_trans with (Rabs (x1 - b)).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+  apply Rlt_le_trans with (Rmin x0 (b - a)).
+  assumption.
+  apply Rmin_r.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros; exists (x - b); 
+        split.
+  change (0 < x - b) in |- *; apply Rlt_Rminus; assumption.
+  intros; elim H8; clear H8; intros.
+  assert (H10 : b < x0).
+  apply Ropp_lt_cancel; apply Rplus_lt_reg_r with x;
+    apply Rle_lt_trans with (Rabs (x0 - x)).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply RRle_abs.
+  assumption.
+  unfold h in |- *; case (Rle_dec x a); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H4)).
+  case (Rle_dec x b); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H6)).
+  case (Rle_dec x0 a); intro.
+  elim (Rlt_irrefl _ (Rlt_trans _ _ _ H1 (Rlt_le_trans _ _ _ H10 r))).
+  case (Rle_dec x0 b); intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ r H10)).
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  intros; elim H3; intros; unfold h in |- *; case (Rle_dec c a); intro.
+  elim r; intro.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H4 H6)).
+  rewrite H6; reflexivity.
+  case (Rle_dec c b); intro.
+  reflexivity.
+  elim n0; assumption.
+  exists (fun _: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 :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall c:R, a <= c <= b -> continuity_pt f c) ->
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall c:R, a <= c <= b -> continuity_pt f c) ->
     exists Mx : R, (forall c:R, a <= c <= b -> f c <= f Mx) /\ a <= Mx <= b.
-intros;
- cut
-  (exists g : R -> R,
-     continuity g /\ (forall 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 (fun c:R => a <= c <= b) Hcont H1).
-assert (H3 := compact_P2 _ H2).
-assert (H4 := compact_P1 _ H2).
-cut (bound (image_dir g (fun c:R => a <= c <= b))).
-cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x).
-intros; assert (H7 := completeness _ H6 H5).
-elim H7; clear H7; intros M H7; cut (image_dir g (fun 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 in |- *; exists c; split; [ reflexivity | apply H10 ].
-apply H9.
-elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro.
-assumption.
-cut
- (exists eps : posreal,
-    (forall y:R,
-       ~
-       intersection_domain (disc M eps)
-         (image_dir g (fun 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 (fun c:R => a <= c <= b)) (M - eps)).
-intro; assert (H12 := H10 _ H11); cut (M - eps < M).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)).
-pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
- apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0;
- rewrite Ropp_involutive; apply (cond_pos eps).
-unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M).
-intro; case (Rle_dec x (M - eps)); intro.
-apply r.
-elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
-apply Rplus_lt_reg_r with (x - eps);
- replace (x - eps + (M - x)) with (M - eps).
-replace (x - eps + eps) with x.
-auto with real.
-ring.
-ring.
-apply Rge_minus; apply Rle_ge; apply H12.
-apply H11.
-apply H7; apply H11.
-cut
- (exists V : R -> Prop,
-    neighbourhood V M /\
-    (forall y:R,
-       ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)).
-intro; elim H9; intros V H10; elim H10; clear H10; intros.
-unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros;
- red in |- *; intro; elim (H11 y).
-unfold intersection_domain in |- *; unfold intersection_domain in H13;
- elim H13; clear H13; intros; split.
-apply (H12 _ H13).
-apply H14.
-cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M).
-intro; unfold point_adherent in H9.
-assert
- (H10 :=
-  not_all_ex_not _
-    (fun V:R -> Prop =>
-       neighbourhood V M ->
+Proof.
+  intros;
+    cut
+      (exists g : R -> R,
+        continuity g /\ (forall 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 (fun c:R => a <= c <= b) Hcont H1).
+  assert (H3 := compact_P2 _ H2).
+  assert (H4 := compact_P1 _ H2).
+  cut (bound (image_dir g (fun c:R => a <= c <= b))).
+  cut (exists x : R, image_dir g (fun c:R => a <= c <= b) x).
+  intros; assert (H7 := completeness _ H6 H5).
+  elim H7; clear H7; intros M H7; cut (image_dir g (fun 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 in |- *; exists c; split; [ reflexivity | apply H10 ].
+  apply H9.
+  elim (classic (image_dir g (fun c:R => a <= c <= b) M)); intro.
+  assumption.
+  cut
+    (exists eps : posreal,
+      (forall y:R,
+        ~
+        intersection_domain (disc M eps)
+        (image_dir g (fun 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 (fun c:R => a <= c <= b)) (M - eps)).
+  intro; assert (H12 := H10 _ H11); cut (M - eps < M).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H12 H13)).
+  pattern M at 2 in |- *; rewrite <- Rplus_0_r; unfold Rminus in |- *;
+    apply Rplus_lt_compat_l; apply Ropp_lt_cancel; rewrite Ropp_0;
+      rewrite Ropp_involutive; apply (cond_pos eps).
+  unfold is_upper_bound, image_dir in |- *; intros; cut (x <= M).
+  intro; case (Rle_dec x (M - eps)); intro.
+  apply r.
+  elim (H9 x); unfold intersection_domain, disc, image_dir in |- *; split.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; rewrite Rabs_right.
+  apply Rplus_lt_reg_r with (x - eps);
+    replace (x - eps + (M - x)) with (M - eps).
+  replace (x - eps + eps) with x.
+  auto with real.
+  ring.
+  ring.
+  apply Rge_minus; apply Rle_ge; apply H12.
+  apply H11.
+  apply H7; apply H11.
+  cut
+    (exists V : R -> Prop,
+      neighbourhood V M /\
+      (forall y:R,
+        ~ intersection_domain V (image_dir g (fun c:R => a <= c <= b)) y)).
+  intro; elim H9; intros V H10; elim H10; clear H10; intros.
+  unfold neighbourhood in H10; elim H10; intros del H12; exists del; intros;
+    red in |- *; intro; elim (H11 y).
+  unfold intersection_domain in |- *; unfold intersection_domain in H13;
+    elim H13; clear H13; intros; split.
+  apply (H12 _ H13).
+  apply H14.
+  cut (~ point_adherent (image_dir g (fun c:R => a <= c <= b)) M).
+  intro; unfold point_adherent in H9.
+  assert
+    (H10 :=
+      not_all_ex_not _
+      (fun V:R -> Prop =>
+        neighbourhood V M ->
         exists y : R,
-         intersection_domain V (image_dir g (fun 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 in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M).
-intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b)));
- intros H11 _; assert (H12 := H11 H3).
-elim H8.
-unfold eq_Dom in H12; elim H12; clear H12; intros.
-apply (H13 _ H10).
-apply H9.
-exists (g a); unfold image_dir in |- *; exists a; split.
-reflexivity.
-split; [ right; reflexivity | apply H ].
-unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4;
- elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *;
- intros; elim (H4 _ H5); intros _ H6; apply H6.
-apply prolongement_C0; assumption.
+          intersection_domain V (image_dir g (fun 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 in |- *; intro; cut (adherence (image_dir g (fun c:R => a <= c <= b)) M).
+  intro; elim (closed_set_P1 (image_dir g (fun c:R => a <= c <= b)));
+    intros H11 _; assert (H12 := H11 H3).
+  elim H8.
+  unfold eq_Dom in H12; elim H12; clear H12; intros.
+  apply (H13 _ H10).
+  apply H9.
+  exists (g a); unfold image_dir in |- *; exists a; split.
+  reflexivity.
+  split; [ right; reflexivity | apply H ].
+  unfold bound in |- *; unfold bounded in H4; elim H4; clear H4; intros m H4;
+    elim H4; clear H4; intros M H4; exists M; unfold is_upper_bound in |- *;
+      intros; elim (H4 _ H5); intros _ H6; apply H6.
+  apply prolongement_C0; assumption.
 Qed.
 
 (**********)
 Lemma continuity_ab_min :
- forall (f:R -> R) (a b:R),
-   a <= b ->
-   (forall c:R, a <= c <= b -> continuity_pt f c) ->
+  forall (f:R -> R) (a b:R),
+    a <= b ->
+    (forall c:R, a <= c <= b -> continuity_pt f c) ->
     exists mx : R, (forall c:R, a <= c <= b -> f mx <= f c) /\ a <= mx <= b.
-intros.
-cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c).
-intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2;
- intros x0 H3; exists x0; intros; split.
-intros; rewrite <- (Ropp_involutive (f0 x0));
- rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; 
- 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).
+Proof.
+  intros.
+  cut (forall c:R, a <= c <= b -> continuity_pt (- f0) c).
+  intro; assert (H2 := continuity_ab_maj (- f0)%F a b H H1); elim H2;
+    intros x0 H3; exists x0; intros; split.
+  intros; rewrite <- (Ropp_involutive (f0 x0));
+    rewrite <- (Ropp_involutive (f0 c)); apply Ropp_le_contravar; 
+      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         *)
+(** *      Proof of Bolzano-Weierstrass theorem         *)
 (********************************************************)
 
 Definition ValAdh (un:nat -> R) (x:R) : Prop :=
@@ -1280,66 +1319,69 @@ Definition intersection_family (f:family) (x:R) : Prop :=
   forall y:R, ind f y -> f y x.
 
 Lemma ValAdh_un_exists :
- forall (un:nat -> R) (D:=fun x:R =>  exists n : nat, x = INR n)
-   (f:=
-    fun x:R =>
-      adherence
+  forall (un:nat -> R) (D:=fun x:R =>  exists n : nat, x = INR n)
+    (f:=
+      fun x:R =>
+        adherence
         (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x))
-   (x:R), (exists 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_0_1)) x0).
-unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1);
- unfold included in |- *; trivial.
-elim (H0 _ H1); intros; unfold intersection_domain in H2; elim H2; intros;
- elim H4; intros; apply H6.
+    (x:R), (exists y : R, f x y) -> D x.
+Proof.
+  intros; elim H; intros; unfold f in H0; unfold adherence in H0;
+    unfold point_adherent in H0;
+      assert (H1 : neighbourhood (disc x0 (mkposreal _ Rlt_0_1)) x0).
+  unfold neighbourhood, disc in |- *; exists (mkposreal _ Rlt_0_1);
+    unfold included in |- *; trivial.
+  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 := fun x:R =>  exists n : nat, x = INR n in
-  let f :=
-    fun x:R =>
-      adherence
+    let f :=
+      fun x:R =>
+        adherence
         (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x) in
-  intersection_family (mkfamily D f (ValAdh_un_exists un)).
+        intersection_family (mkfamily D f (ValAdh_un_exists un)).
 
 Lemma ValAdh_un_prop :
- forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x.
-intros; split; intro.
-unfold ValAdh in H; unfold ValAdh_un in |- *;
- unfold intersection_family in |- *; simpl in |- *; 
- intros; elim H0; intros N H1; unfold adherence in |- *;
- unfold point_adherent in |- *; intros; elim (H V N H2); 
- intros; exists (un x0); unfold intersection_domain in |- *; 
- elim H3; clear H3; intros; split.
-assumption.
-split.
-exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ].
-exists N; assumption.
-unfold ValAdh in |- *; intros; unfold ValAdh_un in H;
- unfold intersection_family in H; simpl in H;
- assert
-  (H1 :
-   adherence
-     (fun y0:R =>
-        (exists p : nat, y0 = un p /\ INR N <= INR p) /\
-        (exists 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.
+  forall (un:nat -> R) (x:R), ValAdh un x <-> ValAdh_un un x.
+Proof.
+  intros; split; intro.
+  unfold ValAdh in H; unfold ValAdh_un in |- *;
+    unfold intersection_family in |- *; simpl in |- *; 
+      intros; elim H0; intros N H1; unfold adherence in |- *;
+        unfold point_adherent in |- *; intros; elim (H V N H2); 
+          intros; exists (un x0); unfold intersection_domain in |- *; 
+            elim H3; clear H3; intros; split.
+  assumption.
+  split.
+  exists x0; split; [ reflexivity | rewrite H1; apply (le_INR _ _ H3) ].
+  exists N; assumption.
+  unfold ValAdh in |- *; intros; unfold ValAdh_un in H;
+    unfold intersection_family in H; simpl in H;
+      assert
+        (H1 :
+          adherence
+          (fun y0:R =>
+            (exists p : nat, y0 = un p /\ INR N <= INR p) /\
+            (exists 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 :
- forall F G:R -> Prop, included F G -> included (adherence F) (adherence G).
-unfold adherence, included in |- *; unfold point_adherent in |- *; intros;
- elim (H0 _ H1); unfold intersection_domain in |- *; 
- intros; elim H2; clear H2; intros; exists x0; split;
- [ assumption | apply (H _ H3) ].
+  forall F G:R -> Prop, included F G -> included (adherence F) (adherence G).
+Proof.
+  unfold adherence, included in |- *; unfold point_adherent in |- *; intros;
+    elim (H0 _ H1); unfold intersection_domain in |- *; 
+      intros; elim H2; clear H2; intros; exists x0; split;
+        [ assumption | apply (H _ H3) ].
 Qed.
 
 Definition family_closed_set (f:family) : Prop :=
@@ -1355,471 +1397,476 @@ Definition intersection_vide_finite_in (D:R -> Prop)
 
 (**********)
 Lemma compact_P6 :
- forall X:R -> Prop,
-   compact X ->
-   (exists z : R, X z) ->
-   forall g:family,
-     family_closed_set g ->
-     intersection_vide_in X g ->
+  forall X:R -> Prop,
+    compact X ->
+    (exists z : R, X z) ->
+    forall g:family,
+      family_closed_set g ->
+      intersection_vide_in X g ->
       exists D : R -> Prop, intersection_vide_finite_in X (subfamily g D).
-intros X H Hyp g H0 H1.
-set (D' := ind g).
-set (f' := fun x y:R => complementary (g x) y /\ D' x).
-assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x).
-intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption.
-set (f0 := mkfamily D' f' H2).
-unfold compact in H; assert (H3 : covering_open_set X f0).
-unfold covering_open_set in |- *; split.
-unfold covering in |- *; intros; unfold intersection_vide_in in H1;
- elim (H1 x); intros; unfold intersection_family in H5;
- assert
-  (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x);
- assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); 
- elim H7; intros; exists x0; elim (imply_to_and _ _ H8); 
- intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; 
- split; [ apply H10 | apply H9 ].
-unfold family_open_set in |- *; intro; elim (classic (D' x)); intro.
-apply open_set_P6 with (complementary (g x)).
-unfold family_closed_set in H0; unfold closed_set in H0; apply H0.
-unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *;
- split.
-unfold included in |- *; intros; split; [ apply H4 | apply H3 ].
-unfold included in |- *; intros; elim H4; intros; assumption.
-apply open_set_P6 with (fun _:R => False).
-apply open_set_P4.
-unfold eq_Dom in |- *; unfold included in |- *; split; intros;
- [ elim H4
- | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ].
-elim (H _ H3); intros SF H4; exists SF;
- unfold intersection_vide_finite_in in |- *; split.
-unfold intersection_vide_in in |- *; simpl in |- *; intros; split.
-intros; unfold included in |- *; intros; unfold intersection_vide_in in H1;
- elim (H1 x); intros; elim H6; intros; apply H7.
-unfold intersection_domain in H5; elim H5; intros; assumption.
-assumption.
-elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'.
-red in |- *; intro; elim H5; intros; unfold intersection_family in H6;
- 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 (exists z : R, X z).
-intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5);
- intros; simpl in H6; elim Hyp'; exists x1; elim H6; 
- intros; unfold intersection_domain in |- *; split.
-apply (cond_fam f0); exists x0; apply H7.
-apply H8.
-apply Hyp.
-unfold covering_finite in H4; elim H4; clear H4; intros;
- unfold family_finite in H5; unfold domain_finite in H5;
- unfold family_finite in |- *; unfold domain_finite in |- *; 
- elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); 
- intros; split; intro;
- [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ].
+Proof.
+  intros X H Hyp g H0 H1.
+  set (D' := ind g).
+  set (f' := fun x y:R => complementary (g x) y /\ D' x).
+  assert (H2 : forall x:R, (exists y : R, f' x y) -> D' x).
+  intros; elim H2; intros; unfold f' in H3; elim H3; intros; assumption.
+  set (f0 := mkfamily D' f' H2).
+  unfold compact in H; assert (H3 : covering_open_set X f0).
+  unfold covering_open_set in |- *; split.
+  unfold covering in |- *; intros; unfold intersection_vide_in in H1;
+    elim (H1 x); intros; unfold intersection_family in H5;
+      assert
+        (H6 := not_ex_all_not _ (fun y:R => forall y0:R, ind g y0 -> g y0 y) H5 x);
+        assert (H7 := not_all_ex_not _ (fun y0:R => ind g y0 -> g y0 x) H6); 
+          elim H7; intros; exists x0; elim (imply_to_and _ _ H8); 
+            intros; unfold f0 in |- *; simpl in |- *; unfold f' in |- *; 
+              split; [ apply H10 | apply H9 ].
+  unfold family_open_set in |- *; intro; elim (classic (D' x)); intro.
+  apply open_set_P6 with (complementary (g x)).
+  unfold family_closed_set in H0; unfold closed_set in H0; apply H0.
+  unfold f0 in |- *; simpl in |- *; unfold f' in |- *; unfold eq_Dom in |- *;
+    split.
+  unfold included in |- *; intros; split; [ apply H4 | apply H3 ].
+  unfold included in |- *; intros; elim H4; intros; assumption.
+  apply open_set_P6 with (fun _:R => False).
+  apply open_set_P4.
+  unfold eq_Dom in |- *; unfold included in |- *; split; intros;
+    [ elim H4
+      | simpl in H4; unfold f' in H4; elim H4; intros; elim H3; assumption ].
+  elim (H _ H3); intros SF H4; exists SF;
+    unfold intersection_vide_finite_in in |- *; split.
+  unfold intersection_vide_in in |- *; simpl in |- *; intros; split.
+  intros; unfold included in |- *; intros; unfold intersection_vide_in in H1;
+    elim (H1 x); intros; elim H6; intros; apply H7.
+  unfold intersection_domain in H5; elim H5; intros; assumption.
+  assumption.
+  elim (classic (exists y : R, intersection_domain (ind g) SF y)); intro Hyp'.
+  red in |- *; intro; elim H5; intros; unfold intersection_family in H6;
+    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 (exists z : R, X z).
+  intro; elim H5; clear H5; intros; unfold covering in H4; elim (H4 x0 H5);
+    intros; simpl in H6; elim Hyp'; exists x1; elim H6; 
+      intros; unfold intersection_domain in |- *; split.
+  apply (cond_fam f0); exists x0; apply H7.
+  apply H8.
+  apply Hyp.
+  unfold covering_finite in H4; elim H4; clear H4; intros;
+    unfold family_finite in H5; unfold domain_finite in H5;
+      unfold family_finite in |- *; unfold domain_finite in |- *; 
+        elim H5; clear H5; intros l H5; exists l; intro; elim (H5 x); 
+          intros; split; intro;
+            [ apply H6; simpl in |- *; simpl in H8; apply H8 | apply (H7 H8) ].
 Qed.
 
 Theorem Bolzano_Weierstrass :
- forall (un:nat -> R) (X:R -> Prop),
-   compact X -> (forall n:nat, X (un n)) ->  exists l : R, ValAdh un l.
-intros; cut (exists l : R, ValAdh_un un l).
-intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros;
- apply (H4 H2).
-assert (H1 :  exists z : R, X z).
-exists (un 0%nat); apply H0.
-set (D := fun x:R =>  exists n : nat, x = INR n).
-set
- (g :=
-  fun x:R =>
-    adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)).
-assert (H2 : forall x:R, (exists 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_0_1)) x0).
-unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1);
- unfold included in |- *; trivial.
-elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5;
- assumption.
-set (f0 := mkfamily D g H2).
-assert (H3 := compact_P6 X H H1 f0).
-elim (classic (exists 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 0); intros _ H10; elim H10; unfold family_finite in H9;
- unfold domain_finite in H9; elim H9; clear H9; intros l H9;
- set (r := MaxRlist l); cut (D r).
-intro; unfold D in H11; elim H11; intros; exists (un x);
- unfold intersection_family in |- *; simpl in |- *;
- unfold intersection_domain in |- *; intros; split.
-unfold g in |- *; apply adherence_P1; split.
-exists x; split;
- [ reflexivity
- | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros;
-    apply H14; simpl in |- *; apply H13 ].
-elim H13; intros; assumption.
-elim H13; intros; assumption.
-elim (H9 r); intros.
-simpl in H12; unfold intersection_domain in H12; cut (In r l).
-intro; elim (H12 H13); intros; assumption.
-unfold r in |- *; apply MaxRlist_P2;
- cut (exists z : R, intersection_domain (ind f0) SF z).
-intro; elim H13; intros; elim (H9 x); intros; simpl in H15;
- assert (H17 := H15 H14); exists x; apply H17.
-elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro.
-assumption.
-elim (H8 0); intros _ H14; elim H1; intros;
- assert
-  (H16 :=
-   not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14);
- assert
-  (H17 :=
-   not_ex_all_not _ (fun 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 _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y)
-     H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20);
- elim (H17 x0); elim H21; intros; assumption.
-unfold intersection_vide_in in |- *; intros; split.
-intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *;
- apply included_trans with (adherence X).
-apply adherence_P4.
-unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10;
- intros; rewrite H11; apply H0.
-apply adherence_P2; apply compact_P2; assumption.
-apply H4.
-unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *;
- unfold g in |- *; intro; apply adherence_P3.
+  forall (un:nat -> R) (X:R -> Prop),
+    compact X -> (forall n:nat, X (un n)) ->  exists l : R, ValAdh un l.
+Proof.
+  intros; cut (exists l : R, ValAdh_un un l).
+  intro; elim H1; intros; exists x; elim (ValAdh_un_prop un x); intros;
+    apply (H4 H2).
+  assert (H1 :  exists z : R, X z).
+  exists (un 0%nat); apply H0.
+  set (D := fun x:R =>  exists n : nat, x = INR n).
+  set
+    (g :=
+      fun x:R =>
+        adherence (fun y:R => (exists p : nat, y = un p /\ x <= INR p) /\ D x)).
+  assert (H2 : forall x:R, (exists 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_0_1)) x0).
+  unfold neighbourhood in |- *; exists (mkposreal _ Rlt_0_1);
+    unfold included in |- *; trivial.
+  elim (H3 _ H4); intros; unfold intersection_domain in H5; decompose [and] H5;
+    assumption.
+  set (f0 := mkfamily D g H2).
+  assert (H3 := compact_P6 X H H1 f0).
+  elim (classic (exists 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 0); intros _ H10; elim H10; unfold family_finite in H9;
+        unfold domain_finite in H9; elim H9; clear H9; intros l H9;
+          set (r := MaxRlist l); cut (D r).
+  intro; unfold D in H11; elim H11; intros; exists (un x);
+    unfold intersection_family in |- *; simpl in |- *;
+      unfold intersection_domain in |- *; intros; split.
+  unfold g in |- *; apply adherence_P1; split.
+  exists x; split;
+    [ reflexivity
+      | rewrite <- H12; unfold r in |- *; apply MaxRlist_P1; elim (H9 y); intros;
+        apply H14; simpl in |- *; apply H13 ].
+  elim H13; intros; assumption.
+  elim H13; intros; assumption.
+  elim (H9 r); intros.
+  simpl in H12; unfold intersection_domain in H12; cut (In r l).
+  intro; elim (H12 H13); intros; assumption.
+  unfold r in |- *; apply MaxRlist_P2;
+    cut (exists z : R, intersection_domain (ind f0) SF z).
+  intro; elim H13; intros; elim (H9 x); intros; simpl in H15;
+    assert (H17 := H15 H14); exists x; apply H17.
+  elim (classic (exists z : R, intersection_domain (ind f0) SF z)); intro.
+  assumption.
+  elim (H8 0); intros _ H14; elim H1; intros;
+    assert
+      (H16 :=
+        not_ex_all_not _ (fun y:R => intersection_family (subfamily f0 SF) y) H14);
+      assert
+        (H17 :=
+          not_ex_all_not _ (fun 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 _ (fun y:R => intersection_domain D SF y -> g y x /\ SF y)
+                H18); elim H19; intros; assert (H21 := imply_to_and _ _ H20);
+              elim (H17 x0); elim H21; intros; assumption.
+  unfold intersection_vide_in in |- *; intros; split.
+  intro; simpl in H6; unfold f0 in |- *; simpl in |- *; unfold g in |- *;
+    apply included_trans with (adherence X).
+  apply adherence_P4.
+  unfold included in |- *; intros; elim H7; intros; elim H8; intros; elim H10;
+    intros; rewrite H11; apply H0.
+  apply adherence_P2; apply compact_P2; assumption.
+  apply H4.
+  unfold family_closed_set in |- *; unfold f0 in |- *; simpl in |- *;
+    unfold g in |- *; intro; apply adherence_P3.
 Qed.
 
 (********************************************************)
-(*               Proof of Heine's theorem               *)
+(** *            Proof of Heine's theorem               *)
 (********************************************************)
 
 Definition uniform_continuity (f:R -> R) (X:R -> Prop) : Prop :=
   forall eps:posreal,
-     exists delta : posreal,
+    exists delta : posreal,
       (forall x y:R,
-         X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps).
+        X x -> X y -> Rabs (x - y) < delta -> Rabs (f x - f y) < eps).
 
 Lemma is_lub_u :
- forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y.
-unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym;
- [ apply (H4 _ H1) | apply (H2 _ H3) ].
+  forall (E:R -> Prop) (x y:R), is_lub E x -> is_lub E y -> x = y.
+Proof.
+  unfold is_lub in |- *; intros; elim H; elim H0; intros; apply Rle_antisym;
+    [ apply (H4 _ H1) | apply (H2 _ H3) ].
 Qed.
 
 Lemma domain_P1 :
- forall X:R -> Prop,
-   ~ (exists y : R, X y) \/
-   (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/
-   (exists x : R, (exists y : R, X x /\ X y /\ x <> y)).
-intro; elim (classic (exists y : R, X y)); intro.
-right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro.
-right; elim H1; intros; elim H2; intros; exists x; exists x0; intros.
-split;
- [ assumption
- | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ].
-left; exists x; split.
-assumption.
-intros; case (Req_dec x0 x); intro.
-assumption.
-elim H1; exists x0; split; assumption.
-left; assumption.
+  forall X:R -> Prop,
+    ~ (exists y : R, X y) \/
+    (exists y : R, X y /\ (forall x:R, X x -> x = y)) \/
+    (exists x : R, (exists y : R, X x /\ X y /\ x <> y)).
+Proof.
+  intro; elim (classic (exists y : R, X y)); intro.
+  right; elim H; intros; elim (classic (exists y : R, X y /\ y <> x)); intro.
+  right; elim H1; intros; elim H2; intros; exists x; exists x0; intros.
+  split;
+    [ assumption
+      | split; [ assumption | apply (sym_not_eq (A:=R)); assumption ] ].
+  left; exists x; split.
+  assumption.
+  intros; case (Req_dec x0 x); intro.
+  assumption.
+  elim H1; exists x0; split; assumption.
+  left; assumption.
 Qed.
 
 Theorem Heine :
- forall (f:R -> R) (X:R -> Prop),
-   compact X ->
-   (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X.
-intros f0 X H0 H; elim (domain_P1 X); intro Hyp.
+  forall (f:R -> R) (X:R -> Prop),
+    compact X ->
+    (forall x:R, X x -> continuity_pt f x) -> uniform_continuity f X.
+Proof.
+  intros f0 X H0 H; elim (domain_P1 X); intro Hyp.
 (* X est vide *)
-unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
- intros; elim Hyp; exists x; assumption.
-elim Hyp; clear Hyp; intro Hyp.
+  unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+    intros; elim Hyp; exists x; assumption.
+  elim Hyp; clear Hyp; intro Hyp.
 (* X possède un seul élément *)
-unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
- intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; 
- intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); 
- rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; apply (cond_pos eps).
+  unfold uniform_continuity in |- *; intros; exists (mkposreal _ Rlt_0_1);
+    intros; elim Hyp; clear Hyp; intros; elim H4; clear H4; 
+      intros; assert (H6 := H5 _ H1); assert (H7 := H5 _ H2); 
+        rewrite H6; rewrite H7; unfold Rminus in |- *; rewrite Rplus_opp_r;
+          rewrite Rabs_R0; apply (cond_pos eps).
 (* X possède au moins deux éléments distincts *)
-assert
- (X_enc :
-   exists m : R, (exists M : R, (forall 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_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)).
-elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc;
- intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp;
- unfold uniform_continuity in |- *; intro;
- assert (H1 : forall t:posreal, 0 < t / 2).
-intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ].
-set
- (g :=
-  fun x y:R =>
-    X x /\
-    (exists del : posreal,
-       (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
-       is_lub
-         (fun zeta:R =>
+  assert
+    (X_enc :
+      exists m : R, (exists M : R, (forall 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_irrefl _ (Rle_lt_trans _ _ _ (Rle_trans _ _ _ H13 H14) r)).
+  elim X_enc; clear X_enc; intros m X_enc; elim X_enc; clear X_enc;
+    intros M X_enc; elim X_enc; clear X_enc Hyp; intros X_enc Hyp;
+      unfold uniform_continuity in |- *; intro;
+        assert (H1 : forall t:posreal, 0 < t / 2).
+  intro; unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply (cond_pos t) | apply Rinv_0_lt_compat; prove_sup0 ].
+  set
+    (g :=
+      fun x y:R =>
+        X x /\
+        (exists del : posreal,
+          (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+          is_lub
+          (fun zeta:R =>
             0 < zeta <= M - m /\
             (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2))
-         del /\ disc x (mkposreal (del / 2) (H1 del)) y)).
-assert (H2 : forall x:R, (exists y : R, g x y) -> X x).
-intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _;
- apply H3.
-set (f' := mkfamily X g H2); unfold compact in H0;
- assert (H3 : covering_open_set X f').
-unfold covering_open_set in |- *; split.
-unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *;
- 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;
- set
-  (E :=
-   fun zeta:R =>
-     0 < zeta <= M - m /\
-     (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
- assert (H6 : bound E).
-unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
- unfold E in |- *; intros; elim H6; clear H6; intros H6 _; 
- elim H6; clear H6; intros _ H6; apply H6.
-assert (H7 :  exists x : R, E x).
-elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros;
- split.
-split.
-unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro.
-apply H5.
-apply Rlt_Rminus; apply Hyp.
-apply Rmin_r.
-intros; case (Req_dec x z); intro.
-rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply (H1 eps).
-apply H7; split.
-unfold D_x, no_cond in |- *; split; [ trivial | assumption ].
-apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ].
-assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros;
- cut (0 < x1 <= M - m).
-intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split.
-intros; cut (exists alp : R, Rabs (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 (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro.
-assumption.
-assert
- (H12 :=
-  not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11);
- unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
-intro; assert (H16 := H14 _ H15);
- elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)).
-unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13;
- assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); 
- intro.
-assumption.
-elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ].
-split.
-apply p.
-unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
- rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; 
- apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ].
-elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _;
- unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12;
- 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 in |- *; intro; simpl in |- *; elim (classic (X x));
- intro.
-unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4;
- intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; 
- intros; unfold neighbourhood in |- *; case (Req_dec x x0); 
- intro.
-exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros;
- split.
-assumption.
-exists x1; split.
-apply H4.
-split.
-elim H5; intros; apply H8.
-apply H7.
-set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d).
-unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros;
- unfold disc in H7; apply H7.
-exists (mkposreal _ H7); unfold included in |- *; intros; split.
-assumption.
-exists x1; split.
-apply H4.
-elim H5; intros; split.
-assumption.
-unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *;
- unfold disc in H10; simpl in H10;
- apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)).
-replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
-replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ].
-do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l;
- apply H8.
-apply open_set_P6 with (fun _:R => False).
-apply open_set_P4.
-unfold eq_Dom in |- *; unfold included in |- *; intros; split.
-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
-  (forall x:R,
-     In x l ->
-      exists del : R,
-       0 < del /\
-       (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
-       included (g x) (fun z:R => Rabs (z - x) < del / 2)).
-intros;
- assert
-  (H7 :=
-   Rlist_P1 l
-     (fun x del:R =>
-        0 < del /\
-        (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
-        included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); 
- elim H7; clear H7; intros l' H7; elim H7; clear H7; 
- intros; set (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 (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)).
-replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y));
- [ apply Rabs_triang | ring ].
-rewrite (double_var eps); apply Rplus_lt_compat.
-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 in |- *; apply Rmult_lt_reg_l with 2.
-prove_sup0.
-rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r;
- rewrite double; apply Rplus_lt_compat_l; apply H19.
-discrR.
-assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20;
- elim H20; clear H20; intros; rewrite <- Rabs_Ropp; 
- rewrite Ropp_minus_distr; apply H20; unfold included in H21; 
- elim H13; intros; assert (H24 := H21 x H22);
- apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)).
-replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ].
-rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat.
-apply Rlt_le_trans with (D / 2).
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12.
-unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
- apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; prove_sup0.
-unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i));
- intros; apply H26; exists i; split;
- [ rewrite <- H7; assumption | reflexivity ].
-assumption.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros;
-    elim (H10 H9); intros; elim H12; intros; rewrite H14;
-    rewrite <- H7 in H13; elim (H8 x H13); intros; 
-    apply H15
- | apply Rinv_0_lt_compat; prove_sup0 ].
-intros; elim (H5 x); intros; elim (H8 H6); intros;
- set
-  (E :=
-   fun zeta:R =>
-     0 < zeta <= M - m /\
-     (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
- assert (H11 : bound E).
-unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
- unfold E in |- *; intros; elim H11; clear H11; intros H11 _; 
- elim H11; clear H11; intros _ H11; apply H11.
-assert (H12 :  exists x : R, E x).
-assert (H13 := H _ H9); unfold continuity_pt in H13;
- unfold continue_in in H13; unfold limit1_in in H13; 
- unfold limit_in in H13; simpl in H13; unfold R_dist in H13;
- elim (H13 _ (H1 eps)); intros; elim H12; clear H12; 
- intros; exists (Rmin x0 (M - m)); unfold E in |- *; 
- intros; split.
-split;
- [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro;
-    [ apply H12 | apply Rlt_Rminus; apply Hyp ]
- | apply Rmin_r ].
-intros; case (Req_dec x z); intro.
-rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
- apply (H1 eps).
-apply H14; split;
- [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ]
- | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ].
-assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros;
- cut (0 < x0 <= M - m).
-intro; elim H13; clear H13; intros; exists x0; split.
-assumption.
-split.
-intros; cut (exists alp : R, Rabs (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 (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro.
-assumption.
-assert
- (H17 :=
-  not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16);
- unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
-intro; assert (H21 := H19 _ H20);
- elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)).
-unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18;
- assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); 
- intro.
-assumption.
-elim (H17 x1); split.
-split; [ auto with real | assumption ].
-assumption.
-unfold included, g in |- *; intros; elim H15; intros; elim H17; intros;
- 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.
+          del /\ disc x (mkposreal (del / 2) (H1 del)) y)).
+  assert (H2 : forall x:R, (exists y : R, g x y) -> X x).
+  intros; elim H2; intros; unfold g in H3; elim H3; clear H3; intros H3 _;
+    apply H3.
+  set (f' := mkfamily X g H2); unfold compact in H0;
+    assert (H3 : covering_open_set X f').
+  unfold covering_open_set in |- *; split.
+  unfold covering in |- *; intros; exists x; simpl in |- *; unfold g in |- *;
+    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;
+          set
+            (E :=
+              fun zeta:R =>
+                0 < zeta <= M - m /\
+                (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
+            assert (H6 : bound E).
+  unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
+    unfold E in |- *; intros; elim H6; clear H6; intros H6 _; 
+      elim H6; clear H6; intros _ H6; apply H6.
+  assert (H7 :  exists x : R, E x).
+  elim H5; clear H5; intros; exists (Rmin x0 (M - m)); unfold E in |- *; intros;
+    split.
+  split.
+  unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro.
+  apply H5.
+  apply Rlt_Rminus; apply Hyp.
+  apply Rmin_r.
+  intros; case (Req_dec x z); intro.
+  rewrite H9; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply (H1 eps).
+  apply H7; split.
+  unfold D_x, no_cond in |- *; split; [ trivial | assumption ].
+  apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H8 | apply Rmin_l ].
+  assert (H8 := completeness _ H6 H7); elim H8; clear H8; intros;
+    cut (0 < x1 <= M - m).
+  intro; elim H8; clear H8; intros; exists (mkposreal _ H8); split.
+  intros; cut (exists alp : R, Rabs (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 (exists alp : R, Rabs (z - x) < alp <= x1 /\ E alp)); intro.
+  assumption.
+  assert
+    (H12 :=
+      not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x1 /\ E alp) H11);
+    unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
+  intro; assert (H16 := H14 _ H15);
+    elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H16)).
+  unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H13;
+    assert (H16 := H13 _ H15); case (Rle_dec x2 (Rabs (z - x))); 
+      intro.
+  assumption.
+  elim (H12 x2); split; [ split; [ auto with real | assumption ] | assumption ].
+  split.
+  apply p.
+  unfold disc in |- *; unfold Rminus in |- *; rewrite Rplus_opp_r;
+    rewrite Rabs_R0; simpl in |- *; unfold Rdiv in |- *; 
+      apply Rmult_lt_0_compat; [ apply H8 | apply Rinv_0_lt_compat; prove_sup0 ].
+  elim H7; intros; unfold E in H8; elim H8; intros H9 _; elim H9; intros H10 _;
+    unfold is_lub in p; elim p; intros; unfold is_upper_bound in H12;
+      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 in |- *; intro; simpl in |- *; elim (classic (X x));
+    intro.
+  unfold g in |- *; unfold open_set in |- *; intros; elim H4; clear H4;
+    intros _ H4; elim H4; clear H4; intros; elim H4; clear H4; 
+      intros; unfold neighbourhood in |- *; case (Req_dec x x0); 
+        intro.
+  exists (mkposreal _ (H1 x1)); rewrite <- H6; unfold included in |- *; intros;
+    split.
+  assumption.
+  exists x1; split.
+  apply H4.
+  split.
+  elim H5; intros; apply H8.
+  apply H7.
+  set (d := x1 / 2 - Rabs (x0 - x)); assert (H7 : 0 < d).
+  unfold d in |- *; apply Rlt_Rminus; elim H5; clear H5; intros;
+    unfold disc in H7; apply H7.
+  exists (mkposreal _ H7); unfold included in |- *; intros; split.
+  assumption.
+  exists x1; split.
+  apply H4.
+  elim H5; intros; split.
+  assumption.
+  unfold disc in H8; simpl in H8; unfold disc in |- *; simpl in |- *;
+    unfold disc in H10; simpl in H10;
+      apply Rle_lt_trans with (Rabs (x2 - x0) + Rabs (x0 - x)).
+  replace (x2 - x) with (x2 - x0 + (x0 - x)); [ apply Rabs_triang | ring ].
+  replace (x1 / 2) with (d + Rabs (x0 - x)); [ idtac | unfold d in |- *; ring ].
+  do 2 rewrite <- (Rplus_comm (Rabs (x0 - x))); apply Rplus_lt_compat_l;
+    apply H8.
+  apply open_set_P6 with (fun _:R => False).
+  apply open_set_P4.
+  unfold eq_Dom in |- *; unfold included in |- *; intros; split.
+  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
+            (forall x:R,
+              In x l ->
+              exists del : R,
+                0 < del /\
+                (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+                included (g x) (fun z:R => Rabs (z - x) < del / 2)).
+  intros;
+    assert
+      (H7 :=
+        Rlist_P1 l
+        (fun x del:R =>
+          0 < del /\
+          (forall z:R, Rabs (z - x) < del -> Rabs (f0 z - f0 x) < eps / 2) /\
+          included (g x) (fun z:R => Rabs (z - x) < del / 2)) H6); 
+      elim H7; clear H7; intros l' H7; elim H7; clear H7; 
+        intros; set (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 (Rabs (f0 x - f0 xi) + Rabs (f0 xi - f0 y)).
+  replace (f0 x - f0 y) with (f0 x - f0 xi + (f0 xi - f0 y));
+  [ apply Rabs_triang | ring ].
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  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 in |- *; apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  rewrite Rmult_comm; rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; pattern (pos_Rl l' i) at 1 in |- *; rewrite <- Rplus_0_r;
+    rewrite double; apply Rplus_lt_compat_l; apply H19.
+  discrR.
+  assert (H19 := H8 i H17); elim H19; clear H19; intros; rewrite <- H18 in H20;
+    elim H20; clear H20; intros; rewrite <- Rabs_Ropp; 
+      rewrite Ropp_minus_distr; apply H20; unfold included in H21; 
+        elim H13; intros; assert (H24 := H21 x H22);
+          apply Rle_lt_trans with (Rabs (y - x) + Rabs (x - xi)).
+  replace (y - xi) with (y - x + (x - xi)); [ apply Rabs_triang | ring ].
+  rewrite (double_var (pos_Rl l' i)); apply Rplus_lt_compat.
+  apply Rlt_le_trans with (D / 2).
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H12.
+  unfold Rdiv in |- *; do 2 rewrite <- (Rmult_comm (/ 2));
+    apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; prove_sup0.
+  unfold D in |- *; apply MinRlist_P1; elim (pos_Rl_P2 l' (pos_Rl l' i));
+    intros; apply H26; exists i; split;
+      [ rewrite <- H7; assumption | reflexivity ].
+  assumption.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ unfold D in |- *; apply MinRlist_P2; intros; elim (pos_Rl_P2 l' y); intros;
+      elim (H10 H9); intros; elim H12; intros; rewrite H14;
+        rewrite <- H7 in H13; elim (H8 x H13); intros; 
+          apply H15
+      | apply Rinv_0_lt_compat; prove_sup0 ].
+  intros; elim (H5 x); intros; elim (H8 H6); intros;
+    set
+      (E :=
+        fun zeta:R =>
+          0 < zeta <= M - m /\
+          (forall z:R, Rabs (z - x) < zeta -> Rabs (f0 z - f0 x) < eps / 2));
+      assert (H11 : bound E).
+  unfold bound in |- *; exists (M - m); unfold is_upper_bound in |- *;
+    unfold E in |- *; intros; elim H11; clear H11; intros H11 _; 
+      elim H11; clear H11; intros _ H11; apply H11.
+  assert (H12 :  exists x : R, E x).
+  assert (H13 := H _ H9); unfold continuity_pt in H13;
+    unfold continue_in in H13; unfold limit1_in in H13; 
+      unfold limit_in in H13; simpl in H13; unfold R_dist in H13;
+        elim (H13 _ (H1 eps)); intros; elim H12; clear H12; 
+          intros; exists (Rmin x0 (M - m)); unfold E in |- *; 
+            intros; split.
+  split;
+    [ unfold Rmin in |- *; case (Rle_dec x0 (M - m)); intro;
+      [ apply H12 | apply Rlt_Rminus; apply Hyp ]
+      | apply Rmin_r ].
+  intros; case (Req_dec x z); intro.
+  rewrite H16; unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0;
+    apply (H1 eps).
+  apply H14; split;
+    [ unfold D_x, no_cond in |- *; split; [ trivial | assumption ]
+      | apply Rlt_le_trans with (Rmin x0 (M - m)); [ apply H15 | apply Rmin_l ] ].
+  assert (H13 := completeness _ H11 H12); elim H13; clear H13; intros;
+    cut (0 < x0 <= M - m).
+  intro; elim H13; clear H13; intros; exists x0; split.
+  assumption.
+  split.
+  intros; cut (exists alp : R, Rabs (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 (exists alp : R, Rabs (z - x) < alp <= x0 /\ E alp)); intro.
+  assumption.
+  assert
+    (H17 :=
+      not_ex_all_not _ (fun alp:R => Rabs (z - x) < alp <= x0 /\ E alp) H16);
+    unfold is_lub in p; elim p; intros; cut (is_upper_bound E (Rabs (z - x))).
+  intro; assert (H21 := H19 _ H20);
+    elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H15 H21)).
+  unfold is_upper_bound in |- *; intros; unfold is_upper_bound in H18;
+    assert (H21 := H18 _ H20); case (Rle_dec x1 (Rabs (z - x))); 
+      intro.
+  assumption.
+  elim (H17 x1); split.
+  split; [ auto with real | assumption ].
+  assumption.
+  unfold included, g in |- *; intros; elim H15; intros; elim H17; intros;
+    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/theories/Reals/Rtrigo.v b/theories/Reals/Rtrigo.v
index 060070c4..6e992aa3 100644
--- a/theories/Reals/Rtrigo.v
+++ b/theories/Reals/Rtrigo.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo.v 6245 2004-10-20 13:50:08Z barras $ i*)
+(*i $Id: Rtrigo.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -27,312 +27,356 @@ Axiom sin_PI2 : sin (PI / 2) = 1.
 
 (**********)
 Lemma PI_neq0 : PI <> 0.
-red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0;
- elim (Rlt_irrefl _ H0).
+Proof.
+  red in |- *; intro; assert (H0 := PI_RGT_0); rewrite H in H0;
+    elim (Rlt_irrefl _ H0).
 Qed.
 
 (**********) 
 Lemma cos_minus : forall x y:R, cos (x - y) = cos x * cos y + sin x * sin y.
-intros; unfold Rminus in |- *; rewrite cos_plus.
-rewrite <- cos_sym; rewrite sin_antisym; ring.
+Proof.
+  intros; unfold Rminus in |- *; rewrite cos_plus.
+  rewrite <- cos_sym; rewrite sin_antisym; ring.
 Qed.
 
 (**********)
 Lemma sin2_cos2 : forall x:R, Rsqr (sin x) + Rsqr (cos x) = 1.
-intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x);
- unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0.
+Proof.
+  intro; unfold Rsqr in |- *; rewrite Rplus_comm; rewrite <- (cos_minus x x);
+    unfold Rminus in |- *; rewrite Rplus_opp_r; apply cos_0.
 Qed.
 
 Lemma cos2 : forall x:R, Rsqr (cos x) = 1 - Rsqr (sin x).
-intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1;
- unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x)));
- rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry  in |- *; 
- apply Rplus_0_r.
+Proof.
+  intro x; generalize (sin2_cos2 x); intro H1; rewrite <- H1;
+    unfold Rminus in |- *; rewrite <- (Rplus_comm (Rsqr (cos x)));
+      rewrite Rplus_assoc; rewrite Rplus_opp_r; symmetry  in |- *; 
+        apply Rplus_0_r.
 Qed.
 
 (**********)
 Lemma cos_PI2 : cos (PI / 2) = 0.
-apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1;
- unfold Rminus in |- *; apply Rplus_opp_r.
+Proof.
+  apply Rsqr_eq_0; rewrite cos2; rewrite sin_PI2; rewrite Rsqr_1;
+    unfold Rminus in |- *; apply Rplus_opp_r.
 Qed.
 
 (**********)
 Lemma cos_PI : cos PI = -1.
-replace PI with (PI / 2 + PI / 2).
-rewrite cos_plus.
-rewrite sin_PI2; rewrite cos_PI2.
-ring.
-symmetry  in |- *; apply double_var.
+Proof.
+  replace PI with (PI / 2 + PI / 2).
+  rewrite cos_plus.
+  rewrite sin_PI2; rewrite cos_PI2.
+  ring.
+  symmetry  in |- *; apply double_var.
 Qed.
 
 Lemma sin_PI : sin PI = 0.
-assert (H := sin2_cos2 PI).
-rewrite cos_PI in H.
-rewrite <- Rsqr_neg in H.
-rewrite Rsqr_1 in H.
-cut (Rsqr (sin PI) = 0).
-intro; apply (Rsqr_eq_0 _ H0).
-apply Rplus_eq_reg_l with 1.
-rewrite Rplus_0_r; rewrite Rplus_comm; exact H.
+Proof.
+  assert (H := sin2_cos2 PI).
+  rewrite cos_PI in H.
+  rewrite <- Rsqr_neg in H.
+  rewrite Rsqr_1 in H.
+  cut (Rsqr (sin PI) = 0).
+  intro; apply (Rsqr_eq_0 _ H0).
+  apply Rplus_eq_reg_l with 1.
+  rewrite Rplus_0_r; rewrite Rplus_comm; exact H.
 Qed.
 
 (**********)
 Lemma neg_cos : forall x:R, cos (x + PI) = - cos x.
-intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring.
+Proof.
+  intro x; rewrite cos_plus; rewrite sin_PI; rewrite cos_PI; ring.
 Qed.
 
 (**********)
 Lemma sin_cos : forall x:R, sin x = - cos (PI / 2 + x).
-intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Proof.
+  intro x; rewrite cos_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
 Qed.
 
 (**********)
 Lemma sin_plus : forall x y:R, sin (x + y) = sin x * cos y + cos x * sin y.
-intros.
-rewrite (sin_cos (x + y)).
-replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ].
-rewrite (sin_cos (PI / 2 + x)).
-replace (PI / 2 + (PI / 2 + x)) with (x + PI).
-rewrite neg_cos.
-replace (cos (PI / 2 + x)) with (- sin x).
-ring.
-rewrite sin_cos; rewrite Ropp_involutive; reflexivity.
-pattern PI at 1 in |- *; rewrite (double_var PI); ring.
+Proof.
+  intros.
+  rewrite (sin_cos (x + y)).
+  replace (PI / 2 + (x + y)) with (PI / 2 + x + y); [ rewrite cos_plus | ring ].
+  rewrite (sin_cos (PI / 2 + x)).
+  replace (PI / 2 + (PI / 2 + x)) with (x + PI).
+  rewrite neg_cos.
+  replace (cos (PI / 2 + x)) with (- sin x).
+  ring.
+  rewrite sin_cos; rewrite Ropp_involutive; reflexivity.
+  pattern PI at 1 in |- *; rewrite (double_var PI); ring.
 Qed.
 
 Lemma sin_minus : forall x y:R, sin (x - y) = sin x * cos y - cos x * sin y.
-intros; unfold Rminus in |- *; rewrite sin_plus.
-rewrite <- cos_sym; rewrite sin_antisym; ring.
+Proof.
+  intros; unfold Rminus in |- *; rewrite sin_plus.
+  rewrite <- cos_sym; rewrite sin_antisym; ring.
 Qed.
 
 (**********)
 Definition tan (x:R) : R := sin x / cos x.
 
 Lemma tan_plus :
- forall x y:R,
-   cos x <> 0 ->
-   cos y <> 0 ->
-   cos (x + y) <> 0 ->
-   1 - tan x * tan y <> 0 ->
-   tan (x + y) = (tan x + tan y) / (1 - tan x * tan y).
-intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus;
- unfold Rdiv in |- *;
- replace (cos x * cos y - sin x * sin y) with
-  (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))).
-rewrite Rinv_mult_distr.
-repeat rewrite <- Rmult_assoc;
- replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with
-  (sin x * / cos x + sin y * / cos y).
-reflexivity.
-rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr.
-repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x));
- repeat rewrite <- Rmult_assoc.
-repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ].
-assumption.
-assumption.
-apply prod_neq_R0; assumption.
-assumption.
-unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
- apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y));
- rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite (Rmult_comm (sin x));
- rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc;
- apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); 
- rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-apply Rmult_1_r.
-assumption.
-assumption.
+  forall x y:R,
+    cos x <> 0 ->
+    cos y <> 0 ->
+    cos (x + y) <> 0 ->
+    1 - tan x * tan y <> 0 ->
+    tan (x + y) = (tan x + tan y) / (1 - tan x * tan y).
+Proof.
+  intros; unfold tan in |- *; rewrite sin_plus; rewrite cos_plus;
+    unfold Rdiv in |- *;
+      replace (cos x * cos y - sin x * sin y) with
+      (cos x * cos y * (1 - sin x * / cos x * (sin y * / cos y))).
+  rewrite Rinv_mult_distr.
+  repeat rewrite <- Rmult_assoc;
+    replace ((sin x * cos y + cos x * sin y) * / (cos x * cos y)) with
+    (sin x * / cos x + sin y * / cos y).
+  reflexivity.
+  rewrite Rmult_plus_distr_r; rewrite Rinv_mult_distr.
+  repeat rewrite Rmult_assoc; repeat rewrite (Rmult_comm (sin x));
+    repeat rewrite <- Rmult_assoc.
+  repeat rewrite Rinv_r_simpl_m; [ reflexivity | assumption | assumption ].
+  assumption.
+  assumption.
+  apply prod_neq_R0; assumption.
+  assumption.
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+    apply Rplus_eq_compat_l; repeat rewrite Rmult_assoc;
+      rewrite (Rmult_comm (sin x)); rewrite (Rmult_comm (cos y));
+        rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite <- Rmult_assoc;
+          rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite (Rmult_comm (sin x));
+    rewrite <- Ropp_mult_distr_r_reverse; repeat rewrite Rmult_assoc;
+      apply Rmult_eq_compat_l; rewrite (Rmult_comm (/ cos y)); 
+        rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  apply Rmult_1_r.
+  assumption.
+  assumption.
 Qed.
 
 (*******************************************************)
-(* Some properties of cos, sin and tan                 *)
+(** * Some properties of cos, sin and tan              *)
 (*******************************************************)
 
 Lemma sin2 : forall x:R, Rsqr (sin x) = 1 - Rsqr (cos x).
-intro x; generalize (cos2 x); intro H1; rewrite H1.
-unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry  in |- *;
- apply Ropp_involutive.
+Proof.
+  intro x; generalize (cos2 x); intro H1; rewrite H1.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite <- Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_l; symmetry  in |- *;
+      apply Ropp_involutive.
 Qed.
 
 Lemma sin_2a : forall x:R, sin (2 * x) = 2 * sin x * cos x.
-intro x; rewrite double; rewrite sin_plus.
-rewrite <- (Rmult_comm (sin x)); symmetry  in |- *; rewrite Rmult_assoc;
- apply double.
+Proof.
+  intro x; rewrite double; rewrite sin_plus.
+  rewrite <- (Rmult_comm (sin x)); symmetry  in |- *; rewrite Rmult_assoc;
+    apply double.
 Qed.
 
 Lemma cos_2a : forall x:R, cos (2 * x) = cos x * cos x - sin x * sin x.
-intro x; rewrite double; apply cos_plus.
+Proof.
+  intro x; rewrite double; apply cos_plus.
 Qed.
 
 Lemma cos_2a_cos : forall x:R, cos (2 * x) = 2 * cos x * cos x - 1.
-intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc;
- rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; 
- intro H1; rewrite <- H1; ring_Rsqr.
+Proof.
+  intro x; rewrite double; unfold Rminus in |- *; rewrite Rmult_assoc;
+    rewrite cos_plus; generalize (sin2_cos2 x); rewrite double; 
+      intro H1; rewrite <- H1; ring_Rsqr.
 Qed.
 
 Lemma cos_2a_sin : forall x:R, cos (2 * x) = 1 - 2 * sin x * sin x.
-intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double.
-generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus;
- ring_Rsqr.
+Proof.
+  intro x; rewrite Rmult_assoc; unfold Rminus in |- *; repeat rewrite double.
+  generalize (sin2_cos2 x); intro H1; rewrite <- H1; rewrite cos_plus;
+    ring_Rsqr.
 Qed.
 
 Lemma tan_2a :
- forall x:R,
-   cos x <> 0 ->
-   cos (2 * x) <> 0 ->
-   1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x).
-repeat rewrite double; intros; repeat rewrite double; rewrite double in H0;
- apply tan_plus; assumption.
+  forall x:R,
+    cos x <> 0 ->
+    cos (2 * x) <> 0 ->
+    1 - tan x * tan x <> 0 -> tan (2 * x) = 2 * tan x / (1 - tan x * tan x).
+Proof.
+  repeat rewrite double; intros; repeat rewrite double; rewrite double in H0;
+    apply tan_plus; assumption.
 Qed.
 
 Lemma sin_neg : forall x:R, sin (- x) = - sin x.
-apply sin_antisym.
+Proof.
+  apply sin_antisym.
 Qed.
 
 Lemma cos_neg : forall x:R, cos (- x) = cos x.
-intro; symmetry  in |- *; apply cos_sym.
+Proof.
+  intro; symmetry  in |- *; apply cos_sym.
 Qed.
 
 Lemma tan_0 : tan 0 = 0.
-unfold tan in |- *; rewrite sin_0; rewrite cos_0.
-unfold Rdiv in |- *; apply Rmult_0_l. 
+Proof.
+  unfold tan in |- *; rewrite sin_0; rewrite cos_0.
+  unfold Rdiv in |- *; apply Rmult_0_l. 
 Qed.
 
 Lemma tan_neg : forall x:R, tan (- x) = - tan x.
-intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg;
- unfold Rdiv in |- *.
-apply Ropp_mult_distr_l_reverse.
+Proof.
+  intros x; unfold tan in |- *; rewrite sin_neg; rewrite cos_neg;
+    unfold Rdiv in |- *.
+  apply Ropp_mult_distr_l_reverse.
 Qed.
 
 Lemma tan_minus :
- forall x y:R,
-   cos x <> 0 ->
-   cos y <> 0 ->
-   cos (x - y) <> 0 ->
-   1 + tan x * tan y <> 0 ->
-   tan (x - y) = (tan x - tan y) / (1 + tan x * tan y).
-intros; unfold Rminus in |- *; rewrite tan_plus.
-rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
- rewrite Rmult_opp_opp; reflexivity.
-assumption.
-rewrite cos_neg; assumption.
-assumption.
-rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
- rewrite Rmult_opp_opp; assumption.
+  forall x y:R,
+    cos x <> 0 ->
+    cos y <> 0 ->
+    cos (x - y) <> 0 ->
+    1 + tan x * tan y <> 0 ->
+    tan (x - y) = (tan x - tan y) / (1 + tan x * tan y).
+Proof.
+  intros; unfold Rminus in |- *; rewrite tan_plus.
+  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+    rewrite Rmult_opp_opp; reflexivity.
+  assumption.
+  rewrite cos_neg; assumption.
+  assumption.
+  rewrite tan_neg; unfold Rminus in |- *; rewrite <- Ropp_mult_distr_l_reverse;
+    rewrite Rmult_opp_opp; assumption.
 Qed.
 
 Lemma cos_3PI2 : cos (3 * (PI / 2)) = 0.
-replace (3 * (PI / 2)) with (PI + PI / 2).
-rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring.
-pattern PI at 1 in |- *; rewrite (double_var PI).
-ring.
+Proof.
+  replace (3 * (PI / 2)) with (PI + PI / 2).
+  rewrite cos_plus; rewrite sin_PI; rewrite cos_PI2; ring.
+  pattern PI at 1 in |- *; rewrite (double_var PI).
+  ring.
 Qed.
 
 Lemma sin_2PI : sin (2 * PI) = 0.
-rewrite sin_2a; rewrite sin_PI; ring.
+Proof.
+  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.
+Proof.
+  rewrite cos_2a; rewrite sin_PI; rewrite cos_PI; ring.
 Qed.
 
 Lemma neg_sin : forall x:R, sin (x + PI) = - sin x.
-intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring.
+Proof.
+  intro x; rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; ring.
 Qed.
 
 Lemma sin_PI_x : forall x:R, sin (PI - x) = sin x.
-intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
- unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
- rewrite Ropp_involutive; apply Rmult_1_l.
+Proof.
+  intro x; rewrite sin_minus; rewrite sin_PI; rewrite cos_PI; rewrite Rmult_0_l;
+    unfold Rminus in |- *; rewrite Rplus_0_l; rewrite Ropp_mult_distr_l_reverse;
+      rewrite Ropp_involutive; apply Rmult_1_l.
 Qed.
 
 Lemma sin_period : forall (x:R) (k:nat), sin (x + 2 * INR k * PI) = sin x.
-intros x k; induction  k as [| k Hreck].
-cut (x + 2 * INR 0 * 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 ].
+Proof.
+  intros x k; induction  k as [| k Hreck].
+  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
+  trivial.
+
+  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
+  rewrite sin_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
+  ring_simplify; trivial.
+  rewrite S_INR in |- *;  ring.
 Qed.
 
 Lemma cos_period : forall (x:R) (k:nat), cos (x + 2 * INR k * PI) = cos x.
-intros x k; induction  k as [| k Hreck].
-cut (x + 2 * INR 0 * 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 ].
+Proof.
+  intros x k; induction  k as [| k Hreck].
+  simpl in |- *;  ring_simplify (x + 2 * 0 * PI).
+  trivial.
+
+  replace (x + 2 * INR (S k) * PI) with (x + 2 * INR k * PI + 2 * PI).
+  rewrite cos_plus in |- *; rewrite sin_2PI in |- *; rewrite cos_2PI in |- *.
+  ring_simplify; trivial.
+  rewrite S_INR in |- *;  ring.
 Qed.
 
 Lemma sin_shift : forall x:R, sin (PI / 2 - x) = cos x.
-intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Proof.
+  intro x; rewrite sin_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
 Qed.
 
 Lemma cos_shift : forall x:R, cos (PI / 2 - x) = sin x.
-intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Proof.
+  intro x; rewrite cos_minus; rewrite sin_PI2; rewrite cos_PI2; ring.
 Qed.
 
 Lemma cos_sin : forall x:R, cos x = sin (PI / 2 + x).
-intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
+Proof.
+  intro x; rewrite sin_plus; rewrite sin_PI2; rewrite cos_PI2; ring.
 Qed.
 
 Lemma PI2_RGT_0 : 0 < PI / 2.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ].
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup ].
 Qed. 
 
 Lemma SIN_bound : forall x:R, -1 <= sin x <= 1.
-intro; case (Rle_dec (-1) (sin x)); intro.
-case (Rle_dec (sin x) 1); intro.
-split; assumption.
-cut (1 < sin x).
-intro;
- generalize
-  (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
-     (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); 
- rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
- generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
- repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; 
- rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
- generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
- repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); 
- intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
-auto with real.
-cut (sin x < -1).
-intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
- rewrite Ropp_involutive; clear H; intro;
- generalize
-  (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
-     (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H)));
- rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; 
- rewrite sin2 in H0; unfold Rminus in H0;
- generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
- repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; 
- rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
- generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
- repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); 
- intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
-auto with real.
+Proof.
+  intro; case (Rle_dec (-1) (sin x)); intro.
+  case (Rle_dec (sin x) 1); intro.
+  split; assumption.
+  cut (1 < sin x).
+  intro;
+    generalize
+      (Rsqr_incrst_1 1 (sin x) H (Rlt_le 0 1 Rlt_0_1)
+        (Rlt_le 0 (sin x) (Rlt_trans 0 1 (sin x) Rlt_0_1 H))); 
+      rewrite Rsqr_1; intro; rewrite sin2 in H0; unfold Rminus in H0;
+        generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+          repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; 
+            rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+              generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+                repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); 
+                  intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+  auto with real.
+  cut (sin x < -1).
+  intro; generalize (Ropp_lt_gt_contravar (sin x) (-1) H);
+    rewrite Ropp_involutive; clear H; intro;
+      generalize
+        (Rsqr_incrst_1 1 (- sin x) H (Rlt_le 0 1 Rlt_0_1)
+          (Rlt_le 0 (- sin x) (Rlt_trans 0 1 (- sin x) Rlt_0_1 H)));
+        rewrite Rsqr_1; intro; rewrite <- Rsqr_neg in H0; 
+          rewrite sin2 in H0; unfold Rminus in H0;
+            generalize (Rplus_lt_compat_l (-1) 1 (1 + - Rsqr (cos x)) H0);
+              repeat rewrite <- Rplus_assoc; repeat rewrite Rplus_opp_l; 
+                rewrite Rplus_0_l; intro; rewrite <- Ropp_0 in H1;
+                  generalize (Ropp_lt_gt_contravar (-0) (- Rsqr (cos x)) H1);
+                    repeat rewrite Ropp_involutive; intro; generalize (Rle_0_sqr (cos x)); 
+                      intro; elim (Rlt_irrefl 0 (Rle_lt_trans 0 (Rsqr (cos x)) 0 H3 H2)).
+  auto with real.
 Qed.
 
 Lemma COS_bound : forall x:R, -1 <= cos x <= 1.
-intro; rewrite <- sin_shift; apply SIN_bound.
+Proof.
+  intro; rewrite <- sin_shift; apply SIN_bound.
 Qed.
 
 Lemma cos_sin_0 : forall x:R, ~ (cos x = 0 /\ sin x = 0).
-intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro;
- rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2;
- rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; 
- rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3).
+Proof.
+  intro; red in |- *; intro; elim H; intros; generalize (sin2_cos2 x); intro;
+    rewrite H0 in H2; rewrite H1 in H2; repeat rewrite Rsqr_0 in H2;
+      rewrite Rplus_0_r in H2; generalize Rlt_0_1; intro; 
+        rewrite <- H2 in H3; elim (Rlt_irrefl 0 H3).
 Qed.
-  
+
 Lemma cos_sin_0_var : forall x:R, cos x <> 0 \/ sin x <> 0.
-intro; apply not_and_or; apply cos_sin_0.
+Proof.
+  intro; apply not_and_or; apply cos_sin_0.
 Qed.
 
 (*****************************************************************)
-(* Using series definitions of cos and sin                       *)
+(** * Using series definitions of cos and sin                    *)
 (*****************************************************************)
 
 Definition sin_lb (a:R) : R := sin_approx a 3.
@@ -341,1367 +385,1415 @@ Definition cos_lb (a:R) : R := cos_approx a 3.
 Definition cos_ub (a:R) : R := cos_approx a 4.
 
 Lemma sin_lb_gt_0 : forall a:R, 0 < a -> a <= PI / 2 -> 0 < sin_lb a.
-intros.
-unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *.
-set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
-replace
- (sum_f_R0
+Proof.
+  intros.
+  unfold sin_lb in |- *; unfold sin_approx in |- *; unfold sin_term in |- *.
+  set (Un := fun i:nat => a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
+  replace
+  (sum_f_R0
     (fun i:nat => (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1)))) 3)
- with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3);
- [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ].
-cut (forall n:nat, Un (S n) < Un n).
-intro; simpl in |- *.
-repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r;
- replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ];
- replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ];
- replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); 
- [ idtac | ring ];
- replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
-  (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
-apply Rplus_lt_0_compat.
-unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
- rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); 
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
- apply H1.
-unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
- rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); 
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
- apply H1.
-intro; unfold Un in |- *.
-cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat).
-intro; rewrite H1.
-rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
- apply Rmult_lt_compat_l.
-apply pow_lt; assumption.
-rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))).
-apply lt_INR_0; apply neq_O_lt.
-assert (H2 := fact_neq_0 (2 * n + 1)).
-red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-rewrite <- Rinv_r_sym.
-apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))).
-apply lt_INR_0; apply neq_O_lt.
-assert (H2 := fact_neq_0 (2 * S n + 1)).
-red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
-apply Rmult_le_compat_l.
-replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
-simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
- [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
- [ idtac | reflexivity ]; apply Rsqr_incr_1.
-apply Rle_trans with (PI / 2);
- [ assumption
- | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
-    [ prove_sup0
-    | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
-       [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
-left; assumption.
-left; prove_sup0.
-rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
-do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
-repeat rewrite <- Rmult_assoc.
-rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
-rewrite Rmult_assoc.
-apply Rmult_lt_compat_l.
-apply lt_INR_0; apply neq_O_lt.
-assert (H2 := fact_neq_0 (2 * n + 1)).
-red in |- *; intro; elim H2; symmetry  in |- *; assumption.
-do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n);
- unfold INR in |- *.
-replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
- [ idtac | ring ].
-apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
- replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
- [ idtac | ring ].
-apply Rplus_le_lt_0_compat.
-cut (0 <= x).
-intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
- assumption || left; prove_sup.
-unfold x in |- *; replace 0 with (INR 0);
- [ apply le_INR; apply le_O_n | reflexivity ].
-prove_sup0.
-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.
+    with (sum_f_R0 (fun i:nat => (-1) ^ i * Un i) 3);
+      [ idtac | apply sum_eq; intros; unfold Un in |- *; reflexivity ].
+  cut (forall n:nat, Un (S n) < Un n).
+  intro; simpl in |- *.
+  repeat rewrite Rmult_1_l; repeat rewrite Rmult_1_r;
+    replace (-1 * Un 1%nat) with (- Un 1%nat); [ idtac | ring ];
+    replace (-1 * -1 * Un 2%nat) with (Un 2%nat); [ idtac | ring ];
+    replace (-1 * (-1 * -1) * Un 3%nat) with (- Un 3%nat); 
+    [ idtac | ring ];
+    replace (Un 0%nat + - Un 1%nat + Un 2%nat + - Un 3%nat) with
+    (Un 0%nat - Un 1%nat + (Un 2%nat - Un 3%nat)); [ idtac | ring ].
+  apply Rplus_lt_0_compat.
+  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 1%nat);
+    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 1%nat)); 
+      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
+        apply H1.
+  unfold Rminus in |- *; apply Rplus_lt_reg_r with (Un 3%nat);
+    rewrite Rplus_0_r; rewrite (Rplus_comm (Un 3%nat)); 
+      rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r; 
+        apply H1.
+  intro; unfold Un in |- *.
+  cut ((2 * S n + 1)%nat = (2 * n + 1 + 2)%nat).
+  intro; rewrite H1.
+  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+    apply Rmult_lt_compat_l.
+  apply pow_lt; assumption.
+  rewrite <- H1; apply Rmult_lt_reg_l with (INR (fact (2 * n + 1))).
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (INR (fact (2 * S n + 1))).
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * S n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  rewrite (Rmult_comm (INR (fact (2 * S n + 1)))); repeat rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  do 2 rewrite Rmult_1_r; apply Rle_lt_trans with (INR (fact (2 * n + 1)) * 4).
+  apply Rmult_le_compat_l.
+  replace 0 with (INR 0); [ idtac | reflexivity ]; apply le_INR; apply le_O_n.
+  simpl in |- *; rewrite Rmult_1_r; replace 4 with (Rsqr 2);
+    [ idtac | ring_Rsqr ]; replace (a * a) with (Rsqr a);
+    [ idtac | reflexivity ]; apply Rsqr_incr_1.
+  apply Rle_trans with (PI / 2);
+    [ assumption
+      | unfold Rdiv in |- *; apply Rmult_le_reg_l with 2;
+        [ prove_sup0
+          | rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m;
+            [ replace 4 with 4; [ apply PI_4 | ring ] | discrR ] ] ].
+  left; assumption.
+  left; prove_sup0.
+  rewrite H1; replace (2 * n + 1 + 2)%nat with (S (S (2 * n + 1))).
+  do 2 rewrite fact_simpl; do 2 rewrite mult_INR.
+  repeat rewrite <- Rmult_assoc.
+  rewrite <- (Rmult_comm (INR (fact (2 * n + 1)))).
+  rewrite Rmult_assoc.
+  apply Rmult_lt_compat_l.
+  apply lt_INR_0; apply neq_O_lt.
+  assert (H2 := fact_neq_0 (2 * n + 1)).
+  red in |- *; intro; elim H2; symmetry  in |- *; assumption.
+  do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; set (x := INR n);
+    unfold INR in |- *.
+  replace ((2 * x + 1 + 1 + 1) * (2 * x + 1 + 1)) with (4 * x * x + 10 * x + 6);
+  [ idtac | ring ].
+  apply Rplus_lt_reg_r with (-4); rewrite Rplus_opp_l;
+    replace (-4 + (4 * x * x + 10 * x + 6)) with (4 * x * x + 10 * x + 2);
+    [ idtac | ring ].
+  apply Rplus_le_lt_0_compat.
+  cut (0 <= x).
+  intro; apply Rplus_le_le_0_compat; repeat apply Rmult_le_pos;
+    assumption || left; prove_sup.
+  unfold x in |- *; replace 0 with (INR 0);
+    [ apply le_INR; apply le_O_n | reflexivity ].
+  prove_sup0.
+  ring_nat.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  ring_nat.
 Qed.
 
 Lemma SIN : forall a:R, 0 <= a -> a <= PI -> sin_lb a <= sin a <= sin_ub a.
-intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
+  intros; unfold sin_lb, sin_ub in |- *; apply (sin_bound a 1 H H0).
 Qed.
 
 Lemma COS :
- forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
-intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
+  forall a:R, - PI / 2 <= a -> a <= PI / 2 -> cos_lb a <= cos a <= cos_ub a.
+  intros; unfold cos_lb, cos_ub in |- *; apply (cos_bound a 1 H H0).
 Qed.
 
 (**********)
 Lemma _PI2_RLT_0 : - (PI / 2) < 0.
-rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
+Proof.
+  rewrite <- Ropp_0; apply Ropp_lt_contravar; apply PI2_RGT_0.
 Qed.
 
 Lemma PI4_RLT_PI2 : PI / 4 < PI / 2.
-unfold Rdiv in |- *; apply Rmult_lt_compat_l.
-apply PI_RGT_0.
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat; prove_sup0.
-pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
-replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+  apply PI_RGT_0.
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat; prove_sup0.
+  pattern 2 at 1 in |- *; rewrite <- Rplus_0_r.
+  replace 4 with (2 + 2); [ apply Rplus_lt_compat_l; prove_sup0 | ring ].
 Qed.
 
 Lemma PI2_Rlt_PI : PI / 2 < PI.
-unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
-apply Rmult_lt_compat_l.
-apply PI_RGT_0.
-pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
-rewrite Rmult_1_l; prove_sup0.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- apply Rlt_0_1.
-Qed.
-
-(********************************************)
-(* Increasing and decreasing of COS and SIN *)
-(********************************************)
+Proof.
+  unfold Rdiv in |- *; pattern PI at 2 in |- *; rewrite <- Rmult_1_r.
+  apply Rmult_lt_compat_l.
+  apply PI_RGT_0.
+  pattern 1 at 3 in |- *; rewrite <- Rinv_1; apply Rinv_lt_contravar.
+  rewrite Rmult_1_l; prove_sup0.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    apply Rlt_0_1.
+Qed.
+
+(***************************************************)
+(** * Increasing and decreasing of [cos] and [sin] *)
+(***************************************************)
 Theorem sin_gt_0 : forall x:R, 0 < x -> x < PI -> 0 < sin x.
-intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _;
- case (Rtotal_order x (PI / 2)); intro H2.
-apply Rlt_le_trans with (sin_lb x).
-apply sin_lb_gt_0; [ assumption | left; assumption ].
-assumption.
-elim H2; intro H3.
-rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
-rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
- intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
-replace (PI + - x) with (PI - x).
-replace (PI + - (PI / 2)) with (PI / 2).
-intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
- change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
-rewrite Rplus_opp_r.
-replace (PI + - x) with (PI - x).
-intro H7;
- elim
-  (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
-     (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI)));
- intros H8 _;
- generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); 
- intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
-reflexivity.
-pattern PI at 2 in |- *; rewrite double_var; ring.
-reflexivity.
+Proof.
+  intros; elim (SIN x (Rlt_le 0 x H) (Rlt_le x PI H0)); intros H1 _;
+    case (Rtotal_order x (PI / 2)); intro H2.
+  apply Rlt_le_trans with (sin_lb x).
+  apply sin_lb_gt_0; [ assumption | left; assumption ].
+  assumption.
+  elim H2; intro H3.
+  rewrite H3; rewrite sin_PI2; apply Rlt_0_1.
+  rewrite <- sin_PI_x; generalize (Ropp_gt_lt_contravar x (PI / 2) H3);
+    intro H4; generalize (Rplus_lt_compat_l PI (- x) (- (PI / 2)) H4).
+  replace (PI + - x) with (PI - x).
+  replace (PI + - (PI / 2)) with (PI / 2).
+  intro H5; generalize (Ropp_lt_gt_contravar x PI H0); intro H6;
+    change (- PI < - x) in H6; generalize (Rplus_lt_compat_l PI (- PI) (- x) H6).
+  rewrite Rplus_opp_r.
+  replace (PI + - x) with (PI - x).
+  intro H7;
+    elim
+      (SIN (PI - x) (Rlt_le 0 (PI - x) H7)
+        (Rlt_le (PI - x) PI (Rlt_trans (PI - x) (PI / 2) PI H5 PI2_Rlt_PI)));
+      intros H8 _;
+        generalize (sin_lb_gt_0 (PI - x) H7 (Rlt_le (PI - x) (PI / 2) H5)); 
+          intro H9; apply (Rlt_le_trans 0 (sin_lb (PI - x)) (sin (PI - x)) H9 H8).
+  reflexivity.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
+  reflexivity.
 Qed.
 
 Theorem cos_gt_0 : forall x:R, - (PI / 2) < x -> x < PI / 2 -> 0 < cos x.
-intros; rewrite cos_sin;
- generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H).
-rewrite Rplus_opp_r; intro H1;
- generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); 
- rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2).
+Proof.
+  intros; rewrite cos_sin;
+    generalize (Rplus_lt_compat_l (PI / 2) (- (PI / 2)) x H).
+  rewrite Rplus_opp_r; intro H1;
+    generalize (Rplus_lt_compat_l (PI / 2) x (PI / 2) H0); 
+      rewrite <- double_var; intro H2; apply (sin_gt_0 (PI / 2 + x) H1 H2).
 Qed.
 
 Lemma sin_ge_0 : forall x:R, 0 <= x -> x <= PI -> 0 <= sin x.
-intros x H1 H2; elim H1; intro H3;
- [ elim H2; intro H4;
-    [ left; apply (sin_gt_0 x H3 H4)
-    | rewrite H4; right; symmetry  in |- *; apply sin_PI ]
- | rewrite <- H3; right; symmetry  in |- *; apply sin_0 ].
+Proof.
+  intros x H1 H2; elim H1; intro H3;
+    [ elim H2; intro H4;
+      [ left; apply (sin_gt_0 x H3 H4)
+        | rewrite H4; right; symmetry  in |- *; apply sin_PI ]
+      | rewrite <- H3; right; symmetry  in |- *; apply sin_0 ].
 Qed.
 
 Lemma cos_ge_0 : forall x:R, - (PI / 2) <= x -> x <= PI / 2 -> 0 <= cos x.
-intros x H1 H2; elim H1; intro H3;
- [ elim H2; intro H4;
-    [ left; apply (cos_gt_0 x H3 H4)
-    | rewrite H4; right; symmetry  in |- *; apply cos_PI2 ]
- | rewrite <- H3; rewrite cos_neg; right; symmetry  in |- *; apply cos_PI2 ].
+Proof.
+  intros x H1 H2; elim H1; intro H3;
+    [ elim H2; intro H4;
+      [ left; apply (cos_gt_0 x H3 H4)
+        | rewrite H4; right; symmetry  in |- *; apply cos_PI2 ]
+      | rewrite <- H3; rewrite cos_neg; right; symmetry  in |- *; apply cos_PI2 ].
 Qed.
 
 Lemma sin_le_0 : forall x:R, PI <= x -> x <= 2 * PI -> sin x <= 0.
-intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
- rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar;
- rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI);
- [ rewrite (sin_period (x - PI) 1); apply sin_ge_0;
-    [ replace (x - PI) with (x + - PI);
-       [ rewrite Rplus_comm; replace 0 with (- PI + PI);
-          [ apply Rplus_le_compat_l; assumption | ring ]
-       | ring ]
-    | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
-       [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
-          [ apply Rplus_le_compat_l; assumption | ring ]
-       | ring ] ]
- | unfold INR in |- *; ring ].
+Proof.
+  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+    rewrite <- (Ropp_involutive (sin x)); apply Ropp_le_ge_contravar;
+      rewrite <- neg_sin; replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+        [ rewrite (sin_period (x - PI) 1); apply sin_ge_0;
+          [ replace (x - PI) with (x + - PI);
+            [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+              [ apply Rplus_le_compat_l; assumption | ring ]
+              | ring ]
+            | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+              [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+                [ apply Rplus_le_compat_l; assumption | ring ]
+                | ring ] ]
+          | unfold INR in |- *; ring ].
 Qed.
 
 Lemma cos_le_0 : forall x:R, PI / 2 <= x -> x <= 3 * (PI / 2) -> cos x <= 0.
-intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
- rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
- rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
-rewrite cos_period; apply cos_ge_0.
-replace (- (PI / 2)) with (- PI + PI / 2).
-unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
- assumption.
-pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
- ring.
-unfold Rminus in |- *; rewrite Rplus_comm;
- replace (PI / 2) with (- PI + 3 * (PI / 2)).
-apply Rplus_le_compat_l; assumption.
-pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
- ring. 
-unfold INR in |- *; ring.
+Proof.
+  intros x H1 H2; apply Rge_le; rewrite <- Ropp_0;
+    rewrite <- (Ropp_involutive (cos x)); apply Ropp_le_ge_contravar;
+      rewrite <- neg_cos; replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+  rewrite cos_period; apply cos_ge_0.
+  replace (- (PI / 2)) with (- PI + PI / 2).
+  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_le_compat_l;
+    assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring.
+  unfold Rminus in |- *; rewrite Rplus_comm;
+    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+  apply Rplus_le_compat_l; assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring. 
+  unfold INR in |- *; ring.
 Qed.
 
 Lemma sin_lt_0 : forall x:R, PI < x -> x < 2 * PI -> sin x < 0.
-intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x));
- apply Ropp_lt_gt_contravar; rewrite <- neg_sin;
- replace (x + PI) with (x - PI + 2 * INR 1 * PI);
- [ rewrite (sin_period (x - PI) 1); apply sin_gt_0;
-    [ replace (x - PI) with (x + - PI);
-       [ rewrite Rplus_comm; replace 0 with (- PI + PI);
-          [ apply Rplus_lt_compat_l; assumption | ring ]
-       | ring ]
-    | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
-       [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
-          [ apply Rplus_lt_compat_l; assumption | ring ]
-       | ring ] ]
- | unfold INR in |- *; ring ].
+Proof.
+  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (sin x));
+    apply Ropp_lt_gt_contravar; rewrite <- neg_sin;
+      replace (x + PI) with (x - PI + 2 * INR 1 * PI);
+      [ rewrite (sin_period (x - PI) 1); apply sin_gt_0;
+        [ replace (x - PI) with (x + - PI);
+          [ rewrite Rplus_comm; replace 0 with (- PI + PI);
+            [ apply Rplus_lt_compat_l; assumption | ring ]
+            | ring ]
+          | replace (x - PI) with (x + - PI); rewrite Rplus_comm;
+            [ pattern PI at 2 in |- *; replace PI with (- PI + 2 * PI);
+              [ apply Rplus_lt_compat_l; assumption | ring ]
+              | ring ] ]
+        | unfold INR in |- *; ring ].
 Qed.
 
 Lemma sin_lt_0_var : forall x:R, - PI < x -> x < 0 -> sin x < 0.
-intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H);
- replace (2 * PI + - PI) with PI;
- [ intro H1; rewrite Rplus_comm in H1;
-    generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); 
-    intro H2; rewrite (Rplus_comm (2 * PI)) in H2;
-    rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2;
-    rewrite <- (sin_period x 1); unfold INR in |- *;
-    replace (2 * 1 * PI) with (2 * PI);
-    [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ]
- | ring ].
+Proof.
+  intros; generalize (Rplus_lt_compat_l (2 * PI) (- PI) x H);
+    replace (2 * PI + - PI) with PI;
+    [ intro H1; rewrite Rplus_comm in H1;
+      generalize (Rplus_lt_compat_l (2 * PI) x 0 H0); 
+        intro H2; rewrite (Rplus_comm (2 * PI)) in H2;
+          rewrite <- (Rplus_comm 0) in H2; rewrite Rplus_0_l in H2;
+            rewrite <- (sin_period x 1); unfold INR in |- *;
+              replace (2 * 1 * PI) with (2 * PI);
+              [ apply (sin_lt_0 (x + 2 * PI) H1 H2) | ring ]
+      | ring ].
 Qed.
 
 Lemma cos_lt_0 : forall x:R, PI / 2 < x -> x < 3 * (PI / 2) -> cos x < 0.
-intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x));
- apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
- replace (x + PI) with (x - PI + 2 * INR 1 * PI).
-rewrite cos_period; apply cos_gt_0.
-replace (- (PI / 2)) with (- PI + PI / 2).
-unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
- assumption.
-pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
- ring. 
-unfold Rminus in |- *; rewrite Rplus_comm;
- replace (PI / 2) with (- PI + 3 * (PI / 2)).
-apply Rplus_lt_compat_l; assumption.
-pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
- ring. 
-unfold INR in |- *; ring.
+Proof.
+  intros x H1 H2; rewrite <- Ropp_0; rewrite <- (Ropp_involutive (cos x));
+    apply Ropp_lt_gt_contravar; rewrite <- neg_cos;
+      replace (x + PI) with (x - PI + 2 * INR 1 * PI).
+  rewrite cos_period; apply cos_gt_0.
+  replace (- (PI / 2)) with (- PI + PI / 2).
+  unfold Rminus in |- *; rewrite (Rplus_comm x); apply Rplus_lt_compat_l;
+    assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring. 
+  unfold Rminus in |- *; rewrite Rplus_comm;
+    replace (PI / 2) with (- PI + 3 * (PI / 2)).
+  apply Rplus_lt_compat_l; assumption.
+  pattern PI at 1 in |- *; rewrite (double_var PI); rewrite Ropp_plus_distr;
+    ring. 
+  unfold INR in |- *; ring.
 Qed.
 
 Lemma tan_gt_0 : forall x:R, 0 < x -> x < PI / 2 -> 0 < tan x.
-intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0;
- generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros;
- generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5;
- generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); 
- intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply sin_gt_0; assumption.
-apply Rinv_0_lt_compat; apply cos_gt_0; assumption.
+Proof.
+  intros x H1 H2; unfold tan in |- *; generalize _PI2_RLT_0;
+    generalize (Rlt_trans 0 x (PI / 2) H1 H2); intros;
+      generalize (Rlt_trans (- (PI / 2)) 0 x H0 H1); intro H5;
+        generalize (Rlt_trans x (PI / 2) PI H2 PI2_Rlt_PI); 
+          intro H7; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply sin_gt_0; assumption.
+  apply Rinv_0_lt_compat; apply cos_gt_0; assumption.
 Qed.
 
 Lemma tan_lt_0 : forall x:R, - (PI / 2) < x -> x < 0 -> tan x < 0.
-intros x H1 H2; unfold tan in |- *;
- generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); 
- intro H3; rewrite <- Ropp_0;
- replace (sin x / cos x) with (- (- sin x / cos x)).
-rewrite <- sin_neg; apply Ropp_gt_lt_contravar;
- change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *;
- apply Rmult_lt_0_compat.
-apply sin_gt_0.
-rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption.
-apply Rlt_trans with (PI / 2).
-rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption.
-apply PI2_Rlt_PI.
-apply Rinv_0_lt_compat; assumption.
-unfold Rdiv in |- *; ring.
+Proof.
+  intros x H1 H2; unfold tan in |- *;
+    generalize (cos_gt_0 x H1 (Rlt_trans x 0 (PI / 2) H2 PI2_RGT_0)); 
+      intro H3; rewrite <- Ropp_0;
+        replace (sin x / cos x) with (- (- sin x / cos x)).
+  rewrite <- sin_neg; apply Ropp_gt_lt_contravar;
+    change (0 < sin (- x) / cos x) in |- *; unfold Rdiv in |- *;
+      apply Rmult_lt_0_compat.
+  apply sin_gt_0.
+  rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; assumption.
+  apply Rlt_trans with (PI / 2).
+  rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_gt_lt_contravar; assumption.
+  apply PI2_Rlt_PI.
+  apply Rinv_0_lt_compat; assumption.
+  unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma cos_ge_0_3PI2 :
- forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
-intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
- unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
-generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
- generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; 
- intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
-rewrite Rplus_opp_r. 
-intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3;
- generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; 
- intro H3;
- generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
-replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
-intro H4;
- apply
-  (cos_ge_0 (2 * PI - x)
-     (Rlt_le (- (PI / 2)) (2 * PI - x)
-        (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
-rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
-ring.
+  forall x:R, 3 * (PI / 2) <= x -> x <= 2 * PI -> 0 <= cos x.
+Proof.
+  intros; rewrite <- cos_neg; rewrite <- (cos_period (- x) 1);
+    unfold INR in |- *; replace (- x + 2 * 1 * PI) with (2 * PI - x).
+  generalize (Ropp_le_ge_contravar x (2 * PI) H0); intro H1;
+    generalize (Rge_le (- x) (- (2 * PI)) H1); clear H1; 
+      intro H1; generalize (Rplus_le_compat_l (2 * PI) (- (2 * PI)) (- x) H1).
+  rewrite Rplus_opp_r. 
+  intro H2; generalize (Ropp_le_ge_contravar (3 * (PI / 2)) x H); intro H3;
+    generalize (Rge_le (- (3 * (PI / 2))) (- x) H3); clear H3; 
+      intro H3;
+        generalize (Rplus_le_compat_l (2 * PI) (- x) (- (3 * (PI / 2))) H3).
+  replace (2 * PI + - (3 * (PI / 2))) with (PI / 2).
+  intro H4;
+    apply
+      (cos_ge_0 (2 * PI - x)
+        (Rlt_le (- (PI / 2)) (2 * PI - x)
+          (Rlt_le_trans (- (PI / 2)) 0 (2 * PI - x) _PI2_RLT_0 H2)) H4).
+  rewrite double; pattern PI at 2 3 in |- *; rewrite double_var; ring.
+  ring.
 Qed.
 
 Lemma form1 :
- forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
-intros p q; pattern p at 1 in |- *;
- replace p with ((p - q) / 2 + (p + q) / 2).
-rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
-rewrite cos_plus; rewrite cos_minus; ring.
-pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  forall p q:R, cos p + cos q = 2 * cos ((p - q) / 2) * cos ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+  rewrite cos_plus; rewrite cos_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma form2 :
- forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
-intros p q; pattern p at 1 in |- *;
- replace p with ((p - q) / 2 + (p + q) / 2).
-rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
-rewrite cos_plus; rewrite cos_minus; ring.
-pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  forall p q:R, cos p - cos q = -2 * sin ((p - q) / 2) * sin ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  rewrite <- (cos_neg q); replace (- q) with ((p - q) / 2 - (p + q) / 2).
+  rewrite cos_plus; rewrite cos_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma form3 :
- forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2).
-intros p q; pattern p at 1 in |- *;
- replace p with ((p - q) / 2 + (p + q) / 2).
-pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
-rewrite sin_plus; rewrite sin_minus; ring.
-pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  forall p q:R, sin p + sin q = 2 * cos ((p - q) / 2) * sin ((p + q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+  rewrite sin_plus; rewrite sin_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 Qed.
 
 Lemma form4 :
- forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
-intros p q; pattern p at 1 in |- *;
- replace p with ((p - q) / 2 + (p + q) / 2).
-pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
-rewrite sin_plus; rewrite sin_minus; ring.
-pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
-pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  forall p q:R, sin p - sin q = 2 * cos ((p + q) / 2) * sin ((p - q) / 2).
+Proof.
+  intros p q; pattern p at 1 in |- *;
+    replace p with ((p - q) / 2 + (p + q) / 2).
+  pattern q at 3 in |- *; replace q with ((p + q) / 2 - (p - q) / 2).
+  rewrite sin_plus; rewrite sin_minus; ring.
+  pattern q at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
+  pattern p at 3 in |- *; rewrite double_var; unfold Rdiv in |- *; ring.
 
 Qed.
 
 Lemma sin_increasing_0 :
- forall x y:R,
-   - (PI / 2) <= x ->
-   x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y.
-intros; cut (sin ((x - y) / 2) < 0).
-intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5.
-assert (Hyp : 0 < 2).
-prove_sup0.
-generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5).
-unfold Rdiv in |- *.
-rewrite <- Rmult_assoc.
-rewrite Rinv_r_simpl_m.
-rewrite Rmult_0_r.
-clear H5; intro H5; apply Rminus_lt; assumption.
-discrR.
-elim H5; intro H6.
-rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4).
-change (0 < (x - y) / 2) in H6;
- generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1).
-rewrite Ropp_involutive.
-intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7;
- generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7).
-rewrite <- double_var.
-intro H8.
-assert (Hyp : 0 < 2).
-prove_sup0.
-generalize
- (Rmult_le_compat_l (/ 2) (x - y) PI
-    (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8).
-repeat rewrite (Rmult_comm (/ 2)). 
-intro H9;
- generalize
-  (sin_gt_0 ((x - y) / 2) H6
-     (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); 
- intro H10;
- elim
-  (Rlt_irrefl (sin ((x - y) / 2))
-     (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)).
-generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3;
- rewrite form4 in H3;
- generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2).
-rewrite <- double_var.
-assert (Hyp : 0 < 2).
-prove_sup0.
-intro H4;
- generalize
-  (Rmult_le_compat_l (/ 2) (x + y) PI
-     (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4).
-repeat rewrite (Rmult_comm (/ 2)). 
-clear H4; intro H4;
- generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
- replace (- (PI / 2) + - (PI / 2)) with (- PI).
-intro H5;
- generalize
-  (Rmult_le_compat_l (/ 2) (- PI) (x + y)
-     (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
-replace (/ 2 * (x + y)) with ((x + y) / 2).
-replace (/ 2 * - PI) with (- (PI / 2)).
-clear H5; intro H5; elim H4; intro H40.
-elim H5; intro H50.
-generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
- generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6).
-rewrite Rmult_0_r. 
-clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7.
-assumption.
-generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7;
- generalize
-  (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2))
-     (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8;
- generalize
-  (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3);
- intro H9; elim (Rlt_irrefl 0 H9).
-rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3;
- rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; 
- elim (Rlt_irrefl 0 H3).
-unfold Rdiv in H3.
-rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
- rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
- elim (Rlt_irrefl 0 H3).
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-apply Rmult_comm.
-unfold Rdiv in |- *; apply Rmult_comm.
-pattern PI at 1 in |- *; rewrite double_var.
-rewrite Ropp_plus_distr.
-reflexivity.
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x < sin y -> x < y.
+Proof.
+  intros; cut (sin ((x - y) / 2) < 0).
+  intro H4; case (Rtotal_order ((x - y) / 2) 0); intro H5.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  generalize (Rmult_lt_compat_l 2 ((x - y) / 2) 0 Hyp H5).
+  unfold Rdiv in |- *.
+  rewrite <- Rmult_assoc.
+  rewrite Rinv_r_simpl_m.
+  rewrite Rmult_0_r.
+  clear H5; intro H5; apply Rminus_lt; assumption.
+  discrR.
+  elim H5; intro H6.
+  rewrite H6 in H4; rewrite sin_0 in H4; elim (Rlt_irrefl 0 H4).
+  change (0 < (x - y) / 2) in H6;
+    generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1).
+  rewrite Ropp_involutive.
+  intro H7; generalize (Rge_le (PI / 2) (- y) H7); clear H7; intro H7;
+    generalize (Rplus_le_compat x (PI / 2) (- y) (PI / 2) H0 H7).
+  rewrite <- double_var.
+  intro H8.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  generalize
+    (Rmult_le_compat_l (/ 2) (x - y) PI
+      (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H8).
+  repeat rewrite (Rmult_comm (/ 2)). 
+  intro H9;
+    generalize
+      (sin_gt_0 ((x - y) / 2) H6
+        (Rle_lt_trans ((x - y) / 2) (PI / 2) PI H9 PI2_Rlt_PI)); 
+      intro H10;
+        elim
+          (Rlt_irrefl (sin ((x - y) / 2))
+            (Rlt_trans (sin ((x - y) / 2)) 0 (sin ((x - y) / 2)) H4 H10)).
+  generalize (Rlt_minus (sin x) (sin y) H3); clear H3; intro H3;
+    rewrite form4 in H3;
+      generalize (Rplus_le_compat x (PI / 2) y (PI / 2) H0 H2).
+  rewrite <- double_var.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  intro H4;
+    generalize
+      (Rmult_le_compat_l (/ 2) (x + y) PI
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H4).
+  repeat rewrite (Rmult_comm (/ 2)). 
+  clear H4; intro H4;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) y H H1);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  intro H5;
+    generalize
+      (Rmult_le_compat_l (/ 2) (- PI) (x + y)
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H5).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  replace (/ 2 * - PI) with (- (PI / 2)).
+  clear H5; intro H5; elim H4; intro H40.
+  elim H5; intro H50.
+  generalize (cos_gt_0 ((x + y) / 2) H50 H40); intro H6;
+    generalize (Rmult_lt_compat_l 2 0 (cos ((x + y) / 2)) Hyp H6).
+  rewrite Rmult_0_r. 
+  clear H6; intro H6; case (Rcase_abs (sin ((x - y) / 2))); intro H7.
+  assumption.
+  generalize (Rge_le (sin ((x - y) / 2)) 0 H7); clear H7; intro H7;
+    generalize
+      (Rmult_le_pos (2 * cos ((x + y) / 2)) (sin ((x - y) / 2))
+        (Rlt_le 0 (2 * cos ((x + y) / 2)) H6) H7); intro H8;
+      generalize
+        (Rle_lt_trans 0 (2 * cos ((x + y) / 2) * sin ((x - y) / 2)) 0 H8 H3);
+        intro H9; elim (Rlt_irrefl 0 H9).
+  rewrite <- H50 in H3; rewrite cos_neg in H3; rewrite cos_PI2 in H3;
+    rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3; 
+      elim (Rlt_irrefl 0 H3).
+  unfold Rdiv in H3.
+  rewrite H40 in H3; assert (H50 := cos_PI2); unfold Rdiv in H50;
+    rewrite H50 in H3; rewrite Rmult_0_r in H3; rewrite Rmult_0_l in H3;
+      elim (Rlt_irrefl 0 H3).
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
 Qed.
 
 Lemma sin_increasing_1 :
- forall x y:R,
-   - (PI / 2) <= x ->
-   x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y.
-intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
- generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
- replace (- (PI / 2) + - (PI / 2)) with (- PI).
-assert (Hyp : 0 < 2).
-prove_sup0.
-intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
- generalize
-  (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
- replace (/ 2 * - PI) with (- (PI / 2)).
-replace (/ 2 * (x + y)) with ((x + y) / 2).
-clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
- rewrite Rplus_comm in H5;
- generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
-rewrite <- double_var.
-intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
- generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
- replace (/ 2 * PI) with (PI / 2).
-replace (/ 2 * (x + y)) with ((x + y) / 2).
-clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
- rewrite Ropp_involutive; clear H1; intro H1;
- generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
- generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; 
- intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); 
- clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
- replace (- y + x) with (x - y).
-rewrite Rplus_opp_l.
-intro H6;
- generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
- rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
-clear H6; intro H6;
- generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
- replace (- (PI / 2) + - (PI / 2)) with (- PI).
-replace (x + - y) with (x - y).
-intro H7;
- generalize
-  (Rmult_le_compat_l (/ 2) (- PI) (x - y)
-     (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
- replace (/ 2 * - PI) with (- (PI / 2)).
-replace (/ 2 * (x - y)) with ((x - y) / 2).
-clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
- generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
- generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); 
- clear H8; intro H8; cut (- PI < - (PI / 2)).
-intro H9;
- generalize
-  (sin_lt_0_var ((x - y) / 2)
-     (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); 
- intro H10;
- generalize
-  (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 (
-     2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
- rewrite Rmult_comm; assumption.
-apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
-unfold Rdiv in |- *; apply Rmult_comm.
-unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
-reflexivity.
-pattern PI at 1 in |- *; rewrite double_var.
-rewrite Ropp_plus_distr.
-reflexivity.
-unfold Rdiv in |- *; apply Rmult_comm.
-unfold Rminus in |- *; apply Rplus_comm.
-unfold Rdiv in |- *; apply Rmult_comm.
-unfold Rdiv in |- *; apply Rmult_comm.
-unfold Rdiv in |- *; apply Rmult_comm.
-unfold Rdiv in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-apply Rmult_comm.
-pattern PI at 1 in |- *; rewrite double_var.
-rewrite Ropp_plus_distr.
-reflexivity.
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x < y -> sin x < sin y.
+Proof.
+  intros; generalize (Rplus_lt_compat_l x x y H3); intro H4;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) x H H);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  intro H5; generalize (Rle_lt_trans (- PI) (x + x) (x + y) H5 H4); intro H6;
+    generalize
+      (Rmult_lt_compat_l (/ 2) (- PI) (x + y) (Rinv_0_lt_compat 2 Hyp) H6);
+      replace (/ 2 * - PI) with (- (PI / 2)).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  clear H4 H5 H6; intro H4; generalize (Rplus_lt_compat_l y x y H3); intro H5;
+    rewrite Rplus_comm in H5;
+      generalize (Rplus_le_compat y (PI / 2) y (PI / 2) H2 H2).
+  rewrite <- double_var.
+  intro H6; generalize (Rlt_le_trans (x + y) (y + y) PI H5 H6); intro H7;
+    generalize (Rmult_lt_compat_l (/ 2) (x + y) PI (Rinv_0_lt_compat 2 Hyp) H7);
+      replace (/ 2 * PI) with (PI / 2).
+  replace (/ 2 * (x + y)) with ((x + y) / 2).
+  clear H5 H6 H7; intro H5; generalize (Ropp_le_ge_contravar (- (PI / 2)) y H1);
+    rewrite Ropp_involutive; clear H1; intro H1;
+      generalize (Rge_le (PI / 2) (- y) H1); clear H1; intro H1;
+        generalize (Ropp_le_ge_contravar y (PI / 2) H2); clear H2; 
+          intro H2; generalize (Rge_le (- y) (- (PI / 2)) H2); 
+            clear H2; intro H2; generalize (Rplus_lt_compat_l (- y) x y H3);
+              replace (- y + x) with (x - y).
+  rewrite Rplus_opp_l.
+  intro H6;
+    generalize (Rmult_lt_compat_l (/ 2) (x - y) 0 (Rinv_0_lt_compat 2 Hyp) H6);
+      rewrite Rmult_0_r; replace (/ 2 * (x - y)) with ((x - y) / 2).
+  clear H6; intro H6;
+    generalize (Rplus_le_compat (- (PI / 2)) x (- (PI / 2)) (- y) H H2);
+      replace (- (PI / 2) + - (PI / 2)) with (- PI).
+  replace (x + - y) with (x - y).
+  intro H7;
+    generalize
+      (Rmult_le_compat_l (/ 2) (- PI) (x - y)
+        (Rlt_le 0 (/ 2) (Rinv_0_lt_compat 2 Hyp)) H7);
+      replace (/ 2 * - PI) with (- (PI / 2)).
+  replace (/ 2 * (x - y)) with ((x - y) / 2).
+  clear H7; intro H7; clear H H0 H1 H2; apply Rminus_lt; rewrite form4;
+    generalize (cos_gt_0 ((x + y) / 2) H4 H5); intro H8;
+      generalize (Rmult_lt_0_compat 2 (cos ((x + y) / 2)) Hyp H8); 
+        clear H8; intro H8; cut (- PI < - (PI / 2)).
+  intro H9;
+    generalize
+      (sin_lt_0_var ((x - y) / 2)
+        (Rlt_le_trans (- PI) (- (PI / 2)) ((x - y) / 2) H9 H7) H6); 
+      intro H10;
+        generalize
+          (Rmult_lt_gt_compat_neg_l (sin ((x - y) / 2)) 0 (
+            2 * cos ((x + y) / 2)) H10 H8); intro H11; rewrite Rmult_0_r in H11;
+          rewrite Rmult_comm; assumption.
+  apply Ropp_lt_gt_contravar; apply PI2_Rlt_PI.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse; apply Rmult_comm.
+  reflexivity.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rminus in |- *; apply Rplus_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *; apply Rmult_comm.
+  unfold Rdiv in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rmult_comm.
+  pattern PI at 1 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  reflexivity.
 Qed.
 
 Lemma sin_decreasing_0 :
- forall x y:R,
-   x <= 3 * (PI / 2) ->
-   PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x.
-intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3;
- generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3);
- repeat rewrite <- sin_neg;
- generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
- generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
- generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
- generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
- replace (- PI + x) with (x - PI).
-replace (- PI + PI / 2) with (- (PI / 2)).
-replace (- PI + y) with (y - PI).
-replace (- PI + 3 * (PI / 2)) with (PI / 2).
-replace (- (PI - x)) with (x - PI).
-replace (- (PI - y)) with (y - PI).
-intros; change (sin (y - PI) < sin (x - PI)) in H8;
- apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
- replace (y + - PI) with (y - PI).
-rewrite Rplus_comm; replace (x + - PI) with (x - PI).
-apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
-reflexivity.
-reflexivity.
-unfold Rminus in |- *; rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-apply Rplus_comm.
-unfold Rminus in |- *; rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-apply Rplus_comm.
-pattern PI at 2 in |- *; rewrite double_var.
-rewrite Ropp_plus_distr.
-ring.
-unfold Rminus in |- *; apply Rplus_comm.
-pattern PI at 2 in |- *; rewrite double_var.
-rewrite Ropp_plus_distr.
-ring.
-unfold Rminus in |- *; apply Rplus_comm.
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x < sin y -> y < x.
+Proof.
+  intros; rewrite <- (sin_PI_x x) in H3; rewrite <- (sin_PI_x y) in H3;
+    generalize (Ropp_lt_gt_contravar (sin (PI - x)) (sin (PI - y)) H3);
+      repeat rewrite <- sin_neg;
+        generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+          generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+            generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+              generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+                replace (- PI + x) with (x - PI).
+  replace (- PI + PI / 2) with (- (PI / 2)).
+  replace (- PI + y) with (y - PI).
+  replace (- PI + 3 * (PI / 2)) with (PI / 2).
+  replace (- (PI - x)) with (x - PI).
+  replace (- (PI - y)) with (y - PI).
+  intros; change (sin (y - PI) < sin (x - PI)) in H8;
+    apply Rplus_lt_reg_r with (- PI); rewrite Rplus_comm;
+      replace (y + - PI) with (y - PI).
+  rewrite Rplus_comm; replace (x + - PI) with (x - PI).
+  apply (sin_increasing_0 (y - PI) (x - PI) H4 H5 H6 H7 H8).
+  reflexivity.
+  reflexivity.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  ring.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var.
+  rewrite Ropp_plus_distr.
+  ring.
+  unfold Rminus in |- *; apply Rplus_comm.
 Qed.
 
 Lemma sin_decreasing_1 :
- forall x y:R,
-   x <= 3 * (PI / 2) ->
-   PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x.
-intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y);
- generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
- generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
- generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
- generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
- generalize (Rplus_lt_compat_l (- PI) x y H3);
- replace (- PI + PI / 2) with (- (PI / 2)).
-replace (- PI + y) with (y - PI).
-replace (- PI + 3 * (PI / 2)) with (PI / 2).
-replace (- PI + x) with (x - PI).
-intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
- replace (- (PI - x)) with (x - PI).
-replace (- (PI - y)) with (y - PI).
-apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
-unfold Rminus in |- *; rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-apply Rplus_comm.
-unfold Rminus in |- *; rewrite Ropp_plus_distr.
-rewrite Ropp_involutive.
-apply Rplus_comm.
-unfold Rminus in |- *; apply Rplus_comm.
-pattern PI at 2 in |- *; rewrite double_var; ring.
-unfold Rminus in |- *; apply Rplus_comm.
-pattern PI at 2 in |- *; rewrite double_var; ring.
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x -> y <= 3 * (PI / 2) -> PI / 2 <= y -> x < y -> sin y < sin x.
+Proof.
+  intros; rewrite <- (sin_PI_x x); rewrite <- (sin_PI_x y);
+    generalize (Rplus_le_compat_l (- PI) x (3 * (PI / 2)) H);
+      generalize (Rplus_le_compat_l (- PI) (PI / 2) x H0);
+        generalize (Rplus_le_compat_l (- PI) y (3 * (PI / 2)) H1);
+          generalize (Rplus_le_compat_l (- PI) (PI / 2) y H2);
+            generalize (Rplus_lt_compat_l (- PI) x y H3);
+              replace (- PI + PI / 2) with (- (PI / 2)).
+  replace (- PI + y) with (y - PI).
+  replace (- PI + 3 * (PI / 2)) with (PI / 2).
+  replace (- PI + x) with (x - PI).
+  intros; apply Ropp_lt_cancel; repeat rewrite <- sin_neg;
+    replace (- (PI - x)) with (x - PI).
+  replace (- (PI - y)) with (y - PI).
+  apply (sin_increasing_1 (x - PI) (y - PI) H7 H8 H5 H6 H4).
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; rewrite Ropp_plus_distr.
+  rewrite Ropp_involutive.
+  apply Rplus_comm.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
+  unfold Rminus in |- *; apply Rplus_comm.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
 Qed.
 
 Lemma cos_increasing_0 :
- forall x y:R,
-   PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y.
-intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
- rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
- unfold INR in |- *;
- replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
-repeat rewrite cos_shift; intro H5;
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
-replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
-replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
-clear H1 H2 H3 H4; intros H1 H2 H3 H4;
- apply Rplus_lt_reg_r with (-3 * (PI / 2));
- replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
-unfold Rminus in |- *.
-rewrite Ropp_mult_distr_l_reverse. 
-apply Rplus_comm. 
-unfold Rminus in |- *.
-rewrite Ropp_mult_distr_l_reverse. 
-apply Rplus_comm. 
-pattern PI at 3 in |- *; rewrite double_var.
-ring.
-rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
-unfold Rminus in |- *.
-rewrite Ropp_mult_distr_l_reverse. 
-apply Rplus_comm. 
-unfold Rminus in |- *.
-rewrite Ropp_mult_distr_l_reverse. 
-apply Rplus_comm. 
-rewrite Rmult_1_r.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
-rewrite Rmult_1_r.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
+  forall x y:R,
+    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x < cos y -> x < y.
+Proof.
+  intros x y H1 H2 H3 H4; rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+    rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+      unfold INR in |- *;
+        replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+  repeat rewrite cos_shift; intro H5;
+    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+  clear H1 H2 H3 H4; intros H1 H2 H3 H4;
+    apply Rplus_lt_reg_r with (-3 * (PI / 2));
+      replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  apply (sin_increasing_0 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H4 H3 H2 H1 H5).
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse. 
+  apply Rplus_comm. 
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse. 
+  apply Rplus_comm. 
+  pattern PI at 3 in |- *; rewrite double_var.
+  ring.
+  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse. 
+  apply Rplus_comm. 
+  unfold Rminus in |- *.
+  rewrite Ropp_mult_distr_l_reverse. 
+  apply Rplus_comm. 
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
 Qed.
 
 Lemma cos_increasing_1 :
- forall x y:R,
-   PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y.
-intros x y H1 H2 H3 H4 H5;
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
- generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4);
- generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
- rewrite <- (cos_neg x); rewrite <- (cos_neg y);
- rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
- unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
-replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
-replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
-replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
-clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
- replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
-replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
-repeat rewrite cos_shift;
- apply
-  (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
-rewrite Rmult_1_r.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
-rewrite Rmult_1_r.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
-ring.
-pattern PI at 3 in |- *; rewrite double_var; ring.
-unfold Rminus in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-apply Rplus_comm.
-unfold Rminus in |- *.
-rewrite <- Ropp_mult_distr_l_reverse.
-apply Rplus_comm.
+  forall x y:R,
+    PI <= x -> x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x < y -> cos x < cos y.
+Proof.
+  intros x y H1 H2 H3 H4 H5;
+    generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI x H1);
+      generalize (Rplus_le_compat_l (-3 * (PI / 2)) x (2 * PI) H2);
+        generalize (Rplus_le_compat_l (-3 * (PI / 2)) PI y H3);
+          generalize (Rplus_le_compat_l (-3 * (PI / 2)) y (2 * PI) H4);
+            generalize (Rplus_lt_compat_l (-3 * (PI / 2)) x y H5);
+              rewrite <- (cos_neg x); rewrite <- (cos_neg y);
+                rewrite <- (cos_period (- x) 1); rewrite <- (cos_period (- y) 1);
+                  unfold INR in |- *; replace (-3 * (PI / 2) + x) with (x - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + y) with (y - 3 * (PI / 2)).
+  replace (-3 * (PI / 2) + PI) with (- (PI / 2)).
+  replace (-3 * (PI / 2) + 2 * PI) with (PI / 2).
+  clear H1 H2 H3 H4 H5; intros H1 H2 H3 H4 H5;
+    replace (- x + 2 * 1 * PI) with (PI / 2 - (x - 3 * (PI / 2))).
+  replace (- y + 2 * 1 * PI) with (PI / 2 - (y - 3 * (PI / 2))).
+  repeat rewrite cos_shift;
+    apply
+      (sin_increasing_1 (x - 3 * (PI / 2)) (y - 3 * (PI / 2)) H5 H4 H3 H2 H1).
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite Rmult_1_r.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite double_var.
+  ring.
+  pattern PI at 3 in |- *; rewrite double_var; ring.
+  unfold Rminus in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
+  unfold Rminus in |- *.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rplus_comm.
 Qed.
 
 Lemma cos_decreasing_0 :
- forall x y:R,
-   0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x.
-intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3);
- repeat rewrite <- neg_cos; intro H4;
- change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4;
- rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H);
- generalize (Rplus_le_compat_l PI x PI H0);
- generalize (Rplus_le_compat_l PI 0 y H1);
- generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
-rewrite <- double.
-clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
- apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x < cos y -> y < x.
+Proof.
+  intros; generalize (Ropp_lt_gt_contravar (cos x) (cos y) H3);
+    repeat rewrite <- neg_cos; intro H4;
+      change (cos (y + PI) < cos (x + PI)) in H4; rewrite (Rplus_comm x) in H4;
+        rewrite (Rplus_comm y) in H4; generalize (Rplus_le_compat_l PI 0 x H);
+          generalize (Rplus_le_compat_l PI x PI H0);
+            generalize (Rplus_le_compat_l PI 0 y H1);
+              generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+  rewrite <- double.
+  clear H H0 H1 H2 H3; intros; apply Rplus_lt_reg_r with PI;
+    apply (cos_increasing_0 (PI + y) (PI + x) H0 H H2 H1 H4).
 Qed.
 
 Lemma cos_decreasing_1 :
- forall x y:R,
-   0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x.
-intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos;
- rewrite (Rplus_comm x); rewrite (Rplus_comm y);
- generalize (Rplus_le_compat_l PI 0 x H);
- generalize (Rplus_le_compat_l PI x PI H0);
- generalize (Rplus_le_compat_l PI 0 y H1);
- generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
-rewrite <- double.
-generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros;
- apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H).
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x < y -> cos y < cos x.
+Proof.
+  intros; apply Ropp_lt_cancel; repeat rewrite <- neg_cos;
+    rewrite (Rplus_comm x); rewrite (Rplus_comm y);
+      generalize (Rplus_le_compat_l PI 0 x H);
+        generalize (Rplus_le_compat_l PI x PI H0);
+          generalize (Rplus_le_compat_l PI 0 y H1);
+            generalize (Rplus_le_compat_l PI y PI H2); rewrite Rplus_0_r.
+  rewrite <- double.
+  generalize (Rplus_lt_compat_l PI x y H3); clear H H0 H1 H2 H3; intros;
+    apply (cos_increasing_1 (PI + x) (PI + y) H3 H2 H1 H0 H).
 Qed.
 
 Lemma tan_diff :
- forall x y:R,
-   cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
-intros; unfold tan in |- *; rewrite sin_minus.
-unfold Rdiv in |- *. 
-unfold Rminus in |- *.
-rewrite Rmult_plus_distr_r.
-rewrite Rinv_mult_distr.
-repeat rewrite (Rmult_comm (sin x)).
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm (cos y)).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-rewrite (Rmult_comm (sin x)).
-apply Rplus_eq_compat_l.
-rewrite <- Ropp_mult_distr_l_reverse.
-rewrite <- Ropp_mult_distr_r_reverse.
-rewrite (Rmult_comm (/ cos x)).
-repeat rewrite Rmult_assoc.
-rewrite (Rmult_comm (cos x)).
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-reflexivity.
-assumption.
-assumption.
-assumption.
-assumption.
+  forall x y:R,
+    cos x <> 0 -> cos y <> 0 -> tan x - tan y = sin (x - y) / (cos x * cos y).
+Proof.
+  intros; unfold tan in |- *; rewrite sin_minus.
+  unfold Rdiv in |- *. 
+  unfold Rminus in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rinv_mult_distr.
+  repeat rewrite (Rmult_comm (sin x)).
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (cos y)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  rewrite (Rmult_comm (sin x)).
+  apply Rplus_eq_compat_l.
+  rewrite <- Ropp_mult_distr_l_reverse.
+  rewrite <- Ropp_mult_distr_r_reverse.
+  rewrite (Rmult_comm (/ cos x)).
+  repeat rewrite Rmult_assoc.
+  rewrite (Rmult_comm (cos x)).
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  reflexivity.
+  assumption.
+  assumption.
+  assumption.
+  assumption.
 Qed.
 
 Lemma tan_increasing_0 :
- forall x y:R,
-   - (PI / 4) <= x ->
-   x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y.
-intros; generalize PI4_RLT_PI2; intro H4;
- generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); 
- intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
- generalize
-  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-     (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
- generalize
-  (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-     (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
- generalize
-  (sym_not_eq
-     (Rlt_not_eq 0 (cos x)
-        (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-           (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); 
- intro H6;
- generalize
-  (sym_not_eq
-     (Rlt_not_eq 0 (cos y)
-        (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-           (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); 
- intro H7; generalize (tan_diff x y H6 H7); intro H8;
- generalize (Rlt_minus (tan x) (tan y) H3); clear H3; 
- intro H3; rewrite H8 in H3; cut (sin (x - y) < 0).
-intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1);
- rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10);
- clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
- intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); 
- clear H11; intro H11;
- generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
- generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
- replace (x + - y) with (x - y).
-replace (PI / 4 + PI / 4) with (PI / 2).
-replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
-intros; case (Rtotal_order 0 (x - y)); intro H14.
-generalize
- (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
- intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)).
-elim H14; intro H15.
-rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). 
-apply Rminus_lt; assumption.
-pattern PI at 1 in |- *; rewrite double_var.
-unfold Rdiv in |- *.
-rewrite Rmult_plus_distr_r.
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_mult_distr.
-rewrite Ropp_plus_distr.
-replace 4 with 4.
-reflexivity.
-ring.
-discrR.
-discrR.
-pattern PI at 1 in |- *; rewrite double_var.
-unfold Rdiv in |- *.
-rewrite Rmult_plus_distr_r.
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_mult_distr.
-replace 4 with 4.
-reflexivity.
-ring.
-discrR.
-discrR.
-reflexivity.
-case (Rcase_abs (sin (x - y))); intro H9.
-assumption.
-generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
- generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
- generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
- generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
- replace (/ cos x * / cos y) with (/ (cos x * cos y)).
-intro H12;
- generalize
-  (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9
-     (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
- elim
-  (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
-rewrite Rinv_mult_distr.
-reflexivity. 
-assumption.
-assumption.
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x < tan y -> x < y.
+Proof.
+  intros; generalize PI4_RLT_PI2; intro H4;
+    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); 
+      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+        generalize
+          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+          generalize
+            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+            generalize
+              (sym_not_eq
+                (Rlt_not_eq 0 (cos x)
+                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); 
+              intro H6;
+                generalize
+                  (sym_not_eq
+                    (Rlt_not_eq 0 (cos y)
+                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); 
+                  intro H7; generalize (tan_diff x y H6 H7); intro H8;
+                    generalize (Rlt_minus (tan x) (tan y) H3); clear H3; 
+                      intro H3; rewrite H8 in H3; cut (sin (x - y) < 0).
+  intro H9; generalize (Ropp_le_ge_contravar (- (PI / 4)) y H1);
+    rewrite Ropp_involutive; intro H10; generalize (Rge_le (PI / 4) (- y) H10);
+      clear H10; intro H10; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+        intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); 
+          clear H11; intro H11;
+            generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+              generalize (Rplus_le_compat x (PI / 4) (- y) (PI / 4) H0 H10);
+                replace (x + - y) with (x - y).
+  replace (PI / 4 + PI / 4) with (PI / 2).
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+  intros; case (Rtotal_order 0 (x - y)); intro H14.
+  generalize
+    (sin_gt_0 (x - y) H14 (Rle_lt_trans (x - y) (PI / 2) PI H12 PI2_Rlt_PI));
+    intro H15; elim (Rlt_irrefl 0 (Rlt_trans 0 (sin (x - y)) 0 H15 H9)).
+  elim H14; intro H15.
+  rewrite <- H15 in H9; rewrite sin_0 in H9; elim (Rlt_irrefl 0 H9). 
+  apply Rminus_lt; assumption.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  rewrite Ropp_plus_distr.
+  replace 4 with 4.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  replace 4 with 4.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  reflexivity.
+  case (Rcase_abs (sin (x - y))); intro H9.
+  assumption.
+  generalize (Rge_le (sin (x - y)) 0 H9); clear H9; intro H9;
+    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+  intro H12;
+    generalize
+      (Rmult_le_pos (sin (x - y)) (/ (cos x * cos y)) H9
+        (Rlt_le 0 (/ (cos x * cos y)) H12)); intro H13;
+      elim
+        (Rlt_irrefl 0 (Rle_lt_trans 0 (sin (x - y) * / (cos x * cos y)) 0 H13 H3)).
+  rewrite Rinv_mult_distr.
+  reflexivity. 
+  assumption.
+  assumption.
 Qed.
 
 Lemma tan_increasing_1 :
- forall x y:R,
-   - (PI / 4) <= x ->
-   x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y.
-intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4;
- generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); 
- intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
- generalize
-  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-     (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
- generalize
-  (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-     (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
- generalize
-  (sym_not_eq
-     (Rlt_not_eq 0 (cos x)
-        (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
-           (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); 
- intro H6;
- generalize
-  (sym_not_eq
-     (Rlt_not_eq 0 (cos y)
-        (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
-           (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); 
- intro H7; rewrite (tan_diff x y H6 H7);
- generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
- generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
- generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
- replace (/ cos x * / cos y) with (/ (cos x * cos y)).
-clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
- intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); 
- clear H11; intro H11;
- generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
- replace (x + - y) with (x - y).
-replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
-clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
- clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; 
- intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); 
- clear H1; intro H1;
- generalize
-  (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3);
- intro H2;
- generalize
-  (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
- rewrite Rmult_0_r; intro H4; assumption.
-pattern PI at 1 in |- *; rewrite double_var.
-unfold Rdiv in |- *.
-rewrite Rmult_plus_distr_r.
-repeat rewrite Rmult_assoc.
-rewrite <- Rinv_mult_distr.
-replace 4 with 4.
-rewrite Ropp_plus_distr.
-reflexivity.
-ring.
-discrR.
-discrR.
-reflexivity.
-apply Rinv_mult_distr; assumption.
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x < y -> tan x < tan y.
+Proof.
+  intros; apply Rminus_lt; generalize PI4_RLT_PI2; intro H4;
+    generalize (Ropp_lt_gt_contravar (PI / 4) (PI / 2) H4); 
+      intro H5; change (- (PI / 2) < - (PI / 4)) in H5;
+        generalize
+          (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+            (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)); intro HP1;
+          generalize
+            (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+              (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)); intro HP2;
+            generalize
+              (sym_not_eq
+                (Rlt_not_eq 0 (cos x)
+                  (cos_gt_0 x (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) x H5 H)
+                    (Rle_lt_trans x (PI / 4) (PI / 2) H0 H4)))); 
+              intro H6;
+                generalize
+                  (sym_not_eq
+                    (Rlt_not_eq 0 (cos y)
+                      (cos_gt_0 y (Rlt_le_trans (- (PI / 2)) (- (PI / 4)) y H5 H1)
+                        (Rle_lt_trans y (PI / 4) (PI / 2) H2 H4)))); 
+                  intro H7; rewrite (tan_diff x y H6 H7);
+                    generalize (Rinv_0_lt_compat (cos x) HP1); intro H10;
+                      generalize (Rinv_0_lt_compat (cos y) HP2); intro H11;
+                        generalize (Rmult_lt_0_compat (/ cos x) (/ cos y) H10 H11);
+                          replace (/ cos x * / cos y) with (/ (cos x * cos y)).
+  clear H10 H11; intro H8; generalize (Ropp_le_ge_contravar y (PI / 4) H2);
+    intro H11; generalize (Rge_le (- y) (- (PI / 4)) H11); 
+      clear H11; intro H11;
+        generalize (Rplus_le_compat (- (PI / 4)) x (- (PI / 4)) (- y) H H11);
+          replace (x + - y) with (x - y).
+  replace (- (PI / 4) + - (PI / 4)) with (- (PI / 2)).
+  clear H11; intro H9; generalize (Rlt_minus x y H3); clear H3; intro H3;
+    clear H H0 H1 H2 H4 H5 HP1 HP2; generalize PI2_Rlt_PI; 
+      intro H1; generalize (Ropp_lt_gt_contravar (PI / 2) PI H1); 
+        clear H1; intro H1;
+          generalize
+            (sin_lt_0_var (x - y) (Rlt_le_trans (- PI) (- (PI / 2)) (x - y) H1 H9) H3);
+            intro H2;
+              generalize
+                (Rmult_lt_gt_compat_neg_l (sin (x - y)) 0 (/ (cos x * cos y)) H2 H8);
+                rewrite Rmult_0_r; intro H4; assumption.
+  pattern PI at 1 in |- *; rewrite double_var.
+  unfold Rdiv in |- *.
+  rewrite Rmult_plus_distr_r.
+  repeat rewrite Rmult_assoc.
+  rewrite <- Rinv_mult_distr.
+  replace 4 with 4.
+  rewrite Ropp_plus_distr.
+  reflexivity.
+  ring.
+  discrR.
+  discrR.
+  reflexivity.
+  apply Rinv_mult_distr; assumption.
 Qed.
 
 Lemma sin_incr_0 :
- forall x y:R,
-   - (PI / 2) <= x ->
-   x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y.
-intros; case (Rtotal_order (sin x) (sin y)); intro H4;
- [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order x y); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ]
-    | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> sin x <= sin y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+    [ left; apply (sin_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (sin_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8) ] ]
+          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
 Qed.
 
 Lemma sin_incr_1 :
- forall x y:R,
-   - (PI / 2) <= x ->
-   x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y.
-intros; case (Rtotal_order x y); intro H4;
- [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order (sin x) (sin y)); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-    | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+  forall x y:R,
+    - (PI / 2) <= x ->
+    x <= PI / 2 -> - (PI / 2) <= y -> y <= PI / 2 -> x <= y -> sin x <= sin y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (sin_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (sin x) (sin y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (sin_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
 Qed.
 
 Lemma sin_decr_0 :
- forall x y:R,
-   x <= 3 * (PI / 2) ->
-   PI / 2 <= x ->
-   y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x.
-intros; case (Rtotal_order (sin x) (sin y)); intro H4;
- [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order x y); intro H6;
-       [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8;
-          rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8)
-       | elim H6; intro H7;
-          [ right; symmetry  in |- *; assumption | left; assumption ] ]
-    | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x ->
+    y <= 3 * (PI / 2) -> PI / 2 <= y -> sin x <= sin y -> y <= x.
+Proof.
+  intros; case (Rtotal_order (sin x) (sin y)); intro H4;
+    [ left; apply (sin_decreasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ generalize (sin_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl (sin y) H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl (sin x) (Rle_lt_trans (sin x) (sin y) (sin x) H3 H5)) ] ].
 Qed.
 
 Lemma sin_decr_1 :
- forall x y:R,
-   x <= 3 * (PI / 2) ->
-   PI / 2 <= x ->
-   y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x.
-intros; case (Rtotal_order x y); intro H4;
- [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order (sin x) (sin y)); intro H6;
-       [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8;
-          rewrite H5 in H8; elim (Rlt_irrefl y H8)
-       | elim H6; intro H7;
-          [ right; symmetry  in |- *; assumption | left; assumption ] ]
-    | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+  forall x y:R,
+    x <= 3 * (PI / 2) ->
+    PI / 2 <= x ->
+    y <= 3 * (PI / 2) -> PI / 2 <= y -> x <= y -> sin y <= sin x.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (sin_decreasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (sin x) (sin y)); intro H6;
+          [ generalize (sin_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl y H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
 Qed.
 
 Lemma cos_incr_0 :
- forall x y:R,
-   PI <= x ->
-   x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y.
-intros; case (Rtotal_order (cos x) (cos y)); intro H4;
- [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order x y); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ]
-    | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+  forall x y:R,
+    PI <= x ->
+    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> cos x <= cos y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+    [ left; apply (cos_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (cos_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8) ] ]
+          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
 Qed.
 
 Lemma cos_incr_1 :
- forall x y:R,
-   PI <= x ->
-   x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y.
-intros; case (Rtotal_order x y); intro H4;
- [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order (cos x) (cos y)); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-    | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+  forall x y:R,
+    PI <= x ->
+    x <= 2 * PI -> PI <= y -> y <= 2 * PI -> x <= y -> cos x <= cos y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (cos_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (cos x) (cos y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (cos_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
 Qed.
 
 Lemma cos_decr_0 :
- forall x y:R,
-   0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x.
-intros; case (Rtotal_order (cos x) (cos y)); intro H4;
- [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order x y); intro H6;
-       [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8;
-          rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8)
-       | elim H6; intro H7;
-          [ right; symmetry  in |- *; assumption | left; assumption ] ]
-    | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> cos x <= cos y -> y <= x.
+Proof.
+  intros; case (Rtotal_order (cos x) (cos y)); intro H4;
+    [ left; apply (cos_decreasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ generalize (cos_decreasing_1 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl (cos y) H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl (cos x) (Rle_lt_trans (cos x) (cos y) (cos x) H3 H5)) ] ].
 Qed.
 
 Lemma cos_decr_1 :
- forall x y:R,
-   0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x.
-intros; case (Rtotal_order x y); intro H4;
- [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order (cos x) (cos y)); intro H6;
-       [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8;
-          rewrite H5 in H8; elim (Rlt_irrefl y H8)
-       | elim H6; intro H7;
-          [ right; symmetry  in |- *; assumption | left; assumption ] ]
-    | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+  forall x y:R,
+    0 <= x -> x <= PI -> 0 <= y -> y <= PI -> x <= y -> cos y <= cos x.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (cos_decreasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (cos x) (cos y)); intro H6;
+          [ generalize (cos_decreasing_0 x y H H0 H1 H2 H6); intro H8;
+            rewrite H5 in H8; elim (Rlt_irrefl y H8)
+            | elim H6; intro H7;
+              [ right; symmetry  in |- *; assumption | left; assumption ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
 Qed.
 
 Lemma tan_incr_0 :
- forall x y:R,
-   - (PI / 4) <= x ->
-   x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y.
-intros; case (Rtotal_order (tan x) (tan y)); intro H4;
- [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order x y); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ]
-    | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ].
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> tan x <= tan y -> x <= y.
+Proof.
+  intros; case (Rtotal_order (tan x) (tan y)); intro H4;
+    [ left; apply (tan_increasing_0 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order x y); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (tan_increasing_1 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl (tan y) H8) ] ]
+          | elim (Rlt_irrefl (tan x) (Rle_lt_trans (tan x) (tan y) (tan x) H3 H5)) ] ].
 Qed.
 
 Lemma tan_incr_1 :
- forall x y:R,
-   - (PI / 4) <= x ->
-   x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y.
-intros; case (Rtotal_order x y); intro H4;
- [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4)
- | elim H4; intro H5;
-    [ case (Rtotal_order (tan x) (tan y)); intro H6;
-       [ left; assumption
-       | elim H6; intro H7;
-          [ right; assumption
-          | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8;
-             rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
-    | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
+  forall x y:R,
+    - (PI / 4) <= x ->
+    x <= PI / 4 -> - (PI / 4) <= y -> y <= PI / 4 -> x <= y -> tan x <= tan y.
+Proof.
+  intros; case (Rtotal_order x y); intro H4;
+    [ left; apply (tan_increasing_1 x y H H0 H1 H2 H4)
+      | elim H4; intro H5;
+        [ case (Rtotal_order (tan x) (tan y)); intro H6;
+          [ left; assumption
+            | elim H6; intro H7;
+              [ right; assumption
+                | generalize (tan_increasing_0 y x H1 H2 H H0 H7); intro H8;
+                  rewrite H5 in H8; elim (Rlt_irrefl y H8) ] ]
+          | elim (Rlt_irrefl x (Rle_lt_trans x y x H3 H5)) ] ].
 Qed.
 
 (**********)
 Lemma sin_eq_0_1 : forall x:R, (exists k : Z, x = IZR k * PI) -> sin x = 0.
-intros.
-elim H; intros.
-apply (Zcase_sign x0).
-intro.
-rewrite H1 in H0.
-simpl in H0.
-rewrite H0; rewrite Rmult_0_l; apply sin_0.
-intro.
-cut (0 <= x0)%Z.
-intro.
-elim (IZN x0 H2); intros.
-rewrite H3 in H0.
-rewrite <- INR_IZR_INZ in H0.
-rewrite H0.
-elim (even_odd_cor x1); intros.
-elim H4; intro.
-rewrite H5.
-rewrite mult_INR.
-simpl in |- *.
-rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-rewrite sin_period.
-apply sin_0.
-rewrite H5.
-rewrite S_INR; rewrite mult_INR.
-simpl in |- *.
-rewrite Rmult_plus_distr_r.
-rewrite Rmult_1_l; rewrite sin_plus.
-rewrite sin_PI.
-rewrite Rmult_0_r.
-rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-rewrite sin_period.
-rewrite sin_0; ring.
-apply le_IZR.
-left; apply IZR_lt.
-assert (H2 := Zorder.Zgt_iff_lt).
-elim (H2 x0 0%Z); intros.
-apply H3; assumption.
-intro.
-rewrite H0.
-replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)).
-cut (0 <= - x0)%Z.
-intro.
-rewrite <- Ropp_Ropp_IZR.
-elim (IZN (- x0) H2); intros.
-rewrite H3.
-rewrite <- INR_IZR_INZ.
-elim (even_odd_cor x1); intros.
-elim H4; intro.
-rewrite H5.
-rewrite mult_INR.
-simpl in |- *.
-rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-rewrite sin_period.
-rewrite sin_0; ring.
-rewrite H5.
-rewrite S_INR; rewrite mult_INR.
-simpl in |- *.
-rewrite Rmult_plus_distr_r.
-rewrite Rmult_1_l; rewrite sin_plus.
-rewrite sin_PI.
-rewrite Rmult_0_r.
-rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
-rewrite sin_period.
-rewrite sin_0; ring.
-apply le_IZR.
-apply Rplus_le_reg_l with (IZR x0).
-rewrite Rplus_0_r.
-rewrite Ropp_Ropp_IZR.
-rewrite Rplus_opp_r.
-left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
-assumption.
-rewrite <- sin_neg.
-rewrite Ropp_mult_distr_l_reverse.
-rewrite Ropp_involutive.
-reflexivity.
+Proof.
+  intros.
+  elim H; intros.
+  apply (Zcase_sign x0).
+  intro.
+  rewrite H1 in H0.
+  simpl in H0.
+  rewrite H0; rewrite Rmult_0_l; apply sin_0.
+  intro.
+  cut (0 <= x0)%Z.
+  intro.
+  elim (IZN x0 H2); intros.
+  rewrite H3 in H0.
+  rewrite <- INR_IZR_INZ in H0.
+  rewrite H0.
+  elim (even_odd_cor x1); intros.
+  elim H4; intro.
+  rewrite H5.
+  rewrite mult_INR.
+  simpl in |- *.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  apply sin_0.
+  rewrite H5.
+  rewrite S_INR; rewrite mult_INR.
+  simpl in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rmult_1_l; rewrite sin_plus.
+  rewrite sin_PI.
+  rewrite Rmult_0_r.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  apply le_IZR.
+  left; apply IZR_lt.
+  assert (H2 := Zorder.Zgt_iff_lt).
+  elim (H2 x0 0%Z); intros.
+  apply H3; assumption.
+  intro.
+  rewrite H0.
+  replace (sin (IZR x0 * PI)) with (- sin (- IZR x0 * PI)).
+  cut (0 <= - x0)%Z.
+  intro.
+  rewrite <- Ropp_Ropp_IZR.
+  elim (IZN (- x0) H2); intros.
+  rewrite H3.
+  rewrite <- INR_IZR_INZ.
+  elim (even_odd_cor x1); intros.
+  elim H4; intro.
+  rewrite H5.
+  rewrite mult_INR.
+  simpl in |- *.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  rewrite H5.
+  rewrite S_INR; rewrite mult_INR.
+  simpl in |- *.
+  rewrite Rmult_plus_distr_r.
+  rewrite Rmult_1_l; rewrite sin_plus.
+  rewrite sin_PI.
+  rewrite Rmult_0_r.
+  rewrite <- (Rplus_0_l (2 * INR x2 * PI)).
+  rewrite sin_period.
+  rewrite sin_0; ring.
+  apply le_IZR.
+  apply Rplus_le_reg_l with (IZR x0).
+  rewrite Rplus_0_r.
+  rewrite Ropp_Ropp_IZR.
+  rewrite Rplus_opp_r.
+  left; replace 0 with (IZR 0); [ apply IZR_lt | reflexivity ].
+  assumption.
+  rewrite <- sin_neg.
+  rewrite Ropp_mult_distr_l_reverse.
+  rewrite Ropp_involutive.
+  reflexivity.
 Qed.
 
 Lemma sin_eq_0_0 : forall x:R, sin x = 0 ->  exists k : Z, x = IZR k * PI.
-intros.
-assert (H0 := euclidian_division x PI PI_neq0).
-elim H0; intros q H1.
-elim H1; intros r H2.
-exists q.
-cut (r = 0).
-intro.
-elim H2; intros H4 _; rewrite H4; rewrite H3.
-apply Rplus_0_r.
-elim H2; intros.
-rewrite H3 in H.
-rewrite sin_plus in H.
-cut (sin (IZR q * PI) = 0).
-intro.
-rewrite H5 in H.
-rewrite Rmult_0_l in H.
-rewrite Rplus_0_l in H.
-assert (H6 := Rmult_integral _ _ H).
-elim H6; intro.
-assert (H8 := sin2_cos2 (IZR q * PI)).
-rewrite H5 in H8; rewrite H7 in H8.
-rewrite Rsqr_0 in H8.
-rewrite Rplus_0_r in H8.
-elim R1_neq_R0; symmetry  in |- *; assumption.
-cut (r = 0 \/ 0 < r < PI).
-intro; elim H8; intro.
-assumption.
-elim H9; intros.
-assert (H12 := sin_gt_0 _ H10 H11).
-rewrite H7 in H12; elim (Rlt_irrefl _ H12).
-rewrite Rabs_right in H4.
-elim H4; intros.
-case (Rtotal_order 0 r); intro.
-right; split; assumption.
-elim H10; intro.
-left; symmetry  in |- *; assumption.
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)).
-apply Rle_ge.
-left; apply PI_RGT_0.
-apply sin_eq_0_1.
-exists q; reflexivity.
+Proof.
+  intros.
+  assert (H0 := euclidian_division x PI PI_neq0).
+  elim H0; intros q H1.
+  elim H1; intros r H2.
+  exists q.
+  cut (r = 0).
+  intro.
+  elim H2; intros H4 _; rewrite H4; rewrite H3.
+  apply Rplus_0_r.
+  elim H2; intros.
+  rewrite H3 in H.
+  rewrite sin_plus in H.
+  cut (sin (IZR q * PI) = 0).
+  intro.
+  rewrite H5 in H.
+  rewrite Rmult_0_l in H.
+  rewrite Rplus_0_l in H.
+  assert (H6 := Rmult_integral _ _ H).
+  elim H6; intro.
+  assert (H8 := sin2_cos2 (IZR q * PI)).
+  rewrite H5 in H8; rewrite H7 in H8.
+  rewrite Rsqr_0 in H8.
+  rewrite Rplus_0_r in H8.
+  elim R1_neq_R0; symmetry  in |- *; assumption.
+  cut (r = 0 \/ 0 < r < PI).
+  intro; elim H8; intro.
+  assumption.
+  elim H9; intros.
+  assert (H12 := sin_gt_0 _ H10 H11).
+  rewrite H7 in H12; elim (Rlt_irrefl _ H12).
+  rewrite Rabs_right in H4.
+  elim H4; intros.
+  case (Rtotal_order 0 r); intro.
+  right; split; assumption.
+  elim H10; intro.
+  left; symmetry  in |- *; assumption.
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 H11)).
+  apply Rle_ge.
+  left; apply PI_RGT_0.
+  apply sin_eq_0_1.
+  exists q; reflexivity.
 Qed.
 
 Lemma cos_eq_0_0 :
- forall x:R, cos x = 0 ->  exists k : Z, x = IZR k * PI + PI / 2. 
-intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H);
- intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z;
- rewrite <- Z_R_minus; ring; rewrite Rmult_comm; rewrite <- H3;
- unfold INR in |- *.
-rewrite (double_var (- PI)); unfold Rdiv in |- *; ring.
+  forall x:R, cos x = 0 ->  exists k : Z, x = IZR k * PI + PI / 2. 
+Proof.
+  intros x H; rewrite cos_sin in H; generalize (sin_eq_0_0 (PI / INR 2 + x) H);
+    intro H2; elim H2; intros x0 H3; exists (x0 - Z_of_nat 1)%Z;
+      rewrite <- Z_R_minus; simpl; ring_simplify;
+(* rewrite (Rmult_comm PI);*) (* old ring compat *)
+        rewrite <- H3; simpl;
+          field; repeat split; discrR.
 Qed.
 
 Lemma cos_eq_0_1 :
- forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0.
-intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2;
- replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI).
-rewrite neg_sin; rewrite <- Ropp_0.
-apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity.
-pattern PI at 2 in |- *; rewrite (double_var PI); ring.
+  forall x:R, (exists k : Z, x = IZR k * PI + PI / 2) -> cos x = 0.
+Proof.
+  intros x H1; rewrite cos_sin; elim H1; intros x0 H2; rewrite H2;
+    replace (PI / 2 + (IZR x0 * PI + PI / 2)) with (IZR x0 * PI + PI).
+  rewrite neg_sin; rewrite <- Ropp_0.
+  apply Ropp_eq_compat; apply sin_eq_0_1; exists x0; reflexivity.
+  pattern PI at 2 in |- *; rewrite (double_var PI); ring.
 Qed.
 
 Lemma sin_eq_O_2PI_0 :
- forall x:R,
-   0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI.
-intros; generalize (sin_eq_0_0 x H1); intro.
-elim H2; intros k0 H3.
-case (Rtotal_order PI x); intro.
-rewrite H3 in H4; rewrite H3 in H0.
-right; right.
-generalize
- (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4);
- rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; intro;
- generalize
-  (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI)
-     (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0);
- repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-repeat rewrite Rmult_1_r; intro;
- generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); 
- rewrite <- plus_IZR.
-replace (IZR (-2) + 1) with (-1).
-intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6);
- rewrite <- plus_IZR.
-replace (IZR (-2) + 2) with 0.
-intro; cut (-1 < IZR (-2 + k0) < 1).
-intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro.
-cut (k0 = 2%Z).
-intro; rewrite H11 in H3; rewrite H3; simpl in |- *.
-reflexivity.
-rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10);
- intro; assumption.
-split.
-assumption.
-apply Rle_lt_trans with 0.
-assumption.
-apply Rlt_0_1.
-simpl in |- *; ring.
-simpl in |- *; ring.
-apply PI_neq0.
-apply PI_neq0.
-elim H4; intro.
-right; left.
-symmetry  in |- *; assumption.
-left.
-rewrite H3 in H5; rewrite H3 in H;
- generalize
-  (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0)
-     H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; intro;
- generalize
-  (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI)
-     (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H);
- repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; rewrite Rmult_0_l; intro.
-cut (-1 < IZR k0 < 1).
-intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3;
- simpl in |- *; apply Rmult_0_l.
-split.
-apply Rlt_le_trans with 0.
-rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1.
-assumption.
-assumption.
-apply PI_neq0.
-apply PI_neq0.
+  forall x:R,
+    0 <= x -> x <= 2 * PI -> sin x = 0 -> x = 0 \/ x = PI \/ x = 2 * PI.
+Proof.
+  intros; generalize (sin_eq_0_0 x H1); intro.
+  elim H2; intros k0 H3.
+  case (Rtotal_order PI x); intro.
+  rewrite H3 in H4; rewrite H3 in H0.
+  right; right.
+  generalize
+    (Rmult_lt_compat_r (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0) H4);
+    rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; intro;
+    generalize
+      (Rmult_le_compat_r (/ PI) (IZR k0 * PI) (2 * PI)
+        (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H0);
+      repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+  repeat rewrite Rmult_1_r; intro;
+    generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H5); 
+      rewrite <- plus_IZR.
+  replace (IZR (-2) + 1) with (-1).
+  intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) 2 H6);
+    rewrite <- plus_IZR.
+  replace (IZR (-2) + 2) with 0.
+  intro; cut (-1 < IZR (-2 + k0) < 1).
+  intro; generalize (one_IZR_lt1 (-2 + k0) H9); intro.
+  cut (k0 = 2%Z).
+  intro; rewrite H11 in H3; rewrite H3; simpl in |- *.
+  reflexivity.
+  rewrite <- (Zplus_opp_l 2) in H10; generalize (Zplus_reg_l (-2) k0 2 H10);
+    intro; assumption.
+  split.
+  assumption.
+  apply Rle_lt_trans with 0.
+  assumption.
+  apply Rlt_0_1.
+  simpl in |- *; ring.
+  simpl in |- *; ring.
+  apply PI_neq0.
+  apply PI_neq0.
+  elim H4; intro.
+  right; left.
+  symmetry  in |- *; assumption.
+  left.
+  rewrite H3 in H5; rewrite H3 in H;
+    generalize
+      (Rmult_lt_compat_r (/ PI) (IZR k0 * PI) PI (Rinv_0_lt_compat PI PI_RGT_0)
+        H5); rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; intro;
+    generalize
+      (Rmult_le_compat_r (/ PI) 0 (IZR k0 * PI)
+        (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H);
+      repeat rewrite Rmult_assoc; repeat rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; rewrite Rmult_0_l; intro.
+  cut (-1 < IZR k0 < 1).
+  intro; generalize (one_IZR_lt1 k0 H8); intro; rewrite H9 in H3; rewrite H3;
+    simpl in |- *; apply Rmult_0_l.
+  split.
+  apply Rlt_le_trans with 0.
+  rewrite <- Ropp_0; apply Ropp_gt_lt_contravar; apply Rlt_0_1.
+  assumption.
+  assumption.
+  apply PI_neq0.
+  apply PI_neq0.
 Qed.
 
 Lemma sin_eq_O_2PI_1 :
- forall x:R,
-   0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0.
-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 ] ].
+  forall x:R,
+    0 <= x -> x <= 2 * PI -> x = 0 \/ x = PI \/ x = 2 * PI -> sin x = 0.
+Proof.
+  intros x H1 H2 H3; elim H3; intro H4;
+    [ rewrite H4; rewrite sin_0; reflexivity
+      | elim H4; intro H5;
+        [ rewrite H5; rewrite sin_PI; reflexivity
+          | rewrite H5; rewrite sin_2PI; reflexivity ] ].
 Qed.
 
 Lemma cos_eq_0_2PI_0 :
- forall x:R,
-   0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2).
-intros; case (Rtotal_order x (3 * (PI / 2))); intro.
-rewrite cos_sin in H1.
-cut (0 <= PI / 2 + x).
-cut (PI / 2 + x <= 2 * PI).
-intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros.
-decompose [or] H5.
-generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6;
- intro.
-elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)).
-left.
-generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7).
-replace (- (PI / 2) + (PI / 2 + x)) with x.
-replace (- (PI / 2) + PI) with (PI / 2).
-intro; assumption.
-pattern PI at 3 in |- *; rewrite (double_var PI); ring.
-ring.
-right.
-generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7).
-replace (- (PI / 2) + (PI / 2 + x)) with x.
-replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
-intro; assumption.
-rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
-ring.
-left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)).
-apply Rplus_lt_compat_l; assumption.
-rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
-apply Rplus_le_le_0_compat.
-left; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply PI_RGT_0.
-apply Rinv_0_lt_compat; prove_sup0. 
-assumption.
-elim H2; intro.
-right; assumption.
-generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5.
-rewrite H5 in H3; rewrite H5 in H0;
- generalize
-  (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3);
- generalize
-  (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0).
-replace (- (PI / 2) + 3 * (PI / 2)) with PI.
-replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI).
-replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
-intros;
- generalize
-  (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0)
-     H7);
- generalize
-  (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2))
-     (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6).
-replace (/ PI * (IZR k0 * PI)) with (IZR k0).
-replace (/ PI * (3 * (PI / 2))) with (3 * / 2).
-rewrite <- Rinv_l_sym.
-intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9);
- rewrite <- plus_IZR.
-replace (IZR (-2) + 1) with (-1).
-intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8);
- rewrite <- plus_IZR.
-replace (IZR (-2) + 2) with 0.
-intro; cut (-1 < IZR (-2 + k0) < 1).
-intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro.
-cut (k0 = 2%Z).
-intro; rewrite H14 in H8.
-assert (Hyp : 0 < 2).
-prove_sup0.
-generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8);
- simpl in |- *.
-replace 4 with 4.
-replace (2 * (3 * / 2)) with 3.
-intro; cut (3 < 4).
-intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)).
-generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r.
-replace (3 + 1) with 4.
-intro; assumption.
-ring.
-symmetry  in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-discrR.
-ring.
-rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13);
- intro; assumption.
-split.
-assumption.
-apply Rle_lt_trans with (IZR (-2) + 3 * / 2).
-assumption.
-simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)).
-apply Rlt_trans with 0.
-rewrite <- Ropp_0; apply Ropp_lt_gt_contravar.
-apply Rmult_lt_0_compat;
- [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ].
-apply Rlt_0_1.
-rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2.
-rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym.
-rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
-ring.
-discrR.
-discrR.
-discrR.
-simpl in |- *; ring.
-simpl in |- *; ring.
-apply PI_neq0.
-unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3);
- repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; apply Rmult_comm.
-apply PI_neq0.
-symmetry  in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc;
- rewrite <- Rinv_r_sym.
-apply Rmult_1_r.
-apply PI_neq0.
-rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring.
-ring.
-pattern PI at 1 in |- *; rewrite double_var; ring.
+  forall x:R,
+    0 <= x -> x <= 2 * PI -> cos x = 0 -> x = PI / 2 \/ x = 3 * (PI / 2).
+Proof.
+  intros; case (Rtotal_order x (3 * (PI / 2))); intro.
+  rewrite cos_sin in H1.
+  cut (0 <= PI / 2 + x).
+  cut (PI / 2 + x <= 2 * PI).
+  intros; generalize (sin_eq_O_2PI_0 (PI / 2 + x) H4 H3 H1); intros.
+  decompose [or] H5.
+  generalize (Rplus_le_compat_l (PI / 2) 0 x H); rewrite Rplus_0_r; rewrite H6;
+    intro.
+  elim (Rlt_irrefl 0 (Rlt_le_trans 0 (PI / 2) 0 PI2_RGT_0 H7)).
+  left.
+  generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) PI H7).
+  replace (- (PI / 2) + (PI / 2 + x)) with x.
+  replace (- (PI / 2) + PI) with (PI / 2).
+  intro; assumption.
+  pattern PI at 3 in |- *; rewrite (double_var PI); ring.
+  ring.
+  right.
+  generalize (Rplus_eq_compat_l (- (PI / 2)) (PI / 2 + x) (2 * PI) H7).
+  replace (- (PI / 2) + (PI / 2 + x)) with x.
+  replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
+  intro; assumption.
+  rewrite double; pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
+  ring.
+  left; replace (2 * PI) with (PI / 2 + 3 * (PI / 2)).
+  apply Rplus_lt_compat_l; assumption.
+  rewrite (double PI); pattern PI at 3 4 in |- *; rewrite (double_var PI); ring.
+  apply Rplus_le_le_0_compat.
+  left; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply PI_RGT_0.
+  apply Rinv_0_lt_compat; prove_sup0. 
+  assumption.
+  elim H2; intro.
+  right; assumption.
+  generalize (cos_eq_0_0 x H1); intro; elim H4; intros k0 H5.
+  rewrite H5 in H3; rewrite H5 in H0;
+    generalize
+      (Rplus_lt_compat_l (- (PI / 2)) (3 * (PI / 2)) (IZR k0 * PI + PI / 2) H3);
+      generalize
+        (Rplus_le_compat_l (- (PI / 2)) (IZR k0 * PI + PI / 2) (2 * PI) H0).
+  replace (- (PI / 2) + 3 * (PI / 2)) with PI.
+  replace (- (PI / 2) + (IZR k0 * PI + PI / 2)) with (IZR k0 * PI).
+  replace (- (PI / 2) + 2 * PI) with (3 * (PI / 2)).
+  intros;
+    generalize
+      (Rmult_lt_compat_l (/ PI) PI (IZR k0 * PI) (Rinv_0_lt_compat PI PI_RGT_0)
+        H7);
+      generalize
+        (Rmult_le_compat_l (/ PI) (IZR k0 * PI) (3 * (PI / 2))
+          (Rlt_le 0 (/ PI) (Rinv_0_lt_compat PI PI_RGT_0)) H6).
+  replace (/ PI * (IZR k0 * PI)) with (IZR k0).
+  replace (/ PI * (3 * (PI / 2))) with (3 * / 2).
+  rewrite <- Rinv_l_sym.
+  intros; generalize (Rplus_lt_compat_l (IZR (-2)) 1 (IZR k0) H9);
+    rewrite <- plus_IZR.
+  replace (IZR (-2) + 1) with (-1).
+  intro; generalize (Rplus_le_compat_l (IZR (-2)) (IZR k0) (3 * / 2) H8);
+    rewrite <- plus_IZR.
+  replace (IZR (-2) + 2) with 0.
+  intro; cut (-1 < IZR (-2 + k0) < 1).
+  intro; generalize (one_IZR_lt1 (-2 + k0) H12); intro.
+  cut (k0 = 2%Z).
+  intro; rewrite H14 in H8.
+  assert (Hyp : 0 < 2).
+  prove_sup0.
+  generalize (Rmult_le_compat_l 2 (IZR 2) (3 * / 2) (Rlt_le 0 2 Hyp) H8);
+    simpl in |- *.
+  replace 4 with 4.
+  replace (2 * (3 * / 2)) with 3.
+  intro; cut (3 < 4).
+  intro; elim (Rlt_irrefl 3 (Rlt_le_trans 3 4 3 H16 H15)).
+  generalize (Rplus_lt_compat_l 3 0 1 Rlt_0_1); rewrite Rplus_0_r.
+  replace (3 + 1) with 4.
+  intro; assumption.
+  ring.
+  symmetry  in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  discrR.
+  ring.
+  rewrite <- (Zplus_opp_l 2) in H13; generalize (Zplus_reg_l (-2) k0 2 H13);
+    intro; assumption.
+  split.
+  assumption.
+  apply Rle_lt_trans with (IZR (-2) + 3 * / 2).
+  assumption.
+  simpl in |- *; replace (-2 + 3 * / 2) with (- (1 * / 2)).
+  apply Rlt_trans with 0.
+  rewrite <- Ropp_0; apply Ropp_lt_gt_contravar.
+  apply Rmult_lt_0_compat;
+    [ apply Rlt_0_1 | apply Rinv_0_lt_compat; prove_sup0 ].
+  apply Rlt_0_1.
+  rewrite Rmult_1_l; apply Rmult_eq_reg_l with 2.
+  rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_r_sym.
+  rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
+  ring.
+  discrR.
+  discrR.
+  discrR.
+  simpl in |- *; ring.
+  simpl in |- *; ring.
+  apply PI_neq0.
+  unfold Rdiv in |- *; pattern 3 at 1 in |- *; rewrite (Rmult_comm 3);
+    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; apply Rmult_comm.
+  apply PI_neq0.
+  symmetry  in |- *; rewrite (Rmult_comm (/ PI)); rewrite Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  apply Rmult_1_r.
+  apply PI_neq0.
+  rewrite double; pattern PI at 3 4 in |- *; rewrite double_var; ring.
+  ring.
+  pattern PI at 1 in |- *; rewrite double_var; ring.
 Qed.
 
 Lemma cos_eq_0_2PI_1 :
- forall x:R,
-   0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0.
-intros x H1 H2 H3; elim H3; intro H4;
- [ rewrite H4; rewrite cos_PI2; reflexivity
- | rewrite H4; rewrite cos_3PI2; reflexivity ].
+  forall x:R,
+    0 <= x -> x <= 2 * PI -> x = PI / 2 \/ x = 3 * (PI / 2) -> cos x = 0.
+Proof.
+  intros x H1 H2 H3; elim H3; intro H4;
+    [ rewrite H4; rewrite cos_PI2; reflexivity
+      | rewrite H4; rewrite cos_3PI2; reflexivity ].
 Qed.
diff --git a/theories/Reals/Rtrigo_alt.v b/theories/Reals/Rtrigo_alt.v
index fc465bc4..a95bc54b 100644
--- a/theories/Reals/Rtrigo_alt.v
+++ b/theories/Reals/Rtrigo_alt.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rtrigo_alt.v 6245 2004-10-20 13:50:08Z barras $ i*)
+
+(*i $Id: Rtrigo_alt.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -14,9 +14,9 @@ Require Import SeqSeries.
 Require Import Rtrigo_def.
 Open Local Scope R_scope.
 
-(*****************************************************************)
-(* Using series definitions of cos and sin                       *)
-(*****************************************************************)
+(***************************************************************)
+(** Using series definitions of cos and sin                    *)
+(***************************************************************)
 
 Definition sin_term (a:R) (i:nat) : R :=
   (-1) ^ i * (a ^ (2 * i + 1) / INR (fact (2 * i + 1))).
@@ -30,397 +30,390 @@ Definition cos_approx (a:R) (n:nat) : R := sum_f_R0 (cos_term a) n.
 
 (**********)
 Lemma PI_4 : PI <= 4.
-assert (H0 := PI_ineq 0).
-elim H0; clear H0; intros _ H0.
-unfold tg_alt, PI_tg in H0; simpl in H0.
-rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0.
-apply Rmult_le_reg_l with (/ 4).
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ].
+Proof.
+  assert (H0 := PI_ineq 0).
+  elim H0; clear H0; intros _ H0.
+  unfold tg_alt, PI_tg in H0; simpl in H0.
+  rewrite Rinv_1 in H0; rewrite Rmult_1_r in H0; unfold Rdiv in H0.
+  apply Rmult_le_reg_l with (/ 4).
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- Rinv_l_sym; [ rewrite Rmult_comm; assumption | discrR ].
 Qed.
 
 (**********)
 Theorem sin_bound :
- forall (a:R) (n:nat),
-   0 <= a ->
-   a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
-intros; case (Req_dec a 0); intro Hyp_a.
-rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *;
- apply sum_eq_R0 || (symmetry  in |- *; apply sum_eq_R0); 
- intros; unfold sin_term in |- *; rewrite pow_add; 
- simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; 
- ring.
-unfold sin_approx in |- *; cut (0 < a).
-intro Hyp_a_pos.
-rewrite (decomp_sum (sin_term a) (2 * n + 1)).
-rewrite (decomp_sum (sin_term a) (2 * (n + 1))).
-replace (sin_term a 0) with a.
-cut
- (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\
-  sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) ->
-  a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\
-  sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))).
-intro; apply H1.
-set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))).
-replace (pred (2 * n + 1)) with (2 * n)%nat.
-replace (pred (2 * (n + 1))) with (S (2 * n)).
-replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with
- (- sum_f_R0 (tg_alt Un) (2 * n)).
-replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with
- (- sum_f_R0 (tg_alt Un) (S (2 * n))).
-cut
- (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <=
-  sum_f_R0 (tg_alt Un) (2 * n) ->
-  - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <=
-  - sum_f_R0 (tg_alt Un) (S (2 * n))).
-intro; apply H2.
-apply alternated_series_ineq.
-unfold Un_decreasing, Un in |- *; intro;
- cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))).
-intro; rewrite H3.
-replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)).
-unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
-left; apply pow_lt; assumption.
-apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))).
-rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
- assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5).
-rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1))));
- rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
- repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r.
-do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
- simpl in |- *;
- 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 | ring_Rsqr ].
-replace (a * a) with (Rsqr a); [ idtac | reflexivity ].
-apply Rsqr_incr_1.
-apply Rle_trans with PI; [ assumption | apply PI_4 ].
-assumption.
-left; prove_sup0.
-rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4);
- [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l.
-apply Rplus_le_le_0_compat.
-repeat apply Rmult_le_pos.
-left; prove_sup0.
-left; prove_sup0.
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-apply Rmult_le_pos.
-left; prove_sup0.
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-simpl in |- *; ring.
-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 in |- *; unfold Un_cv in H3;
- unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; 
- intros; elim (H3 eps H4); intros N H5.
-exists N; intros; apply H5.
-replace (2 * S n0 + 1)%nat with (S (2 * S n0)).
-unfold ge in |- *; apply le_trans with (2 * S n0)%nat.
-apply le_trans with (2 * S N)%nat.
-apply le_trans with (2 * N)%nat.
-apply le_n_2n.
-apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
-apply (fun m n p:nat => mult_le_compat_l p n m); 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 in |- *; unfold R_dist in |- *; 
- intros.
-cut (0 < eps / Rabs a).
-intro; elim (p _ H5); intros N H6.
-exists N; intros.
-replace (sum_f_R0 (tg_alt Un) n0) with
- (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))).
-unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
- rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
- repeat rewrite Rplus_assoc; rewrite (Rplus_comm a);
- rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; 
- rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a).
-rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc;
- rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ];
- rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a));
- rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
- unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *;
- apply le_trans with n0; [ exact H7 | apply le_n_Sn ].
-rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)).
-replace (sin_n 0) with 1.
-simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
- rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
- rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse;
- rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; 
- apply sum_eq.
-intros; unfold sin_n, Un, tg_alt in |- *;
- replace ((-1) ^ S i) with (- (-1) ^ i).
-replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a).
-unfold Rdiv in |- *; ring.
-rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring.
-simpl in |- *; ring.
-unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
- rewrite Rmult_1_r; reflexivity.
-apply lt_O_Sn.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-unfold sin in |- *; case (exist_sin (Rsqr a)).
-intros; cut (x = x0).
-intro; rewrite H3; unfold Rdiv in |- *.
-symmetry  in |- *; apply Rinv_r_simpl_m; assumption.
-unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum.
-apply p.
-apply s.
-intros; elim H2; intros.
-replace (sin a - a) with (- (a - sin a)); [ idtac | ring ].
-split; apply Ropp_le_contravar; assumption.
-replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with
- (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ].
-apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *;
- replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-unfold Rdiv in |- *; ring.
-reflexivity.
-replace (- sum_f_R0 (tg_alt Un) (2 * n)) with
- (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ].
-apply sum_eq; intros.
-unfold sin_term, Un, tg_alt in |- *;
- replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-unfold Rdiv in |- *; ring.
-reflexivity.
-replace (2 * (n + 1))%nat with (S (S (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 (2 * n + 1)%nat with (S (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 Rplus_le_reg_l with (- a).
-rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
- rewrite (Rplus_comm (- a)); apply H2.
-apply Rplus_le_reg_l with (- a).
-rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
- rewrite (Rplus_comm (- a)); apply H3.
-unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
- ring.
-replace (2 * (n + 1))%nat with (S (S (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 (2 * n + 1)%nat with (S (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  in |- *; assumption ].
+  forall (a:R) (n:nat),
+    0 <= a ->
+    a <= PI -> sin_approx a (2 * n + 1) <= sin a <= sin_approx a (2 * (n + 1)).
+Proof.
+  intros; case (Req_dec a 0); intro Hyp_a.
+  rewrite Hyp_a; rewrite sin_0; split; right; unfold sin_approx in |- *;
+    apply sum_eq_R0 || (symmetry  in |- *; apply sum_eq_R0); 
+      intros; unfold sin_term in |- *; rewrite pow_add; 
+        simpl in |- *; unfold Rdiv in |- *; rewrite Rmult_0_l; 
+          ring.
+  unfold sin_approx in |- *; cut (0 < a).
+  intro Hyp_a_pos.
+  rewrite (decomp_sum (sin_term a) (2 * n + 1)).
+  rewrite (decomp_sum (sin_term a) (2 * (n + 1))).
+  replace (sin_term a 0) with a.
+  cut
+    (sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a - a /\
+      sin a - a <= sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1))) ->
+      a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * n + 1)) <= sin a /\
+      sin a <= a + sum_f_R0 (fun i:nat => sin_term a (S i)) (pred (2 * (n + 1)))).
+  intro; apply H1.
+  set (Un := fun n:nat => a ^ (2 * S n + 1) / INR (fact (2 * S n + 1))).
+  replace (pred (2 * n + 1)) with (2 * n)%nat.
+  replace (pred (2 * (n + 1))) with (S (2 * n)).
+  replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (2 * n)) with
+  (- sum_f_R0 (tg_alt Un) (2 * n)).
+  replace (sum_f_R0 (fun i:nat => sin_term a (S i)) (S (2 * n))) with
+  (- sum_f_R0 (tg_alt Un) (S (2 * n))).
+  cut
+    (sum_f_R0 (tg_alt Un) (S (2 * n)) <= a - sin a <=
+      sum_f_R0 (tg_alt Un) (2 * n) ->
+      - sum_f_R0 (tg_alt Un) (2 * n) <= sin a - a <=
+      - sum_f_R0 (tg_alt Un) (S (2 * n))).
+  intro; apply H2.
+  apply alternated_series_ineq.
+  unfold Un_decreasing, Un in |- *; intro;
+    cut ((2 * S (S n0) + 1)%nat = S (S (2 * S n0 + 1))).
+  intro; rewrite H3.
+  replace (a ^ S (S (2 * S n0 + 1))) with (a ^ (2 * S n0 + 1) * (a * a)).
+  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  left; apply pow_lt; assumption.
+  apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n0 + 1))))).
+  rewrite <- H3; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+    assert (H5 := sym_eq H4); elim (fact_neq_0 _ H5).
+  rewrite <- H3; rewrite (Rmult_comm (INR (fact (2 * S (S n0) + 1))));
+    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite H3; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+    repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r.
+  do 2 rewrite S_INR; rewrite plus_INR; rewrite mult_INR; repeat rewrite S_INR;
+    simpl in |- *;
+      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 | ring_Rsqr ].
+  replace (a * a) with (Rsqr a); [ idtac | reflexivity ].
+  apply Rsqr_incr_1.
+  apply Rle_trans with PI; [ assumption | apply PI_4 ].
+  assumption.
+  left; prove_sup0.
+  rewrite <- (Rplus_0_r 16); replace 20 with (16 + 4);
+    [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
+  rewrite <- (Rplus_comm 20); pattern 20 at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_le_compat_l.
+  apply Rplus_le_le_0_compat.
+  repeat apply Rmult_le_pos.
+  left; prove_sup0.
+  left; prove_sup0.
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply Rmult_le_pos.
+  left; prove_sup0.
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  simpl in |- *; ring.
+  ring_nat.
+  assert (H3 := cv_speed_pow_fact a); unfold Un in |- *; unfold Un_cv in H3;
+    unfold R_dist in H3; unfold Un_cv in |- *; unfold R_dist in |- *; 
+      intros; elim (H3 eps H4); intros N H5.
+  exists N; intros; apply H5.
+  replace (2 * S n0 + 1)%nat with (S (2 * S n0)).
+  unfold ge in |- *; apply le_trans with (2 * S n0)%nat.
+  apply le_trans with (2 * S N)%nat.
+  apply le_trans with (2 * N)%nat.
+  apply le_n_2n.
+  apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
+  apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_S; assumption.
+  apply le_n_Sn.
+  ring.
+  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 in |- *; unfold R_dist in |- *; 
+      intros.
+  cut (0 < eps / Rabs a).
+  intro; elim (p _ H5); intros N H6.
+  exists N; intros.
+  replace (sum_f_R0 (tg_alt Un) n0) with
+  (a * (1 - sum_f_R0 (fun i:nat => sin_n i * Rsqr a ^ i) (S n0))).
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+    rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
+      repeat rewrite Rplus_assoc; rewrite (Rplus_comm a);
+        rewrite (Rplus_comm (- a)); repeat rewrite Rplus_assoc; 
+          rewrite Rplus_opp_l; rewrite Rplus_0_r; apply Rmult_lt_reg_l with (/ Rabs a).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  pattern (/ Rabs a) at 1 in |- *; rewrite <- (Rabs_Rinv a Hyp_a).
+  rewrite <- Rabs_mult; rewrite Rmult_plus_distr_l; rewrite <- Rmult_assoc;
+    rewrite <- Rinv_l_sym; [ rewrite Rmult_1_l | assumption ];
+      rewrite (Rmult_comm (/ a)); rewrite (Rmult_comm (/ Rabs a));
+        rewrite <- Rabs_Ropp; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+          unfold Rminus, Rdiv in H6; apply H6; unfold ge in |- *;
+            apply le_trans with n0; [ exact H7 | apply le_n_Sn ].
+  rewrite (decomp_sum (fun i:nat => sin_n i * Rsqr a ^ i) (S n0)).
+  replace (sin_n 0) with 1.
+  simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+    rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+      rewrite Rplus_0_l; rewrite Ropp_mult_distr_r_reverse;
+        rewrite <- Ropp_mult_distr_l_reverse; rewrite scal_sum; 
+          apply sum_eq.
+  intros; unfold sin_n, Un, tg_alt in |- *;
+    replace ((-1) ^ S i) with (- (-1) ^ i).
+  replace (a ^ (2 * S i + 1)) with (Rsqr a * Rsqr a ^ i * a).
+  unfold Rdiv in |- *; ring.
+  rewrite pow_add; rewrite pow_Rsqr; simpl in |- *; ring.
+  simpl in |- *; ring.
+  unfold sin_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+    rewrite Rmult_1_r; reflexivity.
+  apply lt_O_Sn.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  unfold sin in |- *; case (exist_sin (Rsqr a)).
+  intros; cut (x = x0).
+  intro; rewrite H3; unfold Rdiv in |- *.
+  symmetry  in |- *; apply Rinv_r_simpl_m; assumption.
+  unfold sin_in in p; unfold sin_in in s; eapply uniqueness_sum.
+  apply p.
+  apply s.
+  intros; elim H2; intros.
+  replace (sin a - a) with (- (a - sin a)); [ idtac | ring ].
+  split; apply Ropp_le_contravar; assumption.
+  replace (- sum_f_R0 (tg_alt Un) (S (2 * n))) with
+  (-1 * sum_f_R0 (tg_alt Un) (S (2 * n))); [ rewrite scal_sum | ring ].
+  apply sum_eq; intros; unfold sin_term, Un, tg_alt in |- *;
+    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+  unfold Rdiv in |- *; ring.
+  reflexivity.
+  replace (- sum_f_R0 (tg_alt Un) (2 * n)) with
+  (-1 * sum_f_R0 (tg_alt Un) (2 * n)); [ rewrite scal_sum | ring ].
+  apply sum_eq; intros.
+  unfold sin_term, Un, tg_alt in |- *;
+    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+  unfold Rdiv in |- *; ring.
+  reflexivity.
+  replace (2 * (n + 1))%nat with (S (S (2 * n))).
+  reflexivity.
+  ring.
+  replace (2 * n + 1)%nat with (S (2 * n)).
+  reflexivity.
+  ring.
+  intro; elim H1; intros.
+  split.
+  apply Rplus_le_reg_l with (- a).
+  rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+    rewrite (Rplus_comm (- a)); apply H2.
+  apply Rplus_le_reg_l with (- a).
+  rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+    rewrite (Rplus_comm (- a)); apply H3.
+  unfold sin_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+    ring.
+  replace (2 * (n + 1))%nat with (S (S (2 * n))).
+  apply lt_O_Sn.
+  ring.
+  replace (2 * n + 1)%nat with (S (2 * n)).
+  apply lt_O_Sn.
+  ring.
+  inversion H; [ assumption | elim Hyp_a; symmetry  in |- *; assumption ].
 Qed.
 
 (**********)
 Lemma cos_bound :
- forall (a:R) (n:nat),
-   - PI / 2 <= a ->
-   a <= PI / 2 ->
-   cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). 
-cut
- ((forall (a:R) (n:nat),
-     0 <= a ->
-     a <= PI / 2 ->
-     cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) ->
   forall (a:R) (n:nat),
     - PI / 2 <= a ->
     a <= PI / 2 ->
-    cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))).
-intros H a n; apply H.
-intros; unfold cos_approx in |- *.
-rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)).
-rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))).
-replace (cos_term a0 0) with 1.
-cut
- (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\
-  cos a0 - 1 <=
-  sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) ->
-  1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\
-  cos a0 <=
-  1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))).
-intro; apply H2.
-set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))).
-replace (pred (2 * n0 + 1)) with (2 * n0)%nat.
-replace (pred (2 * (n0 + 1))) with (S (2 * n0)).
-replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with
- (- sum_f_R0 (tg_alt Un) (2 * n0)).
-replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with
- (- sum_f_R0 (tg_alt Un) (S (2 * n0))).
-cut
- (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <=
-  sum_f_R0 (tg_alt Un) (2 * n0) ->
-  - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <=
-  - sum_f_R0 (tg_alt Un) (S (2 * n0))).
-intro; apply H3.
-apply alternated_series_ineq.
-unfold Un_decreasing in |- *; intro; unfold Un in |- *.
-cut ((2 * S (S n1))%nat = S (S (2 * S n1))).
-intro; rewrite H4;
- replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)).
-unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
-apply pow_le; assumption.
-apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))).
-rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
- assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6).
-rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1)))));
- rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
- repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR;
- simpl in |- *;
- 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 | ring_Rsqr ].
-replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ].
-apply Rsqr_incr_1.
-apply Rle_trans with (PI / 2).
-assumption.
-unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
-prove_sup0.
-rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
-replace 4 with 4; [ apply PI_4 | ring ].
-discrR.
-assumption.
-left; prove_sup0.
-pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
- [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
-rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_le_compat_l.
-apply Rplus_le_le_0_compat.
-repeat apply Rmult_le_pos.
-left; prove_sup0.
-left; prove_sup0.
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-apply Rmult_le_pos.
-left; prove_sup0.
-replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
-apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-simpl in |- *; ring.
-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 in |- *; unfold Un_cv in H4;
- unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; 
- intros; elim (H4 eps H5); intros N H6; exists N; intros.
-apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat.
-apply le_trans with (2 * N)%nat.
-apply le_n_2n.
-apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
-apply (fun m n p:nat => mult_le_compat_l p n m); 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 in |- *; unfold R_dist in |- *; 
- intros.
-elim (p _ H5); intros N H6.
-exists N; intros.
-replace (sum_f_R0 (tg_alt Un) n1) with
- (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
-unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
- repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1);
- rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; 
- rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp;
- rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
- unfold Rminus in H6; apply H6.
-unfold ge in |- *; apply le_trans with n1.
-exact H7.
-apply le_n_Sn.
-rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
-replace (cos_n 0) with 1.
-simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
- rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
- rewrite Rplus_0_l;
- replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1)
-  with
-  (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1);
- [ idtac | ring ]; rewrite scal_sum; apply sum_eq; 
- intros; unfold cos_n, Un, tg_alt in |- *.
-replace ((-1) ^ S i) with (- (-1) ^ i).
-replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i).
-unfold Rdiv in |- *; ring.
-rewrite pow_Rsqr; reflexivity.
-simpl in |- *; ring.
-unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
- rewrite Rmult_1_r; reflexivity.
-apply lt_O_Sn.
-unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
- unfold cos_in in c; eapply uniqueness_sum.
-apply p.
-apply c.
-intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0));
- [ idtac | ring ].
-split; apply Ropp_le_contravar; assumption.
-replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with
- (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ].
-apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
- replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-unfold Rdiv in |- *; ring.
-reflexivity.
-replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with
- (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ];
- apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
- replace ((-1) ^ S i) with (-1 * (-1) ^ i).
-unfold Rdiv in |- *; ring.
-reflexivity.
-replace (2 * (n0 + 1))%nat with (S (S (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 (2 * n0 + 1)%nat with (S (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 Rplus_le_reg_l with (-1).
-rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
- rewrite (Rplus_comm (-1)); apply H3.
-apply Rplus_le_reg_l with (-1).
-rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
- rewrite (Rplus_comm (-1)); apply H4.
-unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
- ring.
-replace (2 * (n0 + 1))%nat with (S (S (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 (2 * n0 + 1)%nat with (S (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 0 a); intro.
-elim s; intro.
-apply H; [ left; assumption | assumption ].
-apply H; [ right; assumption | assumption ].
-cut (0 < - a).
-intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n).
-intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H.
-left; assumption.
-rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar;
- unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse;
- exact H0.
-intros; unfold cos_approx in |- *; apply sum_eq; intros;
- unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg;
- unfold Rdiv in |- *; reflexivity.
-apply Ropp_0_gt_lt_contravar; assumption.
+    cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1)). 
+Proof.
+  cut
+    ((forall (a:R) (n:nat),
+      0 <= a ->
+      a <= PI / 2 ->
+      cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))) ->
+    forall (a:R) (n:nat),
+      - PI / 2 <= a ->
+      a <= PI / 2 ->
+      cos_approx a (2 * n + 1) <= cos a <= cos_approx a (2 * (n + 1))).
+  intros H a n; apply H.
+  intros; unfold cos_approx in |- *.
+  rewrite (decomp_sum (cos_term a0) (2 * n0 + 1)).
+  rewrite (decomp_sum (cos_term a0) (2 * (n0 + 1))).
+  replace (cos_term a0 0) with 1.
+  cut
+    (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 - 1 /\
+      cos a0 - 1 <=
+      sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1))) ->
+      1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * n0 + 1)) <= cos a0 /\
+      cos a0 <=
+      1 + sum_f_R0 (fun i:nat => cos_term a0 (S i)) (pred (2 * (n0 + 1)))).
+  intro; apply H2.
+  set (Un := fun n:nat => a0 ^ (2 * S n) / INR (fact (2 * S n))).
+  replace (pred (2 * n0 + 1)) with (2 * n0)%nat.
+  replace (pred (2 * (n0 + 1))) with (S (2 * n0)).
+  replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (2 * n0)) with
+  (- sum_f_R0 (tg_alt Un) (2 * n0)).
+  replace (sum_f_R0 (fun i:nat => cos_term a0 (S i)) (S (2 * n0))) with
+  (- sum_f_R0 (tg_alt Un) (S (2 * n0))).
+  cut
+    (sum_f_R0 (tg_alt Un) (S (2 * n0)) <= 1 - cos a0 <=
+      sum_f_R0 (tg_alt Un) (2 * n0) ->
+      - sum_f_R0 (tg_alt Un) (2 * n0) <= cos a0 - 1 <=
+      - sum_f_R0 (tg_alt Un) (S (2 * n0))).
+  intro; apply H3.
+  apply alternated_series_ineq.
+  unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+  cut ((2 * S (S n1))%nat = S (S (2 * S n1))).
+  intro; rewrite H4;
+    replace (a0 ^ S (S (2 * S n1))) with (a0 ^ (2 * S n1) * (a0 * a0)).
+  unfold Rdiv in |- *; rewrite Rmult_assoc; apply Rmult_le_compat_l.
+  apply pow_le; assumption.
+  apply Rmult_le_reg_l with (INR (fact (S (S (2 * S n1))))).
+  rewrite <- H4; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+    assert (H6 := sym_eq H5); elim (fact_neq_0 _ H6).
+  rewrite <- H4; rewrite (Rmult_comm (INR (fact (2 * S (S n1)))));
+    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; rewrite H4; do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+    repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; do 2 rewrite S_INR; rewrite mult_INR; repeat rewrite S_INR;
+    simpl in |- *;
+      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 | ring_Rsqr ].
+  replace (a0 * a0) with (Rsqr a0); [ idtac | reflexivity ].
+  apply Rsqr_incr_1.
+  apply Rle_trans with (PI / 2).
+  assumption.
+  unfold Rdiv in |- *; apply Rmult_le_reg_l with 2.
+  prove_sup0.
+  rewrite <- Rmult_assoc; rewrite Rinv_r_simpl_m.
+  replace 4 with 4; [ apply PI_4 | ring ].
+  discrR.
+  assumption.
+  left; prove_sup0.
+  pattern 4 at 1 in |- *; rewrite <- Rplus_0_r; replace 12 with (4 + 8);
+    [ apply Rplus_le_compat_l; left; prove_sup0 | ring ].
+  rewrite <- (Rplus_comm 12); pattern 12 at 1 in |- *; rewrite <- Rplus_0_r;
+    apply Rplus_le_compat_l.
+  apply Rplus_le_le_0_compat.
+  repeat apply Rmult_le_pos.
+  left; prove_sup0.
+  left; prove_sup0.
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply Rmult_le_pos.
+  left; prove_sup0.
+  replace 0 with (INR 0); [ apply le_INR; apply le_O_n | reflexivity ].
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  simpl in |- *; ring.
+  ring_nat.
+  assert (H4 := cv_speed_pow_fact a0); unfold Un in |- *; unfold Un_cv in H4;
+    unfold R_dist in H4; unfold Un_cv in |- *; unfold R_dist in |- *; 
+      intros; elim (H4 eps H5); intros N H6; exists N; intros.
+  apply H6; unfold ge in |- *; apply le_trans with (2 * S N)%nat.
+  apply le_trans with (2 * N)%nat.
+  apply le_n_2n.
+  apply (fun m n p:nat => mult_le_compat_l p n m); apply le_n_Sn.
+  apply (fun m n p:nat => mult_le_compat_l p n m); 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 in |- *; unfold R_dist in |- *; 
+      intros.
+  elim (p _ H5); intros N H6.
+  exists N; intros.
+  replace (sum_f_R0 (tg_alt Un) n1) with
+  (1 - sum_f_R0 (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
+  unfold Rminus in |- *; rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+    repeat rewrite Rplus_assoc; rewrite (Rplus_comm 1);
+      rewrite (Rplus_comm (-1)); repeat rewrite Rplus_assoc; 
+        rewrite Rplus_opp_l; rewrite Rplus_0_r; rewrite <- Rabs_Ropp;
+          rewrite Ropp_plus_distr; rewrite Ropp_involutive; 
+            unfold Rminus in H6; apply H6.
+  unfold ge in |- *; apply le_trans with n1.
+  exact H7.
+  apply le_n_Sn.
+  rewrite (decomp_sum (fun i:nat => cos_n i * Rsqr a0 ^ i) (S n1)).
+  replace (cos_n 0) with 1.
+  simpl in |- *; rewrite Rmult_1_r; unfold Rminus in |- *;
+    rewrite Ropp_plus_distr; rewrite <- Rplus_assoc; rewrite Rplus_opp_r;
+      rewrite Rplus_0_l;
+        replace (- sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1)
+    with
+      (-1 * sum_f_R0 (fun i:nat => cos_n (S i) * (Rsqr a0 * Rsqr a0 ^ i)) n1);
+      [ idtac | ring ]; rewrite scal_sum; apply sum_eq; 
+        intros; unfold cos_n, Un, tg_alt in |- *.
+  replace ((-1) ^ S i) with (- (-1) ^ i).
+  replace (a0 ^ (2 * S i)) with (Rsqr a0 * Rsqr a0 ^ i).
+  unfold Rdiv in |- *; ring.
+  rewrite pow_Rsqr; reflexivity.
+  simpl in |- *; ring.
+  unfold cos_n in |- *; unfold Rdiv in |- *; simpl in |- *; rewrite Rinv_1;
+    rewrite Rmult_1_r; reflexivity.
+  apply lt_O_Sn.
+  unfold cos in |- *; case (exist_cos (Rsqr a0)); intros; unfold cos_in in p;
+    unfold cos_in in c; eapply uniqueness_sum.
+  apply p.
+  apply c.
+  intros; elim H3; intros; replace (cos a0 - 1) with (- (1 - cos a0));
+    [ idtac | ring ].
+  split; apply Ropp_le_contravar; assumption.
+  replace (- sum_f_R0 (tg_alt Un) (S (2 * n0))) with
+  (-1 * sum_f_R0 (tg_alt Un) (S (2 * n0))); [ rewrite scal_sum | ring ].
+  apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+  unfold Rdiv in |- *; ring.
+  reflexivity.
+  replace (- sum_f_R0 (tg_alt Un) (2 * n0)) with
+  (-1 * sum_f_R0 (tg_alt Un) (2 * n0)); [ rewrite scal_sum | ring ];
+  apply sum_eq; intros; unfold cos_term, Un, tg_alt in |- *;
+    replace ((-1) ^ S i) with (-1 * (-1) ^ i).
+  unfold Rdiv in |- *; ring.
+  reflexivity.
+  replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
+  reflexivity.
+  ring.
+  replace (2 * n0 + 1)%nat with (S (2 * n0)).
+  reflexivity.
+  ring.
+  intro; elim H2; intros; split.
+  apply Rplus_le_reg_l with (-1).
+  rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+    rewrite (Rplus_comm (-1)); apply H3.
+  apply Rplus_le_reg_l with (-1).
+  rewrite <- Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_l;
+    rewrite (Rplus_comm (-1)); apply H4.
+  unfold cos_term in |- *; simpl in |- *; unfold Rdiv in |- *; rewrite Rinv_1;
+    ring.
+  replace (2 * (n0 + 1))%nat with (S (S (2 * n0))).
+  apply lt_O_Sn.
+  ring.
+  replace (2 * n0 + 1)%nat with (S (2 * n0)).
+  apply lt_O_Sn.
+  ring.
+  intros; case (total_order_T 0 a); intro.
+  elim s; intro.
+  apply H; [ left; assumption | assumption ].
+  apply H; [ right; assumption | assumption ].
+  cut (0 < - a).
+  intro; cut (forall (x:R) (n:nat), cos_approx x n = cos_approx (- x) n).
+  intro; rewrite H3; rewrite (H3 a (2 * (n + 1))%nat); rewrite cos_sym; apply H.
+  left; assumption.
+  rewrite <- (Ropp_involutive (PI / 2)); apply Ropp_le_contravar;
+    unfold Rdiv in |- *; unfold Rdiv in H0; rewrite <- Ropp_mult_distr_l_reverse;
+      exact H0.
+  intros; unfold cos_approx in |- *; apply sum_eq; intros;
+    unfold cos_term in |- *; do 2 rewrite pow_Rsqr; rewrite Rsqr_neg;
+      unfold Rdiv in |- *; reflexivity.
+  apply Ropp_0_gt_lt_contravar; assumption.
 Qed.
diff --git a/theories/Reals/Rtrigo_calc.v b/theories/Reals/Rtrigo_calc.v
index f8c15667..baf0fa4b 100644
--- a/theories/Reals/Rtrigo_calc.v
+++ b/theories/Reals/Rtrigo_calc.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_calc.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Rtrigo_calc.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -16,365 +16,388 @@ Require Import R_sqrt.
 Open Local Scope R_scope.
 
 Lemma tan_PI : tan PI = 0.
-unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *;
- apply Rmult_0_l. 
+Proof.
+  unfold tan in |- *; rewrite sin_PI; rewrite cos_PI; unfold Rdiv in |- *;
+    apply Rmult_0_l. 
 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 PI at 1 in |- *; rewrite (double_var PI); ring.
+Proof.
+  replace (3 * (PI / 2)) with (PI + PI / 2).
+  rewrite sin_plus; rewrite sin_PI; rewrite cos_PI; rewrite sin_PI2; ring.
+  pattern PI at 1 in |- *; rewrite (double_var PI); ring.
 Qed.
 
 Lemma tan_2PI : tan (2 * PI) = 0.
-unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l.
+Proof.
+  unfold tan in |- *; rewrite sin_2PI; unfold Rdiv in |- *; apply Rmult_0_l.
 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 PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H...
-assert (H0 : 2 <> 0);
- [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; try ring ]...
+  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 PI at 2 3 in |- *; rewrite H; pattern PI at 2 3 in |- *; rewrite H...
+  assert (H0 : 2 <> 0);
+    [ discrR | unfold Rdiv in |- *; rewrite Rinv_mult_distr; 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 Rmult_eq_reg_l with 6...
-rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
-rewrite <- Rinv_l_sym...
-rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
- repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
-ring...
+  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 Rmult_eq_reg_l with 6...
+  rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
+  unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+  rewrite <- Rinv_l_sym...
+  rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
+  pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+    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 Rmult_eq_reg_l with 6...
-rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
-unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
-rewrite <- Rinv_l_sym...
-rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
-pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
- repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
-ring...
+  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 Rmult_eq_reg_l with 6...
+  rewrite Rmult_minus_distr_l; repeat rewrite (Rmult_comm 6)...
+  unfold Rdiv in |- *; repeat rewrite Rmult_assoc...
+  rewrite <- Rinv_l_sym...
+  rewrite (Rmult_comm (/ 3)); repeat rewrite Rmult_assoc; rewrite <- Rinv_r_sym...
+  pattern PI at 2 in |- *; rewrite (Rmult_comm PI); repeat rewrite Rmult_1_r;
+    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
+  ring...
 Qed.
 
 Lemma PI6_RGT_0 : 0 < PI / 6.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
 Lemma PI6_RLT_PI2 : PI / 6 < PI / 2.
-unfold Rdiv in |- *; apply Rmult_lt_compat_l.
-apply PI_RGT_0.
-apply Rinv_lt_contravar; prove_sup.
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_compat_l.
+  apply PI_RGT_0.
+  apply Rinv_lt_contravar; prove_sup.
 Qed.
 
 Lemma sin_PI6 : sin (PI / 6) = 1 / 2.
 Proof with trivial.
-assert (H : 2 <> 0); [ discrR | idtac ]...
-apply Rmult_eq_reg_l 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 in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc;
- pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r...
-unfold Rdiv in |- *; rewrite Rinv_mult_distr...
-rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2);
- repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r...
-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 ] ]...
+  assert (H : 2 <> 0); [ discrR | idtac ]...
+  apply Rmult_eq_reg_l 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 in |- *; rewrite Rmult_1_l; rewrite Rmult_assoc;
+    pattern 2 at 2 in |- *; rewrite (Rmult_comm 2); rewrite Rmult_assoc;
+      rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r...
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+  rewrite (Rmult_comm (/ 2)); rewrite (Rmult_comm 2);
+    repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r...
+  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);
- [ prove_sup0
- | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; intro H2;
-    generalize (sqrt_eq_0 2 H1 H2); intro H; absurd (2 = 0);
-    [ discrR | assumption ] ].
+Proof.
+  assert (Hyp : 0 < 2);
+    [ prove_sup0
+      | generalize (Rlt_le 0 2 Hyp); intro H1; red in |- *; 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_0_compat (sqrt 2) sqrt2_neq_0); intro H;
- generalize (prod_neq_R0 1 (/ sqrt 2) R1_neq_R0 H); 
- intro H0; assumption.
+Proof.
+  generalize (Rinv_neq_0_compat (sqrt 2) sqrt2_neq_0); intro H;
+    generalize (prod_neq_R0 1 (/ 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);
-    [ prove_sup0
-    | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; intro H2;
-       generalize (sqrt_eq_0 3 H1 H2); intro H; absurd (3 = 0);
-       [ discrR | assumption ] ] ].
+Proof.
+  apply prod_neq_R0;
+    [ discrR
+      | assert (Hyp : 0 < 3);
+        [ prove_sup0
+          | generalize (Rlt_le 0 3 Hyp); intro H1; red in |- *; 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);
- [ prove_sup0
- | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1;
-    intro H2;
-    [ assumption
-    | absurd (0 = sqrt 2);
-       [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ].
+Proof.
+  assert (Hyp : 0 < 2);
+    [ prove_sup0
+      | generalize (sqrt_positivity 2 (Rlt_le 0 2 Hyp)); intro H1; elim H1;
+        intro H2;
+          [ assumption
+            | absurd (0 = sqrt 2);
+              [ apply (sym_not_eq (A:=R)); apply sqrt2_neq_0 | assumption ] ] ].
 Qed.
 
 Lemma Rlt_sqrt3_0 : 0 < sqrt 3.
-cut (0%nat <> 1%nat);
- [ intro H0; assert (Hyp : 0 < 2);
-    [ prove_sup0
-    | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3);
-       [ prove_sup0
-       | generalize (Rlt_le 0 3 Hyp2); intro H2;
-          generalize (lt_INR_0 1 (neq_O_lt 1 H0)); 
-          unfold INR in |- *; intro H3;
-          generalize (Rplus_lt_compat_l 2 0 1 H3); 
-          rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3;
-          [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3;
-             apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3)
-          | ring ] ] ]
- | discriminate ].
+Proof.
+  cut (0%nat <> 1%nat);
+    [ intro H0; assert (Hyp : 0 < 2);
+      [ prove_sup0
+        | generalize (Rlt_le 0 2 Hyp); intro H1; assert (Hyp2 : 0 < 3);
+          [ prove_sup0
+            | generalize (Rlt_le 0 3 Hyp2); intro H2;
+              generalize (lt_INR_0 1 (neq_O_lt 1 H0)); 
+                unfold INR in |- *; intro H3;
+                  generalize (Rplus_lt_compat_l 2 0 1 H3); 
+                    rewrite Rplus_comm; rewrite Rplus_0_l; replace (2 + 1) with 3;
+                      [ intro H4; generalize (sqrt_lt_1 2 3 H1 H2 H4); clear H3; intro H3;
+                        apply (Rlt_trans 0 (sqrt 2) (sqrt 3) Rlt_sqrt2_0 H3)
+                        | ring ] ] ]
+      | discriminate ].
 Qed.
 
 Lemma PI4_RGT_0 : 0 < PI / 4.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ].
+Proof.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_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)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)...
-left; apply PI4_RLT_PI2...
-left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))...
-prove_sup...
-apply Rinv_0_lt_compat; apply Rlt_sqrt2_0...
-rewrite Rsqr_div...
-rewrite Rsqr_1; rewrite Rsqr_sqrt...
-assert (H : 2 <> 0); [ discrR | idtac ]...
-unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *;
- rewrite <- sin_cos_PI4;
- replace (sin (PI / 4) * cos (PI / 4)) with
-  (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))...
-rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)...
-rewrite sin_PI2...
-apply Rmult_1_r...
-unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r...
-unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
-rewrite <- Rinv_l_sym...
-rewrite Rmult_1_l...
-left; prove_sup...
-apply sqrt2_neq_0...
+  apply Rsqr_inj...
+  apply cos_ge_0...
+  left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 4) _PI2_RLT_0 PI4_RGT_0)...
+  left; apply PI4_RLT_PI2...
+  left; apply (Rmult_lt_0_compat 1 (/ sqrt 2))...
+  prove_sup...
+  apply Rinv_0_lt_compat; apply Rlt_sqrt2_0...
+  rewrite Rsqr_div...
+  rewrite Rsqr_1; rewrite Rsqr_sqrt...
+  assert (H : 2 <> 0); [ discrR | idtac ]...
+  unfold Rsqr in |- *; pattern (cos (PI / 4)) at 1 in |- *;
+    rewrite <- sin_cos_PI4;
+      replace (sin (PI / 4) * cos (PI / 4)) with
+      (1 / 2 * (2 * sin (PI / 4) * cos (PI / 4)))...
+  rewrite <- sin_2a; replace (2 * (PI / 4)) with (PI / 2)...
+  rewrite sin_PI2...
+  apply Rmult_1_r...
+  unfold Rdiv in |- *; rewrite (Rmult_comm 2); rewrite Rinv_mult_distr...
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r...
+  unfold Rdiv in |- *; rewrite Rmult_1_l; repeat rewrite <- Rmult_assoc...
+  rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_l...
+  left; prove_sup...
+  apply sqrt2_neq_0...
 Qed.
 
 Lemma sin_PI4 : sin (PI / 4) = 1 / sqrt 2.
-rewrite sin_cos_PI4; apply cos_PI4.
+Proof.
+  rewrite sin_cos_PI4; apply cos_PI4.
 Qed.
 
 Lemma tan_PI4 : tan (PI / 4) = 1.
-unfold tan in |- *; rewrite sin_cos_PI4.
-unfold Rdiv in |- *; apply Rinv_r.
-change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0.
+Proof.
+  unfold tan in |- *; rewrite sin_cos_PI4.
+  unfold Rdiv in |- *; apply Rinv_r.
+  change (cos (PI / 4) <> 0) in |- *; rewrite cos_PI4; apply R1_sqrt2_neq_0.
 Qed.
 
 Lemma cos3PI4 : cos (3 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
-replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
-rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4...
-unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse...
-unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
- rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
- repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
- [ ring | discrR | discrR ]...
+  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
+  rewrite cos_shift; rewrite sin_neg; rewrite sin_PI4...
+  unfold Rdiv in |- *; rewrite Ropp_mult_distr_l_reverse...
+  unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
+    rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+      repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
+        [ 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 in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
- rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
- repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
- [ ring | discrR | discrR ]...
+  replace (3 * (PI / 4)) with (PI / 2 - - (PI / 4))...
+  rewrite sin_shift; rewrite cos_neg; rewrite cos_PI4...
+  unfold Rminus in |- *; rewrite Ropp_involutive; pattern PI at 1 in |- *;
+    rewrite double_var; unfold Rdiv in |- *; rewrite Rmult_plus_distr_r;
+      repeat rewrite Rmult_assoc; rewrite <- Rinv_mult_distr;
+        [ 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)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)...
-left; apply PI6_RLT_PI2...
-left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))...
-apply Rlt_sqrt3_0...
-apply Rinv_0_lt_compat; prove_sup0...
-assert (H : 2 <> 0); [ discrR | idtac ]...
-assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
-rewrite Rsqr_div...
-rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def...
-unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
-rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3);
- repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
-rewrite Rmult_1_l; rewrite Rmult_1_r...
-rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc...
-rewrite <- Rinv_l_sym...
-rewrite Rmult_1_l; rewrite <- Rinv_r_sym...
-ring...
-left; prove_sup0...
+  apply Rsqr_inj...
+  apply cos_ge_0...
+  left; apply (Rlt_trans (- (PI / 2)) 0 (PI / 6) _PI2_RLT_0 PI6_RGT_0)...
+  left; apply PI6_RLT_PI2...
+  left; apply (Rmult_lt_0_compat (sqrt 3) (/ 2))...
+  apply Rlt_sqrt3_0...
+  apply Rinv_0_lt_compat; prove_sup0...
+  assert (H : 2 <> 0); [ discrR | idtac ]...
+  assert (H1 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
+  rewrite Rsqr_div...
+  rewrite cos2; unfold Rsqr in |- *; rewrite sin_PI6; rewrite sqrt_def...
+  unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+  rewrite Rmult_minus_distr_l; rewrite (Rmult_comm 3);
+    repeat rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
+  rewrite Rmult_1_l; rewrite Rmult_1_r...
+  rewrite <- (Rmult_comm (/ 2)); repeat rewrite <- Rmult_assoc...
+  rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_l; rewrite <- Rinv_r_sym...
+  ring...
+  left; prove_sup0...
 Qed.
 
 Lemma tan_PI6 : tan (PI / 6) = 1 / sqrt 3.
-unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *;
- repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
-apply Rmult_1_r.
-discrR.
-discrR.
-red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1;
- elim (Rlt_irrefl 0 H1).
-apply Rinv_neq_0_compat; discrR.
+Proof.
+  unfold tan in |- *; rewrite sin_PI6; rewrite cos_PI6; unfold Rdiv in |- *;
+    repeat rewrite Rmult_1_l; rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  rewrite (Rmult_comm (/ 2)); rewrite Rmult_assoc; rewrite <- Rinv_r_sym.
+  apply Rmult_1_r.
+  discrR.
+  discrR.
+  red in |- *; intro; assert (H1 := Rlt_sqrt3_0); rewrite H in H1;
+    elim (Rlt_irrefl 0 H1).
+  apply Rinv_neq_0_compat; discrR.
 Qed.
 
 Lemma sin_PI3 : sin (PI / 3) = sqrt 3 / 2.
-rewrite sin_PI3_cos_PI6; apply cos_PI6.
+Proof.
+  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.
+Proof.
+  rewrite sin_PI6_cos_PI3; apply sin_PI6.
 Qed.
 
 Lemma tan_PI3 : tan (PI / 3) = sqrt 3.
-unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *;
- rewrite Rmult_1_l; rewrite Rinv_involutive.
-rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-apply Rmult_1_r.
-discrR.
-discrR.
+Proof.
+  unfold tan in |- *; rewrite sin_PI3; rewrite cos_PI3; unfold Rdiv in |- *;
+    rewrite Rmult_1_l; rewrite Rinv_involutive.
+  rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  apply Rmult_1_r.
+  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 in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 2));
- repeat rewrite <- Rmult_assoc; rewrite double_var; 
- reflexivity.
+Proof.
+  rewrite double; rewrite sin_plus; rewrite sin_PI3; rewrite cos_PI3;
+    unfold Rdiv in |- *; repeat rewrite Rmult_1_l; rewrite (Rmult_comm (/ 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 in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
-rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc;
- rewrite (Rmult_comm 2)...
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r; rewrite <- Rinv_r_sym...
-pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r...
-rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))...
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_r; rewrite sqrt_def...
-ring...
-left; prove_sup...
+  assert (H : 2 <> 0); [ discrR | idtac ]...
+  assert (H0 : 4 <> 0); [ apply prod_neq_R0 | idtac ]...
+  rewrite double; rewrite cos_plus; rewrite sin_PI3; rewrite cos_PI3;
+    unfold Rdiv in |- *; rewrite Rmult_1_l; apply Rmult_eq_reg_l with 4...
+  rewrite Rmult_minus_distr_l; repeat rewrite Rmult_assoc;
+    rewrite (Rmult_comm 2)...
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r; rewrite <- Rinv_r_sym...
+  pattern 2 at 4 in |- *; rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r; rewrite Ropp_mult_distr_r_reverse; rewrite Rmult_1_r...
+  rewrite (Rmult_comm 2); repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r; rewrite (Rmult_comm 2); rewrite (Rmult_comm (/ 2))...
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_r; rewrite sqrt_def...
+  ring...
+  left; prove_sup...
 Qed.
 
 Lemma tan_2PI3 : tan (2 * (PI / 3)) = - sqrt 3.
 Proof with trivial.
-assert (H : 2 <> 0); [ discrR | idtac ]...
-unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *;
- rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
- rewrite <- Ropp_inv_permute...
-rewrite Rinv_involutive...
-rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym...
-ring...
-apply Rinv_neq_0_compat...
+  assert (H : 2 <> 0); [ discrR | idtac ]...
+  unfold tan in |- *; rewrite sin_2PI3; rewrite cos_2PI3; unfold Rdiv in |- *;
+    rewrite Ropp_mult_distr_l_reverse; rewrite Rmult_1_l;
+      rewrite <- Ropp_inv_permute...
+  rewrite Rinv_involutive...
+  rewrite Rmult_assoc; rewrite Ropp_mult_distr_r_reverse; rewrite <- Rinv_l_sym...
+  ring...
+  apply Rinv_neq_0_compat...
 Qed.
 
 Lemma cos_5PI4 : cos (5 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
-replace (5 * (PI / 4)) with (PI / 4 + PI)...
-rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *;
- rewrite Ropp_mult_distr_l_reverse...
-pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
- rewrite double_var; assert (H : 2 <> 0);
- [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+  replace (5 * (PI / 4)) with (PI / 4 + PI)...
+  rewrite neg_cos; rewrite cos_PI4; unfold Rdiv in |- *;
+    rewrite Ropp_mult_distr_l_reverse...
+  pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+    rewrite double_var; assert (H : 2 <> 0);
+      [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
 Qed.
 
 Lemma sin_5PI4 : sin (5 * (PI / 4)) = -1 / sqrt 2.
 Proof with trivial.
-replace (5 * (PI / 4)) with (PI / 4 + PI)...
-rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *;
- rewrite Ropp_mult_distr_l_reverse...
-pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
- rewrite double_var; assert (H : 2 <> 0);
- [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
+  replace (5 * (PI / 4)) with (PI / 4 + PI)...
+  rewrite neg_sin; rewrite sin_PI4; unfold Rdiv in |- *;
+    rewrite Ropp_mult_distr_l_reverse...
+  pattern PI at 2 in |- *; rewrite double_var; pattern PI at 2 3 in |- *;
+    rewrite double_var; assert (H : 2 <> 0);
+      [ discrR | unfold Rdiv in |- *; repeat rewrite Rinv_mult_distr; try ring ]...
 Qed.
 
 Lemma sin_cos5PI4 : cos (5 * (PI / 4)) = sin (5 * (PI / 4)).
-rewrite cos_5PI4; rewrite sin_5PI4; reflexivity.
+Proof.
+  rewrite cos_5PI4; rewrite sin_5PI4; reflexivity.
 Qed.
 
 Lemma Rgt_3PI2_0 : 0 < 3 * (PI / 2).
-apply Rmult_lt_0_compat;
- [ prove_sup0
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ].
+Proof.
+  apply Rmult_lt_0_compat;
+    [ prove_sup0
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ apply PI_RGT_0 | apply Rinv_0_lt_compat; prove_sup0 ] ].
 Qed.
 
 Lemma Rgt_2PI_0 : 0 < 2 * PI.
-apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ].
+Proof.
+  apply Rmult_lt_0_compat; [ prove_sup0 | apply PI_RGT_0 ].
 Qed.
 
 Lemma Rlt_PI_3PI2 : PI < 3 * (PI / 2).
-generalize PI2_RGT_0; intro H1;
- generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1);
- replace (PI + PI / 2) with (3 * (PI / 2)).
-rewrite Rplus_0_r; intro H2; assumption.
-pattern PI at 2 in |- *; rewrite double_var; ring.
+Proof.
+  generalize PI2_RGT_0; intro H1;
+    generalize (Rplus_lt_compat_l PI 0 (PI / 2) H1);
+      replace (PI + PI / 2) with (3 * (PI / 2)).
+  rewrite Rplus_0_r; intro H2; assumption.
+  pattern PI at 2 in |- *; rewrite double_var; ring.
 Qed. 
- 
+
 Lemma Rlt_3PI2_2PI : 3 * (PI / 2) < 2 * PI.
-generalize PI2_RGT_0; intro H1;
- generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1);
- replace (3 * (PI / 2) + PI / 2) with (2 * PI).
-rewrite Rplus_0_r; intro H2; assumption.
-rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring.
+Proof.
+  generalize PI2_RGT_0; intro H1;
+    generalize (Rplus_lt_compat_l (3 * (PI / 2)) 0 (PI / 2) H1);
+      replace (3 * (PI / 2) + PI / 2) with (2 * PI).
+  rewrite Rplus_0_r; intro H2; assumption.
+  rewrite double; pattern PI at 1 2 in |- *; rewrite double_var; ring.
 Qed.
 
 (***************************************************************)
-(* Radian -> Degree | Degree -> Radian                         *)
+(** Radian -> Degree | Degree -> Radian                        *)
 (***************************************************************)
 
 Definition plat : R := 180.
@@ -382,27 +405,30 @@ Definition toRad (x:R) : R := x * PI * / plat.
 Definition toDeg (x:R) : R := x * plat * / PI.
 
 Lemma rad_deg : forall x:R, toRad (toDeg x) = x.
-intro; unfold toRad, toDeg in |- *;
- replace (x * plat * / PI * PI * / plat) with
-  (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ].
-repeat rewrite <- Rinv_r_sym.
-ring.
-apply PI_neq0.
-unfold plat in |- *; discrR.
+Proof.
+  intro; unfold toRad, toDeg in |- *;
+    replace (x * plat * / PI * PI * / plat) with
+    (x * (plat * / plat) * (PI * / PI)); [ idtac | ring ].
+  repeat rewrite <- Rinv_r_sym.
+  ring.
+  apply PI_neq0.
+  unfold plat in |- *; discrR.
 Qed.
 
 Lemma toRad_inj : forall x y:R, toRad x = toRad y -> x = y.
-intros; unfold toRad in H; apply Rmult_eq_reg_l with PI.
-rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y).
-apply Rmult_eq_reg_l with (/ plat).
-rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI));
- assumption.
-apply Rinv_neq_0_compat; unfold plat in |- *; discrR.
-apply PI_neq0.
+Proof.
+  intros; unfold toRad in H; apply Rmult_eq_reg_l with PI.
+  rewrite <- (Rmult_comm x); rewrite <- (Rmult_comm y).
+  apply Rmult_eq_reg_l with (/ plat).
+  rewrite <- (Rmult_comm (x * PI)); rewrite <- (Rmult_comm (y * PI));
+    assumption.
+  apply Rinv_neq_0_compat; unfold plat in |- *; discrR.
+  apply PI_neq0.
 Qed.
 
 Lemma deg_rad : forall x:R, toDeg (toRad x) = x.
-intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity.
+Proof.
+  intro x; apply toRad_inj; rewrite (rad_deg (toRad x)); reflexivity.
 Qed.
 
 Definition sind (x:R) : R := sin (toRad x).
@@ -410,25 +436,27 @@ Definition cosd (x:R) : R := cos (toRad x).
 Definition tand (x:R) : R := tan (toRad x).
 
 Lemma Rsqr_sin_cos_d_one : forall x:R, Rsqr (sind x) + Rsqr (cosd x) = 1.
-intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2.
+Proof.
+  intro x; unfold sind in |- *; unfold cosd in |- *; apply sin2_cos2.
 Qed.
 
 (***************************************************)
-(*                Other properties                 *)
+(**               Other properties                 *)
 (***************************************************)
 
 Lemma sin_lb_ge_0 : forall a:R, 0 <= a -> a <= PI / 2 -> 0 <= sin_lb a.
-intros; case (Rtotal_order 0 a); intro.
-left; apply sin_lb_gt_0; assumption.
-elim H1; intro.
-rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *;
- unfold sum_f_R0 in |- *; unfold sin_term in |- *; 
- repeat rewrite pow_ne_zero.
-unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r;
- repeat rewrite Rplus_0_r; right; reflexivity.
-discriminate.
-discriminate.
-discriminate.
-discriminate.
-elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)).
-Qed.
\ No newline at end of file
+Proof.
+  intros; case (Rtotal_order 0 a); intro.
+  left; apply sin_lb_gt_0; assumption.
+  elim H1; intro.
+  rewrite <- H2; unfold sin_lb in |- *; unfold sin_approx in |- *;
+    unfold sum_f_R0 in |- *; unfold sin_term in |- *; 
+      repeat rewrite pow_ne_zero.
+  unfold Rdiv in |- *; repeat rewrite Rmult_0_l; repeat rewrite Rmult_0_r;
+    repeat rewrite Rplus_0_r; right; reflexivity.
+  discriminate.
+  discriminate.
+  discriminate.
+  discriminate.
+  elim (Rlt_irrefl 0 (Rle_lt_trans 0 a 0 H H2)).
+Qed.
diff --git a/theories/Reals/Rtrigo_def.v b/theories/Reals/Rtrigo_def.v
index 94f5ec97..b2aeb766 100644
--- a/theories/Reals/Rtrigo_def.v
+++ b/theories/Reals/Rtrigo_def.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rtrigo_def.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
+
+(*i $Id: Rtrigo_def.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -15,212 +15,222 @@ Require Import Rtrigo_fun.
 Require Import Max.
 Open Local Scope R_scope.
 
-(*****************************)
-(* Definition of exponential *)
-(*****************************)
+(********************************)
+(** * Definition of exponential *)
+(********************************)
 Definition exp_in (x l:R) : Prop :=
   infinit_sum (fun i:nat => / INR (fact i) * x ^ i) l.
 
 Lemma exp_cof_no_R0 : forall n:nat, / INR (fact n) <> 0.
-intro.
-apply Rinv_neq_0_compat.
-apply INR_fact_neq_0.
+Proof.
+  intro.
+  apply Rinv_neq_0_compat.
+  apply INR_fact_neq_0.
 Qed.
 
 Lemma exist_exp : forall x:R, sigT (fun l:R => exp_in x l).
-intro;
- generalize
-  (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp).
-unfold Pser, exp_in in |- *.
-trivial.
+Proof.
+  intro;
+    generalize
+      (Alembert_C3 (fun n:nat => / INR (fact n)) x exp_cof_no_R0 Alembert_exp).
+  unfold Pser, exp_in in |- *.
+  trivial.
 Defined.
 
 Definition exp (x:R) : R := projT1 (exist_exp x).
 
 Lemma pow_i : forall i:nat, (0 < i)%nat -> 0 ^ i = 0.
-intros; apply pow_ne_zero.
-red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H).
+Proof.
+  intros; apply pow_ne_zero.
+  red in |- *; intro; rewrite H0 in H; elim (lt_irrefl _ H).
 Qed.
 
 (*i Calculus of $e^0$ *)
 Lemma exist_exp0 : sigT (fun l:R => exp_in 0 l).
-apply existT with 1.
-unfold exp_in in |- *; unfold infinit_sum in |- *; intros.
-exists 0%nat.
-intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1.
-unfold R_dist in |- *; replace (1 - 1) with 0;
- [ rewrite Rabs_R0; assumption | ring ].
-induction  n as [| n Hrecn].
-simpl in |- *; rewrite Rinv_1; ring.
-rewrite tech5.
-rewrite <- Hrecn.
-simpl in |- *.
-ring.
-unfold ge in |- *; apply le_O_n.
+Proof.
+  apply existT with 1.
+  unfold exp_in in |- *; unfold infinit_sum in |- *; intros.
+  exists 0%nat.
+  intros; replace (sum_f_R0 (fun i:nat => / INR (fact i) * 0 ^ i) n) with 1.
+  unfold R_dist in |- *; replace (1 - 1) with 0;
+    [ rewrite Rabs_R0; assumption | ring ].
+  induction  n as [| n Hrecn].
+  simpl in |- *; rewrite Rinv_1; ring.
+  rewrite tech5.
+  rewrite <- Hrecn.
+  simpl in |- *.
+  ring.
+  unfold ge in |- *; apply le_O_n.
 Defined.
 
 Lemma exp_0 : exp 0 = 1. 
-cut (exp_in 0 (exp 0)).
-cut (exp_in 0 1).
-unfold exp_in in |- *; intros; eapply uniqueness_sum.
-apply H0.
-apply H.
-exact (projT2 exist_exp0).
-exact (projT2 (exist_exp 0)).
+Proof.
+  cut (exp_in 0 (exp 0)).
+  cut (exp_in 0 1).
+  unfold exp_in in |- *; intros; eapply uniqueness_sum.
+  apply H0.
+  apply H.
+  exact (projT2 exist_exp0).
+  exact (projT2 (exist_exp 0)).
 Qed.
 
-(**************************************)
-(* Definition of hyperbolic functions *)
-(**************************************)
+(*****************************************)
+(** * Definition of hyperbolic functions *)
+(*****************************************)
 Definition cosh (x:R) : R := (exp x + exp (- x)) / 2.
 Definition sinh (x:R) : R := (exp x - exp (- x)) / 2.
 Definition tanh (x:R) : R := sinh x / cosh x.
 
 Lemma cosh_0 : cosh 0 = 1.
-unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0.
-unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ].
+Proof.
+  unfold cosh in |- *; rewrite Ropp_0; rewrite exp_0.
+  unfold Rdiv in |- *; rewrite <- Rinv_r_sym; [ reflexivity | discrR ].
 Qed.
 
 Lemma sinh_0 : sinh 0 = 0.
-unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0.
-unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l.
+Proof.
+  unfold sinh in |- *; rewrite Ropp_0; rewrite exp_0.
+  unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r; apply Rmult_0_l.
 Qed.
 
 Definition cos_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n)).
 
 Lemma simpl_cos_n :
- forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). 
-intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-replace
- ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) *
-  (/ (-1) ^ n * INR (fact (2 * n)))) with
- ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) *
-  (-1) ^ 1); [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r.
-replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ].
-do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
- repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate).
-rewrite <- (Rmult_comm (-1)).
-repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r.
-replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ].
-rewrite mult_INR; rewrite Rinv_mult_distr.
-ring.
-apply not_O_INR; discriminate.
-replace (2 * n + 1)%nat with (S (2 * 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_0_compat; apply INR_fact_neq_0.
+  forall n:nat, cos_n (S n) / cos_n n = - / INR (2 * S n * (2 * n + 1)). 
+Proof.
+  intro; unfold cos_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  replace
+  ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1))) *
+    (/ (-1) ^ n * INR (fact (2 * n)))) with
+  ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1))) * INR (fact (2 * n)) *
+    (-1) ^ 1); [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r.
+  replace (2 * (n + 1))%nat with (S (S (2 * n))); [ idtac | ring ].
+  do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+    repeat rewrite Rinv_mult_distr; try (apply not_O_INR; discriminate).
+  rewrite <- (Rmult_comm (-1)).
+  repeat rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r.
+  replace (S (2 * n)) with (2 * n + 1)%nat; [ idtac | ring ].
+  rewrite mult_INR; rewrite Rinv_mult_distr.
+  ring.
+  apply not_O_INR; discriminate.
+  replace (2 * n + 1)%nat with (S (2 * 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_0_compat; apply INR_fact_neq_0.
 Qed.
 
 Lemma archimed_cor1 :
- forall eps:R, 0 < eps ->  exists N : nat, / INR N < eps /\ (0 < N)%nat.
-intros; cut (/ eps < IZR (up (/ eps))).
-intro; cut (0 <= up (/ eps))%Z.
-intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1).
-split.
-cut (0 < IZR (Z_of_nat x)).
-intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)).
-apply Rmult_le_reg_l with (IZR (Z_of_nat x)).
-assumption.
-rewrite <- Rinv_r_sym;
- [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ].
-apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))).
-apply Rlt_le_trans with (IZR (Z_of_nat x)).
-assumption.
-repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l.
-rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1))));
- rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR;
- apply le_max_l.
-rewrite <- INR_IZR_INZ; apply not_O_INR.
-red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat;
- [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6);
- rewrite H5 in H8; elim (lt_irrefl _ H8).
-pattern eps at 1 in |- *; rewrite <- Rinv_involutive.
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ].
-rewrite H3 in H0; assumption.
-red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H).
-apply Rlt_trans with (/ eps).
-apply Rinv_0_lt_compat; assumption.
-rewrite H3 in H0; assumption.
-apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ].
-apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left;
- apply Rlt_trans with (/ eps);
- [ apply Rinv_0_lt_compat; assumption | assumption ].
-assert (H0 := archimed (/ eps)).
-elim H0; intros; assumption.
+  forall eps:R, 0 < eps ->  exists N : nat, / INR N < eps /\ (0 < N)%nat.
+Proof.
+  intros; cut (/ eps < IZR (up (/ eps))).
+  intro; cut (0 <= up (/ eps))%Z.
+  intro; assert (H2 := IZN _ H1); elim H2; intros; exists (max x 1).
+  split.
+  cut (0 < IZR (Z_of_nat x)).
+  intro; rewrite INR_IZR_INZ; apply Rle_lt_trans with (/ IZR (Z_of_nat x)).
+  apply Rmult_le_reg_l with (IZR (Z_of_nat x)).
+  assumption.
+  rewrite <- Rinv_r_sym;
+    [ idtac | red in |- *; intro; rewrite H5 in H4; elim (Rlt_irrefl _ H4) ].
+  apply Rmult_le_reg_l with (IZR (Z_of_nat (max x 1))).
+  apply Rlt_le_trans with (IZR (Z_of_nat x)).
+  assumption.
+  repeat rewrite <- INR_IZR_INZ; apply le_INR; apply le_max_l.
+  rewrite Rmult_1_r; rewrite (Rmult_comm (IZR (Z_of_nat (max x 1))));
+    rewrite Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; repeat rewrite <- INR_IZR_INZ; apply le_INR;
+    apply le_max_l.
+  rewrite <- INR_IZR_INZ; apply not_O_INR.
+  red in |- *; intro; assert (H6 := le_max_r x 1); cut (0 < 1)%nat;
+    [ intro | apply lt_O_Sn ]; assert (H8 := lt_le_trans _ _ _ H7 H6);
+      rewrite H5 in H8; elim (lt_irrefl _ H8).
+  pattern eps at 1 in |- *; rewrite <- Rinv_involutive.
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat; [ apply Rinv_0_lt_compat; assumption | assumption ].
+  rewrite H3 in H0; assumption.
+  red in |- *; intro; rewrite H5 in H; elim (Rlt_irrefl _ H).
+  apply Rlt_trans with (/ eps).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite H3 in H0; assumption.
+  apply lt_le_trans with 1%nat; [ apply lt_O_Sn | apply le_max_r ].
+  apply le_IZR; replace (IZR 0) with 0; [ idtac | reflexivity ]; left;
+    apply Rlt_trans with (/ eps);
+      [ apply Rinv_0_lt_compat; assumption | assumption ].
+  assert (H0 := archimed (/ eps)).
+  elim H0; intros; assumption.
 Qed.
 
 Lemma Alembert_cos : Un_cv (fun n:nat => Rabs (cos_n (S n) / cos_n n)) 0.
-unfold Un_cv in |- *; intros.
-assert (H0 := archimed_cor1 eps H).
-elim H0; intros; exists x.
-intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *;
- rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
- rewrite Rabs_Ropp; rewrite Rabs_right.
-rewrite mult_INR; rewrite Rinv_mult_distr.
-cut (/ INR (2 * S n) < 1).
-intro; cut (/ INR (2 * n + 1) < eps).
-intro; rewrite <- (Rmult_1_l eps).
-apply Rmult_gt_0_lt_compat; try assumption.
-change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat;
- apply lt_INR_0.
-replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
-apply Rlt_0_1.
-cut (x < 2 * n + 1)%nat.
-intro; assert (H5 := lt_INR _ _ H4).
-apply Rlt_trans with (/ INR x).
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat.
-apply lt_INR_0.
-elim H1; intros; assumption.
-apply lt_INR_0; replace (2 * n + 1)%nat with (S (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 (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ].
-apply le_n_S; apply le_n_2n.
-apply Rmult_lt_reg_l with (INR (2 * S n)).
-apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))).
-apply lt_O_Sn.
-replace (S n) with (n + 1)%nat; [ idtac | ring ].
-ring.
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
-replace (2 * S n)%nat with (S (S (2 * n))).
-apply lt_n_S; apply lt_O_Sn.
-replace (S n) with (n + 1)%nat; [ ring | ring ].
-apply not_O_INR; discriminate.
-apply not_O_INR; discriminate.
-replace (2 * n + 1)%nat with (S (2 * n));
- [ apply not_O_INR; discriminate | ring ].
-apply Rle_ge; left; apply Rinv_0_lt_compat.
-apply lt_INR_0.
-replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 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 0) with 0; [ ring | reflexivity ].
+Proof.
+  unfold Un_cv in |- *; intros.
+  assert (H0 := archimed_cor1 eps H).
+  elim H0; intros; exists x.
+  intros; rewrite simpl_cos_n; unfold R_dist in |- *; unfold Rminus in |- *;
+    rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
+      rewrite Rabs_Ropp; rewrite Rabs_right.
+  rewrite mult_INR; rewrite Rinv_mult_distr.
+  cut (/ INR (2 * S n) < 1).
+  intro; cut (/ INR (2 * n + 1) < eps).
+  intro; rewrite <- (Rmult_1_l eps).
+  apply Rmult_gt_0_lt_compat; try assumption.
+  change (0 < / INR (2 * n + 1)) in |- *; apply Rinv_0_lt_compat;
+    apply lt_INR_0.
+  replace (2 * n + 1)%nat with (S (2 * n)); [ apply lt_O_Sn | ring ].
+  apply Rlt_0_1.
+  cut (x < 2 * n + 1)%nat.
+  intro; assert (H5 := lt_INR _ _ H4).
+  apply Rlt_trans with (/ INR x).
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat.
+  apply lt_INR_0.
+  elim H1; intros; assumption.
+  apply lt_INR_0; replace (2 * n + 1)%nat with (S (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 (2 * n + 1)%nat with (S (2 * n)); [ idtac | ring ].
+  apply le_n_S; apply le_n_2n.
+  apply Rmult_lt_reg_l with (INR (2 * S n)).
+  apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n))).
+  apply lt_O_Sn.
+  replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  ring.
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  apply lt_n_S; apply lt_O_Sn.
+  replace (S n) with (n + 1)%nat; [ ring | ring ].
+  apply not_O_INR; discriminate.
+  apply not_O_INR; discriminate.
+  replace (2 * n + 1)%nat with (S (2 * n));
+  [ apply not_O_INR; discriminate | ring ].
+  apply Rle_ge; left; apply Rinv_0_lt_compat.
+  apply lt_INR_0.
+  replace (2 * S n * (2 * n + 1))%nat with (S (S (4 * (n * n) + 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 0) with 0; [ ring | reflexivity ].
 Qed.
 
 Lemma cosn_no_R0 : forall n:nat, cos_n n <> 0.
-intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
-apply pow_nonzero; discrR.
-apply Rinv_neq_0_compat.
-apply INR_fact_neq_0.
+  intro; unfold cos_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat.
+  apply INR_fact_neq_0.
 Qed.
 
 (**********)
@@ -229,119 +239,122 @@ Definition cos_in (x l:R) : Prop :=
 
 (**********)
 Lemma exist_cos : forall x:R, sigT (fun l:R => cos_in x l).
-intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
-unfold Pser, cos_in in |- *; trivial.
+  intro; generalize (Alembert_C3 cos_n x cosn_no_R0 Alembert_cos).
+  unfold Pser, cos_in in |- *; trivial.
 Qed.
 
-(* Definition of cosinus *)
-(*************************)
+
+(** Definition of cosinus *)
 Definition cos (x:R) : R :=
   match exist_cos (Rsqr x) with
-  | existT a b => a
+    | existT a b => a
   end.
 
 
 Definition sin_n (n:nat) : R := (-1) ^ n / INR (fact (2 * n + 1)).
 
 Lemma simpl_sin_n :
- forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). 
-intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
-rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-replace
- ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) *
-  (/ (-1) ^ n * INR (fact (2 * n + 1)))) with
- ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) *
-  INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r;
- replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))).
-do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
- repeat rewrite Rinv_mult_distr.
-rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat.
-repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
-ring.
-apply not_O_INR; discriminate.
-replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
-apply not_O_INR; discriminate.
-apply prod_neq_R0.
-apply not_O_INR; discriminate.
-replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
-apply not_O_INR; discriminate.
-replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
-rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat).
-intros; rewrite (H (2 * n + 1)%nat).
-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 (forall n:nat, S (S n) = (n + 2)%nat);
- [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ].
-apply pow_nonzero; discrR.
-apply INR_fact_neq_0.
-apply pow_nonzero; discrR.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  forall n:nat, sin_n (S n) / sin_n n = - / INR ((2 * S n + 1) * (2 * S n)). 
+Proof.
+  intro; unfold sin_n in |- *; replace (S n) with (n + 1)%nat; [ idtac | ring ].
+  rewrite pow_add; unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  replace
+  ((-1) ^ n * (-1) ^ 1 * / INR (fact (2 * (n + 1) + 1)) *
+    (/ (-1) ^ n * INR (fact (2 * n + 1)))) with
+  ((-1) ^ n * / (-1) ^ n * / INR (fact (2 * (n + 1) + 1)) *
+    INR (fact (2 * n + 1)) * (-1) ^ 1); [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; unfold pow in |- *; rewrite Rmult_1_r;
+    replace (2 * (n + 1) + 1)%nat with (S (S (2 * n + 1))).
+  do 2 rewrite fact_simpl; do 2 rewrite mult_INR;
+    repeat rewrite Rinv_mult_distr.
+  rewrite <- (Rmult_comm (-1)); repeat rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; replace (S (2 * n + 1)) with (2 * (n + 1))%nat.
+  repeat rewrite mult_INR; repeat rewrite Rinv_mult_distr.
+  ring.
+  apply not_O_INR; discriminate.
+  replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+  apply not_O_INR; discriminate.
+  apply prod_neq_R0.
+  apply not_O_INR; discriminate.
+  replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+  apply not_O_INR; discriminate.
+  replace (n + 1)%nat with (S n); [ apply not_O_INR; discriminate | ring ].
+  rewrite mult_plus_distr_l; cut (forall n:nat, S n = (n + 1)%nat).
+  intros; rewrite (H (2 * n + 1)%nat).
+  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 (forall n:nat, S (S n) = (n + 2)%nat);
+    [ intros; rewrite (H (2 * n + 1)%nat); ring | intros; ring ].
+  apply pow_nonzero; discrR.
+  apply INR_fact_neq_0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
 Qed.
 
 Lemma Alembert_sin : Un_cv (fun n:nat => Rabs (sin_n (S n) / sin_n n)) 0.
-unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H).
-elim H0; intros; exists x.
-intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *;
- rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
- rewrite Rabs_Ropp; rewrite Rabs_right.
-rewrite mult_INR; rewrite Rinv_mult_distr.
-cut (/ INR (2 * S n) < 1).
-intro; cut (/ INR (2 * S n + 1) < eps).
-intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1)));
- apply Rmult_gt_0_lt_compat; try assumption.
-change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat;
- apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n));
- [ apply lt_O_Sn | ring ].
-apply Rlt_0_1.
-cut (x < 2 * S n + 1)%nat.
-intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x).
-apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat.
-apply lt_INR_0; elim H1; intros; assumption.
-apply lt_INR_0; replace (2 * S n + 1)%nat with (S (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 (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ].
-apply le_S; apply le_n_2n.
-apply Rmult_lt_reg_l with (INR (2 * S n)).
-apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n)));
- [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
-replace (2 * S n)%nat with (S (S (2 * n))).
-apply lt_n_S; apply lt_O_Sn.
-replace (S n) with (n + 1)%nat; [ ring | ring ].
-apply not_O_INR; discriminate.
-apply not_O_INR; discriminate.
-apply not_O_INR; discriminate.
-left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *;
- apply Rinv_0_lt_compat.
-apply lt_INR_0.
-replace ((2 * S n + 1) * (2 * S n))%nat with
- (S (S (S (S (S (S (4 * (n * n) + 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 0) with 0; [ ring | reflexivity ].
+Proof.
+  unfold Un_cv in |- *; intros; assert (H0 := archimed_cor1 eps H).
+  elim H0; intros; exists x.
+  intros; rewrite simpl_sin_n; unfold R_dist in |- *; unfold Rminus in |- *;
+    rewrite Ropp_0; rewrite Rplus_0_r; rewrite Rabs_Rabsolu; 
+      rewrite Rabs_Ropp; rewrite Rabs_right.
+  rewrite mult_INR; rewrite Rinv_mult_distr.
+  cut (/ INR (2 * S n) < 1).
+  intro; cut (/ INR (2 * S n + 1) < eps).
+  intro; rewrite <- (Rmult_1_l eps); rewrite (Rmult_comm (/ INR (2 * S n + 1)));
+    apply Rmult_gt_0_lt_compat; try assumption.
+  change (0 < / INR (2 * S n + 1)) in |- *; apply Rinv_0_lt_compat;
+    apply lt_INR_0; replace (2 * S n + 1)%nat with (S (2 * S n));
+      [ apply lt_O_Sn | ring ].
+  apply Rlt_0_1.
+  cut (x < 2 * S n + 1)%nat.
+  intro; assert (H5 := lt_INR _ _ H4); apply Rlt_trans with (/ INR x).
+  apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat.
+  apply lt_INR_0; elim H1; intros; assumption.
+  apply lt_INR_0; replace (2 * S n + 1)%nat with (S (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 (2 * S n + 1)%nat with (S (2 * S n)); [ idtac | ring ].
+  apply le_S; apply le_n_2n.
+  apply Rmult_lt_reg_l with (INR (2 * S n)).
+  apply lt_INR_0; replace (2 * S n)%nat with (S (S (2 * n)));
+    [ apply lt_O_Sn | replace (S n) with (n + 1)%nat; [ idtac | ring ]; ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; replace 1 with (INR 1); [ apply lt_INR | reflexivity ].
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  apply lt_n_S; apply lt_O_Sn.
+  replace (S n) with (n + 1)%nat; [ ring | ring ].
+  apply not_O_INR; discriminate.
+  apply not_O_INR; discriminate.
+  apply not_O_INR; discriminate.
+  left; change (0 < / INR ((2 * S n + 1) * (2 * S n))) in |- *;
+    apply Rinv_0_lt_compat.
+  apply lt_INR_0.
+  replace ((2 * S n + 1) * (2 * S n))%nat with
+  (S (S (S (S (S (S (4 * (n * n) + 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 0) with 0; [ ring | reflexivity ].
 Qed.
 
 Lemma sin_no_R0 : forall n:nat, sin_n n <> 0.
-intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
-apply pow_nonzero; discrR.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+Proof.
+  intro; unfold sin_n in |- *; unfold Rdiv in |- *; apply prod_neq_R0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
 Qed.
 
 (**********)
@@ -350,63 +363,69 @@ Definition sin_in (x l:R) : Prop :=
 
 (**********)
 Lemma exist_sin : forall x:R, sigT (fun l:R => sin_in x l).
-intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
-unfold Pser, sin_n in |- *; trivial.
+Proof.
+  intro; generalize (Alembert_C3 sin_n x sin_no_R0 Alembert_sin).
+  unfold Pser, sin_n in |- *; trivial.
 Qed.
 
 (***********************)
 (* Definition of sinus *)
 Definition sin (x:R) : R :=
   match exist_sin (Rsqr x) with
-  | existT a b => x * a
+    | existT a b => x * a
   end.
 
 (*********************************************)
-(*                 PROPERTIES                *)
+(** *              Properties                *)
 (*********************************************)
 
 Lemma cos_sym : forall x:R, cos x = cos (- x).
-intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x).
-reflexivity.
-apply Rsqr_neg.
+Proof.
+  intros; unfold cos in |- *; replace (Rsqr (- x)) with (Rsqr x).
+  reflexivity.
+  apply Rsqr_neg.
 Qed.
 
 Lemma sin_antisym : forall x:R, sin (- x) = - sin x.
-intro; unfold sin in |- *; replace (Rsqr (- x)) with (Rsqr x);
- [ idtac | apply Rsqr_neg ]. 
-case (exist_sin (Rsqr x)); intros; ring.
+Proof.
+  intro; unfold sin in |- *; 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 in |- *; case (exist_sin (Rsqr 0)).
-intros; ring.
+Proof.
+  unfold sin in |- *; case (exist_sin (Rsqr 0)).
+  intros; ring.
 Qed.
 
 Lemma exist_cos0 : sigT (fun l:R => cos_in 0 l).
-apply existT with 1.
-unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat.
-intros.
-unfold R_dist in |- *.
-induction  n as [| n Hrecn].
-unfold cos_n in |- *; simpl in |- *.
-unfold Rdiv in |- *; rewrite Rinv_1.
-do 2 rewrite Rmult_1_r.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-rewrite tech5.
-replace (cos_n (S n) * 0 ^ S n) with 0.
-rewrite Rplus_0_r.
-apply Hrecn; unfold ge in |- *; apply le_O_n.
-simpl in |- *; ring.
+Proof.
+  apply existT with 1.
+  unfold cos_in in |- *; unfold infinit_sum in |- *; intros; exists 0%nat.
+  intros.
+  unfold R_dist in |- *.
+  induction  n as [| n Hrecn].
+  unfold cos_n in |- *; simpl in |- *.
+  unfold Rdiv in |- *; rewrite Rinv_1.
+  do 2 rewrite Rmult_1_r.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  rewrite tech5.
+  replace (cos_n (S n) * 0 ^ S n) with 0.
+  rewrite Rplus_0_r.
+  apply Hrecn; unfold ge in |- *; apply le_O_n.
+  simpl in |- *; ring.
 Defined.
 
 (* Calculus of (cos 0) *)
 Lemma cos_0 : cos 0 = 1.
-cut (cos_in 0 (cos 0)).
-cut (cos_in 0 1).
-unfold cos_in in |- *; intros; eapply uniqueness_sum.
-apply H0.
-apply H.
-exact (projT2 exist_cos0).
-assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *;
- pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ].
+Proof.
+  cut (cos_in 0 (cos 0)).
+  cut (cos_in 0 1).
+  unfold cos_in in |- *; intros; eapply uniqueness_sum.
+  apply H0.
+  apply H.
+  exact (projT2 exist_cos0).
+  assert (H := projT2 (exist_cos (Rsqr 0))); unfold cos in |- *;
+    pattern 0 at 1 in |- *; replace 0 with (Rsqr 0); [ exact H | apply Rsqr_0 ].
 Qed.
diff --git a/theories/Reals/Rtrigo_fun.v b/theories/Reals/Rtrigo_fun.v
index eaf2121e..78ef847f 100644
--- a/theories/Reals/Rtrigo_fun.v
+++ b/theories/Reals/Rtrigo_fun.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rtrigo_fun.v 8691 2006-04-10 09:23:37Z msozeau $ i*)
+(*i $Id: Rtrigo_fun.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -14,96 +14,89 @@ Require Import SeqSeries.
 Open Local Scope R_scope.
 
 (*****************************************************************)
-(*           To define transcendental functions                  *)
-(*                                                               *)
-(*****************************************************************)
-(*****************************************************************)
-(*           For exponential function                            *)
+(**           To define transcendental functions                 *)
+(**           for exponential function                           *)
 (*                                                               *)
 (*****************************************************************)
 
 (*********)
 Lemma Alembert_exp :
- Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0.
-unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro.
-split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *;
- rewrite (Rminus_0_r (Rabs (/ INR (S n))));
- rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
-intro; rewrite (Rabs_pos_eq (/ INR (S n))).
-cut (/ eps - 1 < 0).
-intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n));
- clear H2; intro; unfold Rminus in H2;
- generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2);
- replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ].
-rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2;
- generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); 
- intro; unfold Rgt in H3;
- generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2);
- intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4;
- rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
-   in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
- rewrite (Rmult_comm (/ INR (S n))) in H4;
- rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
- rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4;
- rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; 
- assumption.
-apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1;
- apply (Rinv_lt_contravar 1 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 in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  Un_cv (fun n:nat => Rabs (/ INR (fact (S n)) * / / INR (fact n))) 0.
+Proof.
+  unfold Un_cv in |- *; intros; elim (Rgt_dec eps 1); intro.
+  split with 0%nat; intros; rewrite (simpl_fact n); unfold R_dist in |- *;
+    rewrite (Rminus_0_r (Rabs (/ INR (S n))));
+      rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
+  intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+  cut (/ eps - 1 < 0).
+  intro; generalize (Rlt_le_trans (/ eps - 1) 0 (INR n) H2 (pos_INR n));
+    clear H2; intro; unfold Rminus in H2;
+      generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H2);
+        replace (1 + (/ eps + -1)) with (/ eps); [ clear H2; intro | ring ].
+  rewrite (Rplus_comm 1 (INR n)) in H2; rewrite <- (S_INR n) in H2;
+    generalize (Rmult_gt_0_compat (/ INR (S n)) eps H1 H); 
+      intro; unfold Rgt in H3;
+        generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H3 H2);
+          intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H4;
+            rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+              in H4; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H4;
+                rewrite (Rmult_comm (/ INR (S n))) in H4;
+                  rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H4;
+                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H4;
+                      rewrite (let (H1, H2) := Rmult_ne eps in H1) in H4; 
+                        assumption.
+  apply Rlt_minus; unfold Rgt in a; rewrite <- Rinv_1;
+    apply (Rinv_lt_contravar 1 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 in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
 (**)
-cut (0 <= up (/ eps - 1))%Z.
-intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
- rewrite (simpl_fact n); unfold R_dist in |- *;
- rewrite (Rminus_0_r (Rabs (/ INR (S n))));
- rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
-intro; rewrite (Rabs_pos_eq (/ INR (S n))).
-cut (/ eps - 1 < INR x).
-intro ;
- generalize
-  (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
-     (le_INR x n H2)); 
- clear H4; intro; unfold Rminus in H4;
- generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4);
- replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ].
-rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4;
- generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); 
- intro; unfold Rgt in H5;
- generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4);
- intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6;
- rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
-   in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
- rewrite (Rmult_comm (/ INR (S n))) in H6;
- rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
- rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6;
- rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; 
- assumption.
-cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x));
- [ intro | rewrite H1; trivial ].
-elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
- rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
-unfold Rgt in H1; apply Rlt_le; assumption.
-unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-apply (le_O_IZR (up (/ eps - 1)));
- apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
-generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0;
- clear H0; intro.
-left; unfold Rgt in H;
- generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
- rewrite
-  (Rinv_l eps
-     (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
-  ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); 
- intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; 
- unfold Rgt in |- *; assumption.
-right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto.
-elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
- assumption.
+  cut (0 <= up (/ eps - 1))%Z.
+  intro; elim (IZN (up (/ eps - 1)) H0); intros; split with x; intros;
+    rewrite (simpl_fact n); unfold R_dist in |- *;
+      rewrite (Rminus_0_r (Rabs (/ INR (S n))));
+        rewrite (Rabs_Rabsolu (/ INR (S n))); cut (/ INR (S n) > 0).
+  intro; rewrite (Rabs_pos_eq (/ INR (S n))).
+  cut (/ eps - 1 < INR x).
+  intro ;
+    generalize
+      (Rlt_le_trans (/ eps - 1) (INR x) (INR n) H4
+        (le_INR x n H2)); 
+      clear H4; intro; unfold Rminus in H4;
+        generalize (Rplus_lt_compat_l 1 (/ eps + -1) (INR n) H4);
+          replace (1 + (/ eps + -1)) with (/ eps); [ clear H4; intro | ring ].
+  rewrite (Rplus_comm 1 (INR n)) in H4; rewrite <- (S_INR n) in H4;
+    generalize (Rmult_gt_0_compat (/ INR (S n)) eps H3 H); 
+      intro; unfold Rgt in H5;
+        generalize (Rmult_lt_compat_l (/ INR (S n) * eps) (/ eps) (INR (S n)) H5 H4);
+          intro; rewrite (Rmult_assoc (/ INR (S n)) eps (/ eps)) in H6;
+            rewrite (Rinv_r eps (Rlt_dichotomy_converse eps 0 (or_intror (eps < 0) H)))
+              in H6; rewrite (let (H1, H2) := Rmult_ne (/ INR (S n)) in H1) in H6;
+                rewrite (Rmult_comm (/ INR (S n))) in H6;
+                  rewrite (Rmult_assoc eps (/ INR (S n)) (INR (S n))) in H6;
+                    rewrite (Rinv_l (INR (S n)) (not_O_INR (S n) (sym_not_equal (O_S n)))) in H6;
+                      rewrite (let (H1, H2) := Rmult_ne eps in H1) in H6; 
+                        assumption.
+  cut (IZR (up (/ eps - 1)) = IZR (Z_of_nat x));
+    [ intro | rewrite H1; trivial ].
+  elim (archimed (/ eps - 1)); intros; clear H6; unfold Rgt in H5;
+    rewrite H4 in H5; rewrite INR_IZR_INZ; assumption.
+  unfold Rgt in H1; apply Rlt_le; assumption.
+  unfold Rgt in |- *; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  apply (le_O_IZR (up (/ eps - 1)));
+    apply (Rle_trans 0 (/ eps - 1) (IZR (up (/ eps - 1)))).
+  generalize (Rnot_gt_le eps 1 b); clear b; unfold Rle in |- *; intro; elim H0;
+    clear H0; intro.
+  left; unfold Rgt in H;
+    generalize (Rmult_lt_compat_l (/ eps) eps 1 (Rinv_0_lt_compat eps H) H0);
+      rewrite
+        (Rinv_l eps
+          (sym_not_eq (Rlt_dichotomy_converse 0 eps (or_introl (0 > eps) H))))
+        ; rewrite (let (H1, H2) := Rmult_ne (/ eps) in H1); 
+          intro; fold (/ eps - 1 > 0) in |- *; apply Rgt_minus; 
+            unfold Rgt in |- *; assumption.
+  right; rewrite H0; rewrite Rinv_1; apply sym_eq; apply Rminus_diag_eq; auto.
+  elim (archimed (/ eps - 1)); intros; clear H1; unfold Rgt in H0; apply Rlt_le;
+    assumption.
 Qed.
-
-
-
-
-
diff --git a/theories/Reals/Rtrigo_reg.v b/theories/Reals/Rtrigo_reg.v
index 1c9a9445..854c0b4a 100644
--- a/theories/Reals/Rtrigo_reg.v
+++ b/theories/Reals/Rtrigo_reg.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Rtrigo_reg.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: Rtrigo_reg.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -18,591 +18,603 @@ Open Local Scope nat_scope.
 Open Local Scope R_scope.
 
 Lemma CVN_R_cos :
- forall fn:nat -> R -> R,
-   fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) ->
-   CVN_R fn.
-unfold CVN_R in |- *; intros.
-cut ((r:R) <> 0).
-intro hyp_r; unfold CVN_r in |- *.
-apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)).
-cut
- (sigT
-    (fun l:R =>
-       Un_cv
-         (fun n:nat =>
-            sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
-              n) l)).
-intro X; elim X; intros.
-apply existT with x.
-split.
-apply p.
-intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult.
-rewrite pow_1_abs; rewrite Rmult_1_l.
-cut (0 < / INR (fact (2 * n))).
-intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
-apply Rmult_le_compat_l.
-left; apply H1.
-rewrite <- RPow_abs; apply pow_maj_Rabs.
-rewrite Rabs_Rabsolu.
-unfold Boule in H0; rewrite Rminus_0_r in H0.
-left; apply H0.
-apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-apply Alembert_C2.
-intro; apply Rabs_no_R0.
-apply prod_neq_R0.
-apply Rinv_neq_0_compat.
-apply INR_fact_neq_0.
-apply pow_nonzero; assumption.
-assert (H0 := Alembert_cos).
-unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros.
-cut (0 < eps / Rsqr r).
-intro; elim (H0 _ H2); intros N0 H3.
-exists N0; intros.
-unfold R_dist in |- *; assert (H5 := H3 _ H4).
-unfold R_dist in H5;
- replace
-  (Rabs
-     (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) /
-      Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with
-  (Rsqr r *
-   Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))).
-apply Rmult_lt_reg_l with (/ Rsqr r).
-apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)).
-rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r;
- rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5.
-unfold Rsqr in |- *; apply prod_neq_R0; assumption.
-rewrite Rabs_Rinv.
-rewrite Rabs_right.
-reflexivity.
-apply Rle_ge; apply Rle_0_sqr.
-unfold Rsqr in |- *; apply prod_neq_R0; assumption.
-rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult;
- rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l;
- repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-rewrite Rabs_Rinv.
-rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l;
- rewrite <- Rabs_Rinv.
-rewrite Rinv_involutive.
-rewrite Rinv_mult_distr.
-rewrite Rabs_Rinv.
-rewrite Rinv_involutive.
-rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult;
- rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-rewrite Rabs_Rinv.
-do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right.
-replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
-repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-unfold Rsqr in |- *; ring.
-apply pow_nonzero; assumption.
-replace (2 * S n)%nat with (S (S (2 * n))).
-simpl in |- *; ring.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
-apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-apply Rabs_no_R0; apply pow_nonzero; assumption.
-apply Rabs_no_R0; apply INR_fact_neq_0.
-apply INR_fact_neq_0.
-apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-apply Rabs_no_R0; apply pow_nonzero; assumption.
-apply INR_fact_neq_0.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-apply prod_neq_R0.
-apply pow_nonzero; discrR.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply H1.
-apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
- elim (Rlt_irrefl _ H0).
+  forall fn:nat -> R -> R,
+    fn = (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)) ->
+    CVN_R fn.
+Proof.
+  unfold CVN_R in |- *; intros.
+  cut ((r:R) <> 0).
+  intro hyp_r; unfold CVN_r in |- *.
+  apply existT with (fun n:nat => / INR (fact (2 * n)) * r ^ (2 * n)).
+  cut
+    (sigT
+      (fun l:R =>
+        Un_cv
+        (fun n:nat =>
+          sum_f_R0 (fun k:nat => Rabs (/ INR (fact (2 * k)) * r ^ (2 * k)))
+          n) l)).
+  intro X; elim X; intros.
+  apply existT with x.
+  split.
+  apply p.
+  intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult.
+  rewrite pow_1_abs; rewrite Rmult_1_l.
+  cut (0 < / INR (fact (2 * n))).
+  intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
+  apply Rmult_le_compat_l.
+  left; apply H1.
+  rewrite <- RPow_abs; apply pow_maj_Rabs.
+  rewrite Rabs_Rabsolu.
+  unfold Boule in H0; rewrite Rminus_0_r in H0.
+  left; apply H0.
+  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  apply Alembert_C2.
+  intro; apply Rabs_no_R0.
+  apply prod_neq_R0.
+  apply Rinv_neq_0_compat.
+  apply INR_fact_neq_0.
+  apply pow_nonzero; assumption.
+  assert (H0 := Alembert_cos).
+  unfold cos_n in H0; unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+  cut (0 < eps / Rsqr r).
+  intro; elim (H0 _ H2); intros N0 H3.
+  exists N0; intros.
+  unfold R_dist in |- *; assert (H5 := H3 _ H4).
+  unfold R_dist in H5;
+    replace
+    (Rabs
+      (Rabs (/ INR (fact (2 * S n)) * r ^ (2 * S n)) /
+        Rabs (/ INR (fact (2 * n)) * r ^ (2 * n)))) with
+    (Rsqr r *
+      Rabs ((-1) ^ S n / INR (fact (2 * S n)) / ((-1) ^ n / INR (fact (2 * n))))).
+  apply Rmult_lt_reg_l with (/ Rsqr r).
+  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  pattern (/ Rsqr r) at 1 in |- *; replace (/ Rsqr r) with (Rabs (/ Rsqr r)).
+  rewrite <- Rabs_mult; rewrite Rmult_minus_distr_l; rewrite Rmult_0_r;
+    rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps); apply H5.
+  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  rewrite Rabs_Rinv.
+  rewrite Rabs_right.
+  reflexivity.
+  apply Rle_ge; apply Rle_0_sqr.
+  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  rewrite (Rmult_comm (Rsqr r)); unfold Rdiv in |- *; repeat rewrite Rabs_mult;
+    rewrite Rabs_Rabsolu; rewrite pow_1_abs; rewrite Rmult_1_l;
+      repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rabs_Rinv.
+  rewrite Rabs_mult; rewrite (pow_1_abs n); rewrite Rmult_1_l;
+    rewrite <- Rabs_Rinv.
+  rewrite Rinv_involutive.
+  rewrite Rinv_mult_distr.
+  rewrite Rabs_Rinv.
+  rewrite Rinv_involutive.
+  rewrite (Rmult_comm (Rabs (Rabs (r ^ (2 * S n))))); rewrite Rabs_mult;
+    rewrite Rabs_Rabsolu; rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rabs_Rinv.
+  do 2 rewrite Rabs_Rabsolu; repeat rewrite Rabs_right.
+  replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
+  repeat rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  unfold Rsqr in |- *; ring.
+  apply pow_nonzero; assumption.
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  simpl in |- *; ring.
+  ring_nat.
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply Rabs_no_R0; apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply INR_fact_neq_0.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply prod_neq_R0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply H1.
+  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+    elim (Rlt_irrefl _ H0).
 Qed.
 
 (**********)
 Lemma continuity_cos : continuity cos.
-set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)).
-cut (CVN_R fn).
-intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
-intro cv; cut (forall n:nat, continuity (fn n)).
-intro; cut (forall x:R, cos x = SFL fn cv x).
-intro; cut (continuity (SFL fn cv) -> continuity cos).
-intro; apply H1.
-apply SFL_continuity; assumption.
-unfold continuity in |- *; unfold continuity_pt in |- *;
- unfold continue_in in |- *; unfold limit1_in in |- *;
- unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros.
-elim (H1 x _ H2); intros.
-exists x0; intros.
-elim H3; intros.
-split.
-apply H4.
-intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
-intro; unfold cos, SFL in |- *.
-case (cv x); case (exist_cos (Rsqr x)); intros.
-symmetry  in |- *; eapply UL_sequence.
-apply u.
-unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros.
-elim (c _ H0); intros N0 H1.
-exists N0; intros.
-unfold R_dist in H1; unfold R_dist, SP in |- *.
-replace (sum_f_R0 (fun k:nat => fn k x) n) with
- (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n).
-apply H1; assumption.
-apply sum_eq; intros.
-unfold cos_n, fn in |- *; apply Rmult_eq_compat_l.
-unfold Rsqr in |- *; rewrite pow_sqr; reflexivity.
-intro; unfold fn in |- *;
- replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with
-  (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F;
- [ idtac | reflexivity ].
-apply continuity_mult.
-apply derivable_continuous; apply derivable_const.
-apply derivable_continuous; apply (derivable_pow (2 * n)).
-apply CVN_R_CVS; apply X.
-apply CVN_R_cos; unfold fn in |- *; reflexivity.
+Proof.
+  set (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N)) * x ^ (2 * N)).
+  cut (CVN_R fn).
+  intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+  intro cv; cut (forall n:nat, continuity (fn n)).
+  intro; cut (forall x:R, cos x = SFL fn cv x).
+  intro; cut (continuity (SFL fn cv) -> continuity cos).
+  intro; apply H1.
+  apply SFL_continuity; assumption.
+  unfold continuity in |- *; unfold continuity_pt in |- *;
+    unfold continue_in in |- *; unfold limit1_in in |- *;
+      unfold limit_in in |- *; simpl in |- *; unfold R_dist in |- *; 
+        intros.
+  elim (H1 x _ H2); intros.
+  exists x0; intros.
+  elim H3; intros.
+  split.
+  apply H4.
+  intros; rewrite (H0 x); rewrite (H0 x1); apply H5; apply H6.
+  intro; unfold cos, SFL in |- *.
+  case (cv x); case (exist_cos (Rsqr x)); intros.
+  symmetry  in |- *; eapply UL_sequence.
+  apply u.
+  unfold cos_in in c; unfold infinit_sum in c; unfold Un_cv in |- *; intros.
+  elim (c _ H0); intros N0 H1.
+  exists N0; intros.
+  unfold R_dist in H1; unfold R_dist, SP in |- *.
+  replace (sum_f_R0 (fun k:nat => fn k x) n) with
+  (sum_f_R0 (fun i:nat => cos_n i * Rsqr x ^ i) n).
+  apply H1; assumption.
+  apply sum_eq; intros.
+  unfold cos_n, fn in |- *; apply Rmult_eq_compat_l.
+  unfold Rsqr in |- *; rewrite pow_sqr; reflexivity.
+  intro; unfold fn in |- *;
+    replace (fun x:R => (-1) ^ n / INR (fact (2 * n)) * x ^ (2 * n)) with
+    (fct_cte ((-1) ^ n / INR (fact (2 * n))) * pow_fct (2 * n))%F;
+    [ idtac | reflexivity ].
+  apply continuity_mult.
+  apply derivable_continuous; apply derivable_const.
+  apply derivable_continuous; apply (derivable_pow (2 * n)).
+  apply CVN_R_CVS; apply X.
+  apply CVN_R_cos; unfold fn in |- *; reflexivity.
 Qed.
 
 (**********)
 Lemma continuity_sin : continuity sin.
-unfold continuity in |- *; intro.
-assert (H0 := continuity_cos (PI / 2 - x)).
-unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0;
- unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
- unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros.
-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 in |- *; split.
-trivial.
-red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8;
- rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1);
- apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); 
- apply H7.
-replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ];
- rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6.
+Proof.
+  unfold continuity in |- *; intro.
+  assert (H0 := continuity_cos (PI / 2 - x)).
+  unfold continuity_pt in H0; unfold continue_in in H0; unfold limit1_in in H0;
+    unfold limit_in in H0; simpl in H0; unfold R_dist in H0;
+      unfold continuity_pt in |- *; unfold continue_in in |- *;
+        unfold limit1_in in |- *; unfold limit_in in |- *; 
+          simpl in |- *; unfold R_dist in |- *; intros.
+  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 in |- *; split.
+  trivial.
+  red in |- *; intro; unfold D_x, no_cond in H5; elim H5; intros _ H8; elim H8;
+    rewrite <- (Ropp_involutive x); rewrite <- (Ropp_involutive x1);
+      apply Ropp_eq_compat; apply Rplus_eq_reg_l with (PI / 2); 
+        apply H7.
+  replace (PI / 2 - x1 - (PI / 2 - x)) with (x - x1); [ idtac | ring ];
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr'; apply H6.
 Qed.
 
 Lemma CVN_R_sin :
- forall fn:nat -> R -> R,
-   fn =
-   (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) ->
-   CVN_R fn.
-unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r.
-apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)).
-cut
- (sigT
-    (fun l:R =>
-       Un_cv
-         (fun n:nat =>
-            sum_f_R0
-              (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n)
-         l)).
-intro X; elim X; intros.
-apply existT with x.
-split.
-apply p.
-intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult;
- rewrite pow_1_abs; rewrite Rmult_1_l.
-cut (0 < / INR (fact (2 * n + 1))).
-intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
-apply Rmult_le_compat_l.
-left; apply H1.
-rewrite <- RPow_abs; apply pow_maj_Rabs.
-rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left;
- apply H0.
-apply Rinv_0_lt_compat; apply INR_fact_lt_0.
-cut ((r:R) <> 0).
-intro; apply Alembert_C2.
-intro; apply Rabs_no_R0.
-apply prod_neq_R0.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-apply pow_nonzero; assumption.
-assert (H1 := Alembert_sin).
-unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros.
-cut (0 < eps / Rsqr r).
-intro; elim (H1 _ H3); intros N0 H4.
-exists N0; intros.
-unfold R_dist in |- *; assert (H6 := H4 _ H5).
-unfold R_dist in H5;
- replace
-  (Rabs
-     (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) /
-      Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with
-  (Rsqr r *
-   Rabs
-     ((-1) ^ S n / INR (fact (2 * S n + 1)) /
-      ((-1) ^ n / INR (fact (2 * n + 1))))).
-apply Rmult_lt_reg_l with (/ Rsqr r).
-apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)).
-rewrite <- Rabs_mult.
-rewrite Rmult_minus_distr_l.
-rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
-apply H6.
-unfold Rsqr in |- *; apply prod_neq_R0; assumption.
-apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
-unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult;
- rewrite Rabs_Rabsolu; rewrite pow_1_abs.
-rewrite Rmult_1_l.
-repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-rewrite Rabs_mult.
-rewrite Rabs_Rinv.
-rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l.
-rewrite Rinv_mult_distr.
-rewrite <- Rabs_Rinv.
-rewrite Rinv_involutive.
-rewrite Rabs_mult.
-do 2 rewrite Rabs_Rabsolu.
-rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))).
-rewrite Rmult_assoc; apply Rmult_eq_compat_l.
-rewrite Rabs_Rinv.
-rewrite Rabs_Rabsolu.
-repeat rewrite Rabs_right.
-replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
-do 2 rewrite <- Rmult_assoc.
-rewrite <- Rinv_l_sym.
-unfold Rsqr in |- *; ring.
-apply pow_nonzero; assumption.
-replace (2 * S n)%nat with (S (S (2 * n))).
-simpl in |- *; ring.
-apply INR_eq; do 2 rewrite S_INR; do 2 rewrite mult_INR; repeat rewrite S_INR;
- ring.
-apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-apply Rle_ge; apply pow_le; left; apply (cond_pos r).
-apply Rabs_no_R0; apply pow_nonzero; assumption.
-apply INR_fact_neq_0.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-apply Rabs_no_R0; apply pow_nonzero; assumption.
-apply pow_nonzero; discrR.
-apply INR_fact_neq_0.
-apply pow_nonzero; discrR.
-apply Rinv_neq_0_compat; apply INR_fact_neq_0.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ].
-assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
- elim (Rlt_irrefl _ H0).
+  forall fn:nat -> R -> R,
+    fn =
+    (fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)) ->
+    CVN_R fn.
+Proof.
+  unfold CVN_R in |- *; unfold CVN_r in |- *; intros fn H r.
+  apply existT with (fun n:nat => / INR (fact (2 * n + 1)) * r ^ (2 * n)).
+  cut
+    (sigT
+      (fun l:R =>
+        Un_cv
+        (fun n:nat =>
+          sum_f_R0
+          (fun k:nat => Rabs (/ INR (fact (2 * k + 1)) * r ^ (2 * k))) n)
+        l)).
+  intro X; elim X; intros.
+  apply existT with x.
+  split.
+  apply p.
+  intros; rewrite H; unfold Rdiv in |- *; do 2 rewrite Rabs_mult;
+    rewrite pow_1_abs; rewrite Rmult_1_l.
+  cut (0 < / INR (fact (2 * n + 1))).
+  intro; rewrite (Rabs_right _ (Rle_ge _ _ (Rlt_le _ _ H1))).
+  apply Rmult_le_compat_l.
+  left; apply H1.
+  rewrite <- RPow_abs; apply pow_maj_Rabs.
+  rewrite Rabs_Rabsolu; unfold Boule in H0; rewrite Rminus_0_r in H0; left;
+    apply H0.
+  apply Rinv_0_lt_compat; apply INR_fact_lt_0.
+  cut ((r:R) <> 0).
+  intro; apply Alembert_C2.
+  intro; apply Rabs_no_R0.
+  apply prod_neq_R0.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply pow_nonzero; assumption.
+  assert (H1 := Alembert_sin).
+  unfold sin_n in H1; unfold Un_cv in H1; unfold Un_cv in |- *; intros.
+  cut (0 < eps / Rsqr r).
+  intro; elim (H1 _ H3); intros N0 H4.
+  exists N0; intros.
+  unfold R_dist in |- *; assert (H6 := H4 _ H5).
+  unfold R_dist in H5;
+    replace
+    (Rabs
+      (Rabs (/ INR (fact (2 * S n + 1)) * r ^ (2 * S n)) /
+        Rabs (/ INR (fact (2 * n + 1)) * r ^ (2 * n)))) with
+    (Rsqr r *
+      Rabs
+      ((-1) ^ S n / INR (fact (2 * S n + 1)) /
+        ((-1) ^ n / INR (fact (2 * n + 1))))).
+  apply Rmult_lt_reg_l with (/ Rsqr r).
+  apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  pattern (/ Rsqr r) at 1 in |- *; rewrite <- (Rabs_right (/ Rsqr r)).
+  rewrite <- Rabs_mult.
+  rewrite Rmult_minus_distr_l.
+  rewrite Rmult_0_r; rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite <- (Rmult_comm eps).
+  apply H6.
+  unfold Rsqr in |- *; apply prod_neq_R0; assumption.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption.
+  unfold Rdiv in |- *; rewrite (Rmult_comm (Rsqr r)); repeat rewrite Rabs_mult;
+    rewrite Rabs_Rabsolu; rewrite pow_1_abs.
+  rewrite Rmult_1_l.
+  repeat rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  rewrite Rabs_mult.
+  rewrite Rabs_Rinv.
+  rewrite pow_1_abs; rewrite Rinv_1; rewrite Rmult_1_l.
+  rewrite Rinv_mult_distr.
+  rewrite <- Rabs_Rinv.
+  rewrite Rinv_involutive.
+  rewrite Rabs_mult.
+  do 2 rewrite Rabs_Rabsolu.
+  rewrite (Rmult_comm (Rabs (r ^ (2 * S n)))).
+  rewrite Rmult_assoc; apply Rmult_eq_compat_l.
+  rewrite Rabs_Rinv.
+  rewrite Rabs_Rabsolu.
+  repeat rewrite Rabs_right.
+  replace (r ^ (2 * S n)) with (r ^ (2 * n) * r * r).
+  do 2 rewrite <- Rmult_assoc.
+  rewrite <- Rinv_l_sym.
+  unfold Rsqr in |- *; ring.
+  apply pow_nonzero; assumption.
+  replace (2 * S n)%nat with (S (S (2 * n))).
+  simpl in |- *; ring.
+  ring_nat.
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rle_ge; apply pow_le; left; apply (cond_pos r).
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply INR_fact_neq_0.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  apply Rabs_no_R0; apply pow_nonzero; assumption.
+  apply pow_nonzero; discrR.
+  apply INR_fact_neq_0.
+  apply pow_nonzero; discrR.
+  apply Rinv_neq_0_compat; apply INR_fact_neq_0.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; apply Rsqr_pos_lt; assumption ].
+  assert (H0 := cond_pos r); red in |- *; intro; rewrite H1 in H0;
+    elim (Rlt_irrefl _ H0).
 Qed.
 
-(* (sin h)/h -> 1 when h -> 0 *)
+(** (sin h)/h -> 1 when h -> 0 *)
 Lemma derivable_pt_lim_sin_0 : derivable_pt_lim sin 0 1.
-unfold derivable_pt_lim in |- *; intros.
-set
- (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)).
-cut (CVN_R fn).
-intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
-intro cv.
-set (r := mkposreal _ Rlt_0_1).
-cut (CVN_r fn r).
-intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y).
-intro; cut (Boule 0 r 0).
-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 in |- *; intros.
-rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r.
-cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps).
-intro; cut (SFL fn cv 0 = 1).
-intro; cut (SFL fn cv h = sin h / h).
-intro; rewrite H9 in H8; rewrite H10 in H8.
-apply H8.
-unfold SFL, sin in |- *.
-case (cv h); intros.
-case (exist_sin (Rsqr h)); intros.
-unfold Rdiv in |- *; 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 in |- *; intros.
-elim (s _ H10); intros N0 H11.
-exists N0; intros.
-unfold R_dist in |- *; unfold R_dist in H11.
-replace
- (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n)
- with
- (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n).
-apply H11; assumption.
-apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *;
- rewrite pow_sqr; reflexivity.
-unfold SFL, sin in |- *.
-case (cv 0); intros.
-eapply UL_sequence.
-apply u.
-unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros.
-unfold R_dist in |- *;
- replace
-  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n)
-  with 1.
-unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
-rewrite decomp_sum.
-simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1;
- rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
- apply Rplus_eq_compat_l.
-symmetry  in |- *; apply sum_eq_R0; intros.
-rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity.
-unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ].
-apply H5.
-split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-apply (sym_not_eq (A:=R)); apply H6.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7.
-unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r).
-intros; unfold fn in |- *;
- replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with
-  (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F;
- [ idtac | reflexivity ].
-apply continuity_pt_mult.
-apply derivable_continuous_pt.
-apply derivable_pt_const.
-apply derivable_continuous_pt.
-apply (derivable_pt_pow (2 * n) y).
-apply (X r).
-apply (CVN_R_CVS _ X).
-apply CVN_R_sin; unfold fn in |- *; reflexivity.
+Proof.
+  unfold derivable_pt_lim in |- *; intros.
+  set
+    (fn := fun (N:nat) (x:R) => (-1) ^ N / INR (fact (2 * N + 1)) * x ^ (2 * N)).
+  cut (CVN_R fn).
+  intro; cut (forall x:R, sigT (fun l:R => Un_cv (fun N:nat => SP fn N x) l)).
+  intro cv.
+  set (r := mkposreal _ Rlt_0_1).
+  cut (CVN_r fn r).
+  intro; cut (forall (n:nat) (y:R), Boule 0 r y -> continuity_pt (fn n) y).
+  intro; cut (Boule 0 r 0).
+  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 in |- *; intros.
+  rewrite sin_0; rewrite Rplus_0_l; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r.
+  cut (Rabs (SFL fn cv h - SFL fn cv 0) < eps).
+  intro; cut (SFL fn cv 0 = 1).
+  intro; cut (SFL fn cv h = sin h / h).
+  intro; rewrite H9 in H8; rewrite H10 in H8.
+  apply H8.
+  unfold SFL, sin in |- *.
+  case (cv h); intros.
+  case (exist_sin (Rsqr h)); intros.
+  unfold Rdiv in |- *; 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 in |- *; intros.
+  elim (s _ H10); intros N0 H11.
+  exists N0; intros.
+  unfold R_dist in |- *; unfold R_dist in H11.
+  replace
+  (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * h ^ (2 * k)) n)
+    with
+      (sum_f_R0 (fun i:nat => (-1) ^ i / INR (fact (2 * i + 1)) * Rsqr h ^ i) n).
+  apply H11; assumption.
+  apply sum_eq; intros; apply Rmult_eq_compat_l; unfold Rsqr in |- *;
+    rewrite pow_sqr; reflexivity.
+  unfold SFL, sin in |- *.
+  case (cv 0); intros.
+  eapply UL_sequence.
+  apply u.
+  unfold SP, fn in |- *; unfold Un_cv in |- *; intros; exists 1%nat; intros.
+  unfold R_dist in |- *;
+    replace
+    (sum_f_R0 (fun k:nat => (-1) ^ k / INR (fact (2 * k + 1)) * 0 ^ (2 * k)) n)
+    with 1.
+  unfold Rminus in |- *; rewrite Rplus_opp_r; rewrite Rabs_R0; assumption.
+  rewrite decomp_sum.
+  simpl in |- *; rewrite Rmult_1_r; unfold Rdiv in |- *; rewrite Rinv_1;
+    rewrite Rmult_1_r; pattern 1 at 1 in |- *; rewrite <- Rplus_0_r;
+      apply Rplus_eq_compat_l.
+  symmetry  in |- *; apply sum_eq_R0; intros.
+  rewrite Rmult_0_l; rewrite Rmult_0_r; reflexivity.
+  unfold ge in H10; apply lt_le_trans with 1%nat; [ apply lt_n_Sn | apply H10 ].
+  apply H5.
+  split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  apply (sym_not_eq (A:=R)); apply H6.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; apply H7.
+  unfold Boule in |- *; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite Rabs_R0; apply (cond_pos r).
+  intros; unfold fn in |- *;
+    replace (fun x:R => (-1) ^ n / INR (fact (2 * n + 1)) * x ^ (2 * n)) with
+    (fct_cte ((-1) ^ n / INR (fact (2 * n + 1))) * pow_fct (2 * n))%F;
+    [ idtac | reflexivity ].
+  apply continuity_pt_mult.
+  apply derivable_continuous_pt.
+  apply derivable_pt_const.
+  apply derivable_continuous_pt.
+  apply (derivable_pt_pow (2 * n) y).
+  apply (X r).
+  apply (CVN_R_CVS _ X).
+  apply CVN_R_sin; unfold fn in |- *; reflexivity.
 Qed.
 
-(* ((cos h)-1)/h -> 0 when h -> 0 *)
+(** ((cos h)-1)/h -> 0 when h -> 0 *)
 Lemma derivable_pt_lim_cos_0 : derivable_pt_lim cos 0 0.
-unfold derivable_pt_lim in |- *; 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; set (delta := mkposreal _ H6).
-exists delta; intros.
-rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))).
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
-unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse.
-rewrite Rabs_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
- (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))).
-apply Rabs_triang.
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)).
-rewrite Rabs_mult; rewrite Rmult_comm;
- pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *;
- rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
-apply Rabs_pos.
-assert (H9 := SIN_bound (h / 2)).
-unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro.
-pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1).
-apply Ropp_le_contravar.
-elim H9; intros; assumption.
-elim H9; intros; assumption.
-cut (Rabs (h / 2) < del).
-intro; cut (h / 2 <> 0).
-intro; assert (H11 := H2 _ H10 H9). 
-rewrite Rplus_0_l in H11; rewrite sin_0 in H11.
-rewrite Rminus_0_r in H11; apply H11.
-unfold Rdiv in |- *; apply prod_neq_R0.
-apply H7.
-apply Rinv_neq_0_compat; discrR.
-apply Rlt_trans with (del / 2).
-unfold Rdiv in |- *; rewrite Rabs_mult.
-rewrite (Rabs_right (/ 2)).
-do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
-apply Rinv_0_lt_compat; prove_sup0.
-apply Rlt_le_trans with (pos delta).
-apply H8.
-unfold delta in |- *; simpl in |- *; apply Rmin_l.
-apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *;
- rewrite (double_var del); apply Rplus_lt_compat_l; 
- unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply (cond_pos del).
-apply Rinv_0_lt_compat; prove_sup0.
-elim H5; intros; assert (H11 := H10 (h / 2)).
-rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11.
-apply H11.
-split.
-unfold D_x, no_cond in |- *; split.
-trivial.
-apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0.
-apply H7.
-apply Rinv_neq_0_compat; discrR.
-apply Rlt_trans with (del_c / 2).
-unfold Rdiv in |- *; rewrite Rabs_mult.
-rewrite (Rabs_right (/ 2)).
-do 2 rewrite <- (Rmult_comm (/ 2)).
-apply Rmult_lt_compat_l.
-apply Rinv_0_lt_compat; prove_sup0.
-apply Rlt_le_trans with (pos delta).
-apply H8.
-unfold delta in |- *; simpl in |- *; apply Rmin_r.
-apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
-rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *;
- rewrite (double_var del_c); apply Rplus_lt_compat_l.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply H9.
-apply Rinv_0_lt_compat; prove_sup0.
-rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *;
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
- rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *.
-repeat rewrite Rmult_assoc.
-repeat apply Rmult_eq_compat_l.
-rewrite Rinv_mult_distr.
-rewrite Rinv_involutive.
-apply Rmult_comm.
-discrR.
-apply H7.
-apply Rinv_neq_0_compat; discrR.
-pattern h at 2 in |- *; replace h with (2 * (h / 2)).
-rewrite (cos_2a_sin (h / 2)).
-rewrite cos_0; unfold Rsqr in |- *; ring.
-unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
-discrR.
-unfold Rmin in |- *; case (Rle_dec del del_c); intro.
-apply (cond_pos del).
-elim H5; intros; assumption.
-apply continuity_sin.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
+Proof.
+  unfold derivable_pt_lim in |- *; 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; set (delta := mkposreal _ H6).
+  exists delta; intros.
+  rewrite Rplus_0_l; replace (cos h - cos 0) with (-2 * Rsqr (sin (h / 2))).
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r.
+  unfold Rdiv in |- *; do 2 rewrite Ropp_mult_distr_l_reverse.
+  rewrite Rabs_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
+    (Rabs (sin (h / 2) * (sin (h / 2) / (h / 2) - 1)) + Rabs (sin (h / 2))).
+  apply Rabs_triang.
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply Rle_lt_trans with (Rabs (sin (h / 2) / (h / 2) - 1)).
+  rewrite Rabs_mult; rewrite Rmult_comm;
+    pattern (Rabs (sin (h / 2) / (h / 2) - 1)) at 2 in |- *;
+      rewrite <- Rmult_1_r; apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  assert (H9 := SIN_bound (h / 2)).
+  unfold Rabs in |- *; case (Rcase_abs (sin (h / 2))); intro.
+  pattern 1 at 3 in |- *; rewrite <- (Ropp_involutive 1).
+  apply Ropp_le_contravar.
+  elim H9; intros; assumption.
+  elim H9; intros; assumption.
+  cut (Rabs (h / 2) < del).
+  intro; cut (h / 2 <> 0).
+  intro; assert (H11 := H2 _ H10 H9). 
+  rewrite Rplus_0_l in H11; rewrite sin_0 in H11.
+  rewrite Rminus_0_r in H11; apply H11.
+  unfold Rdiv in |- *; apply prod_neq_R0.
+  apply H7.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rlt_trans with (del / 2).
+  unfold Rdiv in |- *; rewrite Rabs_mult.
+  rewrite (Rabs_right (/ 2)).
+  do 2 rewrite <- (Rmult_comm (/ 2)); apply Rmult_lt_compat_l.
+  apply Rinv_0_lt_compat; prove_sup0.
+  apply Rlt_le_trans with (pos delta).
+  apply H8.
+  unfold delta in |- *; simpl in |- *; apply Rmin_l.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- (Rplus_0_r (del / 2)); pattern del at 1 in |- *;
+    rewrite (double_var del); apply Rplus_lt_compat_l; 
+      unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply (cond_pos del).
+  apply Rinv_0_lt_compat; prove_sup0.
+  elim H5; intros; assert (H11 := H10 (h / 2)).
+  rewrite sin_0 in H11; do 2 rewrite Rminus_0_r in H11.
+  apply H11.
+  split.
+  unfold D_x, no_cond in |- *; split.
+  trivial.
+  apply (sym_not_eq (A:=R)); unfold Rdiv in |- *; apply prod_neq_R0.
+  apply H7.
+  apply Rinv_neq_0_compat; discrR.
+  apply Rlt_trans with (del_c / 2).
+  unfold Rdiv in |- *; rewrite Rabs_mult.
+  rewrite (Rabs_right (/ 2)).
+  do 2 rewrite <- (Rmult_comm (/ 2)).
+  apply Rmult_lt_compat_l.
+  apply Rinv_0_lt_compat; prove_sup0.
+  apply Rlt_le_trans with (pos delta).
+  apply H8.
+  unfold delta in |- *; simpl in |- *; apply Rmin_r.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; prove_sup0.
+  rewrite <- (Rplus_0_r (del_c / 2)); pattern del_c at 2 in |- *;
+    rewrite (double_var del_c); apply Rplus_lt_compat_l.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply H9.
+  apply Rinv_0_lt_compat; prove_sup0.
+  rewrite Rmult_minus_distr_l; rewrite Rmult_1_r; unfold Rminus in |- *;
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+      rewrite (Rmult_comm 2); unfold Rdiv, Rsqr in |- *.
+  repeat rewrite Rmult_assoc.
+  repeat apply Rmult_eq_compat_l.
+  rewrite Rinv_mult_distr.
+  rewrite Rinv_involutive.
+  apply Rmult_comm.
+  discrR.
+  apply H7.
+  apply Rinv_neq_0_compat; discrR.
+  pattern h at 2 in |- *; replace h with (2 * (h / 2)).
+  rewrite (cos_2a_sin (h / 2)).
+  rewrite cos_0; unfold Rsqr in |- *; ring.
+  unfold Rdiv in |- *; rewrite <- Rmult_assoc; apply Rinv_r_simpl_m.
+  discrR.
+  unfold Rmin in |- *; case (Rle_dec del del_c); intro.
+  apply (cond_pos del).
+  elim H5; intros; assumption.
+  apply continuity_sin.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ].
 Qed.
 
 (**********)
 Theorem derivable_pt_lim_sin : forall 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 in |- *; intros.
-cut (0 < eps / 2);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H0 _ H2); intros alp1 H3.
-elim (H _ H2); intros alp2 H4.
-set (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
- (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))).
-apply Rabs_triang.
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply Rle_lt_trans with (Rabs ((cos h - 1) / h)).
-rewrite Rabs_mult; rewrite Rmult_comm;
- pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r;
- apply Rmult_le_compat_l.
-apply Rabs_pos.
-assert (H8 := SIN_bound x); elim H8; intros.
-unfold Rabs in |- *; case (Rcase_abs (sin x)); intro.
-rewrite <- (Ropp_involutive 1).
-apply Ropp_le_contravar; assumption.
-assumption.
-cut (Rabs h < alp2).
-intro; assert (H9 := H4 _ H6 H8).
-rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
- apply H9.
-apply Rlt_le_trans with alp.
-apply H7.
-unfold alp in |- *; apply Rmin_r.
-apply Rle_lt_trans with (Rabs (sin h / h - 1)).
-rewrite Rabs_mult; rewrite Rmult_comm;
- pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r;
- apply Rmult_le_compat_l.
-apply Rabs_pos.
-assert (H8 := COS_bound x); elim H8; intros.
-unfold Rabs in |- *; case (Rcase_abs (cos x)); intro.
-rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption.
-assumption.
-cut (Rabs h < alp1).
-intro; assert (H9 := H3 _ H6 H8).
-rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
- apply H9.
-apply Rlt_le_trans with alp.
-apply H7.
-unfold alp in |- *; apply Rmin_l.
-rewrite sin_plus; unfold Rminus, Rdiv in |- *;
- repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
- repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc;
- apply Rplus_eq_compat_l.
-rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc;
- apply Rplus_eq_compat_l.
-rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse;
- rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse;
- rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm.
-unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro.
-apply (cond_pos alp1).
-apply (cond_pos alp2).
+Proof.
+  intro; assert (H0 := derivable_pt_lim_sin_0).
+  assert (H := derivable_pt_lim_cos_0).
+  unfold derivable_pt_lim in H0, H.
+  unfold derivable_pt_lim in |- *; intros.
+  cut (0 < eps / 2);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ apply H1 | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H0 _ H2); intros alp1 H3.
+  elim (H _ H2); intros alp2 H4.
+  set (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
+    (Rabs (sin x * ((cos h - 1) / h)) + Rabs (cos x * (sin h / h - 1))).
+  apply Rabs_triang.
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply Rle_lt_trans with (Rabs ((cos h - 1) / h)).
+  rewrite Rabs_mult; rewrite Rmult_comm;
+    pattern (Rabs ((cos h - 1) / h)) at 2 in |- *; rewrite <- Rmult_1_r;
+      apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  assert (H8 := SIN_bound x); elim H8; intros.
+  unfold Rabs in |- *; case (Rcase_abs (sin x)); intro.
+  rewrite <- (Ropp_involutive 1).
+  apply Ropp_le_contravar; assumption.
+  assumption.
+  cut (Rabs h < alp2).
+  intro; assert (H9 := H4 _ H6 H8).
+  rewrite cos_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
+    apply H9.
+  apply Rlt_le_trans with alp.
+  apply H7.
+  unfold alp in |- *; apply Rmin_r.
+  apply Rle_lt_trans with (Rabs (sin h / h - 1)).
+  rewrite Rabs_mult; rewrite Rmult_comm;
+    pattern (Rabs (sin h / h - 1)) at 2 in |- *; rewrite <- Rmult_1_r;
+      apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  assert (H8 := COS_bound x); elim H8; intros.
+  unfold Rabs in |- *; case (Rcase_abs (cos x)); intro.
+  rewrite <- (Ropp_involutive 1); apply Ropp_le_contravar; assumption.
+  assumption.
+  cut (Rabs h < alp1).
+  intro; assert (H9 := H3 _ H6 H8).
+  rewrite sin_0 in H9; rewrite Rplus_0_l in H9; rewrite Rminus_0_r in H9;
+    apply H9.
+  apply Rlt_le_trans with alp.
+  apply H7.
+  unfold alp in |- *; apply Rmin_l.
+  rewrite sin_plus; unfold Rminus, Rdiv in |- *;
+    repeat rewrite Rmult_plus_distr_r; repeat rewrite Rmult_plus_distr_l;
+      repeat rewrite Rmult_assoc; repeat rewrite Rplus_assoc;
+        apply Rplus_eq_compat_l.
+  rewrite (Rplus_comm (sin x * (-1 * / h))); repeat rewrite Rplus_assoc;
+    apply Rplus_eq_compat_l.
+  rewrite Ropp_mult_distr_r_reverse; rewrite Ropp_mult_distr_l_reverse;
+    rewrite Rmult_1_r; rewrite Rmult_1_l; rewrite Ropp_mult_distr_r_reverse;
+      rewrite <- Ropp_mult_distr_l_reverse; apply Rplus_comm.
+  unfold alp in |- *; unfold Rmin in |- *; case (Rle_dec alp1 alp2); intro.
+  apply (cond_pos alp1).
+  apply (cond_pos alp2).
 Qed.
 
 Lemma derivable_pt_lim_cos : forall x:R, derivable_pt_lim cos x (- sin x).
-intro; cut (forall h:R, sin (h + PI / 2) = cos h).
-intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)).
-generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros.
-cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)).
-cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))).
-intros; generalize (H0 _ _ _ H2 H1);
- replace (comp sin (id + fct_cte (PI / 2))%F) with
-  (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ].
-unfold derivable_pt_lim in |- *; intros.
-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_comm x); ring.
-intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity.
+Proof.
+  intro; cut (forall h:R, sin (h + PI / 2) = cos h).
+  intro; replace (- sin x) with (cos (x + PI / 2) * (1 + 0)).
+  generalize (derivable_pt_lim_comp (id + fct_cte (PI / 2))%F sin); intros.
+  cut (derivable_pt_lim (id + fct_cte (PI / 2)) x (1 + 0)).
+  cut (derivable_pt_lim sin ((id + fct_cte (PI / 2))%F x) (cos (x + PI / 2))).
+  intros; generalize (H0 _ _ _ H2 H1);
+    replace (comp sin (id + fct_cte (PI / 2))%F) with
+    (fun x:R => sin (x + PI / 2)); [ idtac | reflexivity ].
+  unfold derivable_pt_lim in |- *; intros.
+  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_comm x); ring.
+  intro; rewrite cos_sin; rewrite Rplus_comm; reflexivity.
 Qed.
 
 Lemma derivable_pt_sin : forall x:R, derivable_pt sin x.
-unfold derivable_pt in |- *; intro.
-apply existT with (cos x).
-apply derivable_pt_lim_sin.
+Proof.
+  unfold derivable_pt in |- *; intro.
+  apply existT with (cos x).
+  apply derivable_pt_lim_sin.
 Qed.
 
 Lemma derivable_pt_cos : forall x:R, derivable_pt cos x.
-unfold derivable_pt in |- *; intro.
-apply existT with (- sin x).
-apply derivable_pt_lim_cos.
+Proof.
+  unfold derivable_pt in |- *; intro.
+  apply existT with (- sin x).
+  apply derivable_pt_lim_cos.
 Qed.
 
 Lemma derivable_sin : derivable sin.
-unfold derivable in |- *; intro; apply derivable_pt_sin.
+Proof.
+  unfold derivable in |- *; intro; apply derivable_pt_sin.
 Qed.
 
 Lemma derivable_cos : derivable cos.
-unfold derivable in |- *; intro; apply derivable_pt_cos.
+Proof.
+  unfold derivable in |- *; intro; apply derivable_pt_cos.
 Qed.
 
 Lemma derive_pt_sin :
- forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x.
-intros; apply derive_pt_eq_0.
-apply derivable_pt_lim_sin.
+  forall x:R, derive_pt sin x (derivable_pt_sin _) = cos x.
+Proof.
+  intros; apply derive_pt_eq_0.
+  apply derivable_pt_lim_sin.
 Qed.
 
 Lemma derive_pt_cos :
- forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x.
-intros; apply derive_pt_eq_0.
-apply derivable_pt_lim_cos.
+  forall x:R, derive_pt cos x (derivable_pt_cos _) = - sin x.
+Proof.
+  intros; apply derive_pt_eq_0.
+  apply derivable_pt_lim_cos.
 Qed.
diff --git a/theories/Reals/SeqProp.v b/theories/Reals/SeqProp.v
index 2e851b13..133f2b89 100644
--- a/theories/Reals/SeqProp.v
+++ b/theories/Reals/SeqProp.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SeqProp.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+(*i $Id: SeqProp.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -23,136 +23,143 @@ Definition has_lb (Un:nat -> R) : Prop := bound (EUn (opp_seq Un)).
 
 (**********)
 Lemma growing_cv :
- forall Un:nat -> R,
-   Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l).
-unfold Un_growing, Un_cv in |- *; intros;
- destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
- exists x; intros eps H1.
- unfold is_upper_bound in H2, H3.
-assert (H5 : forall n:nat, Un n <= x).
+  forall Un:nat -> R,
+    Un_growing Un -> has_ub Un -> sigT (fun l:R => Un_cv Un l).
+Proof.
+  unfold Un_growing, Un_cv in |- *; intros;
+    destruct (completeness (EUn Un) H0 (EUn_noempty Un)) as [x [H2 H3]].
+  exists x; intros eps H1.
+  unfold is_upper_bound in H2, H3.
+  assert (H5 : forall n:nat, Un n <= x).
   intro n; apply (H2 (Un n) (Un_in_EUn Un n)).
-cut (exists N : nat, x - eps < Un N).
-intro H6; destruct H6 as [N H6]; exists N.
-intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
-unfold Rgt in H1.
- apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1).
-fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8.
- generalize
-  (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8));
-  intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
-  unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
-  rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
-  rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
-  trivial.
-cut (~ (forall N:nat, Un N <= x - eps)).
-intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)).
- intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7.
-intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8;
- unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
- apply Rlt_not_le; apply tech_Rgt_minus; exact H1.
+  cut (exists N : nat, x - eps < Un N).
+  intro H6; destruct H6 as [N H6]; exists N.
+  intros n H7; unfold R_dist in |- *; apply (Rabs_def1 (Un n - x) eps).
+  unfold Rgt in H1.
+  apply (Rle_lt_trans (Un n - x) 0 eps (Rle_minus (Un n) x (H5 n)) H1).
+  fold Un_growing in H; generalize (growing_prop Un n N H H7); intro H8.
+  generalize
+    (Rlt_le_trans (x - eps) (Un N) (Un n) H6 (Rge_le (Un n) (Un N) H8));
+    intro H9; generalize (Rplus_lt_compat_l (- x) (x - eps) (Un n) H9);
+      unfold Rminus in |- *; rewrite <- (Rplus_assoc (- x) x (- eps));
+        rewrite (Rplus_comm (- x) (Un n)); fold (Un n - x) in |- *;
+          rewrite Rplus_opp_l; rewrite (let (H1, H2) := Rplus_ne (- eps) in H2);
+            trivial.
+  cut (~ (forall N:nat, Un N <= x - eps)).
+  intro H6; apply (not_all_not_ex nat (fun N:nat => x - eps < Un N)).
+  intro H7; apply H6; intro N; apply Rnot_lt_le; apply H7.
+  intro H7; generalize (Un_bound_imp Un (x - eps) H7); intro H8;
+    unfold is_upper_bound in H8; generalize (H3 (x - eps) H8);
+      apply Rlt_not_le; apply tech_Rgt_minus; exact H1.
 Qed.
 
 Lemma decreasing_growing :
- forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un).
-intro.
-unfold Un_growing, opp_seq, Un_decreasing in |- *.
-intros.
-apply Ropp_le_contravar.
-apply H.
+  forall Un:nat -> R, Un_decreasing Un -> Un_growing (opp_seq Un).
+Proof.
+  intro.
+  unfold Un_growing, opp_seq, Un_decreasing in |- *.
+  intros.
+  apply Ropp_le_contravar.
+  apply H.
 Qed.
 
 Lemma decreasing_cv :
- forall Un:nat -> R,
-   Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l).
-intros.
-cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)).
-intro X.
-apply X.
-apply growing_cv.
-apply decreasing_growing; assumption.
-exact H0.
-intro X.
-elim X; intros.
-apply existT with (- x).
-unfold Un_cv in p.
-unfold R_dist in p.
-unfold opp_seq in p.
-unfold Un_cv in |- *.
-unfold R_dist in |- *.
-intros.
-elim (p eps H1); intros.
-exists x0; intros.
-assert (H4 := H2 n H3).
-rewrite <- Rabs_Ropp.
-replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ].
+  forall Un:nat -> R,
+    Un_decreasing Un -> has_lb Un -> sigT (fun l:R => Un_cv Un l).
+Proof.
+  intros.
+  cut (sigT (fun l:R => Un_cv (opp_seq Un) l) -> sigT (fun l:R => Un_cv Un l)).
+  intro X.
+  apply X.
+  apply growing_cv.
+  apply decreasing_growing; assumption.
+  exact H0.
+  intro X.
+  elim X; intros.
+  apply existT with (- x).
+  unfold Un_cv in p.
+  unfold R_dist in p.
+  unfold opp_seq in p.
+  unfold Un_cv in |- *.
+  unfold R_dist in |- *.
+  intros.
+  elim (p eps H1); intros.
+  exists x0; intros.
+  assert (H4 := H2 n H3).
+  rewrite <- Rabs_Ropp.
+  replace (- (Un n - - x)) with (- Un n - x); [ assumption | ring ].
 Qed.
 
 (***********)
 Lemma maj_sup :
- forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l).
-intros.
-unfold has_ub in H.
-apply completeness.
-assumption.
-exists (Un 0%nat).
-unfold EUn in |- *.
-exists 0%nat; reflexivity.
+  forall Un:nat -> R, has_ub Un -> sigT (fun l:R => is_lub (EUn Un) l).
+Proof.
+  intros.
+  unfold has_ub in H.
+  apply completeness.
+  assumption.
+  exists (Un 0%nat).
+  unfold EUn in |- *.
+  exists 0%nat; reflexivity.
 Qed.
 
 (**********)
 Lemma min_inf :
- forall Un:nat -> R,
-   has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l).
-intros; unfold has_lb in H.
-apply completeness.
-assumption.
-exists (- Un 0%nat).
-exists 0%nat.
-reflexivity.
+  forall Un:nat -> R,
+    has_lb Un -> sigT (fun l:R => is_lub (EUn (opp_seq Un)) l).
+Proof.
+  intros; unfold has_lb in H.
+  apply completeness.
+  assumption.
+  exists (- Un 0%nat).
+  exists 0%nat.
+  reflexivity.
 Qed.
 
 Definition majorant (Un:nat -> R) (pr:has_ub Un) : R :=
   match maj_sup Un pr with
-  | existT a b => a
+    | existT a b => a
   end.
 
 Definition minorant (Un:nat -> R) (pr:has_lb Un) : R :=
   match min_inf Un pr with
-  | existT a b => - a
+    | existT a b => - a
   end.
 
 Lemma maj_ss :
- forall (Un:nat -> R) (k:nat),
-   has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat).
-intros.
-unfold has_ub in H.
-unfold bound in H.
-elim H; intros.
-unfold is_upper_bound in H0.
-unfold has_ub in |- *.
-exists x.
-unfold is_upper_bound in |- *.
-intros.
-apply H0.
-elim H1; intros.
-exists (k + x1)%nat; assumption.
+  forall (Un:nat -> R) (k:nat),
+    has_ub Un -> has_ub (fun i:nat => Un (k + i)%nat).
+Proof.
+  intros.
+  unfold has_ub in H.
+  unfold bound in H.
+  elim H; intros.
+  unfold is_upper_bound in H0.
+  unfold has_ub in |- *.
+  exists x.
+  unfold is_upper_bound in |- *.
+  intros.
+  apply H0.
+  elim H1; intros.
+  exists (k + x1)%nat; assumption.
 Qed.
 
 Lemma min_ss :
- forall (Un:nat -> R) (k:nat),
-   has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat).
-intros.
-unfold has_lb in H.
-unfold bound in H.
-elim H; intros.
-unfold is_upper_bound in H0.
-unfold has_lb in |- *.
-exists x.
-unfold is_upper_bound in |- *.
-intros.
-apply H0.
-elim H1; intros.
-exists (k + x1)%nat; assumption.
+  forall (Un:nat -> R) (k:nat),
+    has_lb Un -> has_lb (fun i:nat => Un (k + i)%nat).
+Proof.
+  intros.
+  unfold has_lb in H.
+  unfold bound in H.
+  elim H; intros.
+  unfold is_upper_bound in H0.
+  unfold has_lb in |- *.
+  exists x.
+  unfold is_upper_bound in |- *.
+  intros.
+  apply H0.
+  elim H1; intros.
+  exists (k + x1)%nat; assumption.
 Qed.
 
 Definition sequence_majorant (Un:nat -> R) (pr:has_ub Un)
@@ -162,1134 +169,1163 @@ Definition sequence_minorant (Un:nat -> R) (pr:has_lb Un)
   (i:nat) : R := minorant (fun k:nat => Un (i + k)%nat) (min_ss Un i pr).
 
 Lemma Wn_decreasing :
- forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr).
-intros.
-unfold Un_decreasing in |- *.
-intro.
-unfold sequence_majorant in |- *.
-assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
-assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
-elim H; intros.
-elim H0; intros.
-cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x);
- [ intro Maj1; rewrite Maj1 | idtac ].
-cut (majorant (fun k:nat => Un (n + k)%nat) (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 in |- *.
-intros.
-unfold is_upper_bound in H3.
-apply H3.
-elim H5; intros.
-exists (1 + x2)%nat.
-replace (n + (1 + x2))%nat with (S n + x2)%nat.
-assumption.
-replace (S n) with (1 + n)%nat; [ ring | ring ].
-cut
- (is_lub (EUn (fun k:nat => Un (n + k)%nat))
-    (majorant (fun k:nat => Un (n + k)%nat) (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 (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
-apply Rle_antisym; assumption.
-unfold majorant in |- *.
-case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
-trivial.
-cut
- (is_lub (EUn (fun k:nat => Un (S n + k)%nat))
-    (majorant (fun k:nat => Un (S n + k)%nat) (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 (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
-apply Rle_antisym; assumption.
-unfold majorant in |- *.
-case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
-trivial.
+  forall (Un:nat -> R) (pr:has_ub Un), Un_decreasing (sequence_majorant Un pr).
+Proof.
+  intros.
+  unfold Un_decreasing in |- *.
+  intro.
+  unfold sequence_majorant in |- *.
+  assert (H := maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
+  assert (H0 := maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
+  elim H; intros.
+  elim H0; intros.
+  cut (majorant (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr) = x);
+    [ intro Maj1; rewrite Maj1 | idtac ].
+  cut (majorant (fun k:nat => Un (n + k)%nat) (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 in |- *.
+  intros.
+  unfold is_upper_bound in H3.
+  apply H3.
+  elim H5; intros.
+  exists (1 + x2)%nat.
+  replace (n + (1 + x2))%nat with (S n + x2)%nat.
+  assumption.
+  replace (S n) with (1 + n)%nat; [ ring | ring ].
+  cut
+    (is_lub (EUn (fun k:nat => Un (n + k)%nat))
+      (majorant (fun k:nat => Un (n + k)%nat) (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 (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)) H4).
+  apply Rle_antisym; assumption.
+  unfold majorant in |- *.
+  case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr)).
+  trivial.
+  cut
+    (is_lub (EUn (fun k:nat => Un (S n + k)%nat))
+      (majorant (fun k:nat => Un (S n + k)%nat) (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 (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)) H4).
+  apply Rle_antisym; assumption.
+  unfold majorant in |- *.
+  case (maj_sup (fun k:nat => Un (S n + k)%nat) (maj_ss Un (S n) pr)).
+  trivial.
 Qed.
 
 Lemma Vn_growing :
- forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr).
-intros.
-unfold Un_growing in |- *.
-intro.
-unfold sequence_minorant in |- *.
-assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
-assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
-elim H; intros.
-elim H0; intros.
-cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x);
- [ intro Maj1; rewrite Maj1 | idtac ].
-cut (minorant (fun k:nat => Un (n + k)%nat) (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 Ropp_le_contravar.
-apply H2.
-elim p0; intros.
-unfold is_upper_bound in |- *.
-intros.
-unfold is_upper_bound in H3.
-apply H3.
-elim H5; intros.
-exists (1 + x2)%nat.
-unfold opp_seq in H6.
-unfold opp_seq in |- *.
-replace (n + (1 + x2))%nat with (S n + x2)%nat.
-assumption.
-replace (S n) with (1 + n)%nat; [ ring | ring ].
-cut
- (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
-    (- minorant (fun k:nat => Un (n + k)%nat) (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 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4).
-rewrite <-
- (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)))
- .
-apply Ropp_eq_compat; apply Rle_antisym; assumption.
-unfold minorant in |- *.
-case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
-intro; rewrite Ropp_involutive.
-trivial.
-cut
- (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat)))
-    (- minorant (fun k:nat => Un (S n + k)%nat) (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 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4).
-rewrite <-
- (Ropp_involutive
-    (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)))
- .
-apply Ropp_eq_compat; apply Rle_antisym; assumption.
-unfold minorant in |- *.
-case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
-intro; rewrite Ropp_involutive.
-trivial.
+  forall (Un:nat -> R) (pr:has_lb Un), Un_growing (sequence_minorant Un pr).
+Proof.
+  intros.
+  unfold Un_growing in |- *.
+  intro.
+  unfold sequence_minorant in |- *.
+  assert (H := min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
+  assert (H0 := min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
+  elim H; intros.
+  elim H0; intros.
+  cut (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr) = - x);
+    [ intro Maj1; rewrite Maj1 | idtac ].
+  cut (minorant (fun k:nat => Un (n + k)%nat) (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 Ropp_le_contravar.
+  apply H2.
+  elim p0; intros.
+  unfold is_upper_bound in |- *.
+  intros.
+  unfold is_upper_bound in H3.
+  apply H3.
+  elim H5; intros.
+  exists (1 + x2)%nat.
+  unfold opp_seq in H6.
+  unfold opp_seq in |- *.
+  replace (n + (1 + x2))%nat with (S n + x2)%nat.
+  assumption.
+  replace (S n) with (1 + n)%nat; [ ring | ring ].
+  cut
+    (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
+      (- minorant (fun k:nat => Un (n + k)%nat) (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 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)) H4).
+  rewrite <-
+    (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)))
+    .
+  apply Ropp_eq_compat; apply Rle_antisym; assumption.
+  unfold minorant in |- *.
+  case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr)).
+  intro; rewrite Ropp_involutive.
+  trivial.
+  cut
+    (is_lub (EUn (opp_seq (fun k:nat => Un (S n + k)%nat)))
+      (- minorant (fun k:nat => Un (S n + k)%nat) (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 (- minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)) H4).
+  rewrite <-
+    (Ropp_involutive
+      (minorant (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)))
+    .
+  apply Ropp_eq_compat; apply Rle_antisym; assumption.
+  unfold minorant in |- *.
+  case (min_inf (fun k:nat => Un (S n + k)%nat) (min_ss Un (S n) pr)).
+  intro; rewrite Ropp_involutive.
+  trivial.
 Qed.
 
 (**********)
 Lemma Vn_Un_Wn_order :
- forall (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 in |- *.
-cut
- (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)).
-intro X.
-elim X; intros.
-replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x).
-unfold is_lub in p.
-elim p; intros.
-unfold is_upper_bound in H.
-rewrite <- (Ropp_involutive (Un n)).
-apply Ropp_le_contravar.
-apply H.
-exists 0%nat.
-unfold opp_seq in |- *.
-replace (n + 0)%nat with n; [ reflexivity | ring ].
-cut
- (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
-    (- minorant (fun k:nat => Un (n + k)%nat) (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 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2).
-rewrite <-
- (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)))
- .
-apply Ropp_eq_compat; apply Rle_antisym; assumption.
-unfold minorant in |- *.
-case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)).
-intro; rewrite Ropp_involutive.
-trivial.
-apply min_inf.
-apply min_ss; assumption.
-unfold sequence_majorant in |- *.
-cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)).
-intro X.
-elim X; intros.
-replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x.
-unfold is_lub in p.
-elim p; intros.
-unfold is_upper_bound in H.
-apply H.
-exists 0%nat.
-replace (n + 0)%nat with n; [ reflexivity | ring ].
-cut
- (is_lub (EUn (fun k:nat => Un (n + k)%nat))
-    (majorant (fun k:nat => Un (n + k)%nat) (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 (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2).
-apply Rle_antisym; assumption.
-unfold majorant in |- *.
-case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)).
-intro; trivial.
-apply maj_sup.
-apply maj_ss; assumption.
+  forall (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.
+Proof.
+  intros.
+  split.
+  unfold sequence_minorant in |- *.
+  cut
+    (sigT (fun l:R => is_lub (EUn (opp_seq (fun i:nat => Un (n + i)%nat))) l)).
+  intro X.
+  elim X; intros.
+  replace (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) with (- x).
+  unfold is_lub in p.
+  elim p; intros.
+  unfold is_upper_bound in H.
+  rewrite <- (Ropp_involutive (Un n)).
+  apply Ropp_le_contravar.
+  apply H.
+  exists 0%nat.
+  unfold opp_seq in |- *.
+  replace (n + 0)%nat with n; [ reflexivity | ring ].
+  cut
+    (is_lub (EUn (opp_seq (fun k:nat => Un (n + k)%nat)))
+      (- minorant (fun k:nat => Un (n + k)%nat) (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 (- minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)) H2).
+  rewrite <-
+    (Ropp_involutive (minorant (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)))
+    .
+  apply Ropp_eq_compat; apply Rle_antisym; assumption.
+  unfold minorant in |- *.
+  case (min_inf (fun k:nat => Un (n + k)%nat) (min_ss Un n pr2)).
+  intro; rewrite Ropp_involutive.
+  trivial.
+  apply min_inf.
+  apply min_ss; assumption.
+  unfold sequence_majorant in |- *.
+  cut (sigT (fun l:R => is_lub (EUn (fun i:nat => Un (n + i)%nat)) l)).
+  intro X.
+  elim X; intros.
+  replace (majorant (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) with x.
+  unfold is_lub in p.
+  elim p; intros.
+  unfold is_upper_bound in H.
+  apply H.
+  exists 0%nat.
+  replace (n + 0)%nat with n; [ reflexivity | ring ].
+  cut
+    (is_lub (EUn (fun k:nat => Un (n + k)%nat))
+      (majorant (fun k:nat => Un (n + k)%nat) (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 (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)) H2).
+  apply Rle_antisym; assumption.
+  unfold majorant in |- *.
+  case (maj_sup (fun k:nat => Un (n + k)%nat) (maj_ss Un n pr1)).
+  intro; trivial.
+  apply maj_sup.
+  apply maj_ss; assumption.
 Qed.
 
 Lemma min_maj :
- forall (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 in |- *.
-unfold bound in |- *.
-unfold has_ub in pr1.
-unfold bound in pr1.
-elim pr1; intros.
-exists x.
-unfold is_upper_bound in |- *.
-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.
+  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
+    has_ub (sequence_minorant Un pr2).
+Proof.
+  intros.
+  assert (H := Vn_Un_Wn_order Un pr1 pr2).
+  unfold has_ub in |- *.
+  unfold bound in |- *.
+  unfold has_ub in pr1.
+  unfold bound in pr1.
+  elim pr1; intros.
+  exists x.
+  unfold is_upper_bound in |- *.
+  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 :
- forall (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 in |- *.
-unfold bound in |- *.
-unfold has_lb in pr2.
-unfold bound in pr2.
-elim pr2; intros.
-exists x.
-unfold is_upper_bound in |- *.
-intros.
-unfold is_upper_bound in H0.
-elim H1; intros.
-rewrite H2.
-apply Rle_trans with (opp_seq Un x1).
-assert (H3 := H x1); elim H3; intros.
-unfold opp_seq in |- *; apply Ropp_le_contravar.
-assumption.
-apply H0.
-exists x1; reflexivity.
+  forall (Un:nat -> R) (pr1:has_ub Un) (pr2:has_lb Un),
+    has_lb (sequence_majorant Un pr1).
+Proof.
+  intros.
+  assert (H := Vn_Un_Wn_order Un pr1 pr2).
+  unfold has_lb in |- *.
+  unfold bound in |- *.
+  unfold has_lb in pr2.
+  unfold bound in pr2.
+  elim pr2; intros.
+  exists x.
+  unfold is_upper_bound in |- *.
+  intros.
+  unfold is_upper_bound in H0.
+  elim H1; intros.
+  rewrite H2.
+  apply Rle_trans with (opp_seq Un x1).
+  assert (H3 := H x1); elim H3; intros.
+  unfold opp_seq in |- *; apply Ropp_le_contravar.
+  assumption.
+  apply H0.
+  exists x1; reflexivity.
 Qed.
 
 (**********)
 Lemma cauchy_maj : forall Un:nat -> R, Cauchy_crit Un -> has_ub Un.
-intros.
-unfold has_ub in |- *.
-apply cauchy_bound.
-assumption.
+Proof.
+  intros.
+  unfold has_ub in |- *.
+  apply cauchy_bound.
+  assumption.
 Qed.
 
 (**********)
 Lemma cauchy_opp :
- forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un).
-intro.
-unfold Cauchy_crit in |- *.
-unfold R_dist in |- *.
-intros.
-elim (H eps H0); intros.
-exists x; intros.
-unfold opp_seq in |- *.
-rewrite <- Rabs_Ropp.
-replace (- (- Un n - - Un m)) with (Un n - Un m);
- [ apply H1; assumption | ring ].
+  forall Un:nat -> R, Cauchy_crit Un -> Cauchy_crit (opp_seq Un).
+Proof.
+  intro.
+  unfold Cauchy_crit in |- *.
+  unfold R_dist in |- *.
+  intros.
+  elim (H eps H0); intros.
+  exists x; intros.
+  unfold opp_seq in |- *.
+  rewrite <- Rabs_Ropp.
+  replace (- (- Un n - - Un m)) with (Un n - Un m);
+  [ apply H1; assumption | ring ].
 Qed.
 
 (**********)
 Lemma cauchy_min : forall Un:nat -> R, Cauchy_crit Un -> has_lb Un.
-intros.
-unfold has_lb in |- *.
-assert (H0 := cauchy_opp _ H).
-apply cauchy_bound.
-assumption.
+Proof.
+  intros.
+  unfold has_lb in |- *.
+  assert (H0 := cauchy_opp _ H).
+  apply cauchy_bound.
+  assumption.
 Qed.
 
 (**********)
 Lemma maj_cv :
- forall (Un:nat -> R) (pr:Cauchy_crit Un),
-   sigT (fun 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.
+  forall (Un:nat -> R) (pr:Cauchy_crit Un),
+    sigT (fun l:R => Un_cv (sequence_majorant Un (cauchy_maj Un pr)) l).
+Proof.
+  intros.
+  apply decreasing_cv.
+  apply Wn_decreasing.
+  apply maj_min.
+  apply cauchy_min.
+  assumption.
 Qed.
 
 (**********)
 Lemma min_cv :
- forall (Un:nat -> R) (pr:Cauchy_crit Un),
-   sigT (fun 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.
+  forall (Un:nat -> R) (pr:Cauchy_crit Un),
+    sigT (fun l:R => Un_cv (sequence_minorant Un (cauchy_min Un pr)) l).
+Proof.
+  intros.
+  apply growing_cv.
+  apply Vn_growing.
+  apply min_maj.
+  apply cauchy_maj.
+  assumption.
 Qed.
 
 Lemma cond_eq :
- forall x y:R, (forall eps:R, 0 < eps -> Rabs (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 <- Rabs_Ropp in H1.
-cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ].
-rewrite Rabs_right in H1.
-elim (Rlt_irrefl _ H1).
-left; assumption.
-apply Rplus_lt_reg_r with x.
-rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ].
-assumption.
-cut (0 < x - y).
-intro.
-assert (H1 := H (x - y) H0).
-rewrite Rabs_right in H1.
-elim (Rlt_irrefl _ H1).
-left; assumption.
-apply Rplus_lt_reg_r with y.
-rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ].
+  forall x y:R, (forall eps:R, 0 < eps -> Rabs (x - y) < eps) -> x = y.
+Proof.
+  intros.
+  case (total_order_T x y); intro.
+  elim s; intro.
+  cut (0 < y - x).
+  intro.
+  assert (H1 := H (y - x) H0).
+  rewrite <- Rabs_Ropp in H1.
+  cut (- (x - y) = y - x); [ intro; rewrite H2 in H1 | ring ].
+  rewrite Rabs_right in H1.
+  elim (Rlt_irrefl _ H1).
+  left; assumption.
+  apply Rplus_lt_reg_r with x.
+  rewrite Rplus_0_r; replace (x + (y - x)) with y; [ assumption | ring ].
+  assumption.
+  cut (0 < x - y).
+  intro.
+  assert (H1 := H (x - y) H0).
+  rewrite Rabs_right in H1.
+  elim (Rlt_irrefl _ H1).
+  left; assumption.
+  apply Rplus_lt_reg_r with y.
+  rewrite Rplus_0_r; replace (y + (x - y)) with x; [ assumption | ring ].
 Qed.
 
 Lemma not_Rlt : forall r1 r2:R, ~ r1 < r2 -> r1 >= r2.
-intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
-tauto.
+Proof.
+  intros r1 r2; generalize (Rtotal_order r1 r2); unfold Rge in |- *.
+  tauto.
 Qed.
 
 (**********)
 Lemma approx_maj :
- forall (Un:nat -> R) (pr:has_ub Un) (eps:R),
-   0 < eps ->  exists k : nat, Rabs (majorant Un pr - Un k) < eps.
-intros.
-set (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps).
-unfold P in |- *.
-cut
- ((exists k : nat, P k) ->
-   exists k : nat, Rabs (majorant Un pr - Un k) < eps).
-intros.
-apply H0.
-apply not_all_not_ex.
-red in |- *; intro.
-2: unfold P in |- *; trivial.
-unfold P in H1.
-cut (forall n:nat, Rabs (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 (forall n:nat, eps <= majorant Un pr - Un n).
-intro.
-cut (forall n:nat, Un n <= majorant Un pr - eps).
-intro.
-cut (forall 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_irrefl _ (Rlt_le_trans _ _ _ H H10)).
-apply Rplus_le_reg_l with (majorant Un pr - eps).
-rewrite Rplus_0_r.
-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 Rplus_le_reg_l 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 Rabs_right in H6.
-apply Rge_le.
-assumption.
-apply Rle_ge.
-apply Rplus_le_reg_l with (Un n).
-rewrite Rplus_0_r;
- replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr);
- [ apply H4 | ring ].
-exists n; reflexivity.
-unfold majorant in |- *.
-case (maj_sup Un pr).
-trivial.
-intro.
-assert (H2 := H1 n).
-apply not_Rlt; assumption.
+  forall (Un:nat -> R) (pr:has_ub Un) (eps:R),
+    0 < eps ->  exists k : nat, Rabs (majorant Un pr - Un k) < eps.
+Proof.
+  intros.
+  set (P := fun k:nat => Rabs (majorant Un pr - Un k) < eps).
+  unfold P in |- *.
+  cut
+    ((exists k : nat, P k) ->
+      exists k : nat, Rabs (majorant Un pr - Un k) < eps).
+  intros.
+  apply H0.
+  apply not_all_not_ex.
+  red in |- *; intro.
+  2: unfold P in |- *; trivial.
+  unfold P in H1.
+  cut (forall n:nat, Rabs (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 (forall n:nat, eps <= majorant Un pr - Un n).
+  intro.
+  cut (forall n:nat, Un n <= majorant Un pr - eps).
+  intro.
+  cut (forall 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_irrefl _ (Rlt_le_trans _ _ _ H H10)).
+  apply Rplus_le_reg_l with (majorant Un pr - eps).
+  rewrite Rplus_0_r.
+  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 Rplus_le_reg_l 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 Rabs_right in H6.
+  apply Rge_le.
+  assumption.
+  apply Rle_ge.
+  apply Rplus_le_reg_l with (Un n).
+  rewrite Rplus_0_r;
+    replace (Un n + (majorant Un pr - Un n)) with (majorant Un pr);
+    [ apply H4 | ring ].
+  exists n; reflexivity.
+  unfold majorant in |- *.
+  case (maj_sup Un pr).
+  trivial.
+  intro.
+  assert (H2 := H1 n).
+  apply not_Rlt; assumption.
 Qed.
 
 (**********)
 Lemma approx_min :
- forall (Un:nat -> R) (pr:has_lb Un) (eps:R),
-   0 < eps ->  exists k : nat, Rabs (minorant Un pr - Un k) < eps.
-intros.
-set (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps).
-unfold P in |- *.
-cut
- ((exists k : nat, P k) ->
-   exists k : nat, Rabs (minorant Un pr - Un k) < eps).
-intros.
-apply H0.
-apply not_all_not_ex.
-red in |- *; intro.
-2: unfold P in |- *; trivial.
-unfold P in H1.
-cut (forall n:nat, Rabs (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 (forall n:nat, eps <= Un n - minorant Un pr).
-intro.
-cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps).
-intro.
-cut (forall 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_irrefl _ (Rlt_le_trans _ _ _ H H10)).
-apply Rplus_le_reg_l with (- minorant Un pr - eps).
-rewrite Rplus_0_r.
-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 in |- *.
-apply Rplus_le_reg_l 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 Rabs_left1 in H6.
-apply Rge_le.
-replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n));
- [ assumption | ring ].
-apply Rplus_le_reg_l with (- minorant Un pr).
-rewrite Rplus_0_r;
- replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n).
-apply H4.
-exists n; reflexivity.
-ring.
-unfold minorant in |- *.
-case (min_inf Un pr).
-intro.
-rewrite Ropp_involutive.
-trivial.
-intro.
-assert (H2 := H1 n).
-apply not_Rlt; assumption.
+  forall (Un:nat -> R) (pr:has_lb Un) (eps:R),
+    0 < eps ->  exists k : nat, Rabs (minorant Un pr - Un k) < eps.
+Proof.
+  intros.
+  set (P := fun k:nat => Rabs (minorant Un pr - Un k) < eps).
+  unfold P in |- *.
+  cut
+    ((exists k : nat, P k) ->
+      exists k : nat, Rabs (minorant Un pr - Un k) < eps).
+  intros.
+  apply H0.
+  apply not_all_not_ex.
+  red in |- *; intro.
+  2: unfold P in |- *; trivial.
+  unfold P in H1.
+  cut (forall n:nat, Rabs (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 (forall n:nat, eps <= Un n - minorant Un pr).
+  intro.
+  cut (forall n:nat, opp_seq Un n <= - minorant Un pr - eps).
+  intro.
+  cut (forall 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_irrefl _ (Rlt_le_trans _ _ _ H H10)).
+  apply Rplus_le_reg_l with (- minorant Un pr - eps).
+  rewrite Rplus_0_r.
+  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 in |- *.
+  apply Rplus_le_reg_l 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 Rabs_left1 in H6.
+  apply Rge_le.
+  replace (Un n - minorant Un pr) with (- (minorant Un pr - Un n));
+  [ assumption | ring ].
+  apply Rplus_le_reg_l with (- minorant Un pr).
+  rewrite Rplus_0_r;
+    replace (- minorant Un pr + (minorant Un pr - Un n)) with (- Un n).
+  apply H4.
+  exists n; reflexivity.
+  ring.
+  unfold minorant in |- *.
+  case (min_inf Un pr).
+  intro.
+  rewrite Ropp_involutive.
+  trivial.
+  intro.
+  assert (H2 := H1 n).
+  apply not_Rlt; assumption.
 Qed.
 
-(* Unicity of limit for convergent sequences *)
+(** Unicity of limit for convergent sequences *)
 Lemma UL_sequence :
- forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2.
-intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-apply cond_eq.
-intros; cut (0 < eps / 2);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H (eps / 2) H2); intros.
-elim (H0 (eps / 2) H2); intros.
-set (N := max x x0).
-apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)).
-replace (l1 - l2) with (l1 - Un N + (Un N - l2));
- [ apply Rabs_triang | ring ].
-rewrite (double_var eps); apply Rplus_lt_compat.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
- unfold ge, N in |- *; apply le_max_l.
-apply H4; unfold ge, N in |- *; apply le_max_r.
+  forall (Un:nat -> R) (l1 l2:R), Un_cv Un l1 -> Un_cv Un l2 -> l1 = l2.
+Proof.
+  intros Un l1 l2; unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  apply cond_eq.
+  intros; cut (0 < eps / 2);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H (eps / 2) H2); intros.
+  elim (H0 (eps / 2) H2); intros.
+  set (N := max x x0).
+  apply Rle_lt_trans with (Rabs (l1 - Un N) + Rabs (Un N - l2)).
+  replace (l1 - l2) with (l1 - Un N + (Un N - l2));
+  [ apply Rabs_triang | ring ].
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H3;
+    unfold ge, N in |- *; apply le_max_l.
+  apply H4; unfold ge, N in |- *; apply le_max_r.
 Qed.
 
 (**********)
 Lemma CV_plus :
- forall (An Bn:nat -> R) (l1 l2:R),
-   Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2).
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-cut (0 < eps / 2);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (H (eps / 2) H2); intros.
-elim (H0 (eps / 2) H2); intros.
-set (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 (Rabs (An n - l1) + Rabs (Bn n - l2)).
-apply Rabs_triang.
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply H3; unfold ge in |- *; apply le_trans with N;
- [ unfold N in |- *; apply le_max_l | assumption ].
-apply H4; unfold ge in |- *; apply le_trans with N;
- [ unfold N in |- *; apply le_max_r | assumption ].
+  forall (An Bn:nat -> R) (l1 l2:R),
+    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i + Bn i) (l1 + l2).
+Proof.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  cut (0 < eps / 2);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (H (eps / 2) H2); intros.
+  elim (H0 (eps / 2) H2); intros.
+  set (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 (Rabs (An n - l1) + Rabs (Bn n - l2)).
+  apply Rabs_triang.
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply H3; unfold ge in |- *; apply le_trans with N;
+    [ unfold N in |- *; apply le_max_l | assumption ].
+  apply H4; unfold ge in |- *; apply le_trans with N;
+    [ unfold N in |- *; apply le_max_r | assumption ].
 Qed.
 
 (**********)
 Lemma cv_cvabs :
- forall (Un:nat -> R) (l:R),
-   Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l).
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H eps H0); intros.
-exists x; intros.
-apply Rle_lt_trans with (Rabs (Un n - l)).
-apply Rabs_triang_inv2.
-apply H1; assumption.
+  forall (Un:nat -> R) (l:R),
+    Un_cv Un l -> Un_cv (fun i:nat => Rabs (Un i)) (Rabs l).
+Proof.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H eps H0); intros.
+  exists x; intros.
+  apply Rle_lt_trans with (Rabs (Un n - l)).
+  apply Rabs_triang_inv2.
+  apply H1; assumption.
 Qed.
 
 (**********)
 Lemma CV_Cauchy :
- forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un.
-intros Un X; elim X; intros.
-unfold Cauchy_crit in |- *; intros.
-unfold Un_cv in p; unfold R_dist in p.
-cut (0 < eps / 2);
- [ intro
- | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
-    [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
-elim (p (eps / 2) H0); intros.
-exists x0; intros.
-unfold R_dist in |- *;
- apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)).
-replace (Un n - Un m) with (Un n - x + (x - Un m));
- [ apply Rabs_triang | ring ].
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply H1; assumption.
-rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption.
+  forall Un:nat -> R, sigT (fun l:R => Un_cv Un l) -> Cauchy_crit Un.
+Proof.
+  intros Un X; elim X; intros.
+  unfold Cauchy_crit in |- *; intros.
+  unfold Un_cv in p; unfold R_dist in p.
+  cut (0 < eps / 2);
+    [ intro
+      | unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+        [ assumption | apply Rinv_0_lt_compat; prove_sup0 ] ].
+  elim (p (eps / 2) H0); intros.
+  exists x0; intros.
+  unfold R_dist in |- *;
+    apply Rle_lt_trans with (Rabs (Un n - x) + Rabs (x - Un m)).
+  replace (Un n - Un m) with (Un n - x + (x - Un m));
+  [ apply Rabs_triang | ring ].
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply H1; assumption.
+  rewrite <- Rabs_Ropp; rewrite Ropp_minus_distr; apply H1; assumption.
 Qed.
 
 (**********)
 Lemma maj_by_pos :
- forall Un:nat -> R,
-   sigT (fun l:R => Un_cv Un l) ->
+  forall Un:nat -> R,
+    sigT (fun l:R => Un_cv Un l) ->
     exists l : R, 0 < l /\ (forall n:nat, Rabs (Un n) <= l).
-intros Un X; elim X; intros.
-cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)).
-intro X0.
-assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0).
-assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H).
-elim H0; intros.
-exists (x0 + 1).
-cut (0 <= x0).
-intro.
-split.
-apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ].
-intros.
-apply Rle_trans with x0.
-unfold is_upper_bound in H1.
-apply H1.
-exists n; reflexivity.
-pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- apply Rlt_0_1.
-apply Rle_trans with (Rabs (Un 0%nat)).
-apply Rabs_pos.
-unfold is_upper_bound in H1.
-apply H1.
-exists 0%nat; reflexivity.
-apply existT with (Rabs x).
-apply cv_cvabs; assumption.
+Proof.
+  intros Un X; elim X; intros.
+  cut (sigT (fun l:R => Un_cv (fun k:nat => Rabs (Un k)) l)).
+  intro X0.
+  assert (H := CV_Cauchy (fun k:nat => Rabs (Un k)) X0).
+  assert (H0 := cauchy_bound (fun k:nat => Rabs (Un k)) H).
+  elim H0; intros.
+  exists (x0 + 1).
+  cut (0 <= x0).
+  intro.
+  split.
+  apply Rplus_le_lt_0_compat; [ assumption | apply Rlt_0_1 ].
+  intros.
+  apply Rle_trans with x0.
+  unfold is_upper_bound in H1.
+  apply H1.
+  exists n; reflexivity.
+  pattern x0 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    apply Rlt_0_1.
+  apply Rle_trans with (Rabs (Un 0%nat)).
+  apply Rabs_pos.
+  unfold is_upper_bound in H1.
+  apply H1.
+  exists 0%nat; reflexivity.
+  apply existT with (Rabs x).
+  apply cv_cvabs; assumption.
 Qed.
 
 (**********)
 Lemma CV_mult :
- forall (An Bn:nat -> R) (l1 l2:R),
-   Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2).
-intros.
-cut (sigT (fun l:R => Un_cv An l)).
-intro X.
-assert (H1 := maj_by_pos An X).
-elim H1; intros M H2.
-elim H2; intros.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-cut (0 < eps / (2 * M)).
-intro.
-case (Req_dec l2 0); 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
- (Rabs (An n * Bn n - An n * l2) + Rabs (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 Rabs_triang | ring ].
-replace (Rabs (An n * Bn n - An n * l2)) with
- (Rabs (An n) * Rabs (Bn n - l2)).
-replace (Rabs (An n * l2 - l1 * l2)) with 0.
-rewrite Rplus_0_r.
-apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
-do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-apply H4.
-apply Rmult_lt_reg_l with (/ M).
-apply Rinv_0_lt_compat; apply H3.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
-apply Rlt_trans with (eps / (2 * M)).
-apply H8; assumption.
-unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M));
- [ idtac | ring ].
-rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite double.
-pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r.
-apply Rplus_lt_compat_l; apply Rmult_lt_0_compat;
- [ assumption | apply Rinv_0_lt_compat; assumption ].
-discrR.
-discrR.
-red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
-red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
-rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *;
- rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity.
-replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ].
-symmetry  in |- *; apply Rabs_mult.
-cut (0 < eps / (2 * Rabs 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 * Rabs l2)) H8); intros N1 H9.
-elim (H0 (eps / (2 * M)) H6); intros N2 H10.
-set (N := max N1 N2).
-exists N; intros.
-apply Rle_lt_trans with
- (Rabs (An n * Bn n - An n * l2) + Rabs (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 Rabs_triang | ring ].
-replace (Rabs (An n * Bn n - An n * l2)) with
- (Rabs (An n) * Rabs (Bn n - l2)).
-replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)).
-rewrite (double_var eps); apply Rplus_lt_compat.
-apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
-do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
-apply Rmult_le_compat_l.
-apply Rabs_pos.
-apply H4.
-apply Rmult_lt_reg_l with (/ M).
-apply Rinv_0_lt_compat; apply H3.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
-apply Rlt_le_trans with (eps / (2 * M)).
-apply H10.
-unfold ge in |- *; apply le_trans with N.
-unfold N in |- *; apply le_max_r.
-assumption.
-unfold Rdiv in |- *; rewrite Rinv_mult_distr.
-right; ring.
-discrR.
-red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
-red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
-apply Rmult_lt_reg_l with (/ Rabs l2).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)).
-apply H9.
-unfold ge in |- *; apply le_trans with N.
-unfold N in |- *; apply le_max_l.
-assumption.
-unfold Rdiv in |- *; right; rewrite Rinv_mult_distr.
-ring.
-discrR.
-apply Rabs_no_R0; assumption.
-apply Rabs_no_R0; assumption.
-replace (An n * l2 - l1 * l2) with (l2 * (An n - l1));
- [ symmetry  in |- *; apply Rabs_mult | ring ].
-replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2));
- [ symmetry  in |- *; apply Rabs_mult | ring ].
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
- [ prove_sup0 | apply Rabs_pos_lt; assumption ].
-unfold Rdiv in |- *; apply Rmult_lt_0_compat;
- [ assumption
- | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
-    [ prove_sup0 | assumption ] ].
-apply existT with l1; assumption.
+  forall (An Bn:nat -> R) (l1 l2:R),
+    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i * Bn i) (l1 * l2).
+Proof.
+  intros.
+  cut (sigT (fun l:R => Un_cv An l)).
+  intro X.
+  assert (H1 := maj_by_pos An X).
+  elim H1; intros M H2.
+  elim H2; intros.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  cut (0 < eps / (2 * M)).
+  intro.
+  case (Req_dec l2 0); 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
+    (Rabs (An n * Bn n - An n * l2) + Rabs (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 Rabs_triang | ring ].
+  replace (Rabs (An n * Bn n - An n * l2)) with
+  (Rabs (An n) * Rabs (Bn n - l2)).
+  replace (Rabs (An n * l2 - l1 * l2)) with 0.
+  rewrite Rplus_0_r.
+  apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
+  do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  apply H4.
+  apply Rmult_lt_reg_l with (/ M).
+  apply Rinv_0_lt_compat; apply H3.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
+  apply Rlt_trans with (eps / (2 * M)).
+  apply H8; assumption.
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  replace (2 * (eps * (/ 2 * / M))) with (2 * / 2 * (eps * / M));
+  [ idtac | ring ].
+  rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite double.
+  pattern (eps * / M) at 1 in |- *; rewrite <- Rplus_0_r.
+  apply Rplus_lt_compat_l; apply Rmult_lt_0_compat;
+    [ assumption | apply Rinv_0_lt_compat; assumption ].
+  discrR.
+  discrR.
+  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+  red in |- *; intro; rewrite H10 in H3; elim (Rlt_irrefl _ H3).
+  rewrite H7; do 2 rewrite Rmult_0_r; unfold Rminus in |- *;
+    rewrite Rplus_opp_r; rewrite Rabs_R0; reflexivity.
+  replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2)); [ idtac | ring ].
+  symmetry  in |- *; apply Rabs_mult.
+  cut (0 < eps / (2 * Rabs 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 * Rabs l2)) H8); intros N1 H9.
+  elim (H0 (eps / (2 * M)) H6); intros N2 H10.
+  set (N := max N1 N2).
+  exists N; intros.
+  apply Rle_lt_trans with
+    (Rabs (An n * Bn n - An n * l2) + Rabs (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 Rabs_triang | ring ].
+  replace (Rabs (An n * Bn n - An n * l2)) with
+  (Rabs (An n) * Rabs (Bn n - l2)).
+  replace (Rabs (An n * l2 - l1 * l2)) with (Rabs l2 * Rabs (An n - l1)).
+  rewrite (double_var eps); apply Rplus_lt_compat.
+  apply Rle_lt_trans with (M * Rabs (Bn n - l2)).
+  do 2 rewrite <- (Rmult_comm (Rabs (Bn n - l2))).
+  apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  apply H4.
+  apply Rmult_lt_reg_l with (/ M).
+  apply Rinv_0_lt_compat; apply H3.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite (Rmult_comm (/ M)).
+  apply Rlt_le_trans with (eps / (2 * M)).
+  apply H10.
+  unfold ge in |- *; apply le_trans with N.
+  unfold N in |- *; apply le_max_r.
+  assumption.
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr.
+  right; ring.
+  discrR.
+  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+  red in |- *; intro; rewrite H12 in H3; elim (Rlt_irrefl _ H3).
+  apply Rmult_lt_reg_l with (/ Rabs l2).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; apply Rlt_le_trans with (eps / (2 * Rabs l2)).
+  apply H9.
+  unfold ge in |- *; apply le_trans with N.
+  unfold N in |- *; apply le_max_l.
+  assumption.
+  unfold Rdiv in |- *; right; rewrite Rinv_mult_distr.
+  ring.
+  discrR.
+  apply Rabs_no_R0; assumption.
+  apply Rabs_no_R0; assumption.
+  replace (An n * l2 - l1 * l2) with (l2 * (An n - l1));
+  [ symmetry  in |- *; apply Rabs_mult | ring ].
+  replace (An n * Bn n - An n * l2) with (An n * (Bn n - l2));
+  [ symmetry  in |- *; apply Rabs_mult | ring ].
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+    [ prove_sup0 | apply Rabs_pos_lt; assumption ].
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat;
+    [ assumption
+      | apply Rinv_0_lt_compat; apply Rmult_lt_0_compat;
+        [ prove_sup0 | assumption ] ].
+  apply existT with l1; assumption.
 Qed.
 
 Lemma tech9 :
- forall Un:nat -> R,
-   Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n.
-intros; unfold Un_growing in H.
-induction  n as [| n Hrecn].
-induction  m as [| m Hrecm].
-right; reflexivity.
-elim (le_Sn_O _ H0).
-cut ((m <= n)%nat \/ 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.
+  forall Un:nat -> R,
+    Un_growing Un -> forall m n:nat, (m <= n)%nat -> Un m <= Un n.
+Proof.
+  intros; unfold Un_growing in H.
+  induction  n as [| n Hrecn].
+  induction  m as [| m Hrecm].
+  right; reflexivity.
+  elim (le_Sn_O _ H0).
+  cut ((m <= n)%nat \/ 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 :
- forall (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 (forall n:nat, Un n <= x).
-intro; unfold Un_cv in H3; cut (0 < x0 - x).
-intro; elim (H3 (x0 - x) H5); intros.
-cut (x1 >= x1)%nat.
-intro; assert (H8 := H6 x1 H7).
-unfold R_dist in H8; rewrite Rabs_left1 in H8.
-rewrite Ropp_minus_distr in H8; unfold Rminus in H8.
-assert (H9 := Rplus_lt_reg_r x0 _ _ H8).
-assert (H10 := Ropp_lt_cancel _ _ H9).
-assert (H11 := H4 x1).
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)).
-apply Rle_minus; apply Rle_trans with x.
-apply H4.
-left; assumption.
-unfold ge in |- *; apply le_n.
-apply Rgt_minus; assumption.
-intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
-apply H4; unfold EUn in |- *; exists n; reflexivity.
-rewrite b; assumption.
-cut (forall n:nat, Un n <= x0).
-intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
-cut (forall y:R, EUn Un y -> y <= x0).
-intro; assert (H8 := H6 _ H7).
-elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)).
-unfold EUn in |- *; intros; elim H7; intros.
-rewrite H8; apply H4.
-intro; case (Rle_dec (Un n) x0); intro.
-assumption.
-cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0).
-intro; unfold Un_cv in H3; cut (0 < Un n - x0).
-intro; elim (H3 (Un n - x0) H5); intros.
-cut (max n x1 >= x1)%nat.
-intro; assert (H8 := H6 (max n x1) H7).
-unfold R_dist in H8.
-rewrite Rabs_right in H8.
-unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8.
-assert (H9 := Rplus_lt_reg_r _ _ _ H8).
-cut (Un n <= Un (max n x1)).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)).
-apply tech9; [ assumption | apply le_max_l ].
-apply Rge_trans with (Un n - x0).
-unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0));
- apply Rplus_le_compat_l.
-apply tech9; [ assumption | apply le_max_l ].
-left; assumption.
-unfold ge in |- *; apply le_max_r.
-apply Rplus_lt_reg_r with x0.
-rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0);
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
- apply H4; apply le_n.
-intros; apply Rlt_le_trans with (Un n).
-case (Rlt_le_dec x0 (Un n)); intro.
-assumption.
-elim n0; assumption.
-apply tech9; assumption.
-unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros;
- assumption.
+  forall (Un:nat -> R) (x:R), Un_growing Un -> is_lub (EUn Un) x -> Un_cv Un x.
+Proof.
+  intros; cut (bound (EUn Un)).
+  intro; assert (H2 := Un_cv_crit _ H H1).
+  elim H2; intros.
+  case (total_order_T x x0); intro.
+  elim s; intro.
+  cut (forall n:nat, Un n <= x).
+  intro; unfold Un_cv in H3; cut (0 < x0 - x).
+  intro; elim (H3 (x0 - x) H5); intros.
+  cut (x1 >= x1)%nat.
+  intro; assert (H8 := H6 x1 H7).
+  unfold R_dist in H8; rewrite Rabs_left1 in H8.
+  rewrite Ropp_minus_distr in H8; unfold Rminus in H8.
+  assert (H9 := Rplus_lt_reg_r x0 _ _ H8).
+  assert (H10 := Ropp_lt_cancel _ _ H9).
+  assert (H11 := H4 x1).
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H10 H11)).
+  apply Rle_minus; apply Rle_trans with x.
+  apply H4.
+  left; assumption.
+  unfold ge in |- *; apply le_n.
+  apply Rgt_minus; assumption.
+  intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
+  apply H4; unfold EUn in |- *; exists n; reflexivity.
+  rewrite b; assumption.
+  cut (forall n:nat, Un n <= x0).
+  intro; unfold is_lub in H0; unfold is_upper_bound in H0; elim H0; intros.
+  cut (forall y:R, EUn Un y -> y <= x0).
+  intro; assert (H8 := H6 _ H7).
+  elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H8 r)).
+  unfold EUn in |- *; intros; elim H7; intros.
+  rewrite H8; apply H4.
+  intro; case (Rle_dec (Un n) x0); intro.
+  assumption.
+  cut (forall n0:nat, (n <= n0)%nat -> x0 < Un n0).
+  intro; unfold Un_cv in H3; cut (0 < Un n - x0).
+  intro; elim (H3 (Un n - x0) H5); intros.
+  cut (max n x1 >= x1)%nat.
+  intro; assert (H8 := H6 (max n x1) H7).
+  unfold R_dist in H8.
+  rewrite Rabs_right in H8.
+  unfold Rminus in H8; do 2 rewrite <- (Rplus_comm (- x0)) in H8.
+  assert (H9 := Rplus_lt_reg_r _ _ _ H8).
+  cut (Un n <= Un (max n x1)).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H10 H9)).
+  apply tech9; [ assumption | apply le_max_l ].
+  apply Rge_trans with (Un n - x0).
+  unfold Rminus in |- *; apply Rle_ge; do 2 rewrite <- (Rplus_comm (- x0));
+    apply Rplus_le_compat_l.
+  apply tech9; [ assumption | apply le_max_l ].
+  left; assumption.
+  unfold ge in |- *; apply le_max_r.
+  apply Rplus_lt_reg_r with x0.
+  rewrite Rplus_0_r; unfold Rminus in |- *; rewrite (Rplus_comm x0);
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r;
+      apply H4; apply le_n.
+  intros; apply Rlt_le_trans with (Un n).
+  case (Rlt_le_dec x0 (Un n)); intro.
+  assumption.
+  elim n0; assumption.
+  apply tech9; assumption.
+  unfold bound in |- *; exists x; unfold is_lub in H0; elim H0; intros;
+    assumption.
 Qed.
 
 Lemma tech13 :
- forall (An:nat -> R) (k:R),
-   0 <= k < 1 ->
-   Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
+  forall (An:nat -> R) (k:R),
+    0 <= k < 1 ->
+    Un_cv (fun n:nat => Rabs (An (S n) / An n)) k ->
     exists k0 : R,
-     k < k0 < 1 /\
-     (exists N : nat,
+      k < k0 < 1 /\
+      (exists N : nat,
         (forall n:nat, (N <= n)%nat -> Rabs (An (S n) / An n) < k0)).
-intros; exists (k + (1 - k) / 2).
-split.
-split.
-pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
- [ elim H; intros; assumption | ring ].
-apply Rinv_0_lt_compat; prove_sup0.
-apply Rmult_lt_reg_l with 2.
-prove_sup0.
-unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
- pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r;
- replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ].
-elim H; intros.
-apply Rplus_lt_compat_l; 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 <- Rabs_Rabsolu;
- replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k);
- [ idtac | ring ];
- apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k).
-apply Rabs_triang.
-rewrite (Rabs_right k).
-apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k);
- repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
- repeat rewrite Rplus_0_l; apply H4.
-apply Rle_ge; elim H; intros; assumption.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
- replace (k + (1 - k)) with 1; [ assumption | ring ].
-apply Rinv_0_lt_compat; prove_sup0.
+Proof.
+  intros; exists (k + (1 - k) / 2).
+  split.
+  split.
+  pattern k at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; replace (k + (1 - k)) with 1;
+    [ elim H; intros; assumption | ring ].
+  apply Rinv_0_lt_compat; prove_sup0.
+  apply Rmult_lt_reg_l with 2.
+  prove_sup0.
+  unfold Rdiv in |- *; rewrite Rmult_1_r; rewrite Rmult_plus_distr_l;
+    pattern 2 at 1 in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+      rewrite <- Rinv_l_sym; [ idtac | discrR ]; rewrite Rmult_1_r;
+        replace (2 * k + (1 - k)) with (1 + k); [ idtac | ring ].
+  elim H; intros.
+  apply Rplus_lt_compat_l; 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 <- Rabs_Rabsolu;
+    replace (Rabs (An (S n) / An n)) with (Rabs (An (S n) / An n) - k + k);
+    [ idtac | ring ];
+    apply Rle_lt_trans with (Rabs (Rabs (An (S n) / An n) - k) + Rabs k).
+  apply Rabs_triang.
+  rewrite (Rabs_right k).
+  apply Rplus_lt_reg_r with (- k); rewrite <- (Rplus_comm k);
+    repeat rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+      repeat rewrite Rplus_0_l; apply H4.
+  apply Rle_ge; elim H; intros; assumption.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply Rplus_lt_reg_r with k; rewrite Rplus_0_r; elim H; intros;
+    replace (k + (1 - k)) with 1; [ assumption | ring ].
+  apply Rinv_0_lt_compat; prove_sup0.
 Qed.
 
 (**********)
 Lemma growing_ineq :
- forall (Un:nat -> R) (l:R),
-   Un_growing Un -> Un_cv Un l -> forall 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.
-set (N := max n N1).
-cut (Un n - l <= Un N - l).
-intro; cut (Un N - l < Un n - l).
-intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)).
-apply Rle_lt_trans with (Rabs (Un N - l)).
-apply RRle_abs.
-apply H2.
-unfold ge, N in |- *; apply le_max_r.
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
- apply Rplus_le_compat_l.
-apply tech9.
-assumption.
-unfold N in |- *; apply le_max_l.
-apply Rplus_lt_reg_r with l.
-rewrite Rplus_0_r.
-replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
+  forall (Un:nat -> R) (l:R),
+    Un_growing Un -> Un_cv Un l -> forall n:nat, Un n <= l.
+Proof.
+  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.
+  set (N := max n N1).
+  cut (Un n - l <= Un N - l).
+  intro; cut (Un N - l < Un n - l).
+  intro; elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H3 H4)).
+  apply Rle_lt_trans with (Rabs (Un N - l)).
+  apply RRle_abs.
+  apply H2.
+  unfold ge, N in |- *; apply le_max_r.
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+    apply Rplus_le_compat_l.
+  apply tech9.
+  assumption.
+  unfold N in |- *; apply le_max_l.
+  apply Rplus_lt_reg_r with l.
+  rewrite Rplus_0_r.
+  replace (l + (Un n - l)) with (Un n); [ assumption | ring ].
 Qed.
 
-(* Un->l => (-Un) -> (-l) *)
+(** Un->l => (-Un) -> (-l) *)
 Lemma CV_opp :
- forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l).
-intros An l.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H eps H0); intros.
-exists x; intros.
-unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l));
- [ rewrite Rabs_Ropp | ring ].
-apply H1; assumption.
+  forall (An:nat -> R) (l:R), Un_cv An l -> Un_cv (opp_seq An) (- l).
+Proof.
+  intros An l.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H eps H0); intros.
+  exists x; intros.
+  unfold opp_seq in |- *; replace (- An n - - l) with (- (An n - l));
+    [ rewrite Rabs_Ropp | ring ].
+  apply H1; assumption.
 Qed.
 
 (**********)
 Lemma decreasing_ineq :
- forall (Un:nat -> R) (l:R),
-   Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n.
-intros.
-assert (H1 := decreasing_growing _ H).
-assert (H2 := CV_opp _ _ H0).
-assert (H3 := growing_ineq _ _ H1 H2).
-apply Ropp_le_cancel.
-unfold opp_seq in H3; apply H3.
+  forall (Un:nat -> R) (l:R),
+    Un_decreasing Un -> Un_cv Un l -> forall n:nat, l <= Un n.
+Proof.
+  intros.
+  assert (H1 := decreasing_growing _ H).
+  assert (H2 := CV_opp _ _ H0).
+  assert (H3 := growing_ineq _ _ H1 H2).
+  apply Ropp_le_cancel.
+  unfold opp_seq in H3; apply H3.
 Qed.
 
 (**********)
 Lemma CV_minus :
- forall (An Bn:nat -> R) (l1 l2:R),
-   Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2).
-intros.
-replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i).
-unfold Rminus in |- *; apply CV_plus.
-assumption.
-apply CV_opp; assumption.
-unfold Rminus, opp_seq in |- *; reflexivity.
+  forall (An Bn:nat -> R) (l1 l2:R),
+    Un_cv An l1 -> Un_cv Bn l2 -> Un_cv (fun i:nat => An i - Bn i) (l1 - l2).
+Proof.
+  intros.
+  replace (fun i:nat => An i - Bn i) with (fun i:nat => An i + opp_seq Bn i).
+  unfold Rminus in |- *; apply CV_plus.
+  assumption.
+  apply CV_opp; assumption.
+  unfold Rminus, opp_seq in |- *; reflexivity.
 Qed.
 
-(* Un -> +oo *)
+(** Un -> +oo *)
 Definition cv_infty (Un:nat -> R) : Prop :=
   forall M:R,  exists N : nat, (forall n:nat, (N <= n)%nat -> M < Un n).
 
-(* Un -> +oo => /Un -> O *)
+(** Un -> +oo => /Un -> O *)
 Lemma cv_infty_cv_R0 :
- forall Un:nat -> R,
-   (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0.
-unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H0 (/ eps)); intros N0 H2.
-exists N0; intros.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
- rewrite (Rabs_Rinv _ (H n)).
-apply Rmult_lt_reg_l with (Rabs (Un n)).
-apply Rabs_pos_lt; apply H.
-rewrite <- Rinv_r_sym.
-apply Rmult_lt_reg_l with (/ eps).
-apply Rinv_0_lt_compat; assumption.
-rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; apply Rlt_le_trans with (Un n).
-apply H2; assumption.
-apply RRle_abs.
-red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
-apply Rabs_no_R0; apply H.
+  forall Un:nat -> R,
+    (forall n:nat, Un n <> 0) -> cv_infty Un -> Un_cv (fun n:nat => / Un n) 0.
+Proof.
+  unfold cv_infty, Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H0 (/ eps)); intros N0 H2.
+  exists N0; intros.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+    rewrite (Rabs_Rinv _ (H n)).
+  apply Rmult_lt_reg_l with (Rabs (Un n)).
+  apply Rabs_pos_lt; apply H.
+  rewrite <- Rinv_r_sym.
+  apply Rmult_lt_reg_l with (/ eps).
+  apply Rinv_0_lt_compat; assumption.
+  rewrite Rmult_1_r; rewrite (Rmult_comm (/ eps)); rewrite Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; apply Rlt_le_trans with (Un n).
+  apply H2; assumption.
+  apply RRle_abs.
+  red in |- *; intro; rewrite H4 in H1; elim (Rlt_irrefl _ H1).
+  apply Rabs_no_R0; apply H.
 Qed.
 
 (**********)
 Lemma decreasing_prop :
- forall (Un:nat -> R) (m n:nat),
-   Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m.
-unfold Un_decreasing in |- *; intros.
-induction  n as [| n Hrecn].
-induction  m as [| m Hrecm].
-right; reflexivity.
-elim (le_Sn_O _ H0).
-cut ((m <= n)%nat \/ 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 ].
+  forall (Un:nat -> R) (m n:nat),
+    Un_decreasing Un -> (m <= n)%nat -> Un n <= Un m.
+Proof.
+  unfold Un_decreasing in |- *; intros.
+  induction  n as [| n Hrecn].
+  induction  m as [| m Hrecm].
+  right; reflexivity.
+  elim (le_Sn_O _ H0).
+  cut ((m <= n)%nat \/ 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 *)
+(** |x|^n/n! -> 0 *)
 Lemma cv_speed_pow_fact :
- forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0.
-intro;
- cut
-  (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 ->
-   Un_cv (fun n:nat => x ^ n / INR (fact n)) 0).
-intro; apply H.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0);
- intro.
-exists 1%nat; intros.
-rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
- rewrite Rabs_R0; rewrite pow_ne_zero;
- [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
- | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
-assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z.
-intro; elim (IZN M H3); intros M_nat H4.
-set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))).
-cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H5 eps H0); intros N H6.
-exists (M_nat + N)%nat; intros;
- cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat).
-intro; elim H8; intros p H9.
-elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption.
-exists (n - M_nat)%nat.
-split.
-unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
- rewrite <- le_plus_minus.
-assumption.
-apply le_trans with (M_nat + N)%nat.
-apply le_plus_l.
-assumption.
-apply le_plus_minus; apply le_trans with (M_nat + N)%nat;
- [ apply le_plus_l | assumption ].
-set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))).
-cut (1 <= M_nat)%nat.
-intro; cut (forall n:nat, 0 < Un n).
-intro; cut (Un_decreasing Un).
-intro; cut (forall n:nat, Un (S n) <= Vn n).
-intro; cut (Un_cv Vn 0).
-unfold Un_cv in |- *; unfold R_dist in |- *; intros.
-elim (H10 eps0 H5); intros N1 H11.
-exists (S N1); intros.
-cut (forall n:nat, 0 < Vn n).
-intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)).
-repeat rewrite Rabs_right.
-unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
- replace n with (S (pred n)).
-apply H9.
-inversion H12; simpl in |- *; reflexivity.
-apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
- apply H13.
-apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
- apply H7.
-apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n;
- [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ].
-intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ].
-cut (cv_infty (fun n:nat => INR (S n))).
-intro; cut (Un_cv (fun n:nat => / INR (S n)) 0).
-unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *.
-cut (0 < eps1 / (Rabs x * Un 0%nat)).
-intro; elim (H11 _ H13); intros N H14.
-exists N; intros;
- replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with
-  (Rabs x * Un 0%nat * (/ INR (S n) - 0));
- [ idtac | unfold Rdiv in |- *; ring ].
-rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)).
-apply Rinv_0_lt_compat; apply Rabs_pos_lt.
-apply prod_neq_R0.
-apply Rabs_no_R0; assumption.
-assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
- elim (Rlt_irrefl _ H16).
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l.
-replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)).
-apply H14; assumption.
-unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)).
-apply Rmult_comm.
-apply Rle_ge; apply Rmult_le_pos.
-apply Rabs_pos.
-left; apply H7.
-apply Rabs_no_R0.
-apply prod_neq_R0;
- [ apply Rabs_no_R0; assumption
- | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
-    elim (Rlt_irrefl _ H16) ].
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; apply Rmult_lt_0_compat.
-apply Rabs_pos_lt; assumption.
-apply H7.
-apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
-intro; apply not_O_INR; discriminate.
-assumption.
-unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro.
-elim s; intro.
-exists 0%nat; intros.
-apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
-exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn.
-set (M0_z := up M0).
-assert (H10 := archimed M0).
-cut (0 <= M0_z)%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 in |- *; unfold M0_z in |- *;
- apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ].
-intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)).
-unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
-rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x);
- [ idtac | simpl in |- *; ring ].
-unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x));
- repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l.
-apply Rabs_pos.
-left; apply pow_lt; assumption.
-replace (M_nat + n + 1)%nat with (S (M_nat + n)).
-rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR;
- rewrite Rinv_mult_distr.
-apply Rmult_le_compat_l.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
- intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10).
-left; apply Rinv_lt_contravar.
-apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn.
-apply lt_INR; apply lt_n_S.
-pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ].
-apply plus_lt_compat_r.
-apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
-apply INR_fact_neq_0.
-apply not_O_INR; discriminate.
-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 in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *;
- rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)).
-repeat apply Rmult_le_compat_l.
-apply Rabs_pos.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
-apply decreasing_prop; [ assumption | apply le_O_n ].
-unfold Un_decreasing in |- *; intro; unfold Un in |- *.
-replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
-rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
- apply Rmult_le_compat_l.
-left; apply pow_lt; assumption.
-replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ].
-replace (M_nat + n + 1)%nat with (S (M_nat + n)).
-apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))).
-apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8);
- elim (fact_neq_0 _ H9).
-rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l.
-rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc;
- rewrite <- Rinv_r_sym.
-rewrite Rmult_1_r; apply Rle_trans with (INR M_nat).
-left; rewrite INR_IZR_INZ.
-rewrite <- H4; assert (H8 := archimed (Rabs 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 in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply pow_lt; assumption.
-apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
- assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8).
-clear Un Vn; apply INR_le; simpl in |- *.
-induction  M_nat as [| M_nat HrecM_nat].
-assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
-rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
-simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
-replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
- apply le_O_n.
-apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x).
-assumption.
-elim (archimed (Rabs x)); intros; assumption.
-unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros.
-exists x0; intros;
- apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)).
-unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
- rewrite (Rabs_right (Rabs x ^ n / INR (fact n))).
-unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
-rewrite RPow_abs; right; reflexivity.
-apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt;
- red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
-apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos.
-case (Req_dec x 0); intro.
-rewrite H3; rewrite Rabs_R0.
-induction  n as [| n Hrecn];
- [ simpl in |- *; left; apply Rlt_0_1
- | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ].
-left; apply pow_lt; apply Rabs_pos_lt; assumption.
-left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
- intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
-apply H1; assumption.
+  forall x:R, Un_cv (fun n:nat => x ^ n / INR (fact n)) 0.
+Proof.
+  intro;
+    cut
+      (Un_cv (fun n:nat => Rabs x ^ n / INR (fact n)) 0 ->
+        Un_cv (fun n:nat => x ^ n / INR (fact n)) 0).
+  intro; apply H.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros; case (Req_dec x 0);
+    intro.
+  exists 1%nat; intros.
+  rewrite H1; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+    rewrite Rabs_R0; rewrite pow_ne_zero;
+      [ unfold Rdiv in |- *; rewrite Rmult_0_l; rewrite Rabs_R0; assumption
+        | red in |- *; intro; rewrite H3 in H2; elim (le_Sn_n _ H2) ].
+  assert (H2 := Rabs_pos_lt x H1); set (M := up (Rabs x)); cut (0 <= M)%Z.
+  intro; elim (IZN M H3); intros M_nat H4.
+  set (Un := fun n:nat => Rabs x ^ (M_nat + n) / INR (fact (M_nat + n))).
+  cut (Un_cv Un 0); unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H5 eps H0); intros N H6.
+  exists (M_nat + N)%nat; intros;
+    cut (exists p : nat, (p >= N)%nat /\ n = (M_nat + p)%nat).
+  intro; elim H8; intros p H9.
+  elim H9; intros; rewrite H11; unfold Un in H6; apply H6; assumption.
+  exists (n - M_nat)%nat.
+  split.
+  unfold ge in |- *; apply (fun p n m:nat => plus_le_reg_l n m p) with M_nat;
+    rewrite <- le_plus_minus.
+  assumption.
+  apply le_trans with (M_nat + N)%nat.
+  apply le_plus_l.
+  assumption.
+  apply le_plus_minus; apply le_trans with (M_nat + N)%nat;
+    [ apply le_plus_l | assumption ].
+  set (Vn := fun n:nat => Rabs x * (Un 0%nat / INR (S n))).
+  cut (1 <= M_nat)%nat.
+  intro; cut (forall n:nat, 0 < Un n).
+  intro; cut (Un_decreasing Un).
+  intro; cut (forall n:nat, Un (S n) <= Vn n).
+  intro; cut (Un_cv Vn 0).
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros.
+  elim (H10 eps0 H5); intros N1 H11.
+  exists (S N1); intros.
+  cut (forall n:nat, 0 < Vn n).
+  intro; apply Rle_lt_trans with (Rabs (Vn (pred n) - 0)).
+  repeat rewrite Rabs_right.
+  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+    replace n with (S (pred n)).
+  apply H9.
+  inversion H12; simpl in |- *; reflexivity.
+  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+    apply H13.
+  apply Rle_ge; unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r; left;
+    apply H7.
+  apply H11; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n;
+    [ unfold ge in H12; exact H12 | inversion H12; simpl in |- *; reflexivity ].
+  intro; apply Rlt_le_trans with (Un (S n0)); [ apply H7 | apply H9 ].
+  cut (cv_infty (fun n:nat => INR (S n))).
+  intro; cut (Un_cv (fun n:nat => / INR (S n)) 0).
+  unfold Un_cv, R_dist in |- *; intros; unfold Vn in |- *.
+  cut (0 < eps1 / (Rabs x * Un 0%nat)).
+  intro; elim (H11 _ H13); intros N H14.
+  exists N; intros;
+    replace (Rabs x * (Un 0%nat / INR (S n)) - 0) with
+    (Rabs x * Un 0%nat * (/ INR (S n) - 0));
+    [ idtac | unfold Rdiv in |- *; ring ].
+  rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs (Rabs x * Un 0%nat)).
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt.
+  apply prod_neq_R0.
+  apply Rabs_no_R0; assumption.
+  assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+    elim (Rlt_irrefl _ H16).
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l.
+  replace (/ Rabs (Rabs x * Un 0%nat) * eps1) with (eps1 / (Rabs x * Un 0%nat)).
+  apply H14; assumption.
+  unfold Rdiv in |- *; rewrite (Rabs_right (Rabs x * Un 0%nat)).
+  apply Rmult_comm.
+  apply Rle_ge; apply Rmult_le_pos.
+  apply Rabs_pos.
+  left; apply H7.
+  apply Rabs_no_R0.
+  apply prod_neq_R0;
+    [ apply Rabs_no_R0; assumption
+      | assert (H16 := H7 0%nat); red in |- *; intro; rewrite H17 in H16;
+        elim (Rlt_irrefl _ H16) ].
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; apply Rmult_lt_0_compat.
+  apply Rabs_pos_lt; assumption.
+  apply H7.
+  apply (cv_infty_cv_R0 (fun n:nat => INR (S n))).
+  intro; apply not_O_INR; discriminate.
+  assumption.
+  unfold cv_infty in |- *; intro; case (total_order_T M0 0); intro.
+  elim s; intro.
+  exists 0%nat; intros.
+  apply Rlt_trans with 0; [ assumption | apply lt_INR_0; apply lt_O_Sn ].
+  exists 0%nat; intros; rewrite b; apply lt_INR_0; apply lt_O_Sn.
+  set (M0_z := up M0).
+  assert (H10 := archimed M0).
+  cut (0 <= M0_z)%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 in |- *; unfold M0_z in |- *;
+    apply Rlt_trans with M0; [ assumption | elim H10; intros; assumption ].
+  intro; apply Rle_trans with (Rabs x * Un n * / INR (S n)).
+  unfold Un in |- *; replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
+  rewrite pow_add; replace (Rabs x ^ 1) with (Rabs x);
+    [ idtac | simpl in |- *; ring ].
+  unfold Rdiv in |- *; rewrite <- (Rmult_comm (Rabs x));
+    repeat rewrite Rmult_assoc; repeat apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  left; apply pow_lt; assumption.
+  replace (M_nat + n + 1)%nat with (S (M_nat + n)).
+  rewrite fact_simpl; rewrite mult_comm; rewrite mult_INR;
+    rewrite Rinv_mult_distr.
+  apply Rmult_le_compat_l.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
+    intro; assert (H10 := sym_eq H9); elim (fact_neq_0 _ H10).
+  left; apply Rinv_lt_contravar.
+  apply Rmult_lt_0_compat; apply lt_INR_0; apply lt_O_Sn.
+  apply lt_INR; apply lt_n_S.
+  pattern n at 1 in |- *; replace n with (0 + n)%nat; [ idtac | reflexivity ].
+  apply plus_lt_compat_r.
+  apply lt_le_trans with 1%nat; [ apply lt_O_Sn | assumption ].
+  apply INR_fact_neq_0.
+  apply not_O_INR; discriminate.
+  ring_nat.
+  ring_nat.
+  unfold Vn in |- *; rewrite Rmult_assoc; unfold Rdiv in |- *;
+    rewrite (Rmult_comm (Un 0%nat)); rewrite (Rmult_comm (Un n)).
+  repeat apply Rmult_le_compat_l.
+  apply Rabs_pos.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply lt_O_Sn.
+  apply decreasing_prop; [ assumption | apply le_O_n ].
+  unfold Un_decreasing in |- *; intro; unfold Un in |- *.
+  replace (M_nat + S n)%nat with (M_nat + n + 1)%nat.
+  rewrite pow_add; unfold Rdiv in |- *; rewrite Rmult_assoc;
+    apply Rmult_le_compat_l.
+  left; apply pow_lt; assumption.
+  replace (Rabs x ^ 1) with (Rabs x); [ idtac | simpl in |- *; ring ].
+  replace (M_nat + n + 1)%nat with (S (M_nat + n)).
+  apply Rmult_le_reg_l with (INR (fact (S (M_nat + n)))).
+  apply lt_INR_0; apply neq_O_lt; red in |- *; intro; assert (H9 := sym_eq H8);
+    elim (fact_neq_0 _ H9).
+  rewrite (Rmult_comm (Rabs x)); rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l.
+  rewrite fact_simpl; rewrite mult_INR; rewrite Rmult_assoc;
+    rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_r; apply Rle_trans with (INR M_nat).
+  left; rewrite INR_IZR_INZ.
+  rewrite <- H4; assert (H8 := archimed (Rabs x)); elim H8; intros; assumption.
+  apply le_INR; omega.
+  apply INR_fact_neq_0.
+  apply INR_fact_neq_0.
+  ring_nat.
+  ring_nat.
+  intro; unfold Un in |- *; unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply pow_lt; assumption.
+  apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *; intro;
+    assert (H8 := sym_eq H7); elim (fact_neq_0 _ H8).
+  clear Un Vn; apply INR_le; simpl in |- *.
+  induction  M_nat as [| M_nat HrecM_nat].
+  assert (H6 := archimed (Rabs x)); fold M in H6; elim H6; intros.
+  rewrite H4 in H7; rewrite <- INR_IZR_INZ in H7.
+  simpl in H7; elim (Rlt_irrefl _ (Rlt_trans _ _ _ H2 H7)).
+  replace 1 with (INR 1); [ apply le_INR | reflexivity ]; apply le_n_S;
+    apply le_O_n.
+  apply le_IZR; simpl in |- *; left; apply Rlt_trans with (Rabs x).
+  assumption.
+  elim (archimed (Rabs x)); intros; assumption.
+  unfold Un_cv in |- *; unfold R_dist in |- *; intros; elim (H eps H0); intros.
+  exists x0; intros;
+    apply Rle_lt_trans with (Rabs (Rabs x ^ n / INR (fact n) - 0)).
+  unfold Rminus in |- *; rewrite Ropp_0; do 2 rewrite Rplus_0_r;
+    rewrite (Rabs_right (Rabs x ^ n / INR (fact n))).
+  unfold Rdiv in |- *; rewrite Rabs_mult; rewrite (Rabs_right (/ INR (fact n))).
+  rewrite RPow_abs; right; reflexivity.
+  apply Rle_ge; left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt;
+    red in |- *; intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
+  apply Rle_ge; unfold Rdiv in |- *; apply Rmult_le_pos.
+  case (Req_dec x 0); intro.
+  rewrite H3; rewrite Rabs_R0.
+  induction  n as [| n Hrecn];
+    [ simpl in |- *; left; apply Rlt_0_1
+      | simpl in |- *; rewrite Rmult_0_l; right; reflexivity ].
+  left; apply pow_lt; apply Rabs_pos_lt; assumption.
+  left; apply Rinv_0_lt_compat; apply lt_INR_0; apply neq_O_lt; red in |- *;
+    intro; assert (H4 := sym_eq H3); elim (fact_neq_0 _ H4).
+  apply H1; assumption.
 Qed.
diff --git a/theories/Reals/SeqSeries.v b/theories/Reals/SeqSeries.v
index 6cab2486..bc17cd43 100644
--- a/theories/Reals/SeqSeries.v
+++ b/theories/Reals/SeqSeries.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: SeqSeries.v 8670 2006-03-28 22:16:14Z herbelin $ i*)
+
+(*i $Id: SeqSeries.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -25,393 +25,395 @@ Open Local Scope R_scope.
 
 (**********)
 Lemma sum_maj1 :
- forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) 
-   (N:nat),
-   Un_cv (fun n:nat => SP fn n x) l1 ->
-   Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
-   (forall n:nat, Rabs (fn n x) <= An n) ->
-   Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N.
-intros;
- cut
-  (sigT
-     (fun l:R =>
-        Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)).
-intro X;
- cut
-  (sigT
-     (fun l:R =>
-        Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)).
-intro X0; 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
- (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x.
-unfold SP in |- *; apply H2.
-apply H3.
-intros; apply H1.
-symmetry  in |- *; eapply UL_sequence.
-apply H3.
-unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5);
- intros N0 H6.
-unfold R_dist in H6; exists N0; intros.
-unfold R_dist in |- *;
- replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
-  with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
- [ idtac | ring ].
-replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
- (sum_f_R0 An (S (N + n))).
-apply H6; unfold ge in |- *; apply le_trans with n.
-apply H7.
-apply le_trans with (N + n)%nat.
-apply le_plus_r.
-apply le_n_Sn.
-cut (0 <= N)%nat.
-cut (N < S (N + n))%nat.
-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 (N + n))) with
- (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
-replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
-cut ((S (N + n) - S N)%nat = 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  in |- *; eapply UL_sequence.
-apply H2.
-unfold Un_cv in H; unfold Un_cv in |- *; intros.
-elim (H eps H4); intros N0 H5.
-unfold R_dist in H5; exists N0; intros.
-unfold R_dist, SP in |- *;
- replace
+  forall (fn:nat -> R -> R) (An:nat -> R) (x l1 l2:R) 
+    (N:nat),
+    Un_cv (fun n:nat => SP fn n x) l1 ->
+    Un_cv (fun n:nat => sum_f_R0 An n) l2 ->
+    (forall n:nat, Rabs (fn n x) <= An n) ->
+    Rabs (l1 - SP fn N x) <= l2 - sum_f_R0 An N.
+Proof.
+  intros;
+    cut
+      (sigT
+        (fun l:R =>
+          Un_cv (fun n:nat => sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) l)).
+  intro X;
+    cut
+      (sigT
+        (fun l:R =>
+          Un_cv (fun n:nat => sum_f_R0 (fun l:nat => An (S N + l)%nat) n) l)).
+  intro X0; 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
+    (fun l:nat => An (S N + l)%nat) (fun (l:nat) (x:R) => fn (S N + l)%nat x) x.
+  unfold SP in |- *; apply H2.
+  apply H3.
+  intros; apply H1.
+  symmetry  in |- *; eapply UL_sequence.
+  apply H3.
+  unfold Un_cv in H0; unfold Un_cv in |- *; intros; elim (H0 eps H5);
+    intros N0 H6.
+  unfold R_dist in H6; exists N0; intros.
+  unfold R_dist in |- *;
+    replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
+    with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
+      [ idtac | ring ].
+  replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
+  (sum_f_R0 An (S (N + n))).
+  apply H6; unfold ge in |- *; apply le_trans with n.
+  apply H7.
+  apply le_trans with (N + n)%nat.
+  apply le_plus_r.
+  apply le_n_Sn.
+  cut (0 <= N)%nat.
+  cut (N < S (N + n))%nat.
+  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 (N + n))) with
+  (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
+  replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
+  cut ((S (N + n) - S N)%nat = 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  in |- *; eapply UL_sequence.
+  apply H2.
+  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  elim (H eps H4); intros N0 H5.
+  unfold R_dist in H5; exists N0; intros.
+  unfold R_dist, SP in |- *;
+    replace
+    (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
+      (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
+    (sum_f_R0 (fun k:nat => fn k x) N +
+      sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); 
+    [ idtac | ring ].
+  replace
+  (sum_f_R0 (fun k:nat => fn k x) N +
+    sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
+  (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
+  unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n.
+  apply H6.
+  apply le_trans with (N + n)%nat.
+  apply le_plus_r.
+  apply le_n_Sn.
+  cut (0 <= N)%nat.
+  cut (N < S (N + n))%nat.
+  intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7).
+  unfold sigma in H9.
+  do 2 rewrite <- minus_n_O in H9.
+  replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
+  (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
+  replace (sum_f_R0 (fun k:nat => fn k x) N) with
+  (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
+  cut ((S (N + n) - S N)%nat = 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 existT with (l2 - sum_f_R0 An N).
+  unfold Un_cv in H0; unfold Un_cv in |- *; intros.
+  elim (H0 eps H2); intros N0 H3.
+  unfold R_dist in H3; exists N0; intros.
+  unfold R_dist in |- *;
+    replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
+    with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
+      [ idtac | ring ].
+  replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
+  (sum_f_R0 An (S (N + n))).
+  apply H3; unfold ge in |- *; apply le_trans with n.
+  apply H4.
+  apply le_trans with (N + n)%nat.
+  apply le_plus_r.
+  apply le_n_Sn.
+  cut (0 <= N)%nat.
+  cut (N < S (N + n))%nat.
+  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 (N + n))) with
+  (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
+  replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
+  cut ((S (N + n) - S N)%nat = 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 existT with (l1 - SP fn N x).
+  unfold Un_cv in H; unfold Un_cv in |- *; intros.
+  elim (H eps H2); intros N0 H3.
+  unfold R_dist in H3; exists N0; intros.
+  unfold R_dist, SP in |- *.
+  replace
   (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
-   (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
+    (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
+  (sum_f_R0 (fun k:nat => fn k x) N +
+    sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); 
+  [ idtac | ring ].
+  replace
   (sum_f_R0 (fun k:nat => fn k x) N +
-   sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); 
- [ idtac | ring ].
-replace
- (sum_f_R0 (fun k:nat => fn k x) N +
-  sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
- (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
-unfold SP in H5; apply H5; unfold ge in |- *; apply le_trans with n.
-apply H6.
-apply le_trans with (N + n)%nat.
-apply le_plus_r.
-apply le_n_Sn.
-cut (0 <= N)%nat.
-cut (N < S (N + n))%nat.
-intros; assert (H9 := sigma_split (fun k:nat => fn k x) H8 H7).
-unfold sigma in H9.
-do 2 rewrite <- minus_n_O in H9.
-replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
- (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
-replace (sum_f_R0 (fun k:nat => fn k x) N) with
- (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
-cut ((S (N + n) - S N)%nat = 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 existT with (l2 - sum_f_R0 An N).
-unfold Un_cv in H0; unfold Un_cv in |- *; intros.
-elim (H0 eps H2); intros N0 H3.
-unfold R_dist in H3; exists N0; intros.
-unfold R_dist in |- *;
- replace (sum_f_R0 (fun l:nat => An (S N + l)%nat) n - (l2 - sum_f_R0 An N))
-  with (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n - l2);
- [ idtac | ring ].
-replace (sum_f_R0 An N + sum_f_R0 (fun l:nat => An (S N + l)%nat) n) with
- (sum_f_R0 An (S (N + n))).
-apply H3; unfold ge in |- *; apply le_trans with n.
-apply H4.
-apply le_trans with (N + n)%nat.
-apply le_plus_r.
-apply le_n_Sn.
-cut (0 <= N)%nat.
-cut (N < S (N + n))%nat.
-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 (N + n))) with
- (sum_f_R0 (fun k:nat => An (0 + k)%nat) (S (N + n))).
-replace (sum_f_R0 An N) with (sum_f_R0 (fun k:nat => An (0 + k)%nat) N).
-cut ((S (N + n) - S N)%nat = 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 existT with (l1 - SP fn N x).
-unfold Un_cv in H; unfold Un_cv in |- *; intros.
-elim (H eps H2); intros N0 H3.
-unfold R_dist in H3; exists N0; intros.
-unfold R_dist, SP in |- *.
-replace
- (sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n -
-  (l1 - sum_f_R0 (fun k:nat => fn k x) N)) with
- (sum_f_R0 (fun k:nat => fn k x) N +
-  sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n - l1); 
- [ idtac | ring ].
-replace
- (sum_f_R0 (fun k:nat => fn k x) N +
-  sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
- (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
-unfold SP in H3; apply H3.
-unfold ge in |- *; apply le_trans with n.
-apply H4.
-apply le_trans with (N + n)%nat.
-apply le_plus_r.
-apply le_n_Sn.
-cut (0 <= N)%nat.
-cut (N < S (N + n))%nat.
-intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5).
-unfold sigma in H7.
-do 2 rewrite <- minus_n_O in H7.
-replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
- (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
-replace (sum_f_R0 (fun k:nat => fn k x) N) with
- (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
-cut ((S (N + n) - S N)%nat = 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.
+    sum_f_R0 (fun l:nat => fn (S N + l)%nat x) n) with
+  (sum_f_R0 (fun k:nat => fn k x) (S (N + n))).
+  unfold SP in H3; apply H3.
+  unfold ge in |- *; apply le_trans with n.
+  apply H4.
+  apply le_trans with (N + n)%nat.
+  apply le_plus_r.
+  apply le_n_Sn.
+  cut (0 <= N)%nat.
+  cut (N < S (N + n))%nat.
+  intros; assert (H7 := sigma_split (fun k:nat => fn k x) H6 H5).
+  unfold sigma in H7.
+  do 2 rewrite <- minus_n_O in H7.
+  replace (sum_f_R0 (fun k:nat => fn k x) (S (N + n))) with
+  (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) (S (N + n))).
+  replace (sum_f_R0 (fun k:nat => fn k x) N) with
+  (sum_f_R0 (fun k:nat => fn (0 + k)%nat x) N).
+  cut ((S (N + n) - S N)%nat = 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 *)
+(** Comparaison of convergence for series *)
 Lemma Rseries_CV_comp :
- forall An Bn:nat -> R,
-   (forall n:nat, 0 <= An n <= Bn n) ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) ->
-   sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
-intros An Bn H X; apply cv_cauchy_2.
-assert (H0 := cv_cauchy_1 _ X).
-unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
-intros; elim (H0 eps H1); intros.
-exists x; intros.
-cut
- (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 in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr;
- do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
- do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
-apply sum_Rle; intros.
-elim (H (S n + n0)%nat); intros.
-apply H8.
-apply Rle_ge; apply cond_pos_sum; intro.
-elim (H (S n + n0)%nat); intros.
-apply Rle_trans with (An (S n + n0)%nat); assumption.
-apply Rle_ge; apply cond_pos_sum; intro.
-elim (H (S n + n0)%nat); intros; assumption.
-rewrite b; unfold R_dist in |- *; unfold Rminus in |- *;
- do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; 
- reflexivity.
-rewrite (tech2 An m n); [ idtac | assumption ].
-rewrite (tech2 Bn m n); [ idtac | assumption ].
-unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc;
- rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
- do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; 
- do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
-apply sum_Rle; intros.
-elim (H (S m + n0)%nat); intros; apply H8.
-apply Rle_ge; apply cond_pos_sum; intro.
-elim (H (S m + n0)%nat); intros.
-apply Rle_trans with (An (S m + n0)%nat); assumption.
-apply Rle_ge.
-apply cond_pos_sum; intro.
-elim (H (S m + n0)%nat); intros; assumption.
+  forall An Bn:nat -> R,
+    (forall n:nat, 0 <= An n <= Bn n) ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 Bn N) l) ->
+    sigT (fun l:R => Un_cv (fun N:nat => sum_f_R0 An N) l).
+Proof.
+  intros An Bn H X; apply cv_cauchy_2.
+  assert (H0 := cv_cauchy_1 _ X).
+  unfold Cauchy_crit_series in |- *; unfold Cauchy_crit in |- *.
+  intros; elim (H0 eps H1); intros.
+  exists x; intros.
+  cut
+    (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 in |- *; unfold Rminus in |- *; do 2 rewrite Ropp_plus_distr;
+    do 2 rewrite <- Rplus_assoc; do 2 rewrite Rplus_opp_r;
+      do 2 rewrite Rplus_0_l; do 2 rewrite Rabs_Ropp; repeat rewrite Rabs_right.
+  apply sum_Rle; intros.
+  elim (H (S n + n0)%nat); intros.
+  apply H8.
+  apply Rle_ge; apply cond_pos_sum; intro.
+  elim (H (S n + n0)%nat); intros.
+  apply Rle_trans with (An (S n + n0)%nat); assumption.
+  apply Rle_ge; apply cond_pos_sum; intro.
+  elim (H (S n + n0)%nat); intros; assumption.
+  rewrite b; unfold R_dist in |- *; unfold Rminus in |- *;
+    do 2 rewrite Rplus_opp_r; rewrite Rabs_R0; right; 
+      reflexivity.
+  rewrite (tech2 An m n); [ idtac | assumption ].
+  rewrite (tech2 Bn m n); [ idtac | assumption ].
+  unfold R_dist in |- *; unfold Rminus in |- *; do 2 rewrite Rplus_assoc;
+    rewrite (Rplus_comm (sum_f_R0 An m)); rewrite (Rplus_comm (sum_f_R0 Bn m));
+      do 2 rewrite Rplus_assoc; do 2 rewrite Rplus_opp_l; 
+        do 2 rewrite Rplus_0_r; repeat rewrite Rabs_right.
+  apply sum_Rle; intros.
+  elim (H (S m + n0)%nat); intros; apply H8.
+  apply Rle_ge; apply cond_pos_sum; intro.
+  elim (H (S m + n0)%nat); intros.
+  apply Rle_trans with (An (S m + n0)%nat); assumption.
+  apply Rle_ge.
+  apply cond_pos_sum; intro.
+  elim (H (S m + n0)%nat); intros; assumption.
 Qed.
 
-(* Cesaro's theorem *)
+(** Cesaro's theorem *)
 Lemma Cesaro :
- forall (An Bn:nat -> R) (l:R),
-   Un_cv Bn l ->
-   (forall n:nat, 0 < An n) ->
-   cv_infty (fun n:nat => sum_f_R0 An n) ->
-   Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n)
-     l.
+  forall (An Bn:nat -> R) (l:R),
+    Un_cv Bn l ->
+    (forall n:nat, 0 < An n) ->
+    cv_infty (fun n:nat => sum_f_R0 An n) ->
+    Un_cv (fun n:nat => sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n)
+    l.
 Proof with trivial.
-unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)...
-intro; apply tech1...
-assert (H4 : forall n:nat, sum_f_R0 An n <> 0)...
-intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5;
- elim (Rlt_irrefl _ H5)...
-assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)...
-unfold Rdiv in |- *; apply Rmult_lt_0_compat...
-apply Rinv_0_lt_compat; prove_sup...
-elim (H _ H6); clear H; intros N1 H;
- set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1));
- assert
-  (H7 :
-    exists N : nat,
-     (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))...
-case (Req_dec C 0); intro...
-exists 0%nat; intros...
-rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat...
-apply Rinv_0_lt_compat; prove_sup...
-assert (H8 : 0 < eps / (2 * Rabs C))...
-unfold Rdiv in |- *; apply Rmult_lt_0_compat...
-apply Rinv_0_lt_compat; apply Rmult_lt_0_compat...
-prove_sup...
-apply Rabs_pos_lt...
-elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10);
- unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11;
- rewrite Rplus_0_r in H11...
-apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))...
-apply RRle_abs...
-unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)...
-apply Rinv_0_lt_compat; apply Rabs_pos_lt...
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
-rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))...
-unfold Rdiv in |- *; rewrite Rinv_mult_distr...
-ring...
-discrR...
-apply Rabs_no_R0...
-apply Rabs_no_R0...
-elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros;
- unfold R_dist in |- *;
- replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with
-  (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)...
-assert (H9 : (N1 < n)%nat)...
-apply lt_le_trans with (S N)...
-apply le_lt_n_Sm; unfold N in |- *; apply le_max_l...
-rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *;
- rewrite Rmult_plus_distr_r;
- apply Rle_lt_trans with
-  (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) +
-   Rabs
-     (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
-        (n - S N1) / sum_f_R0 An n))...
-apply Rabs_triang...
-rewrite (double_var eps); apply Rplus_lt_compat...
-unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right...
-apply (H7 n); apply le_trans with (S N)...
-apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]...
-apply Rle_ge; left; apply Rinv_0_lt_compat...
+  unfold Un_cv in |- *; intros; assert (H3 : forall n:nat, 0 < sum_f_R0 An n)...
+  intro; apply tech1...
+  assert (H4 : forall n:nat, sum_f_R0 An n <> 0)...
+  intro; red in |- *; intro; assert (H5 := H3 n); rewrite H4 in H5;
+    elim (Rlt_irrefl _ H5)...
+  assert (H5 := cv_infty_cv_R0 _ H4 H1); assert (H6 : 0 < eps / 2)...
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+  apply Rinv_0_lt_compat; prove_sup...
+  elim (H _ H6); clear H; intros N1 H;
+    set (C := Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1));
+      assert
+        (H7 :
+          exists N : nat,
+            (forall n:nat, (N <= n)%nat -> C / sum_f_R0 An n < eps / 2))...
+  case (Req_dec C 0); intro...
+  exists 0%nat; intros...
+  rewrite H7; unfold Rdiv in |- *; rewrite Rmult_0_l; apply Rmult_lt_0_compat...
+  apply Rinv_0_lt_compat; prove_sup...
+  assert (H8 : 0 < eps / (2 * Rabs C))...
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat...
+  apply Rinv_0_lt_compat; apply Rmult_lt_0_compat...
+  prove_sup...
+  apply Rabs_pos_lt...
+  elim (H5 _ H8); intros; exists x; intros; assert (H11 := H9 _ H10);
+    unfold R_dist in H11; unfold Rminus in H11; rewrite Ropp_0 in H11;
+      rewrite Rplus_0_r in H11...
+  apply Rle_lt_trans with (Rabs (C / sum_f_R0 An n))...
+  apply RRle_abs...
+  unfold Rdiv in |- *; rewrite Rabs_mult; apply Rmult_lt_reg_l with (/ Rabs C)...
+  apply Rinv_0_lt_compat; apply Rabs_pos_lt...
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym...
+  rewrite Rmult_1_l; replace (/ Rabs C * (eps * / 2)) with (eps / (2 * Rabs C))...
+  unfold Rdiv in |- *; rewrite Rinv_mult_distr...
+  ring...
+  discrR...
+  apply Rabs_no_R0...
+  apply Rabs_no_R0...
+  elim H7; clear H7; intros N2 H7; set (N := max N1 N2); exists (S N); intros;
+    unfold R_dist in |- *;
+      replace (sum_f_R0 (fun k:nat => An k * Bn k) n / sum_f_R0 An n - l) with
+      (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n / sum_f_R0 An n)...
+  assert (H9 : (N1 < n)%nat)...
+  apply lt_le_trans with (S N)...
+  apply le_lt_n_Sm; unfold N in |- *; apply le_max_l...
+  rewrite (tech2 (fun k:nat => An k * (Bn k - l)) _ _ H9); unfold Rdiv in |- *;
+    rewrite Rmult_plus_distr_r;
+      apply Rle_lt_trans with
+        (Rabs (sum_f_R0 (fun k:nat => An k * (Bn k - l)) N1 / sum_f_R0 An n) +
+          Rabs
+          (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
+            (n - S N1) / sum_f_R0 An n))...
+  apply Rabs_triang...
+  rewrite (double_var eps); apply Rplus_lt_compat...
+  unfold Rdiv in |- *; rewrite Rabs_mult; fold C in |- *; rewrite Rabs_right...
+  apply (H7 n); apply le_trans with (S N)...
+  apply le_trans with N; [ unfold N in |- *; apply le_max_r | apply le_n_Sn ]...
+  apply Rle_ge; left; apply Rinv_0_lt_compat...
 
-unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult;
- rewrite (Rabs_right (/ sum_f_R0 An n))...
-apply Rle_lt_trans with
- (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)))
-    (n - S N1) * / sum_f_R0 An n)...
-do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
-left; apply Rinv_0_lt_compat...
-apply
- (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
-    (n - S N1))...
-apply Rle_lt_trans with
- (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) *
-  / sum_f_R0 An n)...
-do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
-left; apply Rinv_0_lt_compat...
-apply sum_Rle; intros; rewrite Rabs_mult;
- pattern (An (S N1 + n0)%nat) at 2 in |- *;
- rewrite <- (Rabs_right (An (S N1 + n0)%nat))...
-apply Rmult_le_compat_l...
-apply Rabs_pos...
-left; apply H; unfold ge in |- *; apply le_trans with (S N1);
- [ apply le_n_Sn | apply le_plus_l ]...
-apply Rle_ge; left...
-rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2));
- unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l...
-pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l...
-apply Rinv_0_lt_compat; prove_sup...
-rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)...
-rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
-rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)...
-rewrite Rplus_comm;
- pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *;
- rewrite <- Rplus_0_r; apply Rplus_lt_compat_l...
-apply Rle_ge; left; apply Rinv_0_lt_compat...
-replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with
- (sum_f_R0 (fun k:nat => An k * Bn k) n +
-  sum_f_R0 (fun k:nat => An k * - l) n)...
-rewrite <- (scal_sum An n (- l)); field...
-rewrite <- plus_sum; apply sum_eq; intros; ring...
+  unfold R_dist in H; unfold Rdiv in |- *; rewrite Rabs_mult;
+    rewrite (Rabs_right (/ sum_f_R0 An n))...
+  apply Rle_lt_trans with
+    (sum_f_R0 (fun i:nat => Rabs (An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l)))
+      (n - S N1) * / sum_f_R0 An n)...
+  do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
+  left; apply Rinv_0_lt_compat...
+  apply
+    (Rsum_abs (fun i:nat => An (S N1 + i)%nat * (Bn (S N1 + i)%nat - l))
+      (n - S N1))...
+  apply Rle_lt_trans with
+    (sum_f_R0 (fun i:nat => An (S N1 + i)%nat * (eps / 2)) (n - S N1) *
+      / sum_f_R0 An n)...
+  do 2 rewrite <- (Rmult_comm (/ sum_f_R0 An n)); apply Rmult_le_compat_l...
+  left; apply Rinv_0_lt_compat...
+  apply sum_Rle; intros; rewrite Rabs_mult;
+    pattern (An (S N1 + n0)%nat) at 2 in |- *;
+      rewrite <- (Rabs_right (An (S N1 + n0)%nat))...
+  apply Rmult_le_compat_l...
+  apply Rabs_pos...
+  left; apply H; unfold ge in |- *; apply le_trans with (S N1);
+    [ apply le_n_Sn | apply le_plus_l ]...
+  apply Rle_ge; left...
+  rewrite <- (scal_sum (fun i:nat => An (S N1 + i)%nat) (n - S N1) (eps / 2));
+    unfold Rdiv in |- *; repeat rewrite Rmult_assoc; apply Rmult_lt_compat_l...
+  pattern (/ 2) at 2 in |- *; rewrite <- Rmult_1_r; apply Rmult_lt_compat_l...
+  apply Rinv_0_lt_compat; prove_sup...
+  rewrite Rmult_comm; apply Rmult_lt_reg_l with (sum_f_R0 An n)...
+  rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym...
+  rewrite Rmult_1_l; rewrite Rmult_1_r; rewrite (tech2 An N1 n)...
+  rewrite Rplus_comm;
+    pattern (sum_f_R0 (fun i:nat => An (S N1 + i)%nat) (n - S N1)) at 1 in |- *;
+      rewrite <- Rplus_0_r; apply Rplus_lt_compat_l...
+  apply Rle_ge; left; apply Rinv_0_lt_compat...
+  replace (sum_f_R0 (fun k:nat => An k * (Bn k - l)) n) with
+  (sum_f_R0 (fun k:nat => An k * Bn k) n +
+    sum_f_R0 (fun 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 :
- forall (An:nat -> R) (l:R),
-   Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l.
+  forall (An:nat -> R) (l:R),
+    Un_cv An l -> Un_cv (fun n:nat => sum_f_R0 An (pred n) / INR n) l.
 Proof with trivial.
-intros Bn l H; set (An := fun _:nat => 1)...
-assert (H0 : forall n:nat, 0 < An n)...
-intro; unfold An in |- *; apply Rlt_0_1...
-assert (H1 : forall n:nat, 0 < sum_f_R0 An n)...
-intro; apply tech1...
-assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))...
-unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro...
-exists 0%nat; intros; apply Rle_lt_trans with 0...
-assert (H2 : 0 < M)...
-auto with real...
-clear n; set (m := up M); elim (archimed M); intros;
- assert (H5 : (0 <= m)%Z)...
-apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M...
-elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte;
- rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))...
-apply Rle_lt_trans with (INR x)...
-rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right...
-apply lt_INR; apply le_lt_n_Sm...
-assert (H3 := Cesaro _ _ _ H H0 H2)...
-unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros;
- exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5;
- apply Rle_lt_trans with
-  (Rabs
-     (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))...
-right;
- replace (sum_f_R0 Bn (pred n) / INR n - l) with
-  (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)...
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
- apply Rplus_eq_compat_l...
-unfold An in |- *;
- replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with
-  (sum_f_R0 Bn (pred n))...
-rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n...
-apply S_pred with 0%nat; apply lt_le_trans with (S x)...
-apply lt_O_Sn...
-apply sum_eq; intros; ring...
-apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n...
-apply S_pred with 0%nat; apply lt_le_trans with (S x)...
-apply lt_O_Sn...
+  intros Bn l H; set (An := fun _:nat => 1)...
+  assert (H0 : forall n:nat, 0 < An n)...
+  intro; unfold An in |- *; apply Rlt_0_1...
+  assert (H1 : forall n:nat, 0 < sum_f_R0 An n)...
+  intro; apply tech1...
+  assert (H2 : cv_infty (fun n:nat => sum_f_R0 An n))...
+  unfold cv_infty in |- *; intro; case (Rle_dec M 0); intro...
+  exists 0%nat; intros; apply Rle_lt_trans with 0...
+  assert (H2 : 0 < M)...
+  auto with real...
+  clear n; set (m := up M); elim (archimed M); intros;
+    assert (H5 : (0 <= m)%Z)...
+  apply le_IZR; unfold m in |- *; simpl in |- *; left; apply Rlt_trans with M...
+  elim (IZN _ H5); intros; exists x; intros; unfold An in |- *; rewrite sum_cte;
+    rewrite Rmult_1_l; apply Rlt_trans with (IZR (up M))...
+  apply Rle_lt_trans with (INR x)...
+  rewrite INR_IZR_INZ; fold m in |- *; rewrite <- H6; right...
+  apply lt_INR; apply le_lt_n_Sm...
+  assert (H3 := Cesaro _ _ _ H H0 H2)...
+  unfold Un_cv in |- *; unfold Un_cv in H3; intros; elim (H3 _ H4); intros;
+    exists (S x); intros; unfold R_dist in |- *; unfold R_dist in H5;
+      apply Rle_lt_trans with
+        (Rabs
+          (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l))...
+  right;
+    replace (sum_f_R0 Bn (pred n) / INR n - l) with
+    (sum_f_R0 (fun k:nat => An k * Bn k) (pred n) / sum_f_R0 An (pred n) - l)...
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (- l));
+    apply Rplus_eq_compat_l...
+  unfold An in |- *;
+    replace (sum_f_R0 (fun k:nat => 1 * Bn k) (pred n)) with
+    (sum_f_R0 Bn (pred n))...
+  rewrite sum_cte; rewrite Rmult_1_l; replace (S (pred n)) with n...
+  apply S_pred with 0%nat; apply lt_le_trans with (S x)...
+  apply lt_O_Sn...
+  apply sum_eq; intros; ring...
+  apply H5; unfold ge in |- *; apply le_S_n; replace (S (pred n)) with n...
+  apply S_pred with 0%nat; apply lt_le_trans with (S x)...
+  apply lt_O_Sn...
 Qed.
diff --git a/theories/Reals/SplitAbsolu.v b/theories/Reals/SplitAbsolu.v
index 11b9d57b..08dbd67b 100644
--- a/theories/Reals/SplitAbsolu.v
+++ b/theories/Reals/SplitAbsolu.v
@@ -6,20 +6,20 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i      $Id: SplitAbsolu.v 5920 2004-07-16 20:01:26Z herbelin $       i*)
+(*i      $Id: SplitAbsolu.v 9245 2006-10-17 12:53:34Z notin $       i*)
 
 Require Import Rbasic_fun.
 
 Ltac split_case_Rabs :=
   match goal with
-  |  |- context [(Rcase_abs ?X1)] =>
+    |  |- context [(Rcase_abs ?X1)] =>
       case (Rcase_abs X1); try split_case_Rabs
   end.
 
 
 Ltac split_Rabs :=
   match goal with
-  | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs
-  |  |- context [(Rabs ?X1)] =>
+    | id:context [(Rabs _)] |- _ => generalize id; clear id; try split_Rabs
+    |  |- context [(Rabs ?X1)] =>
       unfold Rabs in |- *; try split_case_Rabs; intros
-  end.
\ No newline at end of file
+  end.
diff --git a/theories/Reals/SplitRmult.v b/theories/Reals/SplitRmult.v
index 31d49b76..4f3fab24 100644
--- a/theories/Reals/SplitRmult.v
+++ b/theories/Reals/SplitRmult.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: SplitRmult.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: SplitRmult.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (*i Lemma mult_non_zero :(r1,r2:R)``r1<>0`` /\ ``r2<>0`` -> ``r1*r2<>0``. i*)
 
@@ -15,6 +15,6 @@ Require Import Rbase.
 
 Ltac split_Rmult :=
   match goal with
-  |  |- ((?X1 * ?X2)%R <> 0%R) =>
+    |  |- ((?X1 * ?X2)%R <> 0%R) =>
       apply Rmult_integral_contrapositive; split; try split_Rmult
   end.
diff --git a/theories/Reals/Sqrt_reg.v b/theories/Reals/Sqrt_reg.v
index 3e2b6b9f..ff0a72e8 100644
--- a/theories/Reals/Sqrt_reg.v
+++ b/theories/Reals/Sqrt_reg.v
@@ -5,8 +5,8 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
- 
-(*i $Id: Sqrt_reg.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+
+(*i $Id: Sqrt_reg.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rbase.
 Require Import Rfunctions.
@@ -15,337 +15,344 @@ Require Import R_sqrt. Open Local Scope R_scope.
 
 (**********)
 Lemma sqrt_var_maj :
- forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h.
-intros; cut (0 <= 1 + h).
-intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)).
-case (total_order_T h 0); intro.
-elim s; intro.
-repeat rewrite Rabs_left.
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)).
-do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
- apply Rplus_le_compat_l.
-apply Ropp_le_contravar; apply sqrt_le_1.
-apply Rle_0_sqr.
-apply H0.
-pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
- apply Rmult_le_compat_l.
-apply H0.
-pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- assumption.
-apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
- unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_r.
-pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
-apply Rle_0_sqr.
-left; apply Rlt_0_1.
-pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1.
-pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- assumption.
-apply H0.
-left; apply Rlt_0_1.
-apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
- unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_r.
-pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
-apply H0.
-left; apply Rlt_0_1.
-pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- assumption.
-rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
- reflexivity.
-repeat rewrite Rabs_right.
-unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1));
- apply Rplus_le_compat_l.
-apply sqrt_le_1.
-apply H0.
-apply Rle_0_sqr.
-pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
- apply Rmult_le_compat_l.
-apply H0.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- assumption.
-apply Rle_ge; apply Rplus_le_reg_l with 1.
-rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1.
-left; apply Rlt_0_1.
-apply Rle_0_sqr.
-pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
- assumption.
-left; apply Rlt_0_1.
-apply H0.
-apply Rle_ge; left; apply Rplus_lt_reg_r with 1.
-rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
- rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
-pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
-left; apply Rlt_0_1.
-apply H0.
-pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
- assumption.
-rewrite sqrt_Rsqr.
-replace (1 + h - 1) with h; [ right; reflexivity | ring ].
-apply H0.
-case (total_order_T h 0); intro.
-elim s; intro.
-rewrite (Rabs_left h a) in H.
-apply Rplus_le_reg_l with (- h).
-rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H.
-left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1.
-left; apply Rplus_lt_0_compat.
-apply Rlt_0_1.
-apply r.
+  forall h:R, Rabs h <= 1 -> Rabs (sqrt (1 + h) - 1) <= Rabs h.
+Proof.
+  intros; cut (0 <= 1 + h).
+  intro; apply Rle_trans with (Rabs (sqrt (Rsqr (1 + h)) - 1)).
+  case (total_order_T h 0); intro.
+  elim s; intro.
+  repeat rewrite Rabs_left.
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1)).
+  do 2 rewrite Ropp_plus_distr; rewrite Ropp_involutive;
+    apply Rplus_le_compat_l.
+  apply Ropp_le_contravar; apply sqrt_le_1.
+  apply Rle_0_sqr.
+  apply H0.
+  pattern (1 + h) at 2 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+    apply Rmult_le_compat_l.
+  apply H0.
+  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    assumption.
+  apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+    unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+      rewrite Rplus_0_r.
+  pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  apply Rle_0_sqr.
+  left; apply Rlt_0_1.
+  pattern 1 at 2 in |- *; rewrite <- Rsqr_1; apply Rsqr_incrst_1.
+  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    assumption.
+  apply H0.
+  left; apply Rlt_0_1.
+  apply Rplus_lt_reg_r with 1; rewrite Rplus_0_r; rewrite Rplus_comm;
+    unfold Rminus in |- *; rewrite Rplus_assoc; rewrite Rplus_opp_l;
+      rewrite Rplus_0_r.
+  pattern 1 at 2 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  apply H0.
+  left; apply Rlt_0_1.
+  pattern 1 at 2 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    assumption.
+  rewrite b; rewrite Rplus_0_r; rewrite Rsqr_1; rewrite sqrt_1; right;
+    reflexivity.
+  repeat rewrite Rabs_right.
+  unfold Rminus in |- *; do 2 rewrite <- (Rplus_comm (-1));
+    apply Rplus_le_compat_l.
+  apply sqrt_le_1.
+  apply H0.
+  apply Rle_0_sqr.
+  pattern (1 + h) at 1 in |- *; rewrite <- Rmult_1_r; unfold Rsqr in |- *;
+    apply Rmult_le_compat_l.
+  apply H0.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    assumption.
+  apply Rle_ge; apply Rplus_le_reg_l with 1.
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+  pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_le_1.
+  left; apply Rlt_0_1.
+  apply Rle_0_sqr.
+  pattern 1 at 1 in |- *; rewrite <- Rsqr_1; apply Rsqr_incr_1.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_le_compat_l; left;
+    assumption.
+  left; apply Rlt_0_1.
+  apply H0.
+  apply Rle_ge; left; apply Rplus_lt_reg_r with 1.
+  rewrite Rplus_0_r; rewrite Rplus_comm; unfold Rminus in |- *;
+    rewrite Rplus_assoc; rewrite Rplus_opp_l; rewrite Rplus_0_r.
+  pattern 1 at 1 in |- *; rewrite <- sqrt_1; apply sqrt_lt_1.
+  left; apply Rlt_0_1.
+  apply H0.
+  pattern 1 at 1 in |- *; rewrite <- Rplus_0_r; apply Rplus_lt_compat_l;
+    assumption.
+  rewrite sqrt_Rsqr.
+  replace (1 + h - 1) with h; [ right; reflexivity | ring ].
+  apply H0.
+  case (total_order_T h 0); intro.
+  elim s; intro.
+  rewrite (Rabs_left h a) in H.
+  apply Rplus_le_reg_l with (- h).
+  rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; exact H.
+  left; rewrite b; rewrite Rplus_0_r; apply Rlt_0_1.
+  left; apply Rplus_lt_0_compat.
+  apply Rlt_0_1.
+  apply r.
 Qed.
 
-(* sqrt is continuous in 1 *)
+(** sqrt is continuous in 1 *)
 Lemma sqrt_continuity_pt_R1 : continuity_pt sqrt 1.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros.
-set (alpha := Rmin eps 1).
-exists alpha; intros.
-split.
-unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro.
-assumption.
-apply Rlt_0_1.
-intros; elim H0; intros.
-rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ];
- apply Rle_lt_trans with (Rabs (x - 1)).
-apply sqrt_var_maj.
-apply Rle_trans with alpha.
-left; apply H2.
-unfold alpha in |- *; apply Rmin_r.
-apply Rlt_le_trans with alpha;
- [ apply H2 | unfold alpha in |- *; apply Rmin_l ].
+Proof.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
+        intros.
+  set (alpha := Rmin eps 1).
+  exists alpha; intros.
+  split.
+  unfold alpha in |- *; unfold Rmin in |- *; case (Rle_dec eps 1); intro.
+  assumption.
+  apply Rlt_0_1.
+  intros; elim H0; intros.
+  rewrite sqrt_1; replace x with (1 + (x - 1)); [ idtac | ring ];
+    apply Rle_lt_trans with (Rabs (x - 1)).
+  apply sqrt_var_maj.
+  apply Rle_trans with alpha.
+  left; apply H2.
+  unfold alpha in |- *; apply Rmin_r.
+  apply Rlt_le_trans with alpha;
+    [ apply H2 | unfold alpha in |- *; apply Rmin_l ].
 Qed.
 
-(* sqrt is continuous forall x>0 *)
+(** sqrt is continuous forall x>0 *)
 Lemma sqrt_continuity_pt : forall x:R, 0 < x -> continuity_pt sqrt x.
-intros; generalize sqrt_continuity_pt_R1.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
- intros.
-cut (0 < eps / sqrt x).
-intro; elim (H0 _ H2); intros alp_1 H3.
-elim H3; intros.
-set (alpha := alp_1 * x).
-exists (Rmin alpha x); intros.
-split.
-change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *;
- case (Rle_dec alpha x); intro.
-unfold alpha in |- *; apply Rmult_lt_0_compat; assumption.
-apply H.
-intros; replace x0 with (x + (x0 - x)); [ idtac | ring ];
- replace (sqrt (x + (x0 - x)) - sqrt x) with
-  (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)).
-rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)).
-apply Rmult_lt_reg_l with (/ sqrt x).
-apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption.
-rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
-rewrite Rmult_1_l; rewrite Rmult_comm.
-unfold Rdiv in H5.
-case (Req_dec x x0); intro.
-rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r;
- rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; 
- rewrite Rabs_R0.
-apply Rmult_lt_0_compat.
-assumption.
-apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption.
-apply H5.
-split.
-unfold D_x, no_cond in |- *.
-split.
-trivial.
-red in |- *; intro.
-cut ((x0 - x) * / x = 0).
-intro.
-elim (Rmult_integral _ _ H9); intro.
-elim H7.
-apply (Rminus_diag_uniq_sym _ _ H10).
-assert (H11 := Rmult_eq_0_compat_r _ x H10).
-rewrite <- Rinv_l_sym in H11.
-elim R1_neq_R0; exact H11.
-red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H).
-symmetry  in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r;
- unfold Rdiv in H8; exact H8.
-unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc;
- rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros.
-unfold Rdiv in |- *; rewrite Rabs_mult.
-rewrite Rabs_Rinv.
-rewrite (Rabs_right x).
-rewrite Rmult_comm; apply Rmult_lt_reg_l with x.
-apply H.
-rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
-rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *.
-apply Rlt_le_trans with (Rmin alpha x).
-apply H9.
-apply Rmin_l.
-red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
-apply Rle_ge; left; apply H.
-red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
-assert (H7 := sqrt_lt_R0 x H).
-red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7).
-apply Rle_ge; apply sqrt_positivity.
-left; apply H.
-unfold Rminus in |- *; rewrite Rmult_plus_distr_l;
- rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult.
-rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
- unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; reflexivity.
-red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H).
-left; apply H.
-left; apply Rlt_0_1.
-left; apply H.
-elim H6; intros.
-case (Rcase_abs (x0 - x)); intro.
-rewrite (Rabs_left (x0 - x) r) in H8.
-rewrite Rplus_comm.
-apply Rplus_le_reg_l with (- ((x0 - x) / x)).
-rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
- rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
-apply Rmult_le_reg_l with x.
-apply H.
-rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
- rewrite <- Rinv_l_sym.
-rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x).
-apply H8.
-apply Rmin_r.
-red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H).
-apply Rplus_le_le_0_compat.
-left; apply Rlt_0_1.
-unfold Rdiv in |- *; apply Rmult_le_pos.
-apply Rge_le; exact r.
-left; apply Rinv_0_lt_compat; apply H.
-unfold Rdiv in |- *; apply Rmult_lt_0_compat.
-apply H1.
-apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H.
+Proof.
+  intros; generalize sqrt_continuity_pt_R1.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      unfold dist in |- *; simpl in |- *; unfold R_dist in |- *; 
+        intros.
+  cut (0 < eps / sqrt x).
+  intro; elim (H0 _ H2); intros alp_1 H3.
+  elim H3; intros.
+  set (alpha := alp_1 * x).
+  exists (Rmin alpha x); intros.
+  split.
+  change (0 < Rmin alpha x) in |- *; unfold Rmin in |- *;
+    case (Rle_dec alpha x); intro.
+  unfold alpha in |- *; apply Rmult_lt_0_compat; assumption.
+  apply H.
+  intros; replace x0 with (x + (x0 - x)); [ idtac | ring ];
+    replace (sqrt (x + (x0 - x)) - sqrt x) with
+    (sqrt x * (sqrt (1 + (x0 - x) / x) - sqrt 1)).
+  rewrite Rabs_mult; rewrite (Rabs_right (sqrt x)).
+  apply Rmult_lt_reg_l with (/ sqrt x).
+  apply Rinv_0_lt_compat; apply sqrt_lt_R0; assumption.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_l; rewrite Rmult_comm.
+  unfold Rdiv in H5.
+  case (Req_dec x x0); intro.
+  rewrite H7; unfold Rminus, Rdiv in |- *; rewrite Rplus_opp_r;
+    rewrite Rmult_0_l; rewrite Rplus_0_r; rewrite Rplus_opp_r; 
+      rewrite Rabs_R0.
+  apply Rmult_lt_0_compat.
+  assumption.
+  apply Rinv_0_lt_compat; rewrite <- H7; apply sqrt_lt_R0; assumption.
+  apply H5.
+  split.
+  unfold D_x, no_cond in |- *.
+  split.
+  trivial.
+  red in |- *; intro.
+  cut ((x0 - x) * / x = 0).
+  intro.
+  elim (Rmult_integral _ _ H9); intro.
+  elim H7.
+  apply (Rminus_diag_uniq_sym _ _ H10).
+  assert (H11 := Rmult_eq_0_compat_r _ x H10).
+  rewrite <- Rinv_l_sym in H11.
+  elim R1_neq_R0; exact H11.
+  red in |- *; intro; rewrite H12 in H; elim (Rlt_irrefl _ H).
+  symmetry  in |- *; apply Rplus_eq_reg_l with 1; rewrite Rplus_0_r;
+    unfold Rdiv in H8; exact H8.
+  unfold Rminus in |- *; rewrite Rplus_comm; rewrite <- Rplus_assoc;
+    rewrite Rplus_opp_l; rewrite Rplus_0_l; elim H6; intros.
+  unfold Rdiv in |- *; rewrite Rabs_mult.
+  rewrite Rabs_Rinv.
+  rewrite (Rabs_right x).
+  rewrite Rmult_comm; apply Rmult_lt_reg_l with x.
+  apply H.
+  rewrite <- Rmult_assoc; rewrite <- Rinv_r_sym.
+  rewrite Rmult_1_l; rewrite Rmult_comm; fold alpha in |- *.
+  apply Rlt_le_trans with (Rmin alpha x).
+  apply H9.
+  apply Rmin_l.
+  red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  apply Rle_ge; left; apply H.
+  red in |- *; intro; rewrite H10 in H; elim (Rlt_irrefl _ H).
+  assert (H7 := sqrt_lt_R0 x H).
+  red in |- *; intro; rewrite H8 in H7; elim (Rlt_irrefl _ H7).
+  apply Rle_ge; apply sqrt_positivity.
+  left; apply H.
+  unfold Rminus in |- *; rewrite Rmult_plus_distr_l;
+    rewrite Ropp_mult_distr_r_reverse; repeat rewrite <- sqrt_mult.
+  rewrite Rmult_1_r; rewrite Rmult_plus_distr_l; rewrite Rmult_1_r;
+    unfold Rdiv in |- *; rewrite Rmult_comm; rewrite Rmult_assoc;
+      rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; reflexivity.
+  red in |- *; intro; rewrite H7 in H; elim (Rlt_irrefl _ H).
+  left; apply H.
+  left; apply Rlt_0_1.
+  left; apply H.
+  elim H6; intros.
+  case (Rcase_abs (x0 - x)); intro.
+  rewrite (Rabs_left (x0 - x) r) in H8.
+  rewrite Rplus_comm.
+  apply Rplus_le_reg_l with (- ((x0 - x) / x)).
+  rewrite Rplus_0_r; rewrite <- Rplus_assoc; rewrite Rplus_opp_l;
+    rewrite Rplus_0_l; unfold Rdiv in |- *; rewrite <- Ropp_mult_distr_l_reverse.
+  apply Rmult_le_reg_l with x.
+  apply H.
+  rewrite Rmult_1_r; rewrite Rmult_comm; rewrite Rmult_assoc;
+    rewrite <- Rinv_l_sym.
+  rewrite Rmult_1_r; left; apply Rlt_le_trans with (Rmin alpha x).
+  apply H8.
+  apply Rmin_r.
+  red in |- *; intro; rewrite H9 in H; elim (Rlt_irrefl _ H).
+  apply Rplus_le_le_0_compat.
+  left; apply Rlt_0_1.
+  unfold Rdiv in |- *; apply Rmult_le_pos.
+  apply Rge_le; exact r.
+  left; apply Rinv_0_lt_compat; apply H.
+  unfold Rdiv in |- *; apply Rmult_lt_0_compat.
+  apply H1.
+  apply Rinv_0_lt_compat; apply sqrt_lt_R0; apply H.
 Qed.
 
-(* sqrt is derivable for all x>0 *)
+(** sqrt is derivable for all x>0 *)
 Lemma derivable_pt_lim_sqrt :
- forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)).
-intros; set (g := fun h:R => sqrt x + sqrt (x + h)).
-cut (continuity_pt g 0).
-intro; cut (g 0 <> 0).
-intro; assert (H2 := continuity_pt_inv g 0 H0 H1).
-unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2;
- unfold 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.
-set (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 in |- *.
-split.
-trivial.
-apply (sym_not_eq (A:=R)); exact H8.
-unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
- apply Rlt_le_trans with alpha1.
-exact H9.
-unfold alpha1 in |- *; apply Rmin_l.
-rewrite Rplus_0_r; ring.
-cut (0 <= x + h).
-intro; cut (0 < sqrt x + sqrt (x + h)).
-intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)).
-rewrite <- Rinv_r_sym.
-rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
- rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt.
-rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym.
-reflexivity.
-apply H8.
-left; apply H.
-assumption.
-red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
-red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
-apply Rplus_lt_le_0_compat.
-apply sqrt_lt_R0; apply H.
-apply sqrt_positivity; apply H10.
-case (Rcase_abs h); intro.
-rewrite (Rabs_left h r) in H9.
-apply Rplus_le_reg_l with (- h).
-rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
- rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1.
-apply H9.
-unfold alpha1 in |- *; apply Rmin_r.
-apply Rplus_le_le_0_compat.
-left; assumption.
-apply Rge_le; apply r.
-unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro.
-apply H5.
-apply H.
-unfold g in |- *; rewrite Rplus_0_r.
-cut (0 < sqrt x + sqrt x).
-intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
-apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H.
-replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F;
- [ idtac | reflexivity ].
-apply continuity_pt_plus.
-apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
- reflexivity.
-apply continuity_pt_comp.
-apply continuity_pt_plus.
-apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
- reflexivity.
-apply derivable_continuous_pt; apply derivable_pt_id.
-apply sqrt_continuity_pt.
-unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H.
+  forall x:R, 0 < x -> derivable_pt_lim sqrt x (/ (2 * sqrt x)).
+Proof.
+  intros; set (g := fun h:R => sqrt x + sqrt (x + h)).
+  cut (continuity_pt g 0).
+  intro; cut (g 0 <> 0).
+  intro; assert (H2 := continuity_pt_inv g 0 H0 H1).
+  unfold derivable_pt_lim in |- *; intros; unfold continuity_pt in H2;
+    unfold 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.
+  set (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 in |- *.
+  split.
+  trivial.
+  apply (sym_not_eq (A:=R)); exact H8.
+  unfold Rminus in |- *; rewrite Ropp_0; rewrite Rplus_0_r;
+    apply Rlt_le_trans with alpha1.
+  exact H9.
+  unfold alpha1 in |- *; apply Rmin_l.
+  rewrite Rplus_0_r; ring.
+  cut (0 <= x + h).
+  intro; cut (0 < sqrt x + sqrt (x + h)).
+  intro; apply Rmult_eq_reg_l with (sqrt x + sqrt (x + h)).
+  rewrite <- Rinv_r_sym.
+  rewrite Rplus_comm; unfold Rdiv in |- *; rewrite <- Rmult_assoc;
+    rewrite Rsqr_plus_minus; repeat rewrite Rsqr_sqrt.
+  rewrite Rplus_comm; unfold Rminus in |- *; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; rewrite <- Rinv_r_sym.
+  reflexivity.
+  apply H8.
+  left; apply H.
+  assumption.
+  red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+  red in |- *; intro; rewrite H12 in H11; elim (Rlt_irrefl _ H11).
+  apply Rplus_lt_le_0_compat.
+  apply sqrt_lt_R0; apply H.
+  apply sqrt_positivity; apply H10.
+  case (Rcase_abs h); intro.
+  rewrite (Rabs_left h r) in H9.
+  apply Rplus_le_reg_l with (- h).
+  rewrite Rplus_0_r; rewrite Rplus_comm; rewrite Rplus_assoc;
+    rewrite Rplus_opp_r; rewrite Rplus_0_r; left; apply Rlt_le_trans with alpha1.
+  apply H9.
+  unfold alpha1 in |- *; apply Rmin_r.
+  apply Rplus_le_le_0_compat.
+  left; assumption.
+  apply Rge_le; apply r.
+  unfold alpha1 in |- *; unfold Rmin in |- *; case (Rle_dec alpha x); intro.
+  apply H5.
+  apply H.
+  unfold g in |- *; rewrite Rplus_0_r.
+  cut (0 < sqrt x + sqrt x).
+  intro; red in |- *; intro; rewrite H2 in H1; elim (Rlt_irrefl _ H1).
+  apply Rplus_lt_0_compat; apply sqrt_lt_R0; apply H.
+  replace g with (fct_cte (sqrt x) + comp sqrt (fct_cte x + id))%F;
+  [ idtac | reflexivity ].
+  apply continuity_pt_plus.
+  apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+    reflexivity.
+  apply continuity_pt_comp.
+  apply continuity_pt_plus.
+  apply continuity_pt_const; unfold constant, fct_cte in |- *; intro;
+    reflexivity.
+  apply derivable_continuous_pt; apply derivable_pt_id.
+  apply sqrt_continuity_pt.
+  unfold plus_fct, fct_cte, id in |- *; rewrite Rplus_0_r; apply H.
 Qed.
 
 (**********)
 Lemma derivable_pt_sqrt : forall x:R, 0 < x -> derivable_pt sqrt x.
-unfold derivable_pt in |- *; intros.
-apply existT with (/ (2 * sqrt x)).
-apply derivable_pt_lim_sqrt; assumption.
+Proof.
+  unfold derivable_pt in |- *; intros.
+  apply existT with (/ (2 * sqrt x)).
+  apply derivable_pt_lim_sqrt; assumption.
 Qed.
 
 (**********)
 Lemma derive_pt_sqrt :
- forall (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.
+  forall (x:R) (pr:0 < x),
+    derive_pt sqrt x (derivable_pt_sqrt _ pr) = / (2 * sqrt x).
+Proof.
+  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 *)
+(** 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 : forall x:R, 0 <= x -> continuity_pt sqrt x.
-intros; case (Rtotal_order 0 x); intro.
-apply (sqrt_continuity_pt x H0).
-elim H0; intro.
-unfold continuity_pt in |- *; unfold continue_in in |- *;
- unfold limit1_in in |- *; unfold limit_in in |- *; 
- simpl in |- *; unfold R_dist in |- *; intros.
-exists (Rsqr eps); intros.
-split.
-change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt.
-red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2).
-intros; elim H3; intros.
-rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0;
- rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
- rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
-case (Rcase_abs x0); intro.
-unfold sqrt in |- *; case (Rcase_abs x0); intro.
-rewrite Rabs_R0; apply H2.
-assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)).
-rewrite Rabs_right.
-apply Rsqr_incrst_0.
-rewrite Rsqr_sqrt.
-rewrite (Rabs_right x0 r) in H5; apply H5.
-apply Rge_le; exact r.
-apply sqrt_positivity; apply Rge_le; exact r.
-left; exact H2.
-apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r.
-elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)).
-Qed.
\ No newline at end of file
+Proof.
+  intros; case (Rtotal_order 0 x); intro.
+  apply (sqrt_continuity_pt x H0).
+  elim H0; intro.
+  unfold continuity_pt in |- *; unfold continue_in in |- *;
+    unfold limit1_in in |- *; unfold limit_in in |- *; 
+      simpl in |- *; unfold R_dist in |- *; intros.
+  exists (Rsqr eps); intros.
+  split.
+  change (0 < Rsqr eps) in |- *; apply Rsqr_pos_lt.
+  red in |- *; intro; rewrite H3 in H2; elim (Rlt_irrefl _ H2).
+  intros; elim H3; intros.
+  rewrite <- H1; rewrite sqrt_0; unfold Rminus in |- *; rewrite Ropp_0;
+    rewrite Rplus_0_r; rewrite <- H1 in H5; unfold Rminus in H5;
+      rewrite Ropp_0 in H5; rewrite Rplus_0_r in H5.
+  case (Rcase_abs x0); intro.
+  unfold sqrt in |- *; case (Rcase_abs x0); intro.
+  rewrite Rabs_R0; apply H2.
+  assert (H6 := Rge_le _ _ r0); elim (Rlt_irrefl _ (Rle_lt_trans _ _ _ H6 r)).
+  rewrite Rabs_right.
+  apply Rsqr_incrst_0.
+  rewrite Rsqr_sqrt.
+  rewrite (Rabs_right x0 r) in H5; apply H5.
+  apply Rge_le; exact r.
+  apply sqrt_positivity; apply Rge_le; exact r.
+  left; exact H2.
+  apply Rle_ge; apply sqrt_positivity; apply Rge_le; exact r.
+  elim (Rlt_irrefl _ (Rlt_le_trans _ _ _ H1 H)).
+Qed.
diff --git a/theories/Relations/Newman.v b/theories/Relations/Newman.v
index ae914933..e7bb66eb 100644
--- a/theories/Relations/Newman.v
+++ b/theories/Relations/Newman.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Newman.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Newman.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Rstar.
 
@@ -23,24 +23,23 @@ Let Rstar_Rstar' := Rstar_Rstar' A R.
 Definition coherence (x y:A) := ex2 (Rstar x) (Rstar y).
 
 Theorem coherence_intro :
- forall x y z:A, Rstar x z -> Rstar y z -> coherence x y.
-Proof
-  fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) =>
-    ex_intro2 (Rstar x) (Rstar y) z h1 h2.
+  forall x y z:A, Rstar x z -> Rstar y z -> coherence x y.
+Proof fun (x y z:A) (h1:Rstar x z) (h2:Rstar y z) =>
+  ex_intro2 (Rstar x) (Rstar y) z h1 h2.
   
 (** A very simple case of coherence : *)
 
 Lemma Rstar_coherence : forall x y:A, Rstar x y -> coherence x y.
- Proof
-   fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y).  
+Proof
+  fun (x y:A) (h:Rstar x y) => coherence_intro x y y h (Rstar_reflexive y).  
   
 (** coherence is symmetric *)
 Lemma coherence_sym : forall x y:A, coherence x y -> coherence y x.
- Proof
-   fun (x y:A) (h:coherence x y) =>
-     ex2_ind
-       (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) =>
-          coherence_intro y x w h2 h1) h.
+Proof
+  fun (x y:A) (h:coherence x y) =>
+    ex2_ind
+      (fun (w:A) (h1:Rstar x w) (h2:Rstar y w) =>
+        coherence_intro y x w h2 h1) h.
 
 Definition confluence (x:A) :=
   forall y z:A, Rstar x y -> Rstar x z -> coherence y z.  
@@ -54,68 +53,67 @@ Definition noetherian :=
   
 Section Newman_section.
 
-(** The general hypotheses of the theorem *)
+  (** The general hypotheses of the theorem *)
 
-Hypothesis Hyp1 : noetherian.
-Hypothesis Hyp2 : forall x:A, local_confluence x.  
+  Hypothesis Hyp1 : noetherian.
+  Hypothesis Hyp2 : forall x:A, local_confluence x.  
   
-(** The induction hypothesis *)
+  (** The induction hypothesis *)
 
-Section Induct.
-  Variable x : A.
-  Hypothesis hyp_ind : forall u:A, R x u -> confluence u.  
+  Section Induct.
+    Variable x : A.
+    Hypothesis hyp_ind : forall u:A, R x u -> confluence u.  
   
-(** Confluence in [x] *)
+    (** Confluence in [x] *)
 
-  Variables y z : A.  
-  Hypothesis h1 : Rstar x y.  
-  Hypothesis h2 : Rstar x z.  
+    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.  
+    (** 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 : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z.
+      Proof
+       (* We draw the diagram ! *)
+      fun (v:A) (u1:R x v) (u2:Rstar v z) =>
+	ex2_ind
+	 (* local confluence in x for u,v *)
+	 (* gives w, u->*w and v->*w *)
+	(fun (w:A) (s1:Rstar u w) (s2:Rstar v w) =>
+          ex2_ind
+              (* confluence in u => coherence(y,w) *)
+              (* gives a, y->*a and z->*a *)
+          (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) =>
+            ex2_ind
+              (* confluence in v => coherence(a,z) *)
+              (* gives b, a->*b and z->*b *)
+            (fun (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).
   
-(** In the usual diagram, we assume also [x->v] and [v->*z] *)
-
-Theorem Diagram : forall (v:A) (u1:R x v) (u2:Rstar v z), coherence y z.
-
-Proof
-   (* We draw the diagram ! *)
-  fun (v:A) (u1:R x v) (u2:Rstar v z) =>
-    ex2_ind
-       (* local confluence in x for u,v *)
-       (* gives w, u->*w and v->*w *)
-      (fun (w:A) (s1:Rstar u w) (s2:Rstar v w) =>
-         ex2_ind
-            (* confluence in u => coherence(y,w) *)
-            (* gives a, y->*a and z->*a *)
-           (fun (a:A) (v1:Rstar y a) (v2:Rstar w a) =>
-              ex2_ind
-                 (* confluence in v => coherence(a,z) *)
-                 (* gives b, a->*b and z->*b *)
-                (fun (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 (fun v 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 (fun u 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 : forall x:A, confluence x.
-Proof fun x:A => Hyp1 x confluence Ind_proof.  
+      Theorem caseRxy : coherence y z.
+      Proof
+        Rstar_Rstar' x z h2 (fun v 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 (fun u 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 : forall x:A, confluence x.
+  Proof fun x:A => Hyp1 x confluence Ind_proof.  
 
 End Newman_section.
 
diff --git a/theories/Relations/Operators_Properties.v b/theories/Relations/Operators_Properties.v
index 22a08a27..40fd8f36 100644
--- a/theories/Relations/Operators_Properties.v
+++ b/theories/Relations/Operators_Properties.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Operators_Properties.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Operators_Properties.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (****************************************************************************)
 (*                            Bruno Barras                                  *)
@@ -22,75 +22,77 @@ Section Properties.
   Variable R : relation A.
 
   Let incl (R1 R2:relation A) : Prop := forall 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 in |- *.
-induction 1; auto with sets.
-intros.
-apply rt_trans with y; auto with sets.
-Qed.
-
-  Lemma clos_refl_trans_ind_left :
-   forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop),
-     P M ->
-     (forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) ->
-     forall 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 in |- *.
-induction 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 in |- *.
-induction 1; auto with sets.
-apply rst_trans with y; auto with sets.
-Qed.
-
-End Clos_Refl_Sym_Trans.
+  
+  Section Clos_Refl_Trans.
+
+    Lemma clos_rt_is_preorder : preorder A (clos_refl_trans A R).
+    Proof.
+      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).
+    Proof.
+      red in |- *.
+      induction 1; auto with sets.
+      intros.
+      apply rt_trans with y; auto with sets.
+    Qed.
+
+    Lemma clos_refl_trans_ind_left :
+      forall (A:Set) (R:A -> A -> Prop) (M:A) (P:A -> Prop),
+	P M ->
+	(forall P0 N:A, clos_refl_trans A R M P0 -> P P0 -> R P0 N -> P N) ->
+	forall a:A, clos_refl_trans A R M a -> P a.
+    Proof.
+      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).
+    Proof.
+      red in |- *.
+      induction 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).
+    Proof.
+      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).
+    Proof.
+      red in |- *.
+      induction 1; auto with sets.
+      apply rst_trans with y; auto with sets.
+    Qed.
+  
+  End Clos_Refl_Sym_Trans.
 
 End Properties.
\ No newline at end of file
diff --git a/theories/Relations/Relation_Definitions.v b/theories/Relations/Relation_Definitions.v
index 22ba7413..762da1ff 100644
--- a/theories/Relations/Relation_Definitions.v
+++ b/theories/Relations/Relation_Definitions.v
@@ -6,67 +6,66 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relation_Definitions.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Relation_Definitions.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Section Relation_Definition.
 
-   Variable A : Type.
-   
-   Definition relation := A -> A -> Prop.
+  Variable A : Type.
+  
+  Definition relation := A -> A -> Prop.
 
-   Variable R : relation.
+  Variable R : relation.
    
 
-Section General_Properties_of_Relations.
-
-  Definition reflexive : Prop := forall x:A, R x x.
-  Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z.
-  Definition symmetric : Prop := forall x y:A, R x y -> R y x.
-  Definition antisymmetric : Prop := forall 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 General_Properties_of_Relations.
+    
+    Definition reflexive : Prop := forall x:A, R x x.
+    Definition transitive : Prop := forall x y z:A, R x y -> R y z -> R x z.
+    Definition symmetric : Prop := forall x y:A, R x y -> R y x.
+    Definition antisymmetric : Prop := forall x y:A, R x y -> R y x -> x = y.
 
+    (* for compatibility with Equivalence in  ../PROGRAMS/ALG/  *)
+    Definition equiv := reflexive /\ transitive /\ symmetric.
 
-Section Sets_of_Relations.
+  End General_Properties_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 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.
+  Section Relations_of_Relations.
+    
+    Definition inclusion (R1 R2:relation) : Prop :=
+      forall x y:A, R1 x y -> R2 x y.
+    
+    Definition same_relation (R1 R2:relation) : Prop :=
+      inclusion R1 R2 /\ inclusion R2 R1.
+    
+    Definition commut (R1 R2:relation) : Prop :=
+      forall x y:A,
+	R1 y x -> forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & R1 z y'.
 
-  Definition inclusion (R1 R2:relation) : Prop :=
-    forall x y:A, R1 x y -> R2 x y.
+  End Relations_of_Relations.
 
-  Definition same_relation (R1 R2:relation) : Prop :=
-    inclusion R1 R2 /\ inclusion R2 R1.
-   
-  Definition commut (R1 R2:relation) : Prop :=
-    forall x y:A,
-      R1 y x -> forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & R1 z y'.
 
-End Relations_of_Relations.
-
-   
 End Relation_Definition.
 
 Hint Unfold reflexive transitive antisymmetric symmetric: sets v62.
@@ -75,4 +74,4 @@ Hint 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.
 
-Hint Unfold inclusion same_relation commut: sets v62.
\ No newline at end of file
+Hint Unfold inclusion same_relation commut: sets v62.
diff --git a/theories/Relations/Relation_Operators.v b/theories/Relations/Relation_Operators.v
index edc112e5..089246da 100644
--- a/theories/Relations/Relation_Operators.v
+++ b/theories/Relations/Relation_Operators.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relation_Operators.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Relation_Operators.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (****************************************************************************)
 (*                      Bruno Barras, Cristina Cornes                       *)
@@ -24,7 +24,7 @@ Require Import List.
 Section Transitive_Closure.
   Variable A : Type.
   Variable R : relation A.
-
+  
   Inductive clos_trans (x: A) : A -> Prop :=
     | t_step : forall y:A, R x y -> clos_trans x y
     | t_trans :
@@ -48,16 +48,16 @@ End Reflexive_Transitive_Closure.
 Section Reflexive_Symetric_Transitive_Closure.
   Variable A : Type.
   Variable R : relation A.
-
+  
   Inductive clos_refl_sym_trans : relation A :=
     | rst_step : forall x y:A, R x y -> clos_refl_sym_trans x y
     | rst_refl : forall x:A, clos_refl_sym_trans x x
     | rst_sym :
-        forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x
+      forall x y:A, clos_refl_sym_trans x y -> clos_refl_sym_trans y x
     | rst_trans :
-        forall x y z:A,
-          clos_refl_sym_trans x y ->
-          clos_refl_sym_trans y z -> clos_refl_sym_trans x z.
+      forall 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.
 
 
@@ -92,18 +92,18 @@ End Disjoint_Union.
 
 
 Section Lexicographic_Product.
-(* Lexicographic order on dependent pairs *)
+  (* Lexicographic order on dependent pairs *)
 
-Variable A : Set.
-Variable B : A -> Set.
-Variable leA : A -> A -> Prop.
-Variable leB : forall x:A, B x -> B x -> Prop.
+  Variable A : Set.
+  Variable B : A -> Set.
+  Variable leA : A -> A -> Prop.
+  Variable leB : forall x:A, B x -> B x -> Prop.
 
-Inductive lexprod : sigS B -> sigS B -> Prop :=
-  | left_lex :
+  Inductive lexprod : sigS B -> sigS B -> Prop :=
+    | left_lex :
       forall (x x':A) (y:B x) (y':B x'),
         leA x x' -> lexprod (existS B x y) (existS B x' y')
-  | right_lex :
+    | right_lex :
       forall (x:A) (y y':B x),
         leB x y y' -> lexprod (existS B x y) (existS B x y').
 End Lexicographic_Product.
@@ -117,9 +117,9 @@ Section Symmetric_Product.
 
   Inductive symprod : A * B -> A * B -> Prop :=
     | left_sym :
-        forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y)
+      forall x x':A, leA x x' -> forall y:B, symprod (x, y) (x', y)
     | right_sym :
-        forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y').
+      forall y y':B, leB y y' -> forall x:A, symprod (x, y) (x, y').
 
 End Symmetric_Product.
 
@@ -131,34 +131,34 @@ Section Swap.
   Inductive swapprod : A * A -> A * A -> Prop :=
     | sp_noswap : forall x x':A * A, symprod A A R R x x' -> swapprod x x'
     | sp_swap :
-        forall (x y:A) (p:A * A),
-          symprod A A R R (x, y) p -> swapprod (y, x) p.
+      forall (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.
-Let Nil := nil (A:=A).
-Let List := list A.
-
-Inductive Ltl : List -> List -> Prop :=
-  | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x)
-  | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y)
-  | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y).
-
-
-Inductive Desc : List -> Prop :=
-  | d_nil : Desc Nil
-  | d_one : forall x:A, Desc (x :: Nil)
-  | d_conc :
+  
+  Variable A : Set.
+  Variable leA : A -> A -> Prop.
+  Let Nil := nil (A:=A).
+  Let List := list A.
+  
+  Inductive Ltl : List -> List -> Prop :=
+    | Lt_nil : forall (a:A) (x:List), Ltl Nil (a :: x)
+    | Lt_hd : forall a b:A, leA a b -> forall x y:list A, Ltl (a :: x) (b :: y)
+    | Lt_tl : forall (a:A) (x y:List), Ltl x y -> Ltl (a :: x) (a :: y).
+
+
+  Inductive Desc : List -> Prop :=
+    | d_nil : Desc Nil
+    | d_one : forall x:A, Desc (x :: Nil)
+    | d_conc :
       forall (x y:A) (l:List),
         leA x y -> Desc (l ++ y :: Nil) -> Desc ((l ++ y :: Nil) ++ x :: Nil).
 
-Definition Pow : Set := sig Desc.
-
-Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b).
+  Definition Pow : Set := sig Desc.
+  
+  Definition lex_exp (a b:Pow) : Prop := Ltl (proj1_sig a) (proj1_sig b).
 
 End Lexicographic_Exponentiation.
 
diff --git a/theories/Relations/Relations.v b/theories/Relations/Relations.v
index 2df0317b..9b2f4057 100644
--- a/theories/Relations/Relations.v
+++ b/theories/Relations/Relations.v
@@ -6,23 +6,26 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Relations.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Relations.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Relation_Definitions.
 Require Export Relation_Operators.
 Require Export Operators_Properties.
 
 Lemma inverse_image_of_equivalence :
- forall (A B:Set) (f:A -> B) (r:relation B),
-   equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)).
-intros; split; elim H; red in |- *; auto.
-intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption.
+  forall (A B:Set) (f:A -> B) (r:relation B),
+    equivalence B r -> equivalence A (fun x y:A => r (f x) (f y)).
+Proof.
+  intros; split; elim H; red in |- *; auto.
+  intros _ equiv_trans _ x y z H0 H1; apply equiv_trans with (f y); assumption.
 Qed.
 
 Lemma inverse_image_of_eq :
- forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y).
-split; red in |- *;
- [  (* reflexivity *) reflexivity
- |  (* transitivity *) intros; transitivity (f y); assumption
- |  (* symmetry *) intros; symmetry  in |- *; assumption ].
-Qed.
\ No newline at end of file
+  forall (A B:Set) (f:A -> B), equivalence A (fun x y:A => f x = f y).
+Proof.
+  split; red in |- *;
+    [  (* reflexivity *) reflexivity
+      |  (* transitivity *) intros; transitivity (f y); assumption
+      |  (* symmetry *) intros; symmetry  in |- *; assumption ].
+Qed.
+
diff --git a/theories/Relations/Rstar.v b/theories/Relations/Rstar.v
index 4e62d73a..91d2aaa4 100644
--- a/theories/Relations/Rstar.v
+++ b/theories/Relations/Rstar.v
@@ -6,82 +6,89 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Rstar.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Rstar.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Properties of a binary relation [R] on type [A] *)
 
 Section Rstar.
+  
+  Variable A : Type.  
+  Variable R : A -> A -> Prop.  
 
-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) :=
-  forall P:A -> A -> Prop,
-    (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y.  
+  (** Definition of the reflexive-transitive closure [R*] of [R] *)
+  (** Smallest reflexive [P] containing [R o P] *)
 
-Theorem Rstar_reflexive : forall x:A, Rstar x x.
- Proof
-   fun (x:A) (P:A -> A -> Prop) (h1:forall u:A, P u u)
-     (h2:forall u v w:A, R u v -> P v w -> P u w) => 
-     h1 x.  
+  Definition Rstar (x y:A) :=
+    forall P:A -> A -> Prop,
+      (forall u:A, P u u) -> (forall u v w:A, R u v -> P v w -> P u w) -> P x y.  
   
-Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z.
- Proof
-   fun (x y z:A) (t1:R x y) (t2:Rstar y z) (P:A -> A -> Prop)
-     (h1:forall u:A, P u u) (h2:forall u v w:A, R u v -> P v w -> P u w) =>
-     h2 x y z t1 (t2 P h1 h2).  
+  Theorem Rstar_reflexive : forall x:A, Rstar x x.
+  Proof.
+    unfold Rstar. intros x P P_refl RoP. apply P_refl.
+  Qed.
+
+  Theorem Rstar_R : forall x y z:A, R x y -> Rstar y z -> Rstar x z.
+  Proof.
+    intros x y z R_xy Rstar_yz.
+    unfold Rstar.
+    intros P P_refl RoP. apply RoP with (v:=y).
+      assumption.
+      apply Rstar_yz; assumption.
+  Qed.
+
+  (** We conclude with transitivity of [Rstar] : *)
+
+  Theorem Rstar_transitive :
+    forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z.
+  Proof.
+    intros x y z Rstar_xy; unfold Rstar in Rstar_xy.
+    apply Rstar_xy; trivial.
+    intros u v w R_uv fz Rstar_wz.
+    apply Rstar_R with (y:=v); auto.
+  Qed.
+
+  (** Another characterization of [R*] *)
+  (** Smallest reflexive [P] containing [R o R*] *)
+
+  Definition Rstar' (x y:A) :=
+    forall P:A -> A -> Prop,
+      P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y.  
+
+  Theorem Rstar'_reflexive : forall x:A, Rstar' x x.
+  Proof.
+    unfold Rstar'; intros; assumption.
+  Qed.
   
-(** We conclude with transitivity of [Rstar] : *)
-
-Theorem Rstar_transitive :
- forall x y z:A, Rstar x y -> Rstar y z -> Rstar x z.
- Proof
-   fun (x y z:A) (h:Rstar x y) =>
-     h (fun u v:A => Rstar v z -> Rstar u z) (fun (u:A) (t:Rstar u z) => t)
-       (fun (u v 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 y:A) :=
-  forall P:A -> A -> Prop,
-    P x x -> (forall u:A, R x u -> Rstar u y -> P x y) -> P x y.  
-
-Theorem Rstar'_reflexive : forall x:A, Rstar' x x.
- Proof
-   fun (x:A) (P:A -> A -> Prop) (h:P x x)
-     (h':forall u:A, R x u -> Rstar u x -> P x x) => h.
+  Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y.
+  Proof.
+    unfold Rstar'. intros x y z Rxz Rstar_zy P Pxx RoP.
+    apply RoP with (u:=z); trivial.
+  Qed.
   
-Theorem Rstar'_R : forall x y z:A, R x z -> Rstar z y -> Rstar' x y.
- Proof
-   fun (x y z:A) (t1:R x z) (t2:Rstar z y) (P:A -> A -> Prop) 
-     (h1:P x x) (h2:forall u:A, R x u -> Rstar u y -> P x y) => 
-     h2 z t1 t2.  
+  (** Equivalence of the two definitions: *)
+
+  Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y.
+  Proof.
+    intros x z Rstar'_xz; unfold Rstar' in Rstar'_xz.
+    apply Rstar'_xz.
+      exact (Rstar_reflexive x).
+      intro y; generalize x y z; exact Rstar_R.
+  Qed.
   
-(** Equivalence of the two definitions: *)
-
-Theorem Rstar'_Rstar : forall x y:A, Rstar' x y -> Rstar x y.
- Proof
-   fun (x y:A) (h:Rstar' x y) =>
-     h Rstar (Rstar_reflexive x) (fun u:A => Rstar_R x u y).  
+  Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y.
+  Proof.
+    intros.
+    apply H.
+      exact Rstar'_reflexive.
+      intros u v  w R_uv Rs'_vw. apply Rstar'_R with (z:=v).
+        assumption.
+        apply Rstar'_Rstar; assumption.
+  Qed.
+
+  (** Property of Commutativity of two relations *)
   
-Theorem Rstar_Rstar' : forall x y:A, Rstar x y -> Rstar' x y.
- Proof
-   fun (x y:A) (h:Rstar x y) =>
-     h Rstar' (fun u:A => Rstar'_reflexive u)
-       (fun (u v 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) :=
-  forall x y:A,
-    R1 y x -> forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & R1 z y'.
-
+  Definition commut (A:Set) (R1 R2:A -> A -> Prop) :=
+    forall x y:A,
+      R1 y x -> forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & R1 z y'.
 
 End Rstar.
diff --git a/theories/Setoids/Setoid.v b/theories/Setoids/Setoid.v
index b670fc19..84af7d5d 100644
--- a/theories/Setoids/Setoid.v
+++ b/theories/Setoids/Setoid.v
@@ -7,13 +7,13 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Setoid.v 8866 2006-05-28 16:21:04Z herbelin $: i*)
+(*i $Id: Setoid.v 9245 2006-10-17 12:53:34Z notin $: i*)
 
 Require Export Relation_Definitions.
 
 Set Implicit Arguments.
 
-(* DEFINITIONS OF Relation_Class AND n-ARY Morphism_Theory *)
+(** * Definitions of [Relation_Class] and n-ary [Morphism_Theory] *)
 
 (* X will be used to distinguish covariant arguments whose type is an   *)
 (* Asymmetric* relation from contravariant arguments of the same type *)
@@ -46,50 +46,50 @@ Inductive Areflexive_Relation_Class  : Type :=
 Implicit Type Hole Out: Relation_Class.
 
 Definition relation_class_of_argument_class : Argument_Class -> Relation_Class.
- destruct 1.
- exact (SymmetricReflexive _ s r).
- exact (AsymmetricReflexive tt r).
- exact (SymmetricAreflexive _ s).
- exact (AsymmetricAreflexive tt Aeq).
- exact (Leibniz _ T).
+  destruct 1.
+  exact (SymmetricReflexive _ s r).
+  exact (AsymmetricReflexive tt r).
+  exact (SymmetricAreflexive _ s).
+  exact (AsymmetricAreflexive tt Aeq).
+  exact (Leibniz _ T).
 Defined.
 
 Definition carrier_of_relation_class : forall X, X_Relation_Class X -> Type.
- destruct 1.
- exact A.
- exact A.
- exact A.
- exact A.
- exact T.
+  destruct 1.
+  exact A.
+  exact A.
+  exact A.
+  exact A.
+  exact T.
 Defined.
 
 Definition relation_of_relation_class :
- forall X R, @carrier_of_relation_class X R -> carrier_of_relation_class R -> Prop.
- destruct R.
- exact Aeq.
- exact Aeq.
- exact Aeq.
- exact Aeq.
- exact (@eq T).
+  forall X R, @carrier_of_relation_class X R -> carrier_of_relation_class R -> Prop.
+  destruct R.
+  exact Aeq.
+  exact Aeq.
+  exact Aeq.
+  exact Aeq.
+  exact (@eq T).
 Defined.
 
 Lemma about_carrier_of_relation_class_and_relation_class_of_argument_class :
- forall R,
-  carrier_of_relation_class (relation_class_of_argument_class R) =
-   carrier_of_relation_class R.
- destruct R; reflexivity.
- Defined.
+  forall R,
+    carrier_of_relation_class (relation_class_of_argument_class R) =
+    carrier_of_relation_class R.
+  destruct R; reflexivity.
+Defined.
 
 Inductive nelistT (A : Type) : Type :=
    singl : A -> nelistT A
- | cons : A -> nelistT A -> nelistT A.
+ | necons : A -> nelistT A -> nelistT A.
 
 Definition Arguments := nelistT Argument_Class.
 
 Implicit Type In: Arguments.
 
 Definition function_type_of_morphism_signature :
- Arguments -> Relation_Class -> Type.
+  Arguments -> Relation_Class -> Type.
   intros In Out.
   induction In.
     exact (carrier_of_relation_class a -> carrier_of_relation_class Out).
@@ -97,12 +97,12 @@ Definition function_type_of_morphism_signature :
 Defined. 
 
 Definition make_compatibility_goal_aux:
- forall In Out
-  (f g: function_type_of_morphism_signature In Out), Prop.
- intros; induction In; simpl in f, g.
-   induction a; simpl in f, g.
-     exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)).
-     destruct x.
+  forall In Out
+    (f g: function_type_of_morphism_signature In Out), Prop.
+  intros; induction In; simpl in f, g.
+    induction a; simpl in f, g.
+      exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)).
+      destruct x.
         exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)).
         exact (forall x1 x2, Aeq x2 x1 -> relation_of_relation_class Out (f x1) (g x2)).
       exact (forall x1 x2, Aeq x1 x2 -> relation_of_relation_class Out (f x1) (g x2)).
@@ -113,35 +113,58 @@ Definition make_compatibility_goal_aux:
   induction a; simpl in f, g.
     exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
     destruct x.
-       exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
-       exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)).
+      exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
+      exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)).
     exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
     destruct x.
-       exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
-       exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)).
+      exact (forall x1 x2, Aeq x1 x2 -> IHIn (f x1) (g x2)).
+      exact (forall x1 x2, Aeq x2 x1 -> IHIn (f x1) (g x2)).
     exact (forall x, IHIn (f x) (g x)).
 Defined. 
 
 Definition make_compatibility_goal :=
- (fun In Out f => make_compatibility_goal_aux In Out f f).
+  (fun In Out f => make_compatibility_goal_aux In Out f f).
 
 Record Morphism_Theory In Out : Type :=
-   {Function : function_type_of_morphism_signature In Out;
-    Compat : make_compatibility_goal In Out Function}.
+  { Function : function_type_of_morphism_signature In Out;
+    Compat : make_compatibility_goal In Out Function }.
+
+(** The [iff] relation class *)
+
+Definition Iff_Relation_Class : Relation_Class.
+  eapply (@SymmetricReflexive unit _ iff).
+  exact iff_sym.
+  exact iff_refl.
+Defined.
+
+(** The [impl] relation class *)
+
+Definition impl (A B: Prop) := A -> B.
+
+Theorem impl_refl: reflexive _ impl.
+Proof.
+  hnf; unfold impl; tauto.
+Qed.
+
+Definition Impl_Relation_Class : Relation_Class.
+  eapply (@AsymmetricReflexive unit tt _ impl).
+  exact impl_refl.
+Defined.
+
+(** Every function is a morphism from Leibniz+ to Leibniz *)
 
 Definition list_of_Leibniz_of_list_of_types: nelistT Type -> Arguments.
  induction 1.
    exact (singl (Leibniz _ a)).
-   exact (cons (Leibniz _ a) IHX).
+   exact (necons (Leibniz _ a) IHX).
 Defined.
 
-(* every function is a morphism from Leibniz+ to Leibniz *)
 Definition morphism_theory_of_function :
- forall (In: nelistT Type) (Out: Type),
-  let In' := list_of_Leibniz_of_list_of_types In in
-  let Out' := Leibniz _ Out in
-   function_type_of_morphism_signature In' Out' ->
-    Morphism_Theory In' Out'.
+  forall (In: nelistT Type) (Out: Type),
+    let In' := list_of_Leibniz_of_list_of_types In in
+      let Out' := Leibniz _ Out in
+	function_type_of_morphism_signature In' Out' ->
+	Morphism_Theory In' Out'.
   intros.
   exists X.
   induction In;  unfold make_compatibility_goal; simpl.
@@ -149,33 +172,26 @@ Definition morphism_theory_of_function :
     intro; apply (IHIn (X x)).
 Defined.
 
-(* THE iff RELATION CLASS *)
-
-Definition Iff_Relation_Class : Relation_Class.
- eapply (@SymmetricReflexive unit _ iff).
- exact iff_sym.
- exact iff_refl.
-Defined.
-
-(* THE impl RELATION CLASS *)
+(** Every predicate is a morphism from Leibniz+ to Iff_Relation_Class *)
 
-Definition impl (A B: Prop) := A -> B.
-
-Theorem impl_refl: reflexive _ impl.
- hnf; unfold impl; tauto.
-Qed.
-
-Definition Impl_Relation_Class : Relation_Class.
- eapply (@AsymmetricReflexive unit tt _ impl).
- exact impl_refl.
+Definition morphism_theory_of_predicate :
+  forall (In: nelistT Type),
+    let In' := list_of_Leibniz_of_list_of_types In in
+      function_type_of_morphism_signature In' Iff_Relation_Class ->
+      Morphism_Theory In' Iff_Relation_Class.
+  intros.
+  exists X.
+  induction In;  unfold make_compatibility_goal; simpl.
+    intro; apply iff_refl.
+    intro; apply (IHIn (X x)).
 Defined.
 
-(* UTILITY FUNCTIONS TO PROVE THAT EVERY TRANSITIVE RELATION IS A MORPHISM *)
+(** * Utility functions to prove that every transitive relation is a morphism *)
 
 Definition equality_morphism_of_symmetric_areflexive_transitive_relation:
  forall (A: Type)(Aeq: relation A)(sym: symmetric _ Aeq)(trans: transitive _ Aeq),
   let ASetoidClass := SymmetricAreflexive _ sym in
-   (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class).
+   (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class).
  intros.
  exists Aeq.
  unfold make_compatibility_goal; simpl; split; eauto.
@@ -184,7 +200,7 @@ Defined.
 Definition equality_morphism_of_symmetric_reflexive_transitive_relation:
  forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(sym: symmetric _ Aeq)
   (trans: transitive _ Aeq), let ASetoidClass := SymmetricReflexive _ sym refl in
-   (Morphism_Theory (cons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class).
+   (Morphism_Theory (necons ASetoidClass (singl ASetoidClass)) Iff_Relation_Class).
  intros.
  exists Aeq.
  unfold make_compatibility_goal; simpl; split; eauto.
@@ -194,7 +210,7 @@ Definition equality_morphism_of_asymmetric_areflexive_transitive_relation:
  forall (A: Type)(Aeq: relation A)(trans: transitive _ Aeq),
   let ASetoidClass1 := AsymmetricAreflexive Contravariant Aeq in
   let ASetoidClass2 := AsymmetricAreflexive Covariant Aeq in
-   (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class).
+   (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class).
  intros.
  exists Aeq.
  unfold make_compatibility_goal; simpl; unfold impl; eauto.
@@ -204,120 +220,154 @@ Definition equality_morphism_of_asymmetric_reflexive_transitive_relation:
  forall (A: Type)(Aeq: relation A)(refl: reflexive _ Aeq)(trans: transitive _ Aeq),
   let ASetoidClass1 := AsymmetricReflexive Contravariant refl in
   let ASetoidClass2 := AsymmetricReflexive Covariant refl in
-   (Morphism_Theory (cons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class).
+   (Morphism_Theory (necons ASetoidClass1 (singl ASetoidClass2)) Impl_Relation_Class).
  intros.
  exists Aeq.
  unfold make_compatibility_goal; simpl; unfold impl; eauto.
 Defined.
 
-(* iff AS A RELATION *)
+(** * A few examples on [iff] *)
 
-Add Relation Prop iff
- reflexivity proved by iff_refl
- symmetry proved by iff_sym
- transitivity proved by iff_trans
- as iff_relation.
+(** [iff] as a relation *)
 
-(* every predicate is  morphism from Leibniz+ to Iff_Relation_Class *)
-Definition morphism_theory_of_predicate :
- forall (In: nelistT Type),
-  let In' := list_of_Leibniz_of_list_of_types In in
-   function_type_of_morphism_signature In' Iff_Relation_Class ->
-    Morphism_Theory In' Iff_Relation_Class.
-  intros.
-  exists X.
-  induction In;  unfold make_compatibility_goal; simpl.
-    intro; apply iff_refl.
-    intro; apply (IHIn (X x)).
-Defined.
+Add Relation Prop iff
+  reflexivity proved by iff_refl
+  symmetry proved by iff_sym
+  transitivity proved by iff_trans
+as iff_relation.
 
-(* impl AS A RELATION *)
+(** [impl] as a relation *)
 
 Theorem impl_trans: transitive _ impl.
- hnf; unfold impl; tauto.
+Proof.
+  hnf; unfold impl; tauto.
 Qed.
 
 Add Relation Prop impl
- reflexivity proved by impl_refl
- transitivity proved by impl_trans
- as impl_relation.
+  reflexivity proved by impl_refl
+  transitivity proved by impl_trans
+as impl_relation.
+
+(** [impl] is a morphism *)
+
+Add Morphism impl with signature iff ==> iff ==> iff as Impl_Morphism.
+Proof.
+  unfold impl; tauto.
+Qed.
+
+(** [and] is a morphism *)
+
+Add Morphism and with signature iff ==> iff ==> iff as And_Morphism.
+ tauto.
+Qed.
+
+(** [or] is a morphism *)
 
-(* THE CIC PART OF THE REFLEXIVE TACTIC (SETOID REWRITE) *)
+Add Morphism or with signature iff ==> iff ==> iff as Or_Morphism.
+Proof.
+  tauto.
+Qed.
+
+(** [not] is a morphism *)
+
+Add Morphism not with signature iff ==> iff as Not_Morphism.
+Proof.
+  tauto.
+Qed.
+
+(** The same examples on [impl] *)
+
+Add Morphism and with signature impl ++> impl ++> impl as And_Morphism2.
+Proof.
+  unfold impl; tauto.
+Qed.
+
+Add Morphism or with signature impl ++> impl ++> impl as Or_Morphism2.
+Proof.
+  unfold impl; tauto.
+Qed.
+
+Add Morphism not with signature impl --> impl as Not_Morphism2.
+Proof.
+  unfold impl; tauto.
+Qed.
+
+(** * The CIC part of the reflexive tactic ([setoid_rewrite]) *)
 
 Inductive rewrite_direction : Type :=
-   Left2Right
- | Right2Left.
+  | Left2Right
+  | Right2Left.
 
 Implicit Type dir: rewrite_direction.
 
 Definition variance_of_argument_class : Argument_Class -> option variance.
- destruct 1.
- exact None.
- exact (Some v).
- exact None.
- exact (Some v).
- exact None.
+  destruct 1.
+  exact None.
+  exact (Some v).
+  exact None.
+  exact (Some v).
+  exact None.
 Defined.
 
 Definition opposite_direction :=
- fun dir =>
-   match dir with
-       Left2Right => Right2Left
-     | Right2Left => Left2Right
+  fun dir =>
+    match dir with
+      | Left2Right => Right2Left
+      | Right2Left => Left2Right
    end.
 
 Lemma opposite_direction_idempotent:
- forall dir, (opposite_direction (opposite_direction dir)) = dir.
+  forall dir, (opposite_direction (opposite_direction dir)) = dir.
+Proof.
   destruct dir; reflexivity.
 Qed.
 
 Inductive check_if_variance_is_respected :
- option variance -> rewrite_direction -> rewrite_direction ->  Prop
-:=
-   MSNone : forall dir dir', check_if_variance_is_respected None dir dir'
- | MSCovariant : forall dir, check_if_variance_is_respected (Some Covariant) dir dir
- | MSContravariant :
-     forall dir,
+  option variance -> rewrite_direction -> rewrite_direction ->  Prop :=
+  | MSNone : forall dir dir', check_if_variance_is_respected None dir dir'
+  | MSCovariant : forall dir, check_if_variance_is_respected (Some Covariant) dir dir
+  | MSContravariant :
+    forall dir,
       check_if_variance_is_respected (Some Contravariant) dir (opposite_direction dir).
 
 Definition relation_class_of_reflexive_relation_class:
- Reflexive_Relation_Class -> Relation_Class.
- induction 1.
-   exact (SymmetricReflexive _ s r).
-   exact (AsymmetricReflexive tt r).
-   exact (Leibniz _ T).
+  Reflexive_Relation_Class -> Relation_Class.
+  induction 1.
+  exact (SymmetricReflexive _ s r).
+  exact (AsymmetricReflexive tt r).
+  exact (Leibniz _ T).
 Defined.
 
 Definition relation_class_of_areflexive_relation_class:
- Areflexive_Relation_Class -> Relation_Class.
- induction 1.
-   exact (SymmetricAreflexive _ s).
-   exact (AsymmetricAreflexive tt Aeq).
+  Areflexive_Relation_Class -> Relation_Class.
+  induction 1.
+    exact (SymmetricAreflexive _ s).
+    exact (AsymmetricAreflexive tt Aeq).
 Defined.
 
 Definition carrier_of_reflexive_relation_class :=
- fun R => carrier_of_relation_class (relation_class_of_reflexive_relation_class R).
+  fun R => carrier_of_relation_class (relation_class_of_reflexive_relation_class R).
 
 Definition carrier_of_areflexive_relation_class :=
- fun R => carrier_of_relation_class (relation_class_of_areflexive_relation_class R).
+  fun R => carrier_of_relation_class (relation_class_of_areflexive_relation_class R).
 
 Definition relation_of_areflexive_relation_class :=
- fun R => relation_of_relation_class (relation_class_of_areflexive_relation_class R).
+  fun R => relation_of_relation_class (relation_class_of_areflexive_relation_class R).
 
 Inductive Morphism_Context Hole dir : Relation_Class -> rewrite_direction ->  Type :=
-    App :
-      forall In Out dir',
-        Morphism_Theory In Out -> Morphism_Context_List Hole dir dir' In ->
-           Morphism_Context Hole dir Out dir'
+  | App :
+    forall In Out dir',
+      Morphism_Theory In Out -> Morphism_Context_List Hole dir dir' In ->
+      Morphism_Context Hole dir Out dir'
   | ToReplace : Morphism_Context Hole dir Hole dir
   | ToKeep :
-     forall S dir',
+    forall S dir',
       carrier_of_reflexive_relation_class S ->
-        Morphism_Context Hole dir (relation_class_of_reflexive_relation_class S) dir'
- | ProperElementToKeep :
-     forall S dir' (x: carrier_of_areflexive_relation_class S),
+      Morphism_Context Hole dir (relation_class_of_reflexive_relation_class S) dir'
+  | ProperElementToKeep :
+    forall S dir' (x: carrier_of_areflexive_relation_class S),
       relation_of_areflexive_relation_class S x x ->
-        Morphism_Context Hole dir (relation_class_of_areflexive_relation_class S) dir'
+      Morphism_Context Hole dir (relation_class_of_areflexive_relation_class S) dir'
 with Morphism_Context_List Hole dir :
    rewrite_direction -> Arguments -> Type
 :=
@@ -331,53 +381,53 @@ with Morphism_Context_List Hole dir :
        check_if_variance_is_respected (variance_of_argument_class S) dir' dir'' ->
         Morphism_Context Hole dir (relation_class_of_argument_class S) dir' ->
          Morphism_Context_List Hole dir dir'' L ->
-          Morphism_Context_List Hole dir dir'' (cons S L).
+          Morphism_Context_List Hole dir dir'' (necons S L).
 
 Scheme Morphism_Context_rect2 := Induction for Morphism_Context  Sort Type
 with Morphism_Context_List_rect2 := Induction for Morphism_Context_List Sort Type.
 
 Definition product_of_arguments : Arguments -> Type.
- induction 1.
-   exact (carrier_of_relation_class a).
-   exact (prod (carrier_of_relation_class a) IHX).
+  induction 1.
+  exact (carrier_of_relation_class a).
+  exact (prod (carrier_of_relation_class a) IHX).
 Defined.
 
 Definition get_rewrite_direction: rewrite_direction -> Argument_Class -> rewrite_direction.
- intros dir R.
-destruct (variance_of_argument_class R).
-   destruct v.
-     exact dir.                                      (* covariant *)
-     exact (opposite_direction dir). (* contravariant *)
-   exact dir.                                       (* symmetric relation *)
+  intros dir R.
+  destruct (variance_of_argument_class R).
+  destruct v.
+    exact dir.                      (* covariant *)
+    exact (opposite_direction dir). (* contravariant *)
+   exact dir.                       (* symmetric relation *)
 Defined.
 
 Definition directed_relation_of_relation_class:
- forall dir (R: Relation_Class),
-   carrier_of_relation_class R -> carrier_of_relation_class R -> Prop.
- destruct 1.
-   exact (@relation_of_relation_class unit).
-   intros; exact (relation_of_relation_class _ X0 X).
+  forall dir (R: Relation_Class),
+    carrier_of_relation_class R -> carrier_of_relation_class R -> Prop.
+  destruct 1.
+    exact (@relation_of_relation_class unit).
+    intros; exact (relation_of_relation_class _ X0 X).
 Defined.
 
 Definition directed_relation_of_argument_class:
- forall dir (R: Argument_Class),
-   carrier_of_relation_class R -> carrier_of_relation_class R -> Prop.
+  forall dir (R: Argument_Class),
+    carrier_of_relation_class R -> carrier_of_relation_class R -> Prop.
   intros dir R.
   rewrite <-
-   (about_carrier_of_relation_class_and_relation_class_of_argument_class R).
+    (about_carrier_of_relation_class_and_relation_class_of_argument_class R).
   exact (directed_relation_of_relation_class dir (relation_class_of_argument_class R)).
 Defined.
 
 
 Definition relation_of_product_of_arguments:
- forall dir In,
-  product_of_arguments In -> product_of_arguments In -> Prop.
- induction In.
-   simpl.
-   exact (directed_relation_of_argument_class (get_rewrite_direction dir a) a).
-
-   simpl; intros.
-   destruct X; destruct X0.
+  forall dir In,
+    product_of_arguments In -> product_of_arguments In -> Prop.
+  induction In.
+    simpl.
+      exact (directed_relation_of_argument_class (get_rewrite_direction dir a) a).
+
+    simpl; intros.
+      destruct X; destruct X0.
    apply and.
      exact
       (directed_relation_of_argument_class (get_rewrite_direction dir a) a c c0).
@@ -385,32 +435,32 @@ Definition relation_of_product_of_arguments:
 Defined. 
 
 Definition apply_morphism:
- forall In Out (m: function_type_of_morphism_signature In Out)
-  (args: product_of_arguments In), carrier_of_relation_class Out.
- intros.
- induction In.
-   exact (m args).
-   simpl in m, args.
-   destruct args.
-   exact (IHIn (m c) p).
+  forall In Out (m: function_type_of_morphism_signature In Out)
+    (args: product_of_arguments In), carrier_of_relation_class Out.
+  intros.
+  induction In.
+    exact (m args).
+    simpl in m, args.
+    destruct args.
+    exact (IHIn (m c) p).
 Defined.
 
 Theorem apply_morphism_compatibility_Right2Left:
- forall In Out (m1 m2: function_type_of_morphism_signature In Out)
-   (args1 args2: product_of_arguments In),
-     make_compatibility_goal_aux _ _ m1 m2 ->
-      relation_of_product_of_arguments Right2Left _ args1 args2 ->
-        directed_relation_of_relation_class Right2Left _
-         (apply_morphism _ _ m2 args1)
-         (apply_morphism _ _ m1 args2).
+  forall In Out (m1 m2: function_type_of_morphism_signature In Out)
+    (args1 args2: product_of_arguments In),
+    make_compatibility_goal_aux _ _ m1 m2 ->
+    relation_of_product_of_arguments Right2Left _ args1 args2 ->
+    directed_relation_of_relation_class Right2Left _
+    (apply_morphism _ _ m2 args1)
+    (apply_morphism _ _ m1 args2).
   induction In; intros.
     simpl in m1, m2, args1, args2, H0 |- *.
     destruct a; simpl in H; hnf in H0.
-          apply H; exact H0.
-          destruct v; simpl in H0; apply H; exact H0.
-          apply H; exact H0.
-          destruct v; simpl in H0; apply H; exact H0.
-          rewrite H0; apply H; exact H0.
+      apply H; exact H0.
+      destruct v; simpl in H0; apply H; exact H0.
+      apply H; exact H0.
+      destruct v; simpl in H0; apply H; exact H0.
+      rewrite H0; apply H; exact H0.
 
    simpl in m1, m2, args1, args2, H0 |- *.
    destruct args1; destruct args2; simpl.
@@ -443,46 +493,47 @@ Theorem apply_morphism_compatibility_Right2Left:
 Qed.
 
 Theorem apply_morphism_compatibility_Left2Right:
- forall In Out (m1 m2: function_type_of_morphism_signature In Out)
-   (args1 args2: product_of_arguments In),
-     make_compatibility_goal_aux _ _ m1 m2 ->
-      relation_of_product_of_arguments Left2Right _ args1 args2 ->
-        directed_relation_of_relation_class Left2Right _
-         (apply_morphism _ _ m1 args1)
-         (apply_morphism _ _ m2 args2).
+  forall In Out (m1 m2: function_type_of_morphism_signature In Out)
+    (args1 args2: product_of_arguments In),
+    make_compatibility_goal_aux _ _ m1 m2 ->
+    relation_of_product_of_arguments Left2Right _ args1 args2 ->
+    directed_relation_of_relation_class Left2Right _
+    (apply_morphism _ _ m1 args1)
+    (apply_morphism _ _ m2 args2).
+Proof.
   induction In; intros.
     simpl in m1, m2, args1, args2, H0 |- *.
     destruct a; simpl in H; hnf in H0.
+      apply H; exact H0.
+      destruct v; simpl in H0; apply H; exact H0.
+      apply H; exact H0.
+      destruct v; simpl in H0; apply H; exact H0.
+      rewrite H0; apply H; exact H0.
+
+  simpl in m1, m2, args1, args2, H0 |- *.
+    destruct args1; destruct args2; simpl.
+    destruct H0.
+    simpl in H.
+    destruct a; simpl in H.
+      apply IHIn.
+        apply H; exact H0.
+        exact H1.
+      destruct v.
+        apply IHIn.
           apply H; exact H0.
-          destruct v; simpl in H0; apply H; exact H0.
-          apply H; exact H0.
-          destruct v; simpl in H0; apply H; exact H0.
-          rewrite H0; apply H; exact H0.
-
-    simpl in m1, m2, args1, args2, H0 |- *.
-   destruct args1; destruct args2; simpl.
-   destruct H0.
-   simpl in H.
-   destruct a; simpl in H.
-     apply IHIn.
-       apply H; exact H0.
-       exact H1.
-     destruct v.
-       apply IHIn.
-         apply H; exact H0.
-         exact H1.
-       apply IHIn.
-         apply H; exact H0.       
           exact H1.
-       apply IHIn.
-         apply H; exact H0.
-         exact H1.
-       apply IHIn.
-         destruct v; simpl in H, H0; apply H; exact H0. 
+        apply IHIn.
+          apply H; exact H0.       
+           exact H1.
+        apply IHIn.
+          apply H; exact H0.
           exact H1.
-    rewrite H0; apply IHIn.
-      apply H.
-      exact H1.
+        apply IHIn.
+          destruct v; simpl in H, H0; apply H; exact H0. 
+            exact H1.
+      rewrite H0; apply IHIn.
+        apply H.
+        exact H1.
 Qed.
 
 Definition interp :
@@ -508,83 +559,84 @@ Definition interp :
        exact X0.
 Defined.
 
-(*CSC: interp and interp_relation_class_list should be mutually defined, since
+(* CSC: interp and interp_relation_class_list should be mutually defined, since
    the proof term of each one contains the proof term of the other one. However
    I cannot do that interactively (I should write the Fix by hand) *)
 Definition interp_relation_class_list :
- forall Hole dir dir' (L: Arguments), carrier_of_relation_class Hole ->
-  Morphism_Context_List Hole dir dir' L -> product_of_arguments L.
- intros Hole dir dir' L H t.
- elim t using
-  (@Morphism_Context_List_rect2 Hole dir (fun S _ _ => carrier_of_relation_class S)
-    (fun _ L fcl => product_of_arguments L));
- intros.
-   exact (apply_morphism _ _ (Function m) X).
-   exact H.
-   exact c.
-   exact x.
-   simpl;
-     rewrite <-
-       (about_carrier_of_relation_class_and_relation_class_of_argument_class S);
-     exact X.
-   split.
-     rewrite <-
-       (about_carrier_of_relation_class_and_relation_class_of_argument_class S);
-       exact X.
-       exact X0.
+  forall Hole dir dir' (L: Arguments), carrier_of_relation_class Hole ->
+    Morphism_Context_List Hole dir dir' L -> product_of_arguments L.
+  intros Hole dir dir' L H t.
+  elim t using
+    (@Morphism_Context_List_rect2 Hole dir (fun S _ _ => carrier_of_relation_class S)
+      (fun _ L fcl => product_of_arguments L));
+    intros.
+  exact (apply_morphism _ _ (Function m) X).
+  exact H.
+  exact c.
+  exact x.
+  simpl;
+    rewrite <-
+      (about_carrier_of_relation_class_and_relation_class_of_argument_class S);
+      exact X.
+  split.
+  rewrite <-
+    (about_carrier_of_relation_class_and_relation_class_of_argument_class S);
+    exact X.
+  exact X0.
 Defined.
 
 Theorem setoid_rewrite:
- forall Hole dir Out dir' (E1 E2: carrier_of_relation_class Hole)
-  (E: Morphism_Context Hole dir Out dir'),
-   (directed_relation_of_relation_class dir Hole E1 E2) ->
+  forall Hole dir Out dir' (E1 E2: carrier_of_relation_class Hole)
+    (E: Morphism_Context Hole dir Out dir'),
+    (directed_relation_of_relation_class dir Hole E1 E2) ->
     (directed_relation_of_relation_class dir' Out (interp E1 E) (interp E2 E)).
- intros.
- elim E using
-   (@Morphism_Context_rect2 Hole dir
-     (fun S dir'' E => directed_relation_of_relation_class dir'' S (interp E1 E) (interp E2 E))
-     (fun dir'' L fcl =>
+Proof.
+  intros.
+  elim E using
+    (@Morphism_Context_rect2 Hole dir
+      (fun S dir'' E => directed_relation_of_relation_class dir'' S (interp E1 E) (interp E2 E))
+      (fun dir'' L fcl =>
         relation_of_product_of_arguments dir'' _
-         (interp_relation_class_list E1 fcl)
-         (interp_relation_class_list E2 fcl))); intros.
-   change (directed_relation_of_relation_class dir'0 Out0
+        (interp_relation_class_list E1 fcl)
+        (interp_relation_class_list E2 fcl))); intros.
+  change (directed_relation_of_relation_class dir'0 Out0
     (apply_morphism _ _ (Function m) (interp_relation_class_list E1 m0))
     (apply_morphism _ _ (Function m) (interp_relation_class_list E2 m0))).
-   destruct dir'0.
-     apply apply_morphism_compatibility_Left2Right.
-       exact (Compat m).
-       exact H0.
-     apply apply_morphism_compatibility_Right2Left.
-       exact (Compat m).
-       exact H0.
-
-   exact H.
-
-   unfold interp, Morphism_Context_rect2.
-   (*CSC: reflexivity used here*)
-   destruct S; destruct dir'0; simpl; (apply r || reflexivity).
-
-   destruct dir'0; exact r.
+  destruct dir'0.
+    apply apply_morphism_compatibility_Left2Right.
+      exact (Compat m).
+      exact H0.
+    apply apply_morphism_compatibility_Right2Left.
+      exact (Compat m).
+      exact H0.
+
+  exact H.
+
+  unfold interp, Morphism_Context_rect2.
+  (* CSC: reflexivity used here *)
+  destruct S; destruct dir'0; simpl; (apply r || reflexivity).
+  
+  destruct dir'0; exact r.
 
   destruct S; unfold directed_relation_of_argument_class; simpl in H0 |- *;
-   unfold get_rewrite_direction; simpl.
-     destruct dir'0; destruct dir'';
-       (exact H0 ||
-        unfold directed_relation_of_argument_class; simpl; apply s; exact H0).
-     (* the following mess with generalize/clear/intros is to help Coq resolving *)
-     (* second order unification problems.                                                                *)
-     generalize m c H0; clear H0 m c; inversion c;
-       generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros;
-         (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3).
-     destruct dir'0; destruct dir'';
-       (exact H0 ||
-        unfold directed_relation_of_argument_class; simpl; apply s; exact H0).
-(* the following mess with generalize/clear/intros is to help Coq resolving *)
-     (* second order unification problems.                                                                *)
-     generalize m c H0; clear H0 m c; inversion c;
-       generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros;
-         (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3).
-     destruct dir'0; destruct dir''; (exact H0 || hnf; symmetry; exact H0).
+    unfold get_rewrite_direction; simpl.
+  destruct dir'0; destruct dir'';
+    (exact H0 ||
+      unfold directed_relation_of_argument_class; simpl; apply s; exact H0).
+  (* the following mess with generalize/clear/intros is to help Coq resolving *)
+  (* second order unification problems.                                       *)
+  generalize m c H0; clear H0 m c; inversion c;
+    generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros;
+      (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3).
+  destruct dir'0; destruct dir'';
+    (exact H0 ||
+      unfold directed_relation_of_argument_class; simpl; apply s; exact H0).
+  (* the following mess with generalize/clear/intros is to help Coq resolving *)
+  (* second order unification problems.                                       *)
+  generalize m c H0; clear H0 m c; inversion c;
+    generalize m c; clear m c; rewrite <- H1; rewrite <- H2; intros;
+      (exact H3 || rewrite (opposite_direction_idempotent dir'0); apply H3).
+  destruct dir'0; destruct dir''; (exact H0 || hnf; symmetry; exact H0).
 
   change
     (directed_relation_of_argument_class (get_rewrite_direction dir'' S) S
@@ -592,96 +644,57 @@ Theorem setoid_rewrite:
          (about_carrier_of_relation_class_and_relation_class_of_argument_class S))
        (eq_rect _ (fun T : Type => T) (interp E2 m) _
          (about_carrier_of_relation_class_and_relation_class_of_argument_class S)) /\
-     relation_of_product_of_arguments dir'' _
+       relation_of_product_of_arguments dir'' _
        (interp_relation_class_list E1 m0) (interp_relation_class_list E2 m0)).
-   split.
-     clear m0 H1; destruct S; simpl in H0 |- *; unfold get_rewrite_direction; simpl.
-        destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0).
-        inversion c.
-          rewrite <- H3; exact H0.
-          rewrite (opposite_direction_idempotent dir'0); exact H0.
-        destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0).
-        inversion c.
-          rewrite <- H3; exact H0.
-          rewrite (opposite_direction_idempotent dir'0); exact H0.
-        destruct dir''; destruct dir'0; (exact H0 || hnf; symmetry; exact H0).
-     exact H1.
-Qed.
-
-(* BEGIN OF UTILITY/BACKWARD COMPATIBILITY PART *)
+  split.
+  clear m0 H1; destruct S; simpl in H0 |- *; unfold get_rewrite_direction; simpl.
+    destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0).
+      inversion c.
+        rewrite <- H3; exact H0.
+        rewrite (opposite_direction_idempotent dir'0); exact H0.
+      destruct dir''; destruct dir'0; (exact H0 || hnf; apply s; exact H0).
+      inversion c.
+        rewrite <- H3; exact H0.
+        rewrite (opposite_direction_idempotent dir'0); exact H0.
+      destruct dir''; destruct dir'0; (exact H0 || hnf; symmetry; exact H0).
+    exact H1.
+  Qed.
+
+(** * Miscelenous *)
+
+(** For backwark compatibility *)
 
 Record Setoid_Theory  (A: Type) (Aeq: relation A) : Prop := 
-  {Seq_refl : forall x:A, Aeq x x;
-   Seq_sym : forall x y:A, Aeq x y -> Aeq y x;
-   Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z}.
-
-(* END OF UTILITY/BACKWARD COMPATIBILITY PART *)
-
-(* A FEW EXAMPLES ON iff *)
-
-(* impl IS A MORPHISM *)
+  { Seq_refl : forall x:A, Aeq x x;
+    Seq_sym : forall x y:A, Aeq x y -> Aeq y x;
+    Seq_trans : forall x y z:A, Aeq x y -> Aeq y z -> Aeq x z }.
 
-Add Morphism impl with signature iff ==> iff ==> iff as Impl_Morphism.
-unfold impl; tauto.
-Qed.
-
-(* and IS A MORPHISM *)
-
-Add Morphism and with signature iff ==> iff ==> iff as And_Morphism.
- tauto.
-Qed.
-
-(* or IS A MORPHISM *)
-
-Add Morphism or with signature iff ==> iff ==> iff as Or_Morphism.
- tauto.
-Qed.
-
-(* not IS A MORPHISM *)
-
-Add Morphism not with signature iff ==> iff as Not_Morphism.
- tauto.
-Qed.
-
-(* THE SAME EXAMPLES ON impl *)
-
-Add Morphism and with signature impl ++> impl ++> impl as And_Morphism2.
- unfold impl; tauto.
-Qed.
-
-Add Morphism or with signature impl ++> impl ++> impl as Or_Morphism2.
- unfold impl; tauto.
-Qed.
-
-Add Morphism not with signature impl --> impl as Not_Morphism2.
- unfold impl; tauto.
-Qed.
-
-(* FOR BACKWARD COMPATIBILITY *)
 Implicit Arguments Setoid_Theory [].
 Implicit Arguments Seq_refl [].
 Implicit Arguments Seq_sym [].
 Implicit Arguments Seq_trans [].
 
 
-(* Some tactics for manipulating Setoid Theory not officially 
-   declared as Setoid. *)
+(** Some tactics for manipulating Setoid Theory not officially 
+    declared as Setoid. *)
 
 Ltac trans_st x := match goal with 
-  | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
-     apply (Seq_trans _ _ H) with x; auto
- end.
+		     | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
+		       apply (Seq_trans _ _ H) with x; auto
+		   end.
 
 Ltac sym_st := match goal with 
-  | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
-     apply (Seq_sym _ _ H); auto
- end.
+		 | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
+		   apply (Seq_sym _ _ H); auto
+	       end.
 
 Ltac refl_st := match goal with 
-  | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
-     apply (Seq_refl _ _ H); auto
- end.
+		  | H : Setoid_Theory _ ?eqA |- ?eqA _ _ => 
+		    apply (Seq_refl _ _ H); auto
+		end.
 
 Definition gen_st : forall A : Set, Setoid_Theory _ (@eq A).
-Proof. constructor; congruence. Qed.
-
+Proof. 
+  constructor; congruence. 
+Qed.
+  
diff --git a/theories/Sets/Classical_sets.v b/theories/Sets/Classical_sets.v
index 382b5d72..e6755898 100644
--- a/theories/Sets/Classical_sets.v
+++ b/theories/Sets/Classical_sets.v
@@ -24,109 +24,104 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Classical_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Classical_sets.v 9245 2006-10-17 12:53:34Z notin $ 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 :
- forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A.
-Proof.
-intros A NI.
-elim (not_all_ex_not U (fun x:U => ~ In U A x)).
-intros x H; apply Inhabited_intro with x.
-apply NNPP; auto with sets.
-red in |- *; intro.
-apply NI; red in |- *.
-intros x H'; elim (H x); trivial with sets.
-Qed.
-Hint Resolve not_included_empty_Inhabited.
-
-Lemma not_empty_Inhabited :
- forall A:Ensemble U, A <> Empty_set U -> Inhabited U A.
-Proof.
-intros; apply not_included_empty_Inhabited.
-red in |- *; auto with sets.
-Qed.
-
-Lemma Inhabited_Setminus :
- forall 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 (fun 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.
-Hint Resolve Inhabited_Setminus.
-
-Lemma Strict_super_set_contains_new_element :
- forall X Y:Ensemble U,
-   Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X).
-Proof.
-auto 7 with sets.
-Qed.
-Hint Resolve Strict_super_set_contains_new_element.
-
-Lemma Subtract_intro :
- forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y.
-Proof.
-unfold Subtract at 1 in |- *; auto with sets.
-Qed.
-Hint Resolve Subtract_intro.
-
-Lemma Subtract_inv :
- forall (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 :
- forall 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 :
- forall 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 :
- forall X:Ensemble U, ~ Strict_Included U X (Empty_set U).
-Proof.
-intro X; red in |- *; 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 :
- forall A:Ensemble U, Complement U (Complement U A) = A.
-Proof.
-unfold Complement in |- *; intros; apply Extensionality_Ensembles;
- auto with sets.
-red in |- *; split; auto with sets.
-red in |- *; intros; apply NNPP; auto with sets.
-Qed.
+  Variable U : Type.
+
+  Lemma not_included_empty_Inhabited :
+    forall A:Ensemble U, ~ Included U A (Empty_set U) -> Inhabited U A.
+  Proof.
+    intros A NI.
+    elim (not_all_ex_not U (fun x:U => ~ In U A x)).
+    intros x H; apply Inhabited_intro with x.
+    apply NNPP; auto with sets.
+    red in |- *; intro.
+    apply NI; red in |- *.
+    intros x H'; elim (H x); trivial with sets.
+  Qed.
+
+  Lemma not_empty_Inhabited :
+    forall A:Ensemble U, A <> Empty_set U -> Inhabited U A.
+  Proof.
+    intros; apply not_included_empty_Inhabited.
+    red in |- *; auto with sets.
+  Qed.
+
+  Lemma Inhabited_Setminus :
+    forall 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 (fun 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.
+
+  Lemma Strict_super_set_contains_new_element :
+    forall X Y:Ensemble U,
+      Included U X Y -> X <> Y -> Inhabited U (Setminus U Y X).
+  Proof.
+    auto 7 using Inhabited_Setminus with sets.
+  Qed.
+
+  Lemma Subtract_intro :
+    forall (A:Ensemble U) (x y:U), In U A y -> x <> y -> In U (Subtract U A x) y.
+  Proof.
+    unfold Subtract at 1 in |- *; auto with sets.
+  Qed.
+  Hint Resolve Subtract_intro : sets.
+  
+  Lemma Subtract_inv :
+    forall (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 :
+    forall 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 :
+    forall 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 :
+    forall X:Ensemble U, ~ Strict_Included U X (Empty_set U).
+  Proof.
+    intro X; red in |- *; 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 :
+    forall A:Ensemble U, Complement U (Complement U A) = A.
+  Proof.
+    unfold Complement in |- *; intros; apply Extensionality_Ensembles;
+      auto with sets.
+    red in |- *; split; auto with sets.
+    red in |- *; intros; apply NNPP; auto with sets.
+  Qed.
 
 End Ensembles_classical.
 
-Hint Resolve Strict_super_set_contains_new_element Subtract_intro
-  not_SIncl_empty: sets v62.
\ No newline at end of file
+ Hint Resolve Strict_super_set_contains_new_element Subtract_intro
+  not_SIncl_empty: sets v62.
diff --git a/theories/Sets/Constructive_sets.v b/theories/Sets/Constructive_sets.v
index 7e4471a0..ad81316d 100644
--- a/theories/Sets/Constructive_sets.v
+++ b/theories/Sets/Constructive_sets.v
@@ -24,136 +24,123 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Constructive_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Constructive_sets.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Ensembles.
 
 Section Ensembles_facts.
-Variable U : Type.
-
-Lemma Extension : forall 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 : forall x:U, ~ In U (Empty_set U) x.
-Proof.
-red in |- *; destruct 1.
-Qed.
-Hint Resolve Noone_in_empty.
-
-Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A.
-Proof.
-intro; red in |- *.
-intros x H; elim (Noone_in_empty x); auto with sets.
-Qed.
-Hint Resolve Included_Empty.
-
-Lemma Add_intro1 :
- forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y.
-Proof.
-unfold Add at 1 in |- *; auto with sets.
-Qed.
-Hint Resolve Add_intro1.
-
-Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x.
-Proof.
-unfold Add at 1 in |- *; auto with sets.
-Qed.
-Hint Resolve Add_intro2.
-
-Lemma Inhabited_add : forall (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.
-Hint Resolve Inhabited_add.
-
-Lemma Inhabited_not_empty :
- forall X:Ensemble U, Inhabited U X -> X <> Empty_set U.
-Proof.
-intros X H'; elim H'.
-intros x H'0; red in |- *; intro H'1.
-absurd (In U X x); auto with sets.
-rewrite H'1; auto with sets.
-Qed.
-Hint Resolve Inhabited_not_empty.
-
-Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U.
-Proof.
-auto with sets.
-Qed.
-Hint Resolve Add_not_Empty.
-
-Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x.
-Proof.
-intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets.
-Qed.
-Hint Resolve not_Empty_Add.
-
-Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y.
-Proof.
-intros x y H'; elim H'; trivial with sets.
-Qed.
-Hint Resolve Singleton_inv.
-
-Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y.
-Proof.
-intros x y H'; rewrite H'; trivial with sets.
-Qed.
-Hint Resolve Singleton_intro.
-
-Lemma Union_inv :
- forall (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 :
- forall (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 :
- forall (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.
-Hint Resolve Intersection_inv.
-
-Lemma Couple_inv : forall 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.
-Hint Resolve Couple_inv.
-
-Lemma Setminus_intro :
- forall (A B:Ensemble U) (x:U),
-   In U A x -> ~ In U B x -> In U (Setminus U A B) x.
-Proof.
-unfold Setminus at 1 in |- *; red in |- *; auto with sets.
-Qed.
-Hint Resolve Setminus_intro.
+  Variable U : Type.
+  
+  Lemma Extension : forall 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 : forall x:U, ~ In U (Empty_set U) x.
+  Proof.
+    red in |- *; destruct 1.
+  Qed.
+
+  Lemma Included_Empty : forall A:Ensemble U, Included U (Empty_set U) A.
+  Proof.
+    intro; red in |- *.
+    intros x H; elim (Noone_in_empty x); auto with sets.
+  Qed.
+
+  Lemma Add_intro1 :
+    forall (A:Ensemble U) (x y:U), In U A y -> In U (Add U A x) y.
+  Proof.
+    unfold Add at 1 in |- *; auto with sets.
+  Qed.
+  
+  Lemma Add_intro2 : forall (A:Ensemble U) (x:U), In U (Add U A x) x.
+  Proof.
+    unfold Add at 1 in |- *; auto with sets.
+  Qed.
+
+  Lemma Inhabited_add : forall (A:Ensemble U) (x:U), Inhabited U (Add U A x).
+  Proof.
+    intros A x.
+    apply Inhabited_intro with (x := x); auto using Add_intro2 with sets.
+  Qed.
+
+  Lemma Inhabited_not_empty :
+    forall X:Ensemble U, Inhabited U X -> X <> Empty_set U.
+  Proof.
+    intros X H'; elim H'.
+    intros x H'0; red in |- *; intro H'1.
+    absurd (In U X x); auto with sets.
+    rewrite H'1; auto using Noone_in_empty with sets.
+  Qed.
+
+  Lemma Add_not_Empty : forall (A:Ensemble U) (x:U), Add U A x <> Empty_set U.
+  Proof.
+    intros A x; apply Inhabited_not_empty; apply Inhabited_add.
+  Qed.
+
+  Lemma not_Empty_Add : forall (A:Ensemble U) (x:U), Empty_set U <> Add U A x.
+  Proof.
+    intros; red in |- *; intro H; generalize (Add_not_Empty A x); auto with sets.
+  Qed.
+
+  Lemma Singleton_inv : forall x y:U, In U (Singleton U x) y -> x = y.
+  Proof.
+    intros x y H'; elim H'; trivial with sets.
+  Qed.
+
+  Lemma Singleton_intro : forall x y:U, x = y -> In U (Singleton U x) y.
+  Proof.
+    intros x y H'; rewrite H'; trivial with sets.
+  Qed.
+
+  Lemma Union_inv :
+    forall (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 :
+    forall (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'; induction H'. 
+      left; assumption.
+      right; apply Singleton_inv; assumption.
+  Qed.
+  
+  Lemma Intersection_inv :
+    forall (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.
+
+  Lemma Couple_inv : forall 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.
+
+  Lemma Setminus_intro :
+    forall (A B:Ensemble U) (x:U),
+      In U A x -> ~ In U B x -> In U (Setminus U A B) x.
+  Proof.
+    unfold Setminus at 1 in |- *; red in |- *; auto with sets.
+  Qed.
  
-Lemma Strict_Included_intro :
- forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y.
-Proof.
-auto with sets.
-Qed.
-Hint Resolve Strict_Included_intro.
-
-Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X.
-Proof.
-intro X; red in |- *; intro H'; elim H'.
-intros H'0 H'1; elim H'1; auto with sets.
-Qed.
-Hint Resolve Strict_Included_strict.
+  Lemma Strict_Included_intro :
+    forall X Y:Ensemble U, Included U X Y /\ X <> Y -> Strict_Included U X Y.
+  Proof.
+    auto with sets.
+  Qed.
+
+  Lemma Strict_Included_strict : forall X:Ensemble U, ~ Strict_Included U X X.
+  Proof.
+    intro X; red in |- *; intro H'; elim H'.
+    intros H'0 H'1; elim H'1; auto with sets.
+  Qed.
 
 End Ensembles_facts.
 
 Hint 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.
\ No newline at end of file
+  not_Empty_Add Inhabited_add Included_Empty: sets v62.
diff --git a/theories/Sets/Cpo.v b/theories/Sets/Cpo.v
index 0b2cf3e3..1e1b70d5 100644
--- a/theories/Sets/Cpo.v
+++ b/theories/Sets/Cpo.v
@@ -24,86 +24,87 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Cpo.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Cpo.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Relations_1.
 Require Export Partial_Order.
 
 Section Bounds.
-Variable U : Type.
-Variable D : PO U.
+  Variable U : Type.
+  Variable D : PO U.
 
-Let C := Carrier_of U D.
+  Let C := Carrier_of U D.
+  
+  Let R := Rel_of U D.
 
-Let R := Rel_of U D.
-
-Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop :=
+  Inductive Upper_Bound (B:Ensemble U) (x:U) : Prop :=
     Upper_Bound_definition :
-      In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x.
+    In U C x -> (forall y:U, In U B y -> R y x) -> Upper_Bound B x.
 
-Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop :=
+  Inductive Lower_Bound (B:Ensemble U) (x:U) : Prop :=
     Lower_Bound_definition :
-      In U C x -> (forall y:U, In U B y -> R x y) -> Lower_Bound B x.
-
-Inductive Lub (B:Ensemble U) (x:U) : Prop :=
+    In U C x -> (forall 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 -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x.
+    Upper_Bound B x -> (forall y:U, Upper_Bound B y -> R x y) -> Lub B x.
 
-Inductive Glb (B:Ensemble U) (x:U) : Prop :=
+  Inductive Glb (B:Ensemble U) (x:U) : Prop :=
     Glb_definition :
-      Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x.
+    Lower_Bound B x -> (forall y:U, Lower_Bound B y -> R y x) -> Glb B x.
 
-Inductive Bottom (bot:U) : Prop :=
+  Inductive Bottom (bot:U) : Prop :=
     Bottom_definition :
-      In U C bot -> (forall y:U, In U C y -> R bot y) -> Bottom bot.
-
-Inductive Totally_ordered (B:Ensemble U) : Prop :=
+    In U C bot -> (forall 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 ->
-       forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) ->
-      Totally_ordered B.
+    (Included U B C ->
+      forall x y:U, Included U (Couple U x y) B -> R x y \/ R y x) ->
+    Totally_ordered B.
 
-Definition Compatible : Relation U :=
-  fun x y:U =>
-    In U C x ->
-    In U C y ->  exists 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 ->
-      (forall x1 x2:U,
-         Included U (Couple U x1 x2) X ->
-          exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) ->
-      Directed X.
+  Definition Compatible : Relation U :=
+    fun x y:U =>
+      In U C x ->
+      In U C y ->  exists z : _, In U C z /\ Upper_Bound (Couple U x y) z.
 
-Inductive Complete : Prop :=
+  Inductive Directed (X:Ensemble U) : Prop :=
+    Definition_of_Directed :
+    Included U X C ->
+    Inhabited U X ->
+    (forall x1 x2:U,
+      Included U (Couple U x1 x2) X ->
+      exists x3 : _, In U X x3 /\ Upper_Bound (Couple U x1 x2) x3) ->
+    Directed X.
+  
+  Inductive Complete : Prop :=
     Definition_of_Complete :
-      (exists bot : _, Bottom bot) ->
-      (forall X:Ensemble U, Directed X ->  exists bsup : _, Lub X bsup) ->
-      Complete.
+    (exists bot : _, Bottom bot) ->
+    (forall X:Ensemble U, Directed X ->  exists bsup : _, Lub X bsup) ->
+    Complete.
 
-Inductive Conditionally_complete : Prop :=
+  Inductive Conditionally_complete : Prop :=
     Definition_of_Conditionally_complete :
-      (forall X:Ensemble U,
-         Included U X C ->
-         (exists maj : _, Upper_Bound X maj) ->
-          exists bsup : _, Lub X bsup) -> Conditionally_complete.
+    (forall X:Ensemble U,
+      Included U X C ->
+      (exists maj : _, Upper_Bound X maj) ->
+      exists bsup : _, Lub X bsup) -> Conditionally_complete.
 End Bounds.
+
 Hint 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)}.
+  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.
\ No newline at end of file
diff --git a/theories/Sets/Ensembles.v b/theories/Sets/Ensembles.v
index d71c96b0..c38a2fe1 100644
--- a/theories/Sets/Ensembles.v
+++ b/theories/Sets/Ensembles.v
@@ -24,72 +24,71 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Ensembles.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Ensembles.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Section Ensembles.
-Variable U : Type.
-
-Definition Ensemble := U -> Prop. 
-
-Definition In (A:Ensemble) (x:U) : Prop := A x.
-
-Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x.
-
-Inductive Empty_set : Ensemble :=.
-
-Inductive Full_set : Ensemble :=
+  Variable U : Type.
+  
+  Definition Ensemble := U -> Prop. 
+
+  Definition In (A:Ensemble) (x:U) : Prop := A x.
+  
+  Definition Included (B C:Ensemble) : Prop := forall x:U, In B x -> In C x.
+  
+  Inductive Empty_set : Ensemble :=.
+  
+  Inductive Full_set : Ensemble :=
     Full_intro : forall x:U, In Full_set x.
 
 (** NB: The following definition builds-in equality of elements in [U] as 
-   Leibniz equality. 
+     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)]. *)
+     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 :=
+  Inductive Singleton (x:U) : Ensemble :=
     In_singleton : In (Singleton x) x.
 
-Inductive Union (B C:Ensemble) : Ensemble :=
-  | Union_introl : forall x:U, In B x -> In (Union B C) x
-  | Union_intror : forall x:U, In C x -> In (Union B C) x.
-
-Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x).
+  Inductive Union (B C:Ensemble) : Ensemble :=
+    | Union_introl : forall x:U, In B x -> In (Union B C) x
+    | Union_intror : forall x:U, In C x -> In (Union B C) x.
 
-Inductive Intersection (B C:Ensemble) : Ensemble :=
+  Definition Add (B:Ensemble) (x:U) : Ensemble := Union B (Singleton x).
+  
+  Inductive Intersection (B C:Ensemble) : Ensemble :=
     Intersection_intro :
-      forall 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 (A:Ensemble) : Ensemble := fun x:U => ~ In A x.
-
-Definition Setminus (B C:Ensemble) : Ensemble :=
-  fun x:U => In B x /\ ~ In C x.
-
-Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x).
-
-Inductive Disjoint (B C:Ensemble) : Prop :=
+    forall 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 (A:Ensemble) : Ensemble := fun x:U => ~ In A x.
+  
+  Definition Setminus (B C:Ensemble) : Ensemble :=
+    fun x:U => In B x /\ ~ In C x.
+  
+  Definition Subtract (B:Ensemble) (x:U) : Ensemble := Setminus B (Singleton x).
+  
+  Inductive Disjoint (B C:Ensemble) : Prop :=
     Disjoint_intro : (forall x:U, ~ In (Intersection B C) x) -> Disjoint B C.
 
-Inductive Inhabited (B:Ensemble) : Prop :=
+  Inductive Inhabited (B:Ensemble) : Prop :=
     Inhabited_intro : forall x:U, In B x -> Inhabited B.
+  
+  Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C.
+  
+  Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B.
+  
+  (** Extensionality Axiom *)
 
-Definition Strict_Included (B C:Ensemble) : Prop := Included B C /\ B <> C.
-
-Definition Same_set (B C:Ensemble) : Prop := Included B C /\ Included C B.
-
-(** Extensionality Axiom *)
-
-Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B.
-Hint Resolve Extensionality_Ensembles.
+  Axiom Extensionality_Ensembles : forall A B:Ensemble, Same_set A B -> A = B.
 
 End Ensembles.
 
@@ -98,4 +97,4 @@ Hint Unfold In Included Same_set Strict_Included Add Setminus Subtract: sets
 
 Hint 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.
\ No newline at end of file
+  Extensionality_Ensembles: sets v62.
diff --git a/theories/Sets/Finite_sets.v b/theories/Sets/Finite_sets.v
index 47b41ec3..f5eae4ed 100644
--- a/theories/Sets/Finite_sets.v
+++ b/theories/Sets/Finite_sets.v
@@ -24,22 +24,22 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Finite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Finite_sets.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Ensembles.
 
 Section Ensembles_finis.
-Variable U : Type.
+  Variable U : Type.
 
-Inductive Finite : Ensemble U -> Prop :=
-  | Empty_is_finite : Finite (Empty_set U)
-  | Union_is_finite :
+  Inductive Finite : Ensemble U -> Prop :=
+    | Empty_is_finite : Finite (Empty_set U)
+    | Union_is_finite :
       forall A:Ensemble U,
         Finite A -> forall x:U, ~ In U A x -> Finite (Add U A x).
 
-Inductive cardinal : Ensemble U -> nat -> Prop :=
-  | card_empty : cardinal (Empty_set U) 0
-  | card_add :
+  Inductive cardinal : Ensemble U -> nat -> Prop :=
+    | card_empty : cardinal (Empty_set U) 0
+    | card_add :
       forall (A:Ensemble U) (n:nat),
         cardinal A n -> forall x:U, ~ In U A x -> cardinal (Add U A x) (S n).
 
@@ -51,31 +51,31 @@ Hint Resolve card_empty card_add: sets v62.
 Require Import Constructive_sets.
 
 Section Ensembles_finis_facts.
-Variable U : Type.
+  Variable U : Type.
+  
+  Lemma cardinal_invert :
+    forall (X:Ensemble U) (p:nat),
+      cardinal U X p ->
+      match p with
+	| O => X = Empty_set U
+	| S n =>
+          exists A : _,
+            (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n)
+      end.
+  Proof.
+    induction 1; simpl in |- *; auto.
+    exists A; exists x; auto.
+  Qed.
 
-Lemma cardinal_invert :
- forall (X:Ensemble U) (p:nat),
-   cardinal U X p ->
-   match p with
-   | O => X = Empty_set U
-   | S n =>
-        exists A : _,
-         (exists x : _, X = Add U A x /\ ~ In U A x /\ cardinal U A n)
-   end.
-Proof.
-induction 1; simpl in |- *; auto.
-exists A; exists x; auto.
-Qed.
-
-Lemma cardinal_elim :
- forall (X:Ensemble U) (p:nat),
-   cardinal U X p ->
-   match p with
-   | O => X = Empty_set U
-   | S n => Inhabited U X
-   end.
-Proof.
-intros X p C; elim C; simpl in |- *; trivial with sets.
-Qed.
+  Lemma cardinal_elim :
+    forall (X:Ensemble U) (p:nat),
+      cardinal U X p ->
+      match p with
+	| O => X = Empty_set U
+	| S n => Inhabited U X
+      end.
+  Proof.
+    intros X p C; elim C; simpl in |- *; trivial with sets.
+  Qed.
 
 End Ensembles_finis_facts.
diff --git a/theories/Sets/Finite_sets_facts.v b/theories/Sets/Finite_sets_facts.v
index ddbf62e4..91717f9e 100644
--- a/theories/Sets/Finite_sets_facts.v
+++ b/theories/Sets/Finite_sets_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Finite_sets_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Finite_sets_facts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
@@ -37,311 +37,308 @@ Require Export Gt.
 Require Export Lt.
 
 Section Finite_sets_facts.
-Variable U : Type.
+  Variable U : Type.
 
-Lemma finite_cardinal :
- forall X:Ensemble U, Finite U X ->  exists n : nat, cardinal U X n.
-Proof.
-induction 1 as [| A _ [n H]].
-exists 0; auto with sets.
-exists (S n); auto with sets.
-Qed.
+  Lemma finite_cardinal :
+    forall X:Ensemble U, Finite U X ->  exists n : nat, cardinal U X n.
+  Proof.
+    induction 1 as [| A _ [n H]].
+    exists 0; auto with sets.
+    exists (S n); auto with sets.
+  Qed.
 
-Lemma cardinal_finite :
- forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X.
-Proof.
-induction 1; auto with sets.
-Qed.
+  Lemma cardinal_finite :
+    forall (X:Ensemble U) (n:nat), cardinal U X n -> Finite U X.
+  Proof.
+    induction 1; auto with sets.
+  Qed.
 
-Theorem Add_preserves_Finite :
- forall (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.
-Hint Resolve Add_preserves_Finite.
+  Theorem Add_preserves_Finite :
+    forall (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.
 
-Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x).
-Proof.
-intro x; rewrite <- (Empty_set_zero U (Singleton U x)).
-change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets.
-Qed.
-Hint Resolve Singleton_is_finite.
+  Theorem Singleton_is_finite : forall x:U, Finite U (Singleton U x).
+  Proof.
+    intro x; rewrite <- (Empty_set_zero U (Singleton U x)).
+    change (Finite U (Add U (Empty_set U) x)) in |- *; auto with sets.
+  Qed.
 
-Theorem Union_preserves_Finite :
- forall 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.
+  Theorem Union_preserves_Finite :
+    forall X Y:Ensemble U, Finite U X -> Finite U Y -> Finite U (Union U X Y).
+  Proof.
+    intros X Y H; induction H as [|A Fin_A Hind x].
+    rewrite (Empty_set_zero U Y). trivial.
+    intros. 
+    rewrite (Union_commutative U (Add U A x) Y).
+    rewrite <- (Union_add U Y A x).
+    rewrite (Union_commutative U Y A).
+    apply Add_preserves_Finite.
+    apply Hind. assumption.
+  Qed.
 
-Lemma Finite_downward_closed :
- forall A:Ensemble U,
-   Finite U A -> forall 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.
-destruct 1 as [A' [H5 H6]].
-rewrite H5; auto with sets.
-Qed.
+  Lemma Finite_downward_closed :
+    forall A:Ensemble U,
+      Finite U A -> forall 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.
+    destruct 1 as [A' [H5 H6]].
+    rewrite H5; auto with sets.
+  Qed.
 
-Lemma Intersection_preserves_finite :
- forall A:Ensemble U,
-   Finite U A -> forall 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 Intersection_preserves_finite :
+    forall A:Ensemble U,
+      Finite U A -> forall 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 :
+    forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U.
+  Proof.
+    intros X H; apply (cardinal_invert U X 0); trivial with sets.
+  Qed.
 
-Lemma cardinalO_empty :
- forall X:Ensemble U, cardinal U X 0 -> X = Empty_set U.
-Proof.
-intros X H; apply (cardinal_invert U X 0); trivial with sets.
-Qed.
-Hint Resolve cardinalO_empty.
+  Lemma inh_card_gt_O :
+    forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0.
+  Proof.
+    induction 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 inh_card_gt_O :
- forall X:Ensemble U, Inhabited U X -> forall n:nat, cardinal U X n -> n > 0.
-Proof.
-induction 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 :
+    forall (X:Ensemble U) (n:nat),
+      cardinal U X n ->
+      forall 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 in |- *; intro H'6; elim H'6.
+    intros H'7 H'8; try assumption.
+    elim H'1; auto with sets.
+    unfold pred at 2 in |- *; symmetry  in |- *.
+    apply S_pred with (m := 0).
+    change (n > 0) in |- *.
+    apply inh_card_gt_O with (X := X); auto with sets.
+    apply Inhabited_intro with (x := x0); auto with sets.
+    red in |- *; intro H'3.
+    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 in |- *; intro H'5; try exact H'5.
+    lapply (Add_inv U X x x0); tauto.
+  Qed.
 
-Lemma card_soustr_1 :
- forall (X:Ensemble U) (n:nat),
-   cardinal U X n ->
-   forall 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 in |- *; intro H'6; elim H'6.
-intros H'7 H'8; try assumption.
-elim H'1; auto with sets.
-unfold pred at 2 in |- *; symmetry  in |- *.
-apply S_pred with (m := 0).
-change (n > 0) in |- *.
-apply inh_card_gt_O with (X := X); auto with sets.
-apply Inhabited_intro with (x := x0); auto with sets.
-red in |- *; intro H'3.
-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 in |- *; intro H'5; try exact H'5.
-lapply (Add_inv U X x x0); tauto.
-Qed.
+  Lemma cardinal_is_functional :
+    forall (X:Ensemble U) (c1:nat),
+      cardinal U X c1 ->
+      forall (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 x at 2 in |- *; rewrite H'6; auto with sets.
+    intros H'6 H'7.
+    absurd (Add U X x = Add U X0 x0); auto with sets.
+    clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
+    red in |- *; intro H'.
+    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_is_functional :
- forall (X:Ensemble U) (c1:nat),
-   cardinal U X c1 ->
-   forall (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 x at 2 in |- *; rewrite H'6; auto with sets.
-intros H'6 H'7.
-absurd (Add U X x = Add U X0 x0); auto with sets.
-clear H'0 H' H'3 n H'5 H'4 H'2 H'1 c2.
-red in |- *; intro H'.
-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 : forall m:nat, cardinal U (Empty_set U) m -> 0 = 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_Empty : forall m:nat, cardinal U (Empty_set U) m -> 0 = 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 :
+    forall (X:Ensemble U) (n:nat),
+      cardinal U X n -> forall 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 :
+    forall (A:Ensemble U) (x:U) (n n':nat),
+      cardinal U A n -> cardinal U (Add U A x) n' -> 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 cardinal_unicity :
- forall (X:Ensemble U) (n:nat),
-   cardinal U X n -> forall m:nat, cardinal U X m -> n = m.
-Proof.
-intros; apply cardinal_is_functional with X X; auto with sets.
-Qed.
+  Lemma incl_st_card_lt :
+    forall (X:Ensemble U) (c1:nat),
+      cardinal U X c1 ->
+      forall (Y:Ensemble U) (c2:nat),
+	cardinal U Y c2 -> Strict_Included U X Y -> 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 x0 at 1 in |- *; 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 card_Add_gen :
- forall (A:Ensemble U) (x:U) (n n':nat),
-   cardinal U A n -> cardinal U (Add U A x) n' -> 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_card_le :
+    forall (X Y:Ensemble U) (n m:nat),
+      cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m.
+  Proof.
+    intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro.
+    cut (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 :
+    forall P:Ensemble U -> Prop,
+      (forall X:Ensemble U,
+	Finite U X ->
+	(forall 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.
 
-Lemma incl_st_card_lt :
- forall (X:Ensemble U) (c1:nat),
-   cardinal U X c1 ->
-   forall (Y:Ensemble U) (c2:nat),
-     cardinal U Y c2 -> Strict_Included U X Y -> 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 x0 at 1 in |- *; 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 Generalized_induction_on_finite_sets :
+    forall P:Ensemble U -> Prop,
+      (forall X:Ensemble U,
+	Finite U X ->
+	(forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) ->
+      forall 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 (forall 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 || elim H'10; try assumption.
+    generalize H'6.
+    rewrite <- H'8.
+    rewrite <- H'15; auto with sets.
+  Qed.
 
-Lemma incl_card_le :
- forall (X Y:Ensemble U) (n m:nat),
-   cardinal U X n -> cardinal U Y m -> Included U X Y -> n <= m.
-Proof.
-intros; elim Included_Strict_Included with U X Y; auto with sets arith; intro.
-cut (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 :
- forall P:Ensemble U -> Prop,
-   (forall X:Ensemble U,
-      Finite U X ->
-      (forall 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.
-
-Hint Unfold not.
-
-Lemma Generalized_induction_on_finite_sets :
- forall P:Ensemble U -> Prop,
-   (forall X:Ensemble U,
-      Finite U X ->
-      (forall Y:Ensemble U, Strict_Included U Y X -> P Y) -> P X) ->
-   forall 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 (forall 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 || elim H'10; try assumption.
-generalize H'6.
-rewrite <- H'8.
-rewrite <- H'15; auto with sets.
-Qed.
-
-End Finite_sets_facts.
\ No newline at end of file
+End Finite_sets_facts.
diff --git a/theories/Sets/Image.v b/theories/Sets/Image.v
index c97aa127..d3591acf 100644
--- a/theories/Sets/Image.v
+++ b/theories/Sets/Image.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Image.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Image.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
@@ -39,167 +39,167 @@ Require Export Le.
 Require Export Finite_sets_facts.
 
 Section Image.
-Variables U V : Type.
-
-Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V :=
+  Variables U V : Type.
+  
+  Inductive Im (X:Ensemble U) (f:U -> V) : Ensemble V :=
     Im_intro : forall x:U, In _ X x -> forall y:V, y = f x -> In _ (Im X f) y.
+  
+  Lemma Im_def :
+    forall (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.
+
+  Lemma Im_add :
+    forall (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 in |- *; intros x0 H'.
+    elim H'; intros.
+    rewrite H0.
+    elim Add_inv with U X x x1; auto using Im_def with sets.
+    destruct 1; auto using Im_def with sets.
+    elim Add_inv with V (Im X f) (f x) x0. 
+    destruct 1 as [x0 H y H0].
+    rewrite H0; auto using Im_def with sets.
+    destruct 1; auto using Im_def with sets.
+    trivial.
+  Qed.
+  
+  Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V.
+  Proof.
+    intro f; try assumption.
+    apply Extensionality_Ensembles.
+    split; auto with sets.
+    red in |- *.
+    intros x H'; elim H'.
+    intros x0 H'0; elim H'0; auto with sets.
+  Qed.
+
+  Lemma finite_image :
+    forall (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.
+  
+  Lemma Im_inv :
+    forall (X:Ensemble U) (f:U -> V) (y:V),
+      In _ (Im X f) y ->  exists 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) := forall x y:U, f x = f y -> x = y.
+  
+  Lemma not_injective_elim :
+    forall f:U -> V,
+      ~ injective f ->  exists x : _, (exists y : _, f x = f y /\ x <> y).
+  Proof.
+    unfold injective in |- *; intros f H.
+    cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)).
+    2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y);
+      trivial with sets.
+    destruct 1 as [x C]; exists x.
+    cut (exists y : _, ~ (f x = f y -> x = y)).
+    2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y);
+      trivial with sets.
+    destruct 1 as [y D]; exists y.
+    apply imply_to_and; trivial with sets.
+  Qed.
+  
+  Lemma cardinal_Im_intro :
+    forall (A:Ensemble U) (f:U -> V) (n:nat),
+      cardinal _ A n ->  exists 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 :
+    forall (A:Ensemble U) (f:U -> V),
+      injective f -> forall 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 :
+    forall (A:Ensemble U) (f:U -> V) (n:nat),
+      injective f ->
+      cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n.
+  Proof.
+    induction 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 in |- *; intro; apply H'2.
+    apply In_Image_elim with f; trivial with sets.
+  Qed.
+  
+  Lemma cardinal_decreases :
+    forall (A:Ensemble U) (f:U -> V) (n:nat),
+      cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n.
+  Proof.
+    induction 1 as [| A n H'0 H'1 x H'2]; auto with sets.
+    rewrite (image_empty f); intros.
+    cut (n' = 0).
+    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 :
+    forall (A:Ensemble U) (f:U -> V) (n:nat),
+      cardinal U A n ->
+      forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f.
+  Proof.
+    unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I.
+    cut (n' = n).
+    intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n).
+    apply injective_preserves_cardinal with (A := A) (f := f) (n := n);
+      trivial with sets.
+  Qed.
+  
+  Lemma Pigeonhole_principle :
+    forall (A:Ensemble U) (f:U -> V) (n:nat),
+      cardinal _ A n ->
+      forall n':nat,
+	cardinal _ (Im A f) n' ->
+	n' < n ->  exists x : _, (exists y : _, f x = f y /\ x <> y).
+  Proof.
+    intros; apply not_injective_elim.
+    apply Pigeonhole with A n n'; trivial with sets.
+  Qed.
 
-Lemma Im_def :
- forall (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.
-Hint Resolve Im_def.
-
-Lemma Im_add :
- forall (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 in |- *; intros x0 H'.
-elim H'; intros.
-rewrite H0.
-elim Add_inv with U X x x1; auto with sets.
-destruct 1; auto with sets.
-elim Add_inv with V (Im X f) (f x) x0; auto with sets.
-destruct 1 as [x0 H y H0].
-rewrite H0; auto with sets.
-destruct 1; auto with sets.
-Qed.
-
-Lemma image_empty : forall f:U -> V, Im (Empty_set U) f = Empty_set V.
-Proof.
-intro f; try assumption.
-apply Extensionality_Ensembles.
-split; auto with sets.
-red in |- *.
-intros x H'; elim H'.
-intros x0 H'0; elim H'0; auto with sets.
-Qed.
-Hint Resolve image_empty.
-
-Lemma finite_image :
- forall (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.
-Hint Resolve finite_image.
-
-Lemma Im_inv :
- forall (X:Ensemble U) (f:U -> V) (y:V),
-   In _ (Im X f) y ->  exists 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) := forall x y:U, f x = f y -> x = y.
-
-Lemma not_injective_elim :
- forall f:U -> V,
-   ~ injective f ->  exists x : _, (exists y : _, f x = f y /\ x <> y).
-Proof.
-unfold injective in |- *; intros f H.
-cut (exists x : _, ~ (forall y:U, f x = f y -> x = y)).
-2: apply not_all_ex_not with (P := fun x:U => forall y:U, f x = f y -> x = y);
-    trivial with sets.
-destruct 1 as [x C]; exists x.
-cut (exists y : _, ~ (f x = f y -> x = y)).
-2: apply not_all_ex_not with (P := fun y:U => f x = f y -> x = y);
-    trivial with sets.
-destruct 1 as [y D]; exists y.
-apply imply_to_and; trivial with sets.
-Qed.
-
-Lemma cardinal_Im_intro :
- forall (A:Ensemble U) (f:U -> V) (n:nat),
-   cardinal _ A n ->  exists 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 :
- forall (A:Ensemble U) (f:U -> V),
-   injective f -> forall 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 :
- forall (A:Ensemble U) (f:U -> V) (n:nat),
-   injective f ->
-   cardinal _ A n -> forall n':nat, cardinal _ (Im A f) n' -> n' = n.
-Proof.
-induction 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 in |- *; intro; apply H'2.
-apply In_Image_elim with f; trivial with sets.
-Qed.
-
-Lemma cardinal_decreases :
- forall (A:Ensemble U) (f:U -> V) (n:nat),
-   cardinal U A n -> forall n':nat, cardinal V (Im A f) n' -> n' <= n.
-Proof.
-induction 1 as [| A n H'0 H'1 x H'2]; auto with sets.
-rewrite (image_empty f); intros.
-cut (n' = 0).
-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 :
- forall (A:Ensemble U) (f:U -> V) (n:nat),
-   cardinal U A n ->
-   forall n':nat, cardinal V (Im A f) n' -> n' < n -> ~ injective f.
-Proof.
-unfold not in |- *; intros A f n CAn n' CIfn' ltn'n I.
-cut (n' = n).
-intro E; generalize ltn'n; rewrite E; exact (lt_irrefl n).
-apply injective_preserves_cardinal with (A := A) (f := f) (n := n);
- trivial with sets.
-Qed.
-
-Lemma Pigeonhole_principle :
- forall (A:Ensemble U) (f:U -> V) (n:nat),
-   cardinal _ A n ->
-   forall n':nat,
-     cardinal _ (Im A f) n' ->
-     n' < n ->  exists x : _, (exists 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.
+
 Hint Resolve Im_def image_empty finite_image: sets v62.
\ No newline at end of file
diff --git a/theories/Sets/Infinite_sets.v b/theories/Sets/Infinite_sets.v
index 806e9dde..47554ac4 100644
--- a/theories/Sets/Infinite_sets.v
+++ b/theories/Sets/Infinite_sets.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Infinite_sets.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Infinite_sets.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
@@ -40,205 +40,205 @@ Require Export Finite_sets_facts.
 Require Export Image.
 
 Section Approx.
-Variable U : Type.
+  Variable U : Type.
 
-Inductive Approximant (A X:Ensemble U) : Prop :=
+  Inductive Approximant (A X:Ensemble U) : Prop :=
     Defn_of_Approximant : Finite U X -> Included U X A -> Approximant A X.
 End Approx.
 
 Hint Resolve Defn_of_Approximant.
 
 Section Infinite_sets.
-Variable U : Type.
-
-Lemma make_new_approximant :
- forall A 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 in |- *; intro H'3; apply H'.
-rewrite <- H'3; auto with sets.
-Qed.
-
-Lemma approximants_grow :
- forall A X:Ensemble U,
-   ~ Finite U A ->
-   forall n:nat,
-     cardinal U X n ->
-     Included U X A ->  exists 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 in |- *; 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 in |- *.
-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' :
- forall A X:Ensemble U,
-   ~ Finite U A ->
-   forall n:nat,
-     cardinal U X n ->
-     Approximant U A X ->
-      exists 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 (exists 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 :
- forall A X:Ensemble U,
-   ~ Finite U A ->
-   forall n:nat,  exists 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 :
- forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
-   Finite V X ->
-   Included V X (Im U V A f) ->
-    exists n : _,
-     (exists 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 0.
-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  5Im_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 ex_intro with (x := Add U x0 x1).
-split; [ split; [ try assumption | idtac ] | idtac ].
-apply card_add; auto with sets.
-red in |- *; intro H'9; try exact H'9.
-apply H'1.
-elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets.
-elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets.
-red in |- *; auto with sets.
-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' :
- forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
-   Approximant V (Im U V A f) X ->
-    exists Y : _, Approximant U A Y /\ Im U V Y f = X.
-Proof.
-intros A f X H'; try assumption.
-cut
- (exists n : _,
-    (exists 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 :
- forall (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 :
- forall (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 in |- *; intro H'2.
-elim (Pigeonhole_bis A f); auto with sets.
-Qed.
+  Variable U : Type.
+  
+  Lemma make_new_approximant :
+    forall A 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 in |- *; intro H'3; apply H'.
+    rewrite <- H'3; auto with sets.
+  Qed.
+  
+  Lemma approximants_grow :
+    forall A X:Ensemble U,
+      ~ Finite U A ->
+      forall n:nat,
+	cardinal U X n ->
+	Included U X A ->  exists 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 in |- *; 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 in |- *.
+    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' :
+    forall A X:Ensemble U,
+      ~ Finite U A ->
+      forall n:nat,
+	cardinal U X n ->
+	Approximant U A X ->
+	exists 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 (exists 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 :
+    forall A X:Ensemble U,
+      ~ Finite U A ->
+      forall n:nat,  exists 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 :
+    forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
+      Finite V X ->
+      Included V X (Im U V A f) ->
+      exists n : _,
+	(exists 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 0.
+    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  5Im_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 ex_intro with (x := Add U x0 x1).
+    split; [ split; [ try assumption | idtac ] | idtac ].
+    apply card_add; auto with sets.
+    red in |- *; intro H'9; try exact H'9.
+    apply H'1.
+    elim H'4; intros H'10 H'11; rewrite <- H'11; clear H'4; auto with sets.
+    elim H'4; intros H'9 H'10; try exact H'9; clear H'4; auto with sets.
+    red in |- *; auto with sets.
+    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' :
+    forall (A:Ensemble U) (f:U -> V) (X:Ensemble V),
+      Approximant V (Im U V A f) X ->
+      exists Y : _, Approximant U A Y /\ Im U V Y f = X.
+  Proof.
+    intros A f X H'; try assumption.
+    cut
+      (exists n : _,
+	(exists 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 :
+    forall (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 :
+    forall (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 in |- *; intro H'2.
+    elim (Pigeonhole_bis A f); auto with sets.
+  Qed.
 
 End Infinite_sets.
diff --git a/theories/Sets/Integers.v b/theories/Sets/Integers.v
index cfadd81c..c969ad9c 100644
--- a/theories/Sets/Integers.v
+++ b/theories/Sets/Integers.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Integers.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Integers.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Finite_sets.
 Require Export Constructive_sets.
@@ -45,120 +45,117 @@ Require Export Partial_Order.
 Require Export Cpo.
 
 Section Integers_sect.
-
-Inductive Integers : Ensemble nat :=
+  
+  Inductive Integers : Ensemble nat :=
     Integers_defn : forall x:nat, In nat Integers x.
-Hint Resolve Integers_defn.
-
-Lemma le_reflexive : Reflexive nat le.
-Proof.
-red in |- *; auto with arith.
-Qed.
-
-Lemma le_antisym : Antisymmetric nat le.
-Proof.
-red in |- *; intros x y H H'; rewrite (le_antisym x y); auto.
-Qed.
-
-Lemma le_trans : Transitive nat le.
-Proof.
-red in |- *; intros; apply le_trans with y; auto.
-Qed.
-Hint Resolve le_reflexive le_antisym le_trans.
-
-Lemma le_Order : Order nat le.
-Proof.
-auto with sets arith.
-Qed.
-Hint Resolve le_Order.
-
-Lemma triv_nat : forall n:nat, In nat Integers n.
-Proof.
-auto with sets arith.
-Qed.
-Hint 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 := 0); auto with sets arith.
-Defined.
-Hint Unfold nat_po.
-
-Lemma le_total_order : Totally_ordered nat nat_po Integers.
-Proof.
-apply Totally_ordered_definition.
-simpl in |- *.
-intros H' x y H'0.
-specialize  2le_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 (y <= x); auto with sets arith.
-Qed.
-Hint Resolve le_total_order.
-
-Lemma Finite_subset_has_lub :
- forall X:Ensemble nat,
-   Finite nat X ->  exists m : nat, Upper_Bound nat nat_po X m.
-Proof.
-intros X H'; elim H'.
-exists 0.
-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 in |- *.
-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 in |- *.
-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 in |- *; 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 in |- *.
-intros y H'1; elim H'1.
-intros x1 H'4; try assumption.
-elim H'3; simpl in |- *; auto with sets arith.
-intros x1 H'4; elim H'4; auto with sets arith.
-red in |- *.
-intros x1 H'1; elim H'1; auto with sets arith.
-Qed.
-
-Lemma Integers_has_no_ub :
- ~ (exists m : nat, Upper_Bound nat nat_po Integers m).
-Proof.
-red in |- *; 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  1H'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 (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 in |- *; intro H'0; try exact H'0.
-apply H'.
-apply Finite_subset_has_lub; auto with sets arith.
-Qed.
+  Lemma le_reflexive : Reflexive nat le.
+  Proof.
+    red in |- *; auto with arith.
+  Qed.
+  
+  Lemma le_antisym : Antisymmetric nat le.
+  Proof.
+    red in |- *; intros x y H H'; rewrite (le_antisym x y); auto.
+  Qed.
+
+  Lemma le_trans : Transitive nat le.
+  Proof.
+    red in |- *; intros; apply le_trans with y; auto.
+  Qed.
+  
+  Lemma le_Order : Order nat le.
+  Proof.
+    split; [exact le_reflexive | exact le_trans | exact le_antisym]. 
+  Qed.
+  
+  Lemma triv_nat : forall n:nat, In nat Integers n.
+  Proof.
+    exact Integers_defn.
+  Qed.
+
+  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 := 0). 
+      apply Integers_defn.
+      exact le_Order.
+  Defined.
+  
+  Lemma le_total_order : Totally_ordered nat nat_po Integers.
+  Proof.
+    apply Totally_ordered_definition.
+    simpl in |- *.
+    intros H' x y H'0.
+    specialize  2le_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 (y <= x); auto with sets arith.
+  Qed.
+  
+  Lemma Finite_subset_has_lub :
+    forall X:Ensemble nat,
+      Finite nat X ->  exists m : nat, Upper_Bound nat nat_po X m.
+  Proof.
+    intros X H'; elim H'.
+    exists 0.
+    apply Upper_Bound_definition.
+      unfold nat_po. simpl. apply triv_nat.
+    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 in |- *.
+    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. simpl in |- *. apply triv_nat.
+    intros y H'1; elim H'1.
+    generalize le_trans.
+    intro H'4; red in H'4.
+    intros x1 H'6; try assumption.
+    apply H'4 with (y := x0). elim H'3; simpl in |- *; auto with sets arith. trivial.
+    intros x1 H'4; elim H'4. unfold nat_po; simpl; trivial.
+    exists x0.
+    apply Upper_Bound_definition. 
+      unfold nat_po. simpl. apply triv_nat.
+    intros y H'1; elim H'1.
+    intros x1 H'4; try assumption.
+    elim H'3; simpl in |- *; auto with sets arith.
+    intros x1 H'4; elim H'4; auto with sets arith.
+    red in |- *.
+    intros x1 H'1; elim H'1; apply triv_nat.
+  Qed.
+
+  Lemma Integers_has_no_ub :
+    ~ (exists m : nat, Upper_Bound nat nat_po Integers m).
+  Proof.
+    red in |- *; intro H'; elim H'.
+    intros x H'0.
+    elim H'0; intros H'1 H'2.
+    cut (In nat Integers (S x)).
+    intro H'3.
+    specialize  1H'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 (S x <= x); auto with arith.
+    apply triv_nat.
+ Qed.
+  
+  Lemma Integers_infinite : ~ Finite nat Integers.
+  Proof.
+    generalize Integers_has_no_ub.
+    intro H'; red in |- *; 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/theories/Sets/Multiset.v b/theories/Sets/Multiset.v
index cdc8520c..7084a82d 100644
--- a/theories/Sets/Multiset.v
+++ b/theories/Sets/Multiset.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Multiset.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Multiset.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (* G. Huet 1-9-95 *)
 
@@ -16,162 +16,156 @@ Set Implicit Arguments.
 
 Section multiset_defs.
 
-Variable A : Set.
-Variable eqA : A -> A -> Prop.
-Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+  Variable A : Set.
+  Variable eqA : A -> A -> Prop.
+  Hypothesis Aeq_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
 
-Inductive multiset : Set :=
+  Inductive multiset : Set :=
     Bag : (A -> nat) -> multiset.
-
-Definition EmptyBag := Bag (fun a:A => 0).
-Definition SingletonBag (a:A) :=
-  Bag (fun a':A => match Aeq_dec a a' with
-                   | left _ => 1
-                   | right _ => 0
-                   end).
-
-Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a.
-
-(** multiset equality *)
-Definition meq (m1 m2:multiset) :=
-  forall a:A, multiplicity m1 a = multiplicity m2 a.
-
-Hint Unfold meq multiplicity.
-
-Lemma meq_refl : forall x:multiset, meq x x.
-Proof.
-destruct x; auto.
-Qed.
-Hint Resolve meq_refl.
-
-Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z.
-Proof.
-unfold meq in |- *.
-destruct x; destruct y; destruct z.
-intros; rewrite H; auto.
-Qed.
-
-Lemma meq_sym : forall x y:multiset, meq x y -> meq y x.
-Proof.
-unfold meq in |- *.
-destruct x; destruct y; auto.
-Qed.
-Hint Immediate meq_sym.
-
-(** multiset union *)
-Definition munion (m1 m2:multiset) :=
-  Bag (fun a:A => multiplicity m1 a + multiplicity m2 a).
-
-Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x).
-Proof.
-unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
-Qed.
-Hint Resolve munion_empty_left.
-
-Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag).
-Proof.
-unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
-Qed.
-
-
-Require Import Plus. (* comm. and ass. of plus *)
-
-Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x).
-Proof.
-unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *.
-destruct x; destruct y; auto with arith.
-Qed.
-Hint Resolve munion_comm.
-
-Lemma munion_ass :
- forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)).
-Proof.
-unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
-destruct x; destruct y; destruct z; auto with arith.
-Qed.
-Hint Resolve munion_ass.
-
-Lemma meq_left :
- forall x y z:multiset, meq x y -> meq (munion x z) (munion y z).
-Proof.
-unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
-destruct x; destruct y; destruct z.
-intros; elim H; auto with arith.
-Qed.
-Hint Resolve meq_left.
-
-Lemma meq_right :
- forall x y z:multiset, meq x y -> meq (munion z x) (munion z y).
-Proof.
-unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
-destruct x; destruct y; destruct z.
-intros; elim H; auto.
-Qed.
-Hint 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 :
- forall 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 :
- forall 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 :
- forall 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 :
- forall 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 :
- forall 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 :
- forall 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 :
- forall 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.
+  
+  Definition EmptyBag := Bag (fun a:A => 0).
+  Definition SingletonBag (a:A) :=
+    Bag (fun a':A => match Aeq_dec a a' with
+                       | left _ => 1
+                       | right _ => 0
+                     end).
+
+  Definition multiplicity (m:multiset) (a:A) : nat := let (f) := m in f a.
+  
+  (** multiset equality *)
+  Definition meq (m1 m2:multiset) :=
+    forall a:A, multiplicity m1 a = multiplicity m2 a.
+  
+  Lemma meq_refl : forall x:multiset, meq x x.
+  Proof.
+    destruct x; unfold meq; reflexivity.
+  Qed.
+  
+  Lemma meq_trans : forall x y z:multiset, meq x y -> meq y z -> meq x z.
+  Proof.
+    unfold meq in |- *.
+    destruct x; destruct y; destruct z.
+    intros; rewrite H; auto.
+  Qed.
+  
+  Lemma meq_sym : forall x y:multiset, meq x y -> meq y x.
+  Proof.
+    unfold meq in |- *.
+    destruct x; destruct y; auto.
+  Qed.
+
+  (** multiset union *)
+  Definition munion (m1 m2:multiset) :=
+    Bag (fun a:A => multiplicity m1 a + multiplicity m2 a).
+
+  Lemma munion_empty_left : forall x:multiset, meq x (munion EmptyBag x).
+  Proof.
+    unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
+  Qed.
+  
+  Lemma munion_empty_right : forall x:multiset, meq x (munion x EmptyBag).
+  Proof.
+    unfold meq in |- *; unfold munion in |- *; simpl in |- *; auto.
+  Qed.
+
+
+  Require Plus. (* comm. and ass. of plus *)
+  
+  Lemma munion_comm : forall x y:multiset, meq (munion x y) (munion y x).
+  Proof.
+    unfold meq in |- *; unfold multiplicity in |- *; unfold munion in |- *.
+    destruct x; destruct y; auto with arith.
+  Qed.
+
+  Lemma munion_ass :
+    forall x y z:multiset, meq (munion (munion x y) z) (munion x (munion y z)).
+  Proof.
+    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    destruct x; destruct y; destruct z; auto with arith.
+  Qed.
+
+  Lemma meq_left :
+    forall x y z:multiset, meq x y -> meq (munion x z) (munion y z).
+  Proof.
+    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    destruct x; destruct y; destruct z.
+    intros; elim H; auto with arith.
+  Qed.
+
+  Lemma meq_right :
+    forall x y z:multiset, meq x y -> meq (munion z x) (munion z y).
+  Proof.
+    unfold meq in |- *; unfold munion in |- *; unfold multiplicity in |- *.
+    destruct x; destruct y; destruct z.
+    intros; elim H; auto.
+  Qed.
+
+  (** Here we should make multiset an abstract datatype, by hiding [Bag],
+      [munion], [multiplicity]; all further properties are proved abstractly *)
+
+  Lemma munion_rotate :
+    forall x y z:multiset, meq (munion x (munion y z)) (munion z (munion x y)).
+  Proof.
+    intros; apply (op_rotate multiset munion meq). 
+      apply munion_comm.
+      apply munion_ass.
+      exact meq_trans.
+      exact meq_sym.
+      trivial.
+  Qed.
+  
+  Lemma meq_congr :
+    forall 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 using meq_left, meq_right.
+      exact meq_trans.
+  Qed.
+  
+  Lemma munion_perm_left :
+    forall x y z:multiset, meq (munion x (munion y z)) (munion y (munion x z)).
+  Proof.
+    intros; apply (perm_left multiset munion meq); auto using munion_comm, munion_ass, meq_left, meq_right, meq_sym.
+      exact meq_trans.
+  Qed.
+  
+  Lemma multiset_twist1 :
+    forall 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 using munion_comm, munion_ass, meq_sym, meq_left, meq_right.
+    exact meq_trans.
+  Qed.
+
+  Lemma multiset_twist2 :
+    forall 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 :
+    forall 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 :
+    forall 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 
@@ -188,4 +182,4 @@ Unset Implicit Arguments.
 Hint Unfold meq multiplicity: v62 datatypes.
 Hint Resolve munion_empty_right munion_comm munion_ass meq_left meq_right
   munion_empty_left: v62 datatypes.
-Hint Immediate meq_sym: v62 datatypes.
\ No newline at end of file
+Hint Immediate meq_sym: v62 datatypes.
diff --git a/theories/Sets/Partial_Order.v b/theories/Sets/Partial_Order.v
index 9924ba66..6210913c 100644
--- a/theories/Sets/Partial_Order.v
+++ b/theories/Sets/Partial_Order.v
@@ -24,32 +24,32 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Partial_Order.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Partial_Order.v 9245 2006-10-17 12:53:34Z notin $ 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 := fun x y:U => Rel_of p x y /\ x <> y.
-
-Inductive covers (y x:U) : Prop :=
+  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 := fun x y:U => Rel_of p x y /\ x <> y.
+  
+  Inductive covers (y x:U) : Prop :=
     Definition_of_covers :
-      Strict_Rel_of x y ->
-      ~ (exists z : _, Strict_Rel_of x z /\ Strict_Rel_of z y) ->
-      covers y x.
+    Strict_Rel_of x y ->
+    ~ (exists z : _, Strict_Rel_of x z /\ Strict_Rel_of z y) ->
+    covers y x.
 
 End Partial_orders.
 
@@ -58,43 +58,45 @@ Hint Resolve Definition_of_covers: sets v62.
 
 
 Section Partial_order_facts.
-Variable U : Type.
-Variable D : PO U.
-
-Lemma Strict_Rel_Transitive_with_Rel :
- forall x y z:U,
-   Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z.
-unfold Strict_Rel_of at 1 in |- *.
-red in |- *.
-elim D; simpl in |- *.
-intros C R H' H'0; elim H'0.
-intros H'1 H'2 H'3 x y z H'4 H'5; split.
-apply H'2 with (y := y); tauto.
-red in |- *; intro H'6.
-elim H'4; intros H'7 H'8; apply H'8; clear H'4.
-apply H'3; auto.
-rewrite H'6; tauto.
-Qed.
+  Variable U : Type.
+  Variable D : PO U.
+  
+  Lemma Strict_Rel_Transitive_with_Rel :
+    forall x y z:U,
+      Strict_Rel_of U D x y -> Rel_of U D y z -> Strict_Rel_of U D x z.
+  Proof.
+    unfold Strict_Rel_of at 1 in |- *.
+    red in |- *.
+    elim D; simpl in |- *.
+    intros C R H' H'0; elim H'0.
+    intros H'1 H'2 H'3 x y z H'4 H'5; split.
+    apply H'2 with (y := y); tauto.
+    red in |- *; intro H'6.
+    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 :
- forall x y z:U,
-   Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
-unfold Strict_Rel_of at 1 in |- *.
-red in |- *.
-elim D; simpl in |- *.
-intros C R H' H'0; elim H'0.
-intros H'1 H'2 H'3 x y z H'4 H'5; split.
-apply H'2 with (y := y); tauto.
-red in |- *; intro H'6.
-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_with_Rel_left :
+    forall x y z:U,
+      Rel_of U D x y -> Strict_Rel_of U D y z -> Strict_Rel_of U D x z.
+  Proof.
+    unfold Strict_Rel_of at 1 in |- *.
+    red in |- *.
+    elim D; simpl in |- *.
+    intros C R H' H'0; elim H'0.
+    intros H'1 H'2 H'3 x y z H'4 H'5; split.
+    apply H'2 with (y := y); tauto.
+    red in |- *; intro H'6.
+    elim H'5; intros H'7 H'8; apply H'8; clear H'5.
+    apply H'3; auto.
+    rewrite <- H'6; auto.
+  Qed.
 
-Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D).
-red in |- *.
-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.
+  Lemma Strict_Rel_Transitive : Transitive U (Strict_Rel_of U D).
+    red in |- *.
+    intros x y z H' H'0.
+    apply Strict_Rel_Transitive_with_Rel with (y := y);
+      [ intuition | unfold Strict_Rel_of in H', H'0; intuition ].
+  Qed.
 End Partial_order_facts.
\ No newline at end of file
diff --git a/theories/Sets/Permut.v b/theories/Sets/Permut.v
index 2b6c899f..a7c3db3a 100644
--- a/theories/Sets/Permut.v
+++ b/theories/Sets/Permut.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Permut.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Permut.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (* G. Huet 1-9-95 *)
 
@@ -15,77 +15,75 @@
 
 Section Axiomatisation.
 
-Variable U : Set.
-
-Variable op : U -> U -> U.
-
-Variable cong : U -> U -> Prop.
-
-Hypothesis op_comm : forall x y:U, cong (op x y) (op y x).
-Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)).
-
-Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z).
-Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y).
-Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z.
-Hypothesis cong_sym : forall 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 :
- forall 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 : forall 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 : forall 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 : forall 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 : forall 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 : forall 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 :
- forall 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.
+  Variable U : Set.
+  Variable op : U -> U -> U.
+  Variable cong : U -> U -> Prop.
+
+  Hypothesis op_comm : forall x y:U, cong (op x y) (op y x).
+  Hypothesis op_ass : forall x y z:U, cong (op (op x y) z) (op x (op y z)).
+
+  Hypothesis cong_left : forall x y z:U, cong x y -> cong (op x z) (op y z).
+  Hypothesis cong_right : forall x y z:U, cong x y -> cong (op z x) (op z y).
+  Hypothesis cong_trans : forall x y z:U, cong x y -> cong y z -> cong x z.
+  Hypothesis cong_sym : forall 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 :
+    forall 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 : forall 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 : forall 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 : forall 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 : forall 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 : forall 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 :
+    forall 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.
\ No newline at end of file
diff --git a/theories/Sets/Powerset_Classical_facts.v b/theories/Sets/Powerset_Classical_facts.v
index 210017d4..47857705 100644
--- a/theories/Sets/Powerset_Classical_facts.v
+++ b/theories/Sets/Powerset_Classical_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset_Classical_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Powerset_Classical_facts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Constructive_sets.
@@ -39,298 +39,294 @@ Require Export Classical_sets.
 
 Section Sets_as_an_algebra.
 
-Variable U : Type.
+  Variable U : Type.
+  
+  Lemma sincl_add_x :
+    forall (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 in |- *.
+    lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets.
+    clear H'0; intro H'0; split.
+    apply incl_add_x with (x := x); tauto.
+    elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2.
+    intros x0 H'0.
+    red in |- *; intro H'2.
+    elim H'0; clear H'0.
+    rewrite <- H'2; auto with sets.
+  Qed.
 
-Lemma sincl_add_x :
- forall (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 in |- *.
-lapply (Strict_Included_inv U (Add U A x) (Add U B x)); auto with sets.
-clear H'0; intro H'0; split.
-apply incl_add_x with (x := x); tauto.
-elim H'0; intros H'1 H'2; elim H'2; clear H'0 H'2.
-intros x0 H'0.
-red in |- *; intro H'2.
-elim H'0; clear H'0.
-rewrite <- H'2; auto with sets.
-Qed.
+  Lemma incl_soustr_in :
+    forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X.
+  Proof.
+    intros X x H'; red in |- *.
+    intros x0 H'0; elim H'0; auto with sets.
+  Qed.
+  
+  Lemma incl_soustr :
+    forall (X Y:Ensemble U) (x:U),
+      Included U X Y -> Included U (Subtract U X x) (Subtract U Y x).
+  Proof.
+    intros X Y x H'; red in |- *.
+    intros x0 H'0; elim H'0.
+    intros H'1 H'2.
+    apply Subtract_intro; auto with sets.
+  Qed.
+  
+  Lemma incl_soustr_add_l :
+    forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X.
+  Proof.
+    intros X x; red in |- *.
+    intros 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.
 
-Lemma incl_soustr_in :
- forall (X:Ensemble U) (x:U), In U X x -> Included U (Subtract U X x) X.
-Proof.
-intros X x H'; red in |- *.
-intros x0 H'0; elim H'0; auto with sets.
-Qed.
-Hint Resolve incl_soustr_in: sets v62.
-
-Lemma incl_soustr :
- forall (X Y:Ensemble U) (x:U),
-   Included U X Y -> Included U (Subtract U X x) (Subtract U Y x).
-Proof.
-intros X Y x H'; red in |- *.
-intros x0 H'0; elim H'0.
-intros H'1 H'2.
-apply Subtract_intro; auto with sets.
-Qed.
-Hint Resolve incl_soustr: sets v62.
-
-
-Lemma incl_soustr_add_l :
- forall (X:Ensemble U) (x:U), Included U (Subtract U (Add U X x) x) X.
-Proof.
-intros X x; red in |- *.
-intros 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.
-Hint Resolve incl_soustr_add_l: sets v62.
+  Lemma incl_soustr_add_r :
+    forall (X:Ensemble U) (x:U),
+      ~ In U X x -> Included U X (Subtract U (Add U X x) x).
+  Proof.
+    intros X x H'; red in |- *.
+    intros x0 H'0; try assumption.
+    apply Subtract_intro; auto with sets.
+    red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets.
+  Qed.
+  Hint Resolve incl_soustr_add_r: sets v62.
+  
+  Lemma add_soustr_2 :
+    forall (X:Ensemble U) (x:U),
+      In U X x -> Included U X (Add U (Subtract U X x) x).
+  Proof.
+    intros X x H'; red in |- *.
+    intros x0 H'0; try assumption.
+    elim (classic (x = x0)); intro K; auto with sets.
+    elim K; auto with sets.
+  Qed.
+  
+  Lemma add_soustr_1 :
+    forall (X:Ensemble U) (x:U),
+      In U X x -> Included U (Add U (Subtract U X x) x) X.
+  Proof.
+    intros X x H'; red in |- *.
+    intros 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.
+  
+  Lemma add_soustr_xy :
+    forall (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 in |- *.
+    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.
+  
+  Lemma incl_st_add_soustr :
+    forall (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 using add_soustr_1 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 using add_soustr_2 with sets.
+    red in H'0.
+    elim H'0; intros H'1 H'2; try exact H'1; clear H'0. (* PB *)
+    red in |- *; intro H'0; apply H'2.
+    rewrite H'0; auto 8 using add_soustr_xy, add_soustr_1, add_soustr_2 with sets.
+  Qed.
+  
+  Lemma Sub_Add_new :
+    forall (X:Ensemble U) (x:U), ~ In U X x -> X = Subtract U (Add U X x) x.
+  Proof.
+    auto using incl_soustr_add_l with sets.
+  Qed.
+  
+  Lemma Simplify_add :
+    forall (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 :
+    forall (X A:Ensemble U) (x:U),
+      Included U X (Add U A x) ->
+      Included U X A \/ (exists 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 using incl_soustr_in, add_soustr_xy, add_soustr_1, add_soustr_2 with sets.
+    red in H'0.
+    red in |- *.
+    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 in |- *.
+    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 :
+    forall A x y:Ensemble U,
+      covers (Ensemble U) (Power_set_PO U A) y x ->
+      Strict_Included U x y /\
+      (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y).
+  Proof.
+    intros A x y H'; elim H'.
+    unfold Strict_Rel_of in |- *; simpl in |- *.
+    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 :
+    forall A a:Ensemble U,
+      Included U a A ->
+      forall 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 in |- *.
+    split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets.
+    apply H'1.
+    rewrite H'2; auto with sets.
+    red in |- *; intro H'2; elim H'2; clear H'2.
+    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 in |- *.
+    intros x1 H'10; elim H'10; auto with sets.
+    intros x2 H'11; elim H'11; auto with sets.
+  Qed.
+  
+  Theorem covers_Add :
+    forall A a a':Ensemble U,
+      Included U a A ->
+      Included U a' A ->
+      covers (Ensemble U) (Power_set_PO U A) a' a ->
+      exists 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 in |- *; intro H'8; try exact H'8.
+    apply H'3.
+    rewrite H'8; auto with sets.
+    auto with sets.
+    red in |- *.
+    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.
 
-Lemma incl_soustr_add_r :
- forall (X:Ensemble U) (x:U),
-   ~ In U X x -> Included U X (Subtract U (Add U X x) x).
-Proof.
-intros X x H'; red in |- *.
-intros x0 H'0; try assumption.
-apply Subtract_intro; auto with sets.
-red in |- *; intro H'1; apply H'; rewrite H'1; auto with sets.
-Qed.
-Hint Resolve incl_soustr_add_r: sets v62.
-
-Lemma add_soustr_2 :
- forall (X:Ensemble U) (x:U),
-   In U X x -> Included U X (Add U (Subtract U X x) x).
-Proof.
-intros X x H'; red in |- *.
-intros x0 H'0; try assumption.
-elim (classic (x = x0)); intro K; auto with sets.
-elim K; auto with sets.
-Qed.
-
-Lemma add_soustr_1 :
- forall (X:Ensemble U) (x:U),
-   In U X x -> Included U (Add U (Subtract U X x) x) X.
-Proof.
-intros X x H'; red in |- *.
-intros 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.
-Hint Resolve add_soustr_1 add_soustr_2: sets v62.
-
-Lemma add_soustr_xy :
- forall (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 in |- *.
-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.
-Hint Resolve add_soustr_xy: sets v62.
-
-Lemma incl_st_add_soustr :
- forall (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 in |- *; intro H'0; apply H'2.
-rewrite H'0; auto 8 with sets.
-Qed.
-
-Lemma Sub_Add_new :
- forall (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 :
- forall (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 :
- forall (X A:Ensemble U) (x:U),
-   Included U X (Add U A x) ->
-   Included U X A \/ (exists 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 in |- *.
-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 in |- *.
-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 :
- forall A x y:Ensemble U,
-   covers (Ensemble U) (Power_set_PO U A) y x ->
-   Strict_Included U x y /\
-   (forall z:Ensemble U, Included U x z -> Included U z y -> x = z \/ z = y).
-Proof.
-intros A x y H'; elim H'.
-unfold Strict_Rel_of in |- *; simpl in |- *.
-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 :
- forall A a:Ensemble U,
-   Included U a A ->
-   forall 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 in |- *.
-split; [ idtac | red in |- *; intro H'2; try exact H'2 ]; auto with sets.
-apply H'1.
-rewrite H'2; auto with sets.
-red in |- *; intro H'2; elim H'2; clear H'2.
-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 in |- *.
-intros x1 H'10; elim H'10; auto with sets.
-intros x2 H'11; elim H'11; auto with sets.
-Qed.
-
-Theorem covers_Add :
- forall A a a':Ensemble U,
-   Included U a A ->
-   Included U a' A ->
-   covers (Ensemble U) (Power_set_PO U A) a' a ->
-    exists 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 in |- *; intro H'8; try exact H'8.
-apply H'3.
-rewrite H'8; auto with sets.
-auto with sets.
-red in |- *.
-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 :
- forall A a a':Ensemble U,
-   Included U a A ->
-   Included U a' A ->
-   (covers (Ensemble U) (Power_set_PO U A) a' a <->
-    (exists 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 :
- forall (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 :
- forall (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.
+  Theorem covers_is_Add :
+    forall A a a':Ensemble U,
+      Included U a A ->
+      Included U a' A ->
+      (covers (Ensemble U) (Power_set_PO U A) a' a <->
+	(exists 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 :
+    forall (x:U) (A:Ensemble U),
+      In U A x ->
+      covers (Ensemble U) (Power_set_PO U A) (Singleton U x) (Empty_set U).
+  Proof.
+    intros x A H'.
+    rewrite <- (Empty_set_zero' U x).
+    apply Add_covers; auto with sets.
+  Qed.
+  
+  Lemma less_than_singleton :
+    forall (X:Ensemble U) (x:U),
+      Strict_Included U X (Singleton U x) -> X = Empty_set U.
+  Proof.
+    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.
 
@@ -339,4 +335,4 @@ Hint Resolve incl_soustr: sets v62.
 Hint Resolve incl_soustr_add_l: sets v62.
 Hint Resolve incl_soustr_add_r: sets v62.
 Hint Resolve add_soustr_1 add_soustr_2: sets v62.
-Hint Resolve add_soustr_xy: sets v62.
\ No newline at end of file
+Hint Resolve add_soustr_xy: sets v62.
diff --git a/theories/Sets/Powerset_facts.v b/theories/Sets/Powerset_facts.v
index 47ef2ea7..edb6a215 100644
--- a/theories/Sets/Powerset_facts.v
+++ b/theories/Sets/Powerset_facts.v
@@ -24,7 +24,7 @@
 (* in Summer 1995. Several developments by E. Ledinot were an inspiration.  *)
 (****************************************************************************)
 
-(*i $Id: Powerset_facts.v 8642 2006-03-17 10:09:02Z notin $ i*)
+(*i $Id: Powerset_facts.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Export Ensembles.
 Require Export Constructive_sets.
@@ -35,231 +35,223 @@ Require Export Cpo.
 Require Export Powerset.
 
 Section Sets_as_an_algebra.
-Variable U : Type.
-Hint Unfold not.
+  Variable U : Type.
 
-Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X.
-Proof.
-auto 6 with sets.
-Qed.
-Hint Resolve Empty_set_zero.
+  Theorem Empty_set_zero : forall X:Ensemble U, Union U (Empty_set U) X = X.
+  Proof.
+    auto 6 with sets.
+  Qed.
+  
+  Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x.
+  Proof.
+    unfold Add at 1 in |- *; auto using Empty_set_zero with sets.
+  Qed.
+  
+  Lemma less_than_empty :
+    forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U.
+  Proof.
+    auto with sets.
+  Qed.
+  
+  Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A.
+  Proof.
+    auto with sets.
+  Qed.
+  
+  Theorem Union_associative :
+    forall 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.
+  
+  Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A.
+  Proof.
+    auto 7 with sets.
+  Qed.
+  
+  Lemma Union_absorbs :
+    forall A B:Ensemble U, Included U B A -> Union U A B = A.
+  Proof.
+    auto 7 with sets.
+  Qed.
 
-Theorem Empty_set_zero' : forall x:U, Add U (Empty_set U) x = Singleton U x.
-Proof.
-unfold Add at 1 in |- *; auto with sets.
-Qed.
-Hint Resolve Empty_set_zero'.
+  Theorem Couple_as_union :
+    forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y.
+  Proof.
+    intros x y; apply Extensionality_Ensembles; split; red in |- *.
+    intros 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 :
+    forall 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 in |- *.
+    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 : forall 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 :
+    forall 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 :
+    forall A B:Ensemble U, Intersection U A B = Intersection U B A.
+  Proof.
+    intros A B.
+    apply Extensionality_Ensembles.
+    split; red in |- *; intros x H'; elim H'; auto with sets.
+  Qed.
+  
+  Theorem Distributivity :
+    forall 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 in |- *; 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' :
+    forall 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 in |- *; 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 :
+    forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x).
+  Proof.
+    unfold Add in |- *; auto using Union_associative with sets.
+  Qed.
+  
+  Theorem Non_disjoint_union :
+    forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X.
+  Proof.
+    intros X x H'; unfold Add in |- *.
+    apply Extensionality_Ensembles; red in |- *.
+    split; red in |- *; auto with sets.
+    intros x0 H'0; elim H'0; auto with sets.
+    intros t H'1; elim H'1; auto with sets.
+  Qed.
+  
+  Theorem Non_disjoint_union' :
+    forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X.
+  Proof.
+    intros X x H'; unfold Subtract in |- *.
+    apply Extensionality_Ensembles.
+    split; red in |- *; auto with sets.
+    intros x0 H'0; elim H'0; auto with sets.
+    intros x0 H'0; apply Setminus_intro; auto with sets.
+    red in |- *; intro H'1; elim H'1.
+    lapply (Singleton_inv U x x0); auto with sets.
+    intro H'4; apply H'; rewrite H'4; auto with sets.
+  Qed.
+  
+  Lemma singlx : forall 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.
+  
+  Lemma incl_add :
+    forall (A B:Ensemble U) (x:U),
+      Included U A B -> Included U (Add U A x) (Add U B x).
+  Proof.
+    intros A B x H'; red in |- *; auto with sets.
+    intros 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.
 
-Lemma less_than_empty :
- forall X:Ensemble U, Included U X (Empty_set U) -> X = Empty_set U.
-Proof.
-auto with sets.
-Qed.
-Hint Resolve less_than_empty.
+  Lemma incl_add_x :
+    forall (A B:Ensemble U) (x:U),
+      ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B.
+  Proof.
+    unfold Included in |- *.
+    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 :
+    forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x.
+  Proof.
+    intros A x y.
+    unfold Add in |- *.
+    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' :
+    forall (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 :
+    forall (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 Add at 4 in |- *.
+    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.
 
-Theorem Union_commutative : forall A B:Ensemble U, Union U A B = Union U B A.
-Proof.
-auto with sets.
-Qed.
-
-Theorem Union_associative :
- forall 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.
-Hint Resolve Union_associative.
-
-Theorem Union_idempotent : forall A:Ensemble U, Union U A A = A.
-Proof.
-auto 7 with sets.
-Qed.
-
-Lemma Union_absorbs :
- forall A B:Ensemble U, Included U B A -> Union U A B = A.
-Proof.
-auto 7 with sets.
-Qed.
-
-Theorem Couple_as_union :
- forall x y:U, Union U (Singleton U x) (Singleton U y) = Couple U x y.
-Proof.
-intros x y; apply Extensionality_Ensembles; split; red in |- *.
-intros 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 :
- forall 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 in |- *.
-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 : forall 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 :
- forall 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 :
- forall A B:Ensemble U, Intersection U A B = Intersection U B A.
-Proof.
-intros A B.
-apply Extensionality_Ensembles.
-split; red in |- *; intros x H'; elim H'; auto with sets.
-Qed.
-
-Theorem Distributivity :
- forall 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 in |- *; 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' :
- forall 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 in |- *; 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 :
- forall (A B:Ensemble U) (x:U), Add U (Union U A B) x = Union U A (Add U B x).
-Proof.
-unfold Add in |- *; auto with sets.
-Qed.
-Hint Resolve Union_add.
-
-Theorem Non_disjoint_union :
- forall (X:Ensemble U) (x:U), In U X x -> Add U X x = X.
-intros X x H'; unfold Add in |- *.
-apply Extensionality_Ensembles; red in |- *.
-split; red in |- *; 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' :
- forall (X:Ensemble U) (x:U), ~ In U X x -> Subtract U X x = X.
-Proof.
-intros X x H'; unfold Subtract in |- *.
-apply Extensionality_Ensembles.
-split; red in |- *; auto with sets.
-intros x0 H'0; elim H'0; auto with sets.
-intros x0 H'0; apply Setminus_intro; auto with sets.
-red in |- *; intro H'1; elim H'1.
-lapply (Singleton_inv U x x0); auto with sets.
-intro H'4; apply H'; rewrite H'4; auto with sets.
-Qed.
-
-Lemma singlx : forall 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.
-Hint Resolve singlx.
-
-Lemma incl_add :
- forall (A B:Ensemble U) (x:U),
-   Included U A B -> Included U (Add U A x) (Add U B x).
-Proof.
-intros A B x H'; red in |- *; auto with sets.
-intros 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.
-Hint Resolve incl_add.
-
-Lemma incl_add_x :
- forall (A B:Ensemble U) (x:U),
-   ~ In U A x -> Included U (Add U A x) (Add U B x) -> Included U A B.
-Proof.
-unfold Included in |- *.
-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 :
- forall (A:Ensemble U) (x y:U), Add U (Add U A x) y = Add U (Add U A y) x.
-Proof.
-intros A x y.
-unfold Add in |- *.
-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' :
- forall (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 :
- forall (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 Add at 4 in |- *.
-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 :
- forall (U:Type) (A x y:Ensemble U),
-   Strict_Included U x y ->
-   ~ (exists 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.
-Hint Resolve setcover_intro.
+  Lemma setcover_intro :
+    forall (U:Type) (A x y:Ensemble U),
+      Strict_Included U x y ->
+      ~ (exists 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.
 
 End Sets_as_an_algebra.
 
diff --git a/theories/Sorting/Heap.v b/theories/Sorting/Heap.v
index 346ae95a..e1e026f5 100644
--- a/theories/Sorting/Heap.v
+++ b/theories/Sorting/Heap.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Heap.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Heap.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** A development of Treesort on Heap trees *)
 
@@ -21,207 +21,216 @@ Require Import Sorting.
 
 Section defs.
 
-Variable A : Set.
-Variable leA : relation A.
-Variable eqA : relation A.
+  (** * Trees and heap trees *)
 
-Let gtA (x y:A) := ~ leA x y.
+  (** ** Definition of trees over an ordered set *)
 
-Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
-Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
-Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
+  Variable A : Set.
+  Variable leA : relation A.
+  Variable eqA : relation A.
 
-Hint Resolve leA_refl.
-Hint Immediate eqA_dec leA_dec leA_antisym.
+  Let gtA (x y:A) := ~ leA x y.
+  
+  Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
+  Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+  Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
+  Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
+  Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
 
-Let emptyBag := EmptyBag A.
-Let singletonBag := SingletonBag _ eqA_dec.
+  Hint Resolve leA_refl.
+  Hint Immediate eqA_dec leA_dec leA_antisym.
 
-Inductive Tree : Set :=
-  | Tree_Leaf : Tree
-  | Tree_Node : A -> Tree -> Tree -> Tree.
+  Let emptyBag := EmptyBag A.
+  Let 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] *)
+  (** [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) :=
-  match t with
-  | Tree_Leaf => True
-  | Tree_Node b T1 T2 => leA a b
-  end.
+  Definition leA_Tree (a:A) (t:Tree) :=
+    match t with
+      | Tree_Leaf => True
+      | Tree_Node b T1 T2 => leA a b
+    end.
 
-Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf.
-Proof.
-simpl in |- *; auto with datatypes.
-Qed.
+  Lemma leA_Tree_Leaf : forall a:A, leA_Tree a Tree_Leaf.
+  Proof.
+    simpl in |- *; auto with datatypes.
+  Qed.
 
-Lemma leA_Tree_Node :
- forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D).
-Proof.
-simpl in |- *; auto with datatypes.
-Qed.
+  Lemma leA_Tree_Node :
+    forall (a b:A) (G D:Tree), leA a b -> leA_Tree a (Tree_Node b G D).
+  Proof.
+    simpl in |- *; auto with datatypes.
+  Qed.
 
-Hint Resolve leA_Tree_Leaf leA_Tree_Node.
 
+  (** ** The heap property *)
 
-(** The heap property *)
-
-Inductive is_heap : Tree -> Prop :=
-  | nil_is_heap : is_heap Tree_Leaf
-  | node_is_heap :
+  Inductive is_heap : Tree -> Prop :=
+    | nil_is_heap : is_heap Tree_Leaf
+    | node_is_heap :
       forall (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 Constructors is_heap.
-
-Lemma invert_heap :
- forall (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 :
- forall P:Tree -> Set,
-   P Tree_Leaf ->
-   (forall (a:A) (T1 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)) ->
-   forall T:Tree, is_heap T -> P T.
-Proof.
-simple 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 :
- forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T.
-Proof.
-simple induction T; auto with datatypes.
-intros; simpl in |- *; apply leA_trans with b; auto with datatypes.
-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 :=
-  match t with
-  | 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 :=
+  Lemma invert_heap :
+    forall (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 :
+    forall P:Tree -> Set,
+      P Tree_Leaf ->
+      (forall (a:A) (T1 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)) ->
+      forall T:Tree, is_heap T -> P T.
+  Proof.
+    simple 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 :
+    forall (T:Tree) (a b:A), leA a b -> leA_Tree b T -> leA_Tree a T.
+  Proof.
+    simple induction T; auto with datatypes.
+    intros; simpl in |- *; apply leA_trans with b; auto with datatypes.
+  Qed.
+
+
+  (** ** From trees to multisets *)
+
+  (** 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 :=
+    match t with
+      | 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).
+
+
+
+  (** * From lists to sorted lists *)
+
+  (** ** Specification of heap insertion *)
+
+  Inductive insert_spec (a:A) (T:Tree) : Set :=
     insert_exist :
-      forall T1:Tree,
-        is_heap T1 ->
-        meq (contents T1) (munion (contents T) (singletonBag a)) ->
-        (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) ->
-        insert_spec a T.
-
-
-Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T.
-Proof.
-simple induction 1; intros.
-apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf);
- auto with datatypes.
-simpl in |- *; unfold meq, munion in |- *; 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 in |- *; 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 in |- *; apply treesort_twist2; trivial with datatypes. 
-Qed.
-
-(** building a heap from a list *)
-
-Inductive build_heap (l:list A) : Set :=
+    forall T1:Tree,
+      is_heap T1 ->
+      meq (contents T1) (munion (contents T) (singletonBag a)) ->
+      (forall b:A, leA b a -> leA_Tree b T -> leA_Tree b T1) ->
+      insert_spec a T.
+
+
+  Lemma insert : forall T:Tree, is_heap T -> forall a:A, insert_spec a T.
+  Proof.
+    simple induction 1; intros.
+    apply insert_exist with (Tree_Node a Tree_Leaf Tree_Leaf);
+      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
+    simpl in |- *; unfold meq, munion in |- *; auto using node_is_heap with datatypes.
+    elim (leA_dec a a0); intros.
+    elim (H3 a0); intros.
+    apply insert_exist with (Tree_Node a T2 T0);
+      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
+    simpl in |- *; apply treesort_twist1; trivial with datatypes. 
+    elim (H3 a); intros T3 HeapT3 ConT3 LeA.
+    apply insert_exist with (Tree_Node a0 T2 T3); 
+      auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
+    apply node_is_heap; auto using node_is_heap, nil_is_heap, leA_Tree_Leaf with datatypes.
+    apply low_trans with a; auto with datatypes. 
+    apply LeA; auto with datatypes.
+    apply low_trans with a; auto with datatypes.
+    simpl in |- *; apply treesort_twist2; trivial with datatypes. 
+  Qed.
+
+
+  (** ** Building a heap from a list *)
+
+  Inductive build_heap (l:list A) : Set :=
     heap_exist :
-      forall T:Tree,
-        is_heap T ->
-        meq (list_contents _ eqA_dec l) (contents T) -> build_heap l.
-
-Lemma list_to_heap : forall l:list A, build_heap l.
-Proof.
-simple induction l.
-apply (heap_exist nil Tree_Leaf); auto with datatypes.
-simpl in |- *; unfold meq in |- *; auto with datatypes.
-simple induction 1.
-intros T i m; elim (insert T i a).
-intros; apply heap_exist with T1; simpl in |- *; 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 :=
+    forall T:Tree,
+      is_heap T ->
+      meq (list_contents _ eqA_dec l) (contents T) -> build_heap l.
+  
+  Lemma list_to_heap : forall l:list A, build_heap l.
+  Proof.
+    simple induction l.
+    apply (heap_exist nil Tree_Leaf); auto with datatypes.
+    simpl in |- *; unfold meq in |- *; exact nil_is_heap.
+    simple induction 1.
+    intros T i m; elim (insert T i a).
+    intros; apply heap_exist with T1; simpl in |- *; auto with datatypes.
+    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 :
-      forall l:list A,
-        sort leA l ->
-        (forall 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 : forall T:Tree, is_heap T -> flat_spec T.
-Proof.
-  intros T h; elim h; intros.
-  apply flat_exist with (nil (A:=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 (a :: l); simpl in |- *; 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 :
- forall l:list A, {m : list A | sort leA m &  permutation _ eqA_dec l m}.
-Proof.
-  intro l; unfold permutation in |- *.
-  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.
+    forall l:list A,
+      sort leA l ->
+      (forall 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 : forall T:Tree, is_heap T -> flat_spec T.
+  Proof.
+    intros T h; elim h; intros.
+    apply flat_exist with (nil (A:=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 (a :: l); simpl in |- *; 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 :
+    forall l:list A, {m : list A | sort leA m &  permutation _ eqA_dec l m}.
+  Proof.
+    intro l; unfold permutation in |- *.
+    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.
\ No newline at end of file
diff --git a/theories/Sorting/PermutEq.v b/theories/Sorting/PermutEq.v
index e56ff27d..f4986198 100644
--- a/theories/Sorting/PermutEq.v
+++ b/theories/Sorting/PermutEq.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PermutEq.v 8853 2006-05-23 18:17:38Z herbelin $ i*)
+(*i $Id: PermutEq.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Omega.
 Require Import Relations.
@@ -18,224 +18,224 @@ Require Import Permutation.
 Set Implicit Arguments.
 
 (** This file is similar to [PermutSetoid], except that the equality used here
-      is Coq usual one instead of a setoid equality. In particular, we can then 
-      prove the equivalence between [List.Permutation] and 
-      [Permutation.permutation].
+    is Coq usual one instead of a setoid equality. In particular, we can then 
+    prove the equivalence between [List.Permutation] and 
+    [Permutation.permutation].
 *)
 
 Section Perm.
-
-Variable A : Set.
-Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}.
-
-Notation permutation := (permutation _ eq_dec).
-Notation list_contents := (list_contents _ eq_dec).
-
-(** we can use [multiplicity] to define [In] and [NoDup]. *)
-
-Lemma multiplicity_In : 
-  forall l a, In a l <-> 0 < multiplicity (list_contents l) a.
-Proof.
-induction l.
-simpl.
-split; inversion 1.
-simpl.
-split; intros.
-inversion_clear H.
-subst a0.
-destruct (eq_dec a a) as [_|H]; auto with arith; destruct H; auto.
-destruct (eq_dec a a0) as [H1|H1]; auto with arith; simpl.
-rewrite <- IHl; auto.
-destruct (eq_dec a a0); auto.
-simpl in H.
-right; rewrite IHl; auto.
-Qed.
-
-Lemma multiplicity_In_O :
-  forall l a, ~ In a l -> multiplicity (list_contents l) a = 0.
-Proof.
-intros l a; rewrite multiplicity_In; 
- destruct (multiplicity (list_contents l) a); auto.
-destruct 1; auto with arith.
-Qed.
-
-Lemma multiplicity_In_S :
- forall l a, In a l -> multiplicity (list_contents l) a >= 1.
-Proof.
-intros l a; rewrite multiplicity_In; auto.
-Qed.
-
-Lemma multiplicity_NoDup : 
-  forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1).
-Proof.
-induction l.
-simpl.
-split; auto with arith.
-intros; apply NoDup_nil.
-split; simpl.
-inversion_clear 1.
-rewrite IHl in H1.
-intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto.
-subst a0.
-rewrite multiplicity_In_O; auto.
-intros; constructor.
-rewrite multiplicity_In.
-generalize (H a).
-destruct (eq_dec a a) as [H0|H0].
-destruct (multiplicity (list_contents l) a); auto with arith.
-simpl; inversion 1. 
-inversion H3.
-destruct H0; auto.
-rewrite IHl; intros.
-generalize (H a0); auto with arith.
-destruct (eq_dec a a0); simpl; auto with arith.
-Qed.
-
-Lemma NoDup_permut : 
-  forall l l', NoDup l -> NoDup l' -> 
-     (forall x, In x l <-> In x l') -> permutation l l'.
-Proof.
-intros.
-red; unfold meq; intros.
-rewrite multiplicity_NoDup in H, H0. 
-generalize (H a) (H0 a) (H1 a); clear H H0 H1.
-do 2 rewrite multiplicity_In.
-destruct 3; omega.
-Qed.
-
-(** Permutation is compatible with In. *)
-Lemma permut_In_In :
-  forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2.
-Proof.
-unfold Permutation.permutation, meq; intros l1 l2 e P IN.
-generalize (P e); clear P.
-destruct (In_dec eq_dec e l2) as [H|H]; auto.
-rewrite (multiplicity_In_O _ _ H).
-intros.
-generalize (multiplicity_In_S _ _ IN).
-rewrite H0.
-inversion 1.
-Qed.
-
-Lemma permut_cons_In :
-  forall l1 l2 e, permutation (e :: l1) l2 -> In e l2.
-Proof.
-intros; eapply permut_In_In; eauto.
-red; auto.
-Qed.
-
-(** Permutation of an empty list. *)
-Lemma permut_nil :
- forall l, permutation l nil -> l = nil.
-Proof.
-intro l; destruct l as [ | e l ]; trivial.
-assert (In e (e::l)) by (red; auto).
-intro Abs; generalize (permut_In_In _ Abs H).
-inversion 1.
-Qed.
-
-(** When used with [eq], this permutation notion is equivalent to 
-  the one defined in [List.v]. *)
-
-Lemma permutation_Permutation : 
- forall l l', Permutation l l' <-> permutation l l'.
-Proof.
-split.
-induction 1.
-apply permut_refl.
-apply permut_cons; auto.
-change (permutation (y::x::l) ((x::nil)++y::l)).
-apply permut_add_cons_inside; simpl; apply permut_refl.
-apply permut_tran with l'; auto.
-revert l'.
-induction l.
-intros.
-rewrite (permut_nil (permut_sym H)).
-apply Permutation_refl.
-intros.
-destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)).
-subst l'.
-apply Permutation_cons_app.
-apply IHl.
-apply permut_remove_hd with a; auto.
-Qed.
-
-(** Permutation for short lists. *)
-
-Lemma permut_length_1:
- forall a b, permutation (a :: nil) (b :: nil)  -> a=b.
-Proof.
-intros a b; unfold Permutation.permutation, meq; intro P;
-generalize (P b); clear P; simpl.
-destruct (eq_dec b b) as [H|H]; [ | destruct H; auto].
-destruct (eq_dec a b); simpl; auto; intros; discriminate.
-Qed.
-
-Lemma permut_length_2 :
- forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) ->
- (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1).
-Proof.
-intros a1 b1 a2 b2 P.
-assert (H:=permut_cons_In P).
-inversion_clear H.
-left; split; auto.
-apply permut_length_1.
-red; red; intros.
-generalize (P a); clear P; simpl.
-destruct (eq_dec a1 a) as [H2|H2]; 
- destruct (eq_dec a2 a) as [H3|H3]; auto.
-destruct H3; transitivity a1; auto.
-destruct H2; transitivity a2; auto.
-right.
-inversion_clear H0; [|inversion H].
-split; auto.
-apply permut_length_1.
-red; red; intros.
-generalize (P a); clear P; simpl.
-destruct (eq_dec a1 a) as [H2|H2]; 
- destruct (eq_dec b2 a) as [H3|H3]; auto.
-simpl; rewrite <- plus_n_Sm; inversion 1; auto.
-destruct H3; transitivity a1; auto.
-destruct H2; transitivity b2; auto.
-Qed.
-
-(** Permutation is compatible with length. *)
-Lemma permut_length :
- forall l1 l2, permutation l1 l2 -> length l1 = length l2.
-Proof.
-induction l1; intros l2 H.
-rewrite (permut_nil (permut_sym H)); auto.
-destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)).
-subst l2.
-rewrite app_length.
-simpl; rewrite <- plus_n_Sm; f_equal.
-rewrite <- app_length.
-apply IHl1.
-apply permut_remove_hd with a; auto.
-Qed.
-
-Variable B : Set.
-Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. 
-
-(** Permutation is compatible with map. *)
-
-Lemma permutation_map :
-  forall f l1 l2, permutation l1 l2 -> 
-   Permutation.permutation _ eqB_dec (map f l1) (map f l2).
-Proof.
-intros f; induction l1.
-intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl.
-intros l2 P.
-simpl.
-destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)).
-subst l2.
-rewrite map_app.
-simpl.
-apply permut_add_cons_inside.
-rewrite <- map_app.
-apply IHl1; auto.
-apply permut_remove_hd with a; auto.
-Qed.
+  
+  Variable A : Set.
+  Hypothesis eq_dec : forall x y:A, {x=y} + {~ x=y}.
+  
+  Notation permutation := (permutation _ eq_dec).
+  Notation list_contents := (list_contents _ eq_dec).
+
+  (** we can use [multiplicity] to define [In] and [NoDup]. *)
+
+  Lemma multiplicity_In : 
+    forall l a, In a l <-> 0 < multiplicity (list_contents l) a.
+  Proof.
+    induction l.
+    simpl.
+    split; inversion 1.
+    simpl.
+    split; intros.
+    inversion_clear H.
+    subst a0.
+    destruct (eq_dec a a) as [_|H]; auto with arith; destruct H; auto.
+    destruct (eq_dec a a0) as [H1|H1]; auto with arith; simpl.
+    rewrite <- IHl; auto.
+    destruct (eq_dec a a0); auto.
+    simpl in H.
+    right; rewrite IHl; auto.
+  Qed.
+
+  Lemma multiplicity_In_O :
+    forall l a, ~ In a l -> multiplicity (list_contents l) a = 0.
+  Proof.
+    intros l a; rewrite multiplicity_In; 
+      destruct (multiplicity (list_contents l) a); auto.
+    destruct 1; auto with arith.
+  Qed.
+  
+  Lemma multiplicity_In_S :
+    forall l a, In a l -> multiplicity (list_contents l) a >= 1.
+  Proof.
+    intros l a; rewrite multiplicity_In; auto.
+  Qed.
+
+  Lemma multiplicity_NoDup : 
+    forall l, NoDup l <-> (forall a, multiplicity (list_contents l) a <= 1).
+  Proof.
+    induction l.
+    simpl.
+    split; auto with arith.
+    intros; apply NoDup_nil.
+    split; simpl.
+    inversion_clear 1.
+    rewrite IHl in H1.
+    intros; destruct (eq_dec a a0) as [H2|H2]; simpl; auto.
+    subst a0.
+    rewrite multiplicity_In_O; auto.
+    intros; constructor.
+    rewrite multiplicity_In.
+    generalize (H a).
+    destruct (eq_dec a a) as [H0|H0].
+    destruct (multiplicity (list_contents l) a); auto with arith.
+    simpl; inversion 1. 
+    inversion H3.
+    destruct H0; auto.
+    rewrite IHl; intros.
+    generalize (H a0); auto with arith.
+    destruct (eq_dec a a0); simpl; auto with arith.
+  Qed.
+
+  Lemma NoDup_permut : 
+    forall l l', NoDup l -> NoDup l' -> 
+      (forall x, In x l <-> In x l') -> permutation l l'.
+  Proof.
+    intros.
+    red; unfold meq; intros.
+    rewrite multiplicity_NoDup in H, H0. 
+    generalize (H a) (H0 a) (H1 a); clear H H0 H1.
+    do 2 rewrite multiplicity_In.
+    destruct 3; omega.
+  Qed.
+
+  (** Permutation is compatible with In. *)
+  Lemma permut_In_In :
+    forall l1 l2 e, permutation l1 l2 -> In e l1 -> In e l2.
+  Proof.
+    unfold Permutation.permutation, meq; intros l1 l2 e P IN.
+    generalize (P e); clear P.
+    destruct (In_dec eq_dec e l2) as [H|H]; auto.
+    rewrite (multiplicity_In_O _ _ H).
+    intros.
+    generalize (multiplicity_In_S _ _ IN).
+    rewrite H0.
+    inversion 1.
+  Qed.
+
+  Lemma permut_cons_In :
+    forall l1 l2 e, permutation (e :: l1) l2 -> In e l2.
+  Proof.
+    intros; eapply permut_In_In; eauto.
+    red; auto.
+  Qed.
+
+  (** Permutation of an empty list. *)
+  Lemma permut_nil :
+    forall l, permutation l nil -> l = nil.
+  Proof.
+    intro l; destruct l as [ | e l ]; trivial.
+    assert (In e (e::l)) by (red; auto).
+    intro Abs; generalize (permut_In_In _ Abs H).
+    inversion 1.
+  Qed.
+  
+  (** When used with [eq], this permutation notion is equivalent to 
+      the one defined in [List.v]. *)
+
+  Lemma permutation_Permutation : 
+    forall l l', Permutation l l' <-> permutation l l'.
+  Proof.
+    split.
+    induction 1.
+    apply permut_refl.
+    apply permut_cons; auto.
+    change (permutation (y::x::l) ((x::nil)++y::l)).
+    apply permut_add_cons_inside; simpl; apply permut_refl.
+    apply permut_tran with l'; auto.
+    revert l'.
+    induction l.
+    intros.
+    rewrite (permut_nil (permut_sym H)).
+    apply Permutation_refl.
+    intros.
+    destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)).
+    subst l'.
+    apply Permutation_cons_app.
+    apply IHl.
+    apply permut_remove_hd with a; auto.
+  Qed.
+
+  (** Permutation for short lists. *)
+
+  Lemma permut_length_1:
+    forall a b, permutation (a :: nil) (b :: nil)  -> a=b.
+  Proof.
+    intros a b; unfold Permutation.permutation, meq; intro P;
+      generalize (P b); clear P; simpl.
+    destruct (eq_dec b b) as [H|H]; [ | destruct H; auto].
+    destruct (eq_dec a b); simpl; auto; intros; discriminate.
+  Qed.
+  
+  Lemma permut_length_2 :
+    forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) ->
+      (a1=a2) /\ (b1=b2) \/ (a1=b2) /\ (a2=b1).
+  Proof.
+    intros a1 b1 a2 b2 P.
+    assert (H:=permut_cons_In P).
+    inversion_clear H.
+    left; split; auto.
+    apply permut_length_1.
+    red; red; intros.
+    generalize (P a); clear P; simpl.
+    destruct (eq_dec a1 a) as [H2|H2]; 
+      destruct (eq_dec a2 a) as [H3|H3]; auto.
+    destruct H3; transitivity a1; auto.
+    destruct H2; transitivity a2; auto.
+    right.
+    inversion_clear H0; [|inversion H].
+    split; auto.
+    apply permut_length_1.
+    red; red; intros.
+    generalize (P a); clear P; simpl.
+    destruct (eq_dec a1 a) as [H2|H2]; 
+      destruct (eq_dec b2 a) as [H3|H3]; auto.
+    simpl; rewrite <- plus_n_Sm; inversion 1; auto.
+    destruct H3; transitivity a1; auto.
+    destruct H2; transitivity b2; auto.
+  Qed.
+
+  (** Permutation is compatible with length. *)
+  Lemma permut_length :
+    forall l1 l2, permutation l1 l2 -> length l1 = length l2.
+  Proof.
+    induction l1; intros l2 H.
+    rewrite (permut_nil (permut_sym H)); auto.
+    destruct (In_split _ _ (permut_cons_In H)) as (h2,(t2,H1)).
+    subst l2.
+    rewrite app_length.
+    simpl; rewrite <- plus_n_Sm; f_equal.
+    rewrite <- app_length.
+    apply IHl1.
+    apply permut_remove_hd with a; auto.
+  Qed.
+
+  Variable B : Set.
+  Variable eqB_dec : forall x y:B, { x=y }+{ ~x=y }. 
+
+  (** Permutation is compatible with map. *)
+
+  Lemma permutation_map :
+    forall f l1 l2, permutation l1 l2 -> 
+      Permutation.permutation _ eqB_dec (map f l1) (map f l2).
+  Proof.
+    intros f; induction l1.
+    intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl.
+    intros l2 P.
+    simpl.
+    destruct (In_split _ _ (permut_cons_In P)) as (h2,(t2,H1)).
+    subst l2.
+    rewrite map_app.
+    simpl.
+    apply permut_add_cons_inside.
+    rewrite <- map_app.
+    apply IHl1; auto.
+    apply permut_remove_hd with a; auto.
+  Qed.
 
 End Perm.
 
diff --git a/theories/Sorting/PermutSetoid.v b/theories/Sorting/PermutSetoid.v
index 46ea088f..65369a01 100644
--- a/theories/Sorting/PermutSetoid.v
+++ b/theories/Sorting/PermutSetoid.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: PermutSetoid.v 8823 2006-05-16 16:17:43Z letouzey $ i*)
+(*i $Id: PermutSetoid.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Omega.
 Require Import Relations.
@@ -41,59 +41,59 @@ Variable eqA_trans : forall x y z, eqA x y -> eqA y z -> eqA x z.
 Lemma multiplicity_InA : 
   forall l a, InA eqA a l <-> 0 < multiplicity (list_contents l) a.
 Proof.
-induction l.
-simpl.
-split; inversion 1.
-simpl.
-split; intros.
-inversion_clear H.
-destruct (eqA_dec a a0) as [_|H1]; auto with arith.
-destruct H1; auto.
-destruct (eqA_dec a a0); auto with arith.
-simpl; rewrite <- IHl; auto.
-destruct (eqA_dec a a0) as [H0|H0]; auto.
-simpl in H.
-constructor 2; rewrite IHl; auto.
+  induction l.
+  simpl.
+  split; inversion 1.
+  simpl.
+  split; intros.
+  inversion_clear H.
+  destruct (eqA_dec a a0) as [_|H1]; auto with arith.
+  destruct H1; auto.
+  destruct (eqA_dec a a0); auto with arith.
+  simpl; rewrite <- IHl; auto.
+  destruct (eqA_dec a a0) as [H0|H0]; auto.
+  simpl in H.
+  constructor 2; rewrite IHl; auto.
 Qed.
 
 Lemma multiplicity_InA_O :
   forall l a, ~ InA eqA a l -> multiplicity (list_contents l) a = 0.
 Proof.
-intros l a; rewrite multiplicity_InA; 
-destruct (multiplicity (list_contents l) a); auto with arith.
-destruct 1; auto with arith.
+  intros l a; rewrite multiplicity_InA; 
+    destruct (multiplicity (list_contents l) a); auto with arith.
+  destruct 1; auto with arith.
 Qed.
 
 Lemma multiplicity_InA_S :
- forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1.
+  forall l a, InA eqA a l -> multiplicity (list_contents l) a >= 1.
 Proof.
-intros l a; rewrite multiplicity_InA; auto with arith.
+  intros l a; rewrite multiplicity_InA; auto with arith.
 Qed.
 
 Lemma multiplicity_NoDupA : forall l, 
   NoDupA eqA l <-> (forall a, multiplicity (list_contents l) a <= 1).
 Proof.
-induction l.
-simpl.
-split; auto with arith.
-split; simpl.
-inversion_clear 1.
-rewrite IHl in H1.
-intros; destruct (eqA_dec a a0) as [H2|H2]; simpl; auto.
-rewrite multiplicity_InA_O; auto.
-swap H0.
-apply InA_eqA with a0; auto.
-intros; constructor.
-rewrite multiplicity_InA.
-generalize (H a).
-destruct (eqA_dec a a) as [H0|H0].
-destruct (multiplicity (list_contents l) a); auto with arith.
-simpl; inversion 1. 
-inversion H3.
-destruct H0; auto.
-rewrite IHl; intros.
-generalize (H a0); auto with arith.
-destruct (eqA_dec a a0); simpl; auto with arith.
+  induction l.
+  simpl.
+  split; auto with arith.
+  split; simpl.
+  inversion_clear 1.
+  rewrite IHl in H1.
+  intros; destruct (eqA_dec a a0) as [H2|H2]; simpl; auto.
+  rewrite multiplicity_InA_O; auto.
+  swap H0.
+  apply InA_eqA with a0; auto.
+  intros; constructor.
+  rewrite multiplicity_InA.
+  generalize (H a).
+  destruct (eqA_dec a a) as [H0|H0].
+  destruct (multiplicity (list_contents l) a); auto with arith.
+  simpl; inversion 1. 
+  inversion H3.
+  destruct H0; auto.
+  rewrite IHl; intros.
+  generalize (H a0); auto with arith.
+  destruct (eqA_dec a a0); simpl; auto with arith.
 Qed.
 
 
@@ -101,100 +101,100 @@ Qed.
 Lemma permut_InA_InA :
   forall l1 l2 e, permutation l1 l2 -> InA eqA e l1 -> InA eqA e l2.
 Proof.
-intros l1 l2 e.
-do 2 rewrite multiplicity_InA.
-unfold Permutation.permutation, meq.
-intros H;rewrite H; auto.
+  intros l1 l2 e.
+  do 2 rewrite multiplicity_InA.
+  unfold Permutation.permutation, meq.
+  intros H;rewrite H; auto.
 Qed.
 
 Lemma permut_cons_InA :
   forall l1 l2 e, permutation (e :: l1) l2 -> InA eqA e l2.
 Proof.
-intros; apply (permut_InA_InA (e:=e) H); auto.
+  intros; apply (permut_InA_InA (e:=e) H); auto.
 Qed.
 
 (** Permutation of an empty list. *)
 Lemma permut_nil :
- forall l, permutation l nil -> l = nil.
+  forall l, permutation l nil -> l = nil.
 Proof.
-intro l; destruct l as [ | e l ]; trivial.
-assert (InA eqA e (e::l)) by auto.
-intro Abs; generalize (permut_InA_InA Abs H).
-inversion 1.
+  intro l; destruct l as [ | e l ]; trivial.
+  assert (InA eqA e (e::l)) by auto.
+  intro Abs; generalize (permut_InA_InA Abs H).
+  inversion 1.
 Qed.
 
 (** Permutation for short lists. *)
 
 Lemma permut_length_1:
- forall a b, permutation (a :: nil) (b :: nil)  -> eqA a b.
+  forall a b, permutation (a :: nil) (b :: nil)  -> eqA a b.
 Proof.
-intros a b; unfold Permutation.permutation, meq; intro P;
-generalize (P b); clear P; simpl.
-destruct (eqA_dec b b) as [H|H]; [ | destruct H; auto].
-destruct (eqA_dec a b); simpl; auto; intros; discriminate.
+  intros a b; unfold Permutation.permutation, meq; intro P;
+  generalize (P b); clear P; simpl.
+  destruct (eqA_dec b b) as [H|H]; [ | destruct H; auto].
+  destruct (eqA_dec a b); simpl; auto; intros; discriminate.
 Qed.
 
 Lemma permut_length_2 :
- forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) ->
- (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1).
+  forall a1 b1 a2 b2, permutation (a1 :: b1 :: nil) (a2 :: b2 :: nil) ->
+    (eqA a1 a2) /\ (eqA b1 b2) \/ (eqA a1 b2) /\ (eqA a2 b1).
 Proof.
-intros a1 b1 a2 b2 P.
-assert (H:=permut_cons_InA P).
-inversion_clear H.
-left; split; auto.
-apply permut_length_1.
-red; red; intros.
-generalize (P a); clear P; simpl.
-destruct (eqA_dec a1 a) as [H2|H2]; 
- destruct (eqA_dec a2 a) as [H3|H3]; auto.
-destruct H3; apply eqA_trans with a1; auto.
-destruct H2; apply eqA_trans with a2; auto.
-right.
-inversion_clear H0; [|inversion H].
-split; auto.
-apply permut_length_1.
-red; red; intros.
-generalize (P a); clear P; simpl.
-destruct (eqA_dec a1 a) as [H2|H2]; 
- destruct (eqA_dec b2 a) as [H3|H3]; auto.
-simpl; rewrite <- plus_n_Sm; inversion 1; auto.
-destruct H3; apply eqA_trans with a1; auto.
-destruct H2; apply eqA_trans with b2; auto.
+  intros a1 b1 a2 b2 P.
+  assert (H:=permut_cons_InA P).
+  inversion_clear H.
+  left; split; auto.
+  apply permut_length_1.
+  red; red; intros.
+  generalize (P a); clear P; simpl.
+  destruct (eqA_dec a1 a) as [H2|H2]; 
+    destruct (eqA_dec a2 a) as [H3|H3]; auto.
+  destruct H3; apply eqA_trans with a1; auto.
+  destruct H2; apply eqA_trans with a2; auto.
+  right.
+  inversion_clear H0; [|inversion H].
+  split; auto.
+  apply permut_length_1.
+  red; red; intros.
+  generalize (P a); clear P; simpl.
+  destruct (eqA_dec a1 a) as [H2|H2]; 
+    destruct (eqA_dec b2 a) as [H3|H3]; auto.
+  simpl; rewrite <- plus_n_Sm; inversion 1; auto.
+  destruct H3; apply eqA_trans with a1; auto.
+  destruct H2; apply eqA_trans with b2; auto.
 Qed.
 
 (** Permutation is compatible with length. *)
 Lemma permut_length :
- forall l1 l2, permutation l1 l2 -> length l1 = length l2.
+  forall l1 l2, permutation l1 l2 -> length l1 = length l2.
 Proof.
-induction l1; intros l2 H.
-rewrite (permut_nil (permut_sym H)); auto.
-assert (H0:=permut_cons_InA H).
-destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
-subst l2.
-rewrite app_length.
-simpl; rewrite <- plus_n_Sm; f_equal.
-rewrite <- app_length.
-apply IHl1.
-apply permut_remove_hd with b.
-apply permut_tran with (a::l1); auto.
-revert H1; unfold Permutation.permutation, meq; simpl.
-intros; f_equal; auto.
-destruct (eqA_dec b a0) as [H2|H2]; 
- destruct (eqA_dec a a0) as [H3|H3]; auto.
-destruct H3; apply eqA_trans with b; auto.
-destruct H2; apply eqA_trans with a; auto.
+  induction l1; intros l2 H.
+  rewrite (permut_nil (permut_sym H)); auto.
+  assert (H0:=permut_cons_InA H).
+  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
+  subst l2.
+  rewrite app_length.
+  simpl; rewrite <- plus_n_Sm; f_equal.
+  rewrite <- app_length.
+  apply IHl1.
+  apply permut_remove_hd with b.
+  apply permut_tran with (a::l1); auto.
+  revert H1; unfold Permutation.permutation, meq; simpl.
+  intros; f_equal; auto.
+  destruct (eqA_dec b a0) as [H2|H2]; 
+    destruct (eqA_dec a a0) as [H3|H3]; auto.
+  destruct H3; apply eqA_trans with b; auto.
+  destruct H2; apply eqA_trans with a; auto.
 Qed.
 
 Lemma NoDupA_eqlistA_permut : 
   forall l l', NoDupA eqA l -> NoDupA eqA l' -> 
-     eqlistA eqA l l' -> permutation l l'.
+    eqlistA eqA l l' -> permutation l l'.
 Proof.
-intros.
-red; unfold meq; intros.
-rewrite multiplicity_NoDupA in H, H0. 
-generalize (H a) (H0 a) (H1 a); clear H H0 H1.
-do 2 rewrite multiplicity_InA.
-destruct 3; omega.
+  intros.
+  red; unfold meq; intros.
+  rewrite multiplicity_NoDupA in H, H0. 
+  generalize (H a) (H0 a) (H1 a); clear H H0 H1.
+  do 2 rewrite multiplicity_InA.
+  destruct 3; omega.
 Qed.
 
 
@@ -207,37 +207,37 @@ Variable eqB_trans : forall x y z, eqB x y -> eqB y z -> eqB x z.
 
 Lemma permut_map :
   forall f, 
-  (forall x y, eqA x y -> eqB (f x) (f y)) ->
-  forall l1 l2, permutation l1 l2 -> 
-   Permutation.permutation _ eqB_dec (map f l1) (map f l2).
+    (forall x y, eqA x y -> eqB (f x) (f y)) ->
+    forall l1 l2, permutation l1 l2 -> 
+      Permutation.permutation _ eqB_dec (map f l1) (map f l2).
 Proof.
-intros f; induction l1.
-intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl.
-intros l2 P.
-simpl.
-assert (H0:=permut_cons_InA P).
-destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
-subst l2.
-rewrite map_app.
-simpl.
-apply permut_tran with (f b :: map f l1).
-revert H1; unfold Permutation.permutation, meq; simpl.
-intros; f_equal; auto.
-destruct (eqB_dec (f b) a0) as [H2|H2]; 
- destruct (eqB_dec (f a) a0) as [H3|H3]; auto.
-destruct H3; apply eqB_trans with (f b); auto.
-destruct H2; apply eqB_trans with (f a); auto.
-apply permut_add_cons_inside.
-rewrite <- map_app.
-apply IHl1; auto.
-apply permut_remove_hd with b.
-apply permut_tran with (a::l1); auto.
-revert H1; unfold Permutation.permutation, meq; simpl.
-intros; f_equal; auto.
-destruct (eqA_dec b a0) as [H2|H2]; 
- destruct (eqA_dec a a0) as [H3|H3]; auto.
-destruct H3; apply eqA_trans with b; auto.
-destruct H2; apply eqA_trans with a; auto.
+  intros f; induction l1.
+  intros l2 P; rewrite (permut_nil (permut_sym P)); apply permut_refl.
+  intros l2 P.
+  simpl.
+  assert (H0:=permut_cons_InA P).
+  destruct (InA_split H0) as (h2,(b,(t2,(H1,H2)))).
+  subst l2.
+  rewrite map_app.
+  simpl.
+  apply permut_tran with (f b :: map f l1).
+  revert H1; unfold Permutation.permutation, meq; simpl.
+  intros; f_equal; auto.
+  destruct (eqB_dec (f b) a0) as [H2|H2]; 
+    destruct (eqB_dec (f a) a0) as [H3|H3]; auto.
+  destruct H3; apply eqB_trans with (f b); auto.
+  destruct H2; apply eqB_trans with (f a); auto.
+  apply permut_add_cons_inside.
+  rewrite <- map_app.
+  apply IHl1; auto.
+  apply permut_remove_hd with b.
+  apply permut_tran with (a::l1); auto.
+  revert H1; unfold Permutation.permutation, meq; simpl.
+  intros; f_equal; auto.
+  destruct (eqA_dec b a0) as [H2|H2]; 
+    destruct (eqA_dec a a0) as [H3|H3]; auto.
+  destruct H3; apply eqA_trans with b; auto.
+  destruct H2; apply eqA_trans with a; auto.
 Qed.
 
 End Perm.
diff --git a/theories/Sorting/Permutation.v b/theories/Sorting/Permutation.v
index 0f2e02b5..3ff026c2 100644
--- a/theories/Sorting/Permutation.v
+++ b/theories/Sorting/Permutation.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Permutation.v 8823 2006-05-16 16:17:43Z letouzey $ i*)
+(*i $Id: Permutation.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Relations.
 Require Import List.
@@ -14,193 +14,194 @@ Require Import Multiset.
 Require Import Arith.
 
 (** This file define a notion of permutation for lists, based on multisets: 
-     there exists a permutation between two lists iff every elements have 
-     the same multiplicities in the two lists. 
+    there exists a permutation between two lists iff every elements have 
+    the same multiplicities in the two lists. 
 
-     Unlike [List.Permutation], the present notion of permutation requires
-     a decidable equality. At the same time, this definition can be used 
-     with a non-standard equality, whereas [List.Permutation] cannot.
+    Unlike [List.Permutation], the present notion of permutation requires
+    a decidable equality. At the same time, this definition can be used 
+    with a non-standard equality, whereas [List.Permutation] cannot.
       
-     The present file contains basic results, obtained without any particular
-     assumption on the decidable equality used.
+    The present file contains basic results, obtained without any particular
+    assumption on the decidable equality used.
 	
-     File [PermutSetoid] contains additional results about permutations 
-     with respect to an setoid equality (i.e. an equivalence relation). 
+    File [PermutSetoid] contains additional results about permutations 
+    with respect to an setoid equality (i.e. an equivalence relation). 
 
-     Finally, file [PermutEq] concerns Coq equality : this file is similar 
-     to the previous one, but proves in addition that [List.Permutation]
-     and [permutation] are equivalent in this context.
-*)
+    Finally, file [PermutEq] concerns Coq equality : this file is similar 
+    to the previous one, but proves in addition that [List.Permutation]
+    and [permutation] are equivalent in this context.
+x*)
 
 Set Implicit Arguments.
 
 Section defs.
 
-Variable A : Set.
-Variable eqA : relation A.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-
-Let emptyBag := EmptyBag A.
-Let singletonBag := SingletonBag _ eqA_dec.
-
-(** contents of a list *)
-
-Fixpoint list_contents (l:list A) : multiset A :=
-  match l with
-  | nil => emptyBag
-  | a :: l => munion (singletonBag a) (list_contents l)
-  end.
-
-Lemma list_contents_app :
- forall l m:list A,
-   meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
-Proof.
-simple induction l; simpl in |- *; auto with datatypes.
-intros.
-apply meq_trans with
- (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
- auto with datatypes.
-Qed.
-Hint Resolve list_contents_app.
-
-Definition permutation (l m:list A) :=
-  meq (list_contents l) (list_contents m).
-
-Lemma permut_refl : forall l:list A, permutation l l.
-Proof.
-unfold permutation in |- *; auto with datatypes.
-Qed.
-Hint Resolve permut_refl.
-
-Lemma permut_sym :
- forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1.
-Proof.
-unfold permutation, meq; intros; apply sym_eq; trivial.
-Qed.
-
-Lemma permut_tran :
- forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
-Proof.
-unfold permutation in |- *; intros.
-apply meq_trans with (list_contents m); auto with datatypes.
-Qed.
-
-Lemma permut_cons :
- forall l m:list A,
-   permutation l m -> forall a:A, permutation (a :: l) (a :: m).
-Proof.
-unfold permutation in |- *; simpl in |- *; auto with datatypes.
-Qed.
-Hint Resolve permut_cons.
-
-Lemma permut_app :
- forall l l' m m':list A,
-   permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
-Proof.
-unfold permutation in |- *; intros.
-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.
-Hint Resolve permut_app.
-
-Lemma permut_add_inside :
- forall a l1 l2 l3 l4, 
-  permutation (l1 ++ l2) (l3 ++ l4) ->
-  permutation (l1 ++ a :: l2) (l3 ++ a :: l4).
-Proof.
-unfold permutation, meq in *; intros.
-generalize (H a0); clear H.
-do 4 rewrite list_contents_app.
-simpl.
-destruct (eqA_dec a a0); simpl; auto with arith.
-do 2 rewrite <- plus_n_Sm; f_equal; auto.
-Qed.
-
-Lemma permut_add_cons_inside :
- forall a l l1 l2, 
-  permutation l (l1 ++ l2) ->
-  permutation (a :: l) (l1 ++ a :: l2).
-Proof.
-intros;
-replace (a :: l) with (nil ++ a :: l); trivial;
-apply permut_add_inside; trivial.
-Qed.
-
-Lemma permut_middle :
- forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m).
-Proof.
-intros; apply permut_add_cons_inside; auto.
-Qed.
-Hint Resolve permut_middle.
-
-Lemma permut_sym_app :
- forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1).
-Proof.
-intros l1 l2;
-unfold permutation, meq; 
-intro a; do 2 rewrite list_contents_app; simpl; 
-auto with arith.
-Qed.
-
-Lemma permut_rev : 
- forall l, permutation l (rev l).
-Proof.
-induction l.
-simpl; auto.
-simpl.
-apply permut_add_cons_inside.
-rewrite <- app_nil_end; auto.
-Qed.
-
-(** Some inversion results. *)
-Lemma permut_conv_inv :
-  forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2.
-Proof.
-intros e l1 l2; unfold permutation, meq; simpl; intros H a;
-generalize (H a); apply plus_reg_l.
-Qed.
-
-Lemma permut_app_inv1 : 
-  forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2.
-Proof.
-intros l l1 l2; unfold permutation, meq; simpl;
-intros H a; generalize (H a); clear H.
-do 2 rewrite list_contents_app.
-simpl.
-intros; apply plus_reg_l with (multiplicity (list_contents l) a).
-rewrite plus_comm; rewrite H; rewrite plus_comm.
-trivial.
-Qed.
-
-Lemma permut_app_inv2 : 
-  forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2.
-Proof.
-intros l l1 l2; unfold permutation, meq; simpl;
-intros H a; generalize (H a); clear H.
-do 2 rewrite list_contents_app.
-simpl.
-intros; apply plus_reg_l with (multiplicity (list_contents l) a).
-trivial.
-Qed.
-
-Lemma permut_remove_hd :
-  forall l l1 l2 a,   
-  permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2).
-Proof.
-intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H.
-do 2 rewrite list_contents_app; simpl; intro H.
-apply plus_reg_l with (if eqA_dec a a0 then 1 else 0).
-rewrite H; clear H.
-symmetry; rewrite plus_comm.
-repeat rewrite <- plus_assoc; f_equal.
-apply plus_comm.
-Qed.
+  (** * From lists to multisets *)
+
+  Variable A : Set.
+  Variable eqA : relation A.
+  Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+
+  Let emptyBag := EmptyBag A.
+  Let singletonBag := SingletonBag _ eqA_dec.
+
+  (** contents of a list *)
+
+  Fixpoint list_contents (l:list A) : multiset A :=
+    match l with
+      | nil => emptyBag
+      | a :: l => munion (singletonBag a) (list_contents l)
+    end.
+
+  Lemma list_contents_app :
+    forall l m:list A,
+      meq (list_contents (l ++ m)) (munion (list_contents l) (list_contents m)).
+  Proof.
+    simple induction l; simpl in |- *; auto with datatypes.
+    intros.
+    apply meq_trans with
+      (munion (singletonBag a) (munion (list_contents l0) (list_contents m)));
+      auto with datatypes.
+  Qed.
+
+  
+  (** * [permutation]: definition and basic properties *)
+  
+  Definition permutation (l m:list A) :=
+    meq (list_contents l) (list_contents m).
+
+  Lemma permut_refl : forall l:list A, permutation l l.
+  Proof.
+    unfold permutation in |- *; auto with datatypes.
+  Qed.
+  
+  Lemma permut_sym :
+    forall l1 l2 : list A, permutation l1 l2 -> permutation l2 l1.
+  Proof.
+    unfold permutation, meq; intros; apply sym_eq; trivial.
+  Qed.
+  
+  Lemma permut_tran :
+    forall l m n:list A, permutation l m -> permutation m n -> permutation l n.
+  Proof.
+    unfold permutation in |- *; intros.
+    apply meq_trans with (list_contents m); auto with datatypes.
+  Qed.
+  
+  Lemma permut_cons :
+    forall l m:list A,
+      permutation l m -> forall a:A, permutation (a :: l) (a :: m).
+  Proof.
+    unfold permutation in |- *; simpl in |- *; auto with datatypes.
+  Qed.
+  
+  Lemma permut_app :
+    forall l l' m m':list A,
+      permutation l l' -> permutation m m' -> permutation (l ++ m) (l' ++ m').
+  Proof.
+    unfold permutation in |- *; intros.
+    apply meq_trans with (munion (list_contents l) (list_contents m)); 
+      auto using permut_cons, list_contents_app with datatypes.
+    apply meq_trans with (munion (list_contents l') (list_contents m')); 
+      auto using permut_cons, list_contents_app with datatypes.
+    apply meq_trans with (munion (list_contents l') (list_contents m));
+      auto using permut_cons, list_contents_app with datatypes.
+  Qed.
+
+  Lemma permut_add_inside :
+    forall a l1 l2 l3 l4, 
+      permutation (l1 ++ l2) (l3 ++ l4) ->
+      permutation (l1 ++ a :: l2) (l3 ++ a :: l4).
+  Proof.
+    unfold permutation, meq in *; intros.
+    generalize (H a0); clear H.
+    do 4 rewrite list_contents_app.
+    simpl.
+    destruct (eqA_dec a a0); simpl; auto with arith.
+    do 2 rewrite <- plus_n_Sm; f_equal; auto.
+  Qed.
+  
+  Lemma permut_add_cons_inside :
+    forall a l l1 l2, 
+      permutation l (l1 ++ l2) ->
+      permutation (a :: l) (l1 ++ a :: l2).
+  Proof.
+    intros;
+      replace (a :: l) with (nil ++ a :: l); trivial;
+	apply permut_add_inside; trivial.
+  Qed.
+
+  Lemma permut_middle :
+    forall (l m:list A) (a:A), permutation (a :: l ++ m) (l ++ a :: m).
+  Proof.
+    intros; apply permut_add_cons_inside; auto using permut_sym, permut_refl.
+  Qed.
+  
+  Lemma permut_sym_app :
+    forall l1 l2, permutation (l1 ++ l2) (l2 ++ l1).
+  Proof.
+    intros l1 l2;
+      unfold permutation, meq; 
+	intro a; do 2 rewrite list_contents_app; simpl; 
+	  auto with arith.
+  Qed.
+
+  Lemma permut_rev : 
+    forall l, permutation l (rev l).
+  Proof.
+    induction l.
+    simpl; trivial using permut_refl.
+    simpl.
+    apply permut_add_cons_inside.
+    rewrite <- app_nil_end. trivial.
+  Qed.
+
+  (** * Some inversion results. *)
+  Lemma permut_conv_inv :
+    forall e l1 l2, permutation (e :: l1) (e :: l2) -> permutation l1 l2.
+  Proof.
+    intros e l1 l2; unfold permutation, meq; simpl; intros H a;
+      generalize (H a); apply plus_reg_l.
+  Qed.
+
+  Lemma permut_app_inv1 : 
+    forall l l1 l2, permutation (l1 ++ l) (l2 ++ l) -> permutation l1 l2.
+  Proof.
+    intros l l1 l2; unfold permutation, meq; simpl;
+      intros H a; generalize (H a); clear H.
+    do 2 rewrite list_contents_app.
+    simpl.
+    intros; apply plus_reg_l with (multiplicity (list_contents l) a).
+    rewrite plus_comm; rewrite H; rewrite plus_comm.
+    trivial.
+  Qed.
+
+  Lemma permut_app_inv2 : 
+    forall l l1 l2, permutation (l ++ l1) (l ++ l2) -> permutation l1 l2.
+  Proof.
+    intros l l1 l2; unfold permutation, meq; simpl;
+      intros H a; generalize (H a); clear H.
+    do 2 rewrite list_contents_app.
+    simpl.
+    intros; apply plus_reg_l with (multiplicity (list_contents l) a).
+    trivial.
+  Qed.
+
+  Lemma permut_remove_hd :
+    forall l l1 l2 a,   
+      permutation (a :: l) (l1 ++ a :: l2) -> permutation l (l1 ++ l2).
+  Proof.
+    intros l l1 l2 a; unfold permutation, meq; simpl; intros H a0; generalize (H a0); clear H.
+    do 2 rewrite list_contents_app; simpl; intro H.
+    apply plus_reg_l with (if eqA_dec a a0 then 1 else 0).
+    rewrite H; clear H.
+    symmetry; rewrite plus_comm.
+    repeat rewrite <- plus_assoc; f_equal.
+    apply plus_comm.
+  Qed.
 
 End defs.
-(* For compatibilty *) 
+
+(** For compatibilty *) 
 Notation permut_right := permut_cons.
 Unset Implicit Arguments.
diff --git a/theories/Sorting/Sorting.v b/theories/Sorting/Sorting.v
index 0e0bfe8f..f895d79e 100644
--- a/theories/Sorting/Sorting.v
+++ b/theories/Sorting/Sorting.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Sorting.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Sorting.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import List.
 Require Import Multiset.
@@ -17,107 +17,107 @@ Set Implicit Arguments.
 
 Section defs.
 
-Variable A : Set.
-Variable leA : relation A.
-Variable eqA : relation A.
+  Variable A : Set.
+  Variable leA : relation A.
+  Variable eqA : relation A.
 
-Let gtA (x y:A) := ~ leA x y.
+  Let gtA (x y:A) := ~ leA x y.
+  
+  Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
+  Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
+  Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
+  Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
+  Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
 
-Hypothesis leA_dec : forall x y:A, {leA x y} + {leA y x}.
-Hypothesis eqA_dec : forall x y:A, {eqA x y} + {~ eqA x y}.
-Hypothesis leA_refl : forall x y:A, eqA x y -> leA x y.
-Hypothesis leA_trans : forall x y z:A, leA x y -> leA y z -> leA x z.
-Hypothesis leA_antisym : forall x y:A, leA x y -> leA y x -> eqA x y.
+  Hint Resolve leA_refl.
+  Hint Immediate eqA_dec leA_dec leA_antisym.
 
-Hint Resolve leA_refl.
-Hint Immediate eqA_dec leA_dec leA_antisym.
+  Let emptyBag := EmptyBag A.
+  Let singletonBag := SingletonBag _ eqA_dec.
 
-Let emptyBag := EmptyBag A.
-Let singletonBag := SingletonBag _ eqA_dec.
+  (** [lelistA] *)
 
-(** [lelistA] *)
+  Inductive lelistA (a:A) : list A -> Prop :=
+    | nil_leA : lelistA a nil
+    | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l).
 
-Inductive lelistA (a:A) : list A -> Prop :=
-  | nil_leA : lelistA a nil
-  | cons_leA : forall (b:A) (l:list A), leA a b -> lelistA a (b :: l).
-Hint Constructors lelistA.
+  Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b.
+  Proof.
+    intros; inversion H; trivial with datatypes.
+  Qed.
 
-Lemma lelistA_inv : forall (a b:A) (l:list A), lelistA a (b :: l) -> leA a b.
-Proof.
-  intros; inversion H; trivial with datatypes.
-Qed.
+  (** * Definition for a list to be sorted *)
 
-(** definition for a list to be sorted *)
-
-Inductive sort : list A -> Prop :=
-  | nil_sort : sort nil
-  | cons_sort :
+  Inductive sort : list A -> Prop :=
+    | nil_sort : sort nil
+    | cons_sort :
       forall (a:A) (l:list A), sort l -> lelistA a l -> sort (a :: l).
-Hint Constructors sort.
-
-Lemma sort_inv :
- forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l.
-Proof.
-intros; inversion H; auto with datatypes.
-Qed.
-
-Lemma sort_rec :
- forall P:list A -> Set,
-   P nil ->
-   (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) ->
-   forall y:list A, sort y -> P y.
-Proof.
-simple induction y; auto with datatypes.
-intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes.
-Qed.
-
-(** merging two sorted lists *)
-
-Inductive merge_lem (l1 l2:list A) : Set :=
+
+  Lemma sort_inv :
+    forall (a:A) (l:list A), sort (a :: l) -> sort l /\ lelistA a l.
+  Proof.
+    intros; inversion H; auto with datatypes.
+  Qed.
+
+  Lemma sort_rec :
+    forall P:list A -> Set,
+      P nil ->
+      (forall (a:A) (l:list A), sort l -> P l -> lelistA a l -> P (a :: l)) ->
+      forall y:list A, sort y -> P y.
+  Proof.
+    simple induction y; auto with datatypes.
+    intros; elim (sort_inv (a:=a) (l:=l)); auto with datatypes.
+  Qed.
+
+  (** * Merging two sorted lists *)
+
+  Inductive merge_lem (l1 l2:list A) : Set :=
     merge_exist :
-      forall l:list A,
-        sort l ->
-        meq (list_contents _ eqA_dec l)
-          (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) ->
-        (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) ->
-        merge_lem l1 l2.
-
-Lemma merge :
- forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2.
-Proof.
-  simple induction 1; intros.
-  apply merge_exist with l2; auto with datatypes.
-  elim H3; intros.
-  apply merge_exist with (a :: l); simpl in |- *; auto with datatypes.
-  elim (leA_dec a a0); intros.
-
-(* 1 (leA a a0) *)
-  cut (merge_lem l (a0 :: l0)); auto with datatypes.
-  intros [l3 l3sorted l3contents Hrec].
-  apply merge_exist with (a :: l3); simpl in |- *; auto with datatypes.
-  apply meq_trans with
-   (munion (singletonBag a)
-      (munion (list_contents _ eqA_dec l)
-         (list_contents _ eqA_dec (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 in |- *; intros.
-  apply merge_exist with (a0 :: l3); simpl in |- *; 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.
+    forall l:list A,
+      sort l ->
+      meq (list_contents _ eqA_dec l)
+      (munion (list_contents _ eqA_dec l1) (list_contents _ eqA_dec l2)) ->
+      (forall a:A, lelistA a l1 -> lelistA a l2 -> lelistA a l) ->
+      merge_lem l1 l2.
+
+  Lemma merge :
+    forall l1:list A, sort l1 -> forall l2:list A, sort l2 -> merge_lem l1 l2.
+  Proof.
+    simple induction 1; intros.
+    apply merge_exist with l2; auto with datatypes.
+    elim H3; intros.
+    apply merge_exist with (a :: l); simpl in |- *; auto using cons_sort with datatypes.
+    elim (leA_dec a a0); intros.
+
+    (* 1 (leA a a0) *)
+    cut (merge_lem l (a0 :: l0)); auto using cons_sort with datatypes.
+    intros [l3 l3sorted l3contents Hrec].
+    apply merge_exist with (a :: l3); simpl in |- *;
+      auto using cons_sort, cons_leA with datatypes.
+    apply meq_trans with
+      (munion (singletonBag a)
+	(munion (list_contents _ eqA_dec l)
+          (list_contents _ eqA_dec (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 in |- *; intros.
+    apply merge_exist with (a0 :: l3); simpl in |- *; 
+      auto using cons_sort, cons_leA 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 Constructors sort: datatypes v62.
-Hint Constructors lelistA: datatypes v62.
\ No newline at end of file
+Hint Constructors lelistA: datatypes v62.
diff --git a/theories/Strings/Ascii.v b/theories/Strings/Ascii.v
index 919989fd..1c02be7f 100644
--- a/theories/Strings/Ascii.v
+++ b/theories/Strings/Ascii.v
@@ -6,17 +6,17 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Ascii.v 8026 2006-02-11 19:40:49Z herbelin $ *)
+(* $Id: Ascii.v 9245 2006-10-17 12:53:34Z notin $ *)
 
-(* Contributed by Laurent Théry (INRIA);
-   Adapted to Coq V8 by the Coq Development Team *)
+(** Contributed by Laurent Théry (INRIA);
+    Adapted to Coq V8 by the Coq Development Team *)
 
 Require Import Bool.
 Require Import BinPos.
 
-(** *** Definition of ascii characters *)
+(** * Definition of ascii characters *)
 
-(* Definition of ascii character as a 8 bits constructor *)
+(** Definition of ascii character as a 8 bits constructor *)
  
 Inductive ascii : Set := Ascii (_ _ _ _ _ _ _ _ : bool).
 
@@ -29,86 +29,86 @@ Definition one := Ascii true false false false false false false false.
  
 Definition app1 (f : bool -> bool) (a : ascii) :=
   match a with
-  | Ascii a1 a2 a3 a4 a5 a6 a7 a8 =>
+    | Ascii a1 a2 a3 a4 a5 a6 a7 a8 =>
       Ascii (f a1) (f a2) (f a3) (f a4) (f a5) (f a6) (f a7) (f a8)
   end.
  
 Definition app2 (f : bool -> bool -> bool) (a b : ascii) :=
   match a, b with
-  | Ascii a1 a2 a3 a4 a5 a6 a7 a8, Ascii b1 b2 b3 b4 b5 b6 b7 b8 =>
+    | Ascii a1 a2 a3 a4 a5 a6 a7 a8, Ascii b1 b2 b3 b4 b5 b6 b7 b8 =>
       Ascii (f a1 b1) (f a2 b2) (f a3 b3) (f a4 b4) 
-        (f a5 b5) (f a6 b6) (f a7 b7) (f a8 b8)
+      (f a5 b5) (f a6 b6) (f a7 b7) (f a8 b8)
   end.
 
 Definition shift (c : bool) (a : ascii) :=
   match a with
-  | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii c a1 a2 a3 a4 a5 a6 a7
+    | Ascii a1 a2 a3 a4 a5 a6 a7 a8 => Ascii c a1 a2 a3 a4 a5 a6 a7
   end.
 
-(* Definition of a decidable function that is effective *)
+(** Definition of a decidable function that is effective *)
  
 Definition ascii_dec : forall a b : ascii, {a = b} + {a <> b}.
- decide equality; apply bool_dec.
+  decide equality; apply bool_dec.
 Defined.
 
-(** *** Conversion between natural numbers modulo 256 and ascii characters *)
+(** * Conversion between natural numbers modulo 256 and ascii characters *)
 
-(* Auxillary function that turns a positive into an ascii by
+(** Auxillary function that turns a positive into an ascii by
    looking at the last n bits, ie z mod 2^n *)
 
 Fixpoint ascii_of_pos_aux (res acc : ascii) (z : positive) 
- (n : nat) {struct n} : ascii :=
+  (n : nat) {struct n} : ascii :=
   match n with
-  | O => res
-  | S n1 =>
+    | O => res
+    | S n1 =>
       match z with
-      | xH => app2 orb res acc
-      | xI z' => ascii_of_pos_aux (app2 orb res acc) (shift false acc) z' n1
-      | xO z' => ascii_of_pos_aux res (shift false acc) z' n1
+	| xH => app2 orb res acc
+	| xI z' => ascii_of_pos_aux (app2 orb res acc) (shift false acc) z' n1
+	| xO z' => ascii_of_pos_aux res (shift false acc) z' n1
       end
   end.
 
 
-(* Function that turns a positive into an ascii by
-   looking at the last 8 bits, ie a mod 8 *)
+(** Function that turns a positive into an ascii by
+    looking at the last 8 bits, ie a mod 8 *)
  
 Definition ascii_of_pos (a : positive) := ascii_of_pos_aux zero one a 8.
- 
-(* Function that turns a Peano number into an ascii by converting it
-   to positive *)
+
+(** Function that turns a Peano number into an ascii by converting it
+    to positive *)
 
 Definition ascii_of_nat (a : nat) :=
   match a with
-  | O => zero
-  | S a' => ascii_of_pos (P_of_succ_nat a')
+    | O => zero
+    | S a' => ascii_of_pos (P_of_succ_nat a')
   end.
  
-(* The opposite function *)
+(** The opposite function *)
 
 Definition nat_of_ascii (a : ascii) : nat :=
   let (a1, a2, a3, a4, a5, a6, a7, a8) := a in
-      2 *
+    2 *
+    (2 *
       (2 *
-       (2 *
         (2 *
-         (2 *
           (2 *
-           (2 * (if a8 then 1 else 0)
-            + (if a7 then 1 else 0))
-           + (if a6 then 1 else 0))
-          + (if a5 then 1 else 0))
-         + (if a4 then 1 else 0))
+            (2 *
+              (2 * (if a8 then 1 else 0)
+		+ (if a7 then 1 else 0))
+              + (if a6 then 1 else 0))
+            + (if a5 then 1 else 0))
+          + (if a4 then 1 else 0))
         + (if a3 then 1 else 0))
-       + (if a2 then 1 else 0))
-      + (if a1 then 1 else 0).
+      + (if a2 then 1 else 0))
+    + (if a1 then 1 else 0).
 
 Theorem ascii_nat_embedding : 
   forall a : ascii, ascii_of_nat (nat_of_ascii a) = a.
 Proof.
   destruct a as [[|][|][|][|][|][|][|][|]]; compute; reflexivity.
-Abort.
+Qed.
 
-(** *** Concrete syntax *)
+(** * Concrete syntax *)
 
 (**
   Ascii characters can be represented in scope char_scope as follows:
diff --git a/theories/Wellfounded/Disjoint_Union.v b/theories/Wellfounded/Disjoint_Union.v
index 940569bd..1e22730b 100644
--- a/theories/Wellfounded/Disjoint_Union.v
+++ b/theories/Wellfounded/Disjoint_Union.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Disjoint_Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Disjoint_Union.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Cristina Cornes
     From : Constructing Recursion Operators in Type Theory                 
@@ -15,41 +15,41 @@
 Require Import Relation_Operators.
 
 Section Wf_Disjoint_Union.
-Variables 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 : forall x:A, Acc leA x -> Acc Le_AsB (inl B x).
-Proof.
- induction 1.
- apply Acc_intro; intros y H2.
- inversion_clear H2.
- auto with sets.
-Qed.
-
-Lemma acc_B_sum :
- well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x).
-Proof.
- induction 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 leA -> well_founded leB -> well_founded Le_AsB.
-Proof.
- intros.
- unfold well_founded in |- *.
- destruct a as [a| b].
- apply (acc_A_sum a).
- apply (H a).
-
- apply (acc_B_sum H b).
- apply (H0 b).
-Qed.
+  Variables 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 : forall x:A, Acc leA x -> Acc Le_AsB (inl B x).
+  Proof.
+    induction 1.
+    apply Acc_intro; intros y H2.
+    inversion_clear H2.
+    auto with sets.
+  Qed.
+
+  Lemma acc_B_sum :
+    well_founded leA -> forall x:B, Acc leB x -> Acc Le_AsB (inr A x).
+  Proof.
+    induction 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 leA -> well_founded leB -> well_founded Le_AsB.
+  Proof.
+    intros.
+    unfold well_founded in |- *.
+    destruct 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.
\ No newline at end of file
diff --git a/theories/Wellfounded/Inclusion.v b/theories/Wellfounded/Inclusion.v
index f596640d..44e07d0b 100644
--- a/theories/Wellfounded/Inclusion.v
+++ b/theories/Wellfounded/Inclusion.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Inclusion.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Inclusion.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Bruno Barras *)
 
@@ -21,7 +21,7 @@ Section WfInclusion.
     induction 2.
     apply Acc_intro; auto with sets.
   Qed.
-
+  
   Hint Resolve Acc_incl.
 
   Theorem wf_incl : inclusion A R1 R2 -> well_founded R2 -> well_founded R1.
diff --git a/theories/Wellfounded/Inverse_Image.v b/theories/Wellfounded/Inverse_Image.v
index 3323590e..210cc757 100644
--- a/theories/Wellfounded/Inverse_Image.v
+++ b/theories/Wellfounded/Inverse_Image.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Inverse_Image.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Inverse_Image.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Bruno Barras *)
 
@@ -19,6 +19,7 @@ Section Inverse_Image.
   Let Rof (x y:A) : Prop := R (f x) (f y).
 
   Remark Acc_lemma : forall y:B, Acc R y -> forall x:A, y = f x -> Acc Rof x.
+  Proof.
     induction 1 as [y _ IHAcc]; intros x H.
     apply Acc_intro; intros y0 H1.
     apply (IHAcc (f y0)); try trivial.
@@ -26,30 +27,34 @@ Section Inverse_Image.
   Qed.
 
   Lemma Acc_inverse_image : forall x:A, Acc R (f x) -> Acc Rof x.
+  Proof.
     intros; apply (Acc_lemma (f x)); trivial.
   Qed.
 
   Theorem wf_inverse_image : well_founded R -> well_founded Rof.
+  Proof.
     red in |- *; intros; apply Acc_inverse_image; auto.
   Qed.
 
   Variable F : A -> B -> Prop.
   Let RoF (x y:A) : Prop :=
-     exists2 b : B, F x b & (forall c:B, F y c -> R b c).
-
-Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x.
-induction 1 as [x _ IHAcc]; intros x0 H2.
-constructor; intros y H3.
-destruct H3.
-apply (IHAcc x1); auto.
-Qed.
-
-
-Theorem wf_inverse_rel : well_founded R -> well_founded RoF.
+    exists2 b : B, F x b & (forall c:B, F y c -> R b c).
+
+  Lemma Acc_inverse_rel : forall b:B, Acc R b -> forall x:A, F x b -> Acc RoF x.
+  Proof.
+    induction 1 as [x _ IHAcc]; intros x0 H2.
+    constructor; intros y H3.
+    destruct H3.
+    apply (IHAcc x1); auto.
+  Qed.
+  
+  
+  Theorem wf_inverse_rel : well_founded R -> well_founded RoF.
+  Proof.
     red in |- *; constructor; intros.
     case H0; intros.
     apply (Acc_inverse_rel x); auto.
-Qed.
+  Qed.
 
 End Inverse_Image.
 
diff --git a/theories/Wellfounded/Lexicographic_Exponentiation.v b/theories/Wellfounded/Lexicographic_Exponentiation.v
index 988d2475..24816a20 100644
--- a/theories/Wellfounded/Lexicographic_Exponentiation.v
+++ b/theories/Wellfounded/Lexicographic_Exponentiation.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lexicographic_Exponentiation.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Lexicographic_Exponentiation.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Cristina Cornes
 
@@ -19,356 +19,350 @@ Require Import Relation_Operators.
 Require Import 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:=A)).
-(* useless but symmetric *)
-Notation Cons := (cons (A:=A)).
-Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100).
-
-Hint Resolve d_one d_nil t_step.
-
-Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z.
-Proof.
- simple induction x.
- simple induction z.
- simpl in |- *; intros H.
- inversion_clear H. 
- simpl in |- *; intros; apply (Lt_nil A leA).
- intros a l HInd.
- simpl in |- *.
- 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 :
- forall x y z:List,
-   ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z).
-Proof.
- intros x y; generalize x.
- elim y; simpl in |- *.
- 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).
- simple induction 1.
- left; apply (Lt_tl A leA); auto with sets.
- simple induction 1.
- simple induction 1; intros.
- rewrite H8.
- right; exists x2; auto with sets.
-Qed.
-
-
-
-Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x.
-Proof.
- intros.
- inversion H.
- generalize (app_cons_not_nil _ _ _ H1); simple induction 1. 
- cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets.
- intro.
- generalize (app_eq_unit _ _ H0).
- simple induction 1; simple induction 1; intros.
- rewrite H4; auto with sets.
- discriminate H5.
- generalize (app_inj_tail _ _ _ _ H0).
- simple induction 1; intros.
- rewrite <- H4; auto with sets.
-Qed.
-
-Lemma desc_tail :
- forall (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 := fun x:List =>
-          forall 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 (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4);
-  simple induction 1.
- intros.
-
- generalize (app_inj_tail _ _ _ _ H6); simple 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);
-  simple 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); simple 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); simple induction 1.
- intros.
- rewrite <- H11; rewrite <- H16; auto with sets.
-Qed.
-
-
-Lemma dist_aux :
- forall z:List, Descl z -> forall 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); simple 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); simple induction 1.
- simple induction 1; intros.
- rewrite H2; rewrite H3; split.
- apply d_nil.
-
- apply d_one.
-
- simple 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 := fun y0:List =>
-          forall x0:List,
-            (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 ->
-            Descl x0 /\ Descl y0).
-
- intro.
- generalize (app_nil_end x1); simple induction 1; simple induction 1.
- split. apply d_conc; auto with sets.
-
- apply d_nil.
-
- do 3 intro.
- generalize x1.
- apply rev_ind with
-  (A := A)
-  (P := fun l0:List =>
-          forall (x1:A) (x0:List),
-            (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil ->
-            Descl x0 /\ Descl (l0 ++ Cons x1 Nil)).
-
-
- simpl in |- *.
- split.
- generalize (app_inj_tail _ _ _ _ H2); simple induction 1.
- simple induction 1; auto with sets.
-
- apply d_one.
- do 5 intro.
- generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)).
- simple induction 1.
- generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1.
- intro E.
- generalize (app_inj_tail _ _ _ _ E).
- simple induction 1; intros.
- generalize (app_inj_tail _ _ _ _ H6); simple 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).
- simple induction 1; split.
- auto with sets.
-
- generalize H14.
- rewrite <- H10; intro.
- apply d_conc; auto with sets.
-Qed.
-
-
-
-Lemma dist_Desc_concat :
- forall 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 :
- forall (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 in |- *.
- simple induction 1.
- intros.
- inversion H1; auto with sets.
- inversion H3.
-
- simple 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 :
- forall (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 in |- *; intros.
- inversion_clear H0.
- apply (Lt_hd A leA a b); auto with sets.
- 
- inversion_clear H1.
-Qed.
-
-
-Lemma acc_app :
- forall (x1 x2:List) (y1:Descl (x1 ++ x2)),
-   Acc Lex_Exp << x1 ++ x2, y1 >> ->
-   forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>.
-Proof.
- intros.
- apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)).
- auto with sets.
-
- unfold lex_exp in |- *; simpl in |- *; auto with sets.
-Qed.
-
-
-Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp.
-Proof.
- unfold well_founded at 2 in |- *.
- simple induction a; intros x y.
- apply Acc_intro.
- simple induction y0.
- unfold lex_exp at 1 in |- *; simpl in |- *.
- apply rev_ind with
-  (A := A)
-  (P := fun x:List =>
-          forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>).
- intros.
- inversion_clear H0.
-
- intro.
- generalize (well_founded_ind (wf_clos_trans A leA H)).
- intros GR.
- apply GR with
-  (P := fun x0:A =>
-          forall l:List,
-            (forall (x1:List) (y:Descl x1),
-               ltl x1 l -> Acc Lex_Exp << x1, y >>) ->
-            forall (x1:List) (y:Descl x1),
-              ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>).
- intro; intros HInd; intros.
- generalize (right_prefix x2 l (Cons x1 Nil) H1).
- simple induction 1.
- intro; apply (H0 x2 y1 H3).
-
- simple induction 1.
- intro; simple induction 1.
- clear H4 H2.
- intro; generalize y1; clear y1.
- rewrite H2.
- apply rev_ind with
-  (A := A)
-  (P := fun x3:List =>
-          forall y1:Descl (l ++ x3),
-            ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>).
- intros.
- generalize (app_nil_end l); intros Heq.
- generalize y1.
- clear y1.
- rewrite <- Heq.
- intro.
- apply Acc_intro.
- simple induction y2.
- unfold lex_exp at 1 in |- *.
- simpl in |- *; intros x4 y3. intros.
- apply (H0 x4 y3); auto with sets.
-
- intros. 
- generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1).
- simple 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).
- simple induction 1; intros.
- generalize (H4 H12 H10); intro.
- generalize (Acc_inv H14).
- generalize (acc_app l l0 H12 H14).
- intros f g.
- generalize (HInd2 f); intro.
- apply Acc_intro.
- simple induction y3.
- unfold lex_exp at 1 in |- *; simpl in |- *; intros.
- apply H15; auto with sets.
-Qed.
+  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:=A)).
+  (* useless but symmetric *)
+  Notation Cons := (cons (A:=A)).
+  Notation "<< x , y >>" := (exist Descl x y) (at level 0, x, y at level 100).
+
+  (* Hint Resolve d_one d_nil t_step. *)
+  
+  Lemma left_prefix : forall x y z:List, ltl (x ++ y) z -> ltl x z.
+  Proof.
+    simple induction x.
+    simple induction z.
+    simpl in |- *; intros H.
+    inversion_clear H. 
+    simpl in |- *; intros; apply (Lt_nil A leA).
+    intros a l HInd.
+    simpl in |- *.
+    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 :
+    forall x y z:List,
+      ltl x (y ++ z) -> ltl x y \/ (exists y' : List, x = y ++ y' /\ ltl y' z).
+  Proof.
+    intros x y; generalize x.
+    elim y; simpl in |- *.
+    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).
+    simple induction 1.
+    left; apply (Lt_tl A leA); auto with sets.
+    simple induction 1.
+    simple induction 1; intros.
+    rewrite H8.
+    right; exists x2; auto with sets.
+  Qed.
+  
+  Lemma desc_prefix : forall (x:List) (a:A), Descl (x ++ Cons a Nil) -> Descl x.
+  Proof.
+    intros.
+    inversion H.
+    generalize (app_cons_not_nil _ _ _ H1); simple induction 1. 
+    cut (x ++ Cons a Nil = Cons x0 Nil); auto with sets.
+    intro.
+    generalize (app_eq_unit _ _ H0).
+    simple induction 1; simple induction 1; intros.
+    rewrite H4; auto using d_nil with sets.
+    discriminate H5.
+    generalize (app_inj_tail _ _ _ _ H0).
+    simple induction 1; intros.
+    rewrite <- H4; auto with sets.
+  Qed.
+  
+  Lemma desc_tail :
+    forall (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 := fun x:List =>
+        forall 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 (l ++ Cons y Nil) (Nil ++ Cons b Nil) _ _ H4);
+      simple induction 1.
+    intros.
+    
+    generalize (app_inj_tail _ _ _ _ H6); simple 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);
+      simple 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); simple 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); simple induction 1.
+    intros.
+    rewrite <- H11; rewrite <- H16; auto with sets.
+  Qed.
+
+
+  Lemma dist_aux :
+    forall z:List, Descl z -> forall 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); simple 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); simple induction 1.
+    simple induction 1; intros.
+    rewrite H2; rewrite H3; split.
+    apply d_nil.
+    
+    apply d_one.
+    
+    simple 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 := fun y0:List =>
+        forall x0:List,
+          (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ y0 ->
+          Descl x0 /\ Descl y0).
+    
+    intro.
+    generalize (app_nil_end x1); simple induction 1; simple induction 1.
+    split. apply d_conc; auto with sets.
+    
+    apply d_nil.
+    
+    do 3 intro.
+    generalize x1.
+    apply rev_ind with
+      (A := A)
+      (P := fun l0:List =>
+        forall (x1:A) (x0:List),
+          (l ++ Cons y Nil) ++ Cons x Nil = x0 ++ l0 ++ Cons x1 Nil ->
+          Descl x0 /\ Descl (l0 ++ Cons x1 Nil)).
+
+
+    simpl in |- *.
+    split.
+    generalize (app_inj_tail _ _ _ _ H2); simple induction 1.
+    simple induction 1; auto with sets.
+    
+    apply d_one.
+    do 5 intro.
+    generalize (app_ass x4 (l1 ++ Cons x2 Nil) (Cons x3 Nil)).
+    simple induction 1.
+    generalize (app_ass x4 l1 (Cons x2 Nil)); simple induction 1.
+    intro E.
+    generalize (app_inj_tail _ _ _ _ E).
+    simple induction 1; intros.
+    generalize (app_inj_tail _ _ _ _ H6); simple 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).
+    simple induction 1; split.
+    auto with sets.
+    
+    generalize H14.
+    rewrite <- H10; intro.
+    apply d_conc; auto with sets.
+  Qed.
+
+
+
+  Lemma dist_Desc_concat :
+    forall 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 :
+    forall (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 in |- *.
+    simple induction 1.
+    intros.
+    inversion H1; auto with sets.
+    inversion H3.
+    
+    simple 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 :
+    forall (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 in |- *; intros.
+    inversion_clear H0.
+    apply (Lt_hd A leA a b); auto with sets.
+    
+    inversion_clear H1.
+  Qed.
+  
+  
+  Lemma acc_app :
+    forall (x1 x2:List) (y1:Descl (x1 ++ x2)),
+      Acc Lex_Exp << x1 ++ x2, y1 >> ->
+      forall (x:List) (y:Descl x), ltl x (x1 ++ x2) -> Acc Lex_Exp << x, y >>.
+  Proof.
+    intros.
+    apply (Acc_inv (R:=Lex_Exp) (x:=<< x1 ++ x2, y1 >>)).
+    auto with sets.
+    
+    unfold lex_exp in |- *; simpl in |- *; auto with sets.
+  Qed.
+  
+  
+  Theorem wf_lex_exp : well_founded leA -> well_founded Lex_Exp.
+  Proof.
+    unfold well_founded at 2 in |- *.
+    simple induction a; intros x y.
+    apply Acc_intro.
+    simple induction y0.
+    unfold lex_exp at 1 in |- *; simpl in |- *.
+    apply rev_ind with
+      (A := A)
+      (P := fun x:List =>
+	forall (x0:List) (y:Descl x0), ltl x0 x -> Acc Lex_Exp << x0, y >>).
+    intros.
+    inversion_clear H0.
+    
+    intro.
+    generalize (well_founded_ind (wf_clos_trans A leA H)).
+    intros GR.
+    apply GR with
+      (P := fun x0:A =>
+        forall l:List,
+          (forall (x1:List) (y:Descl x1),
+            ltl x1 l -> Acc Lex_Exp << x1, y >>) ->
+          forall (x1:List) (y:Descl x1),
+            ltl x1 (l ++ Cons x0 Nil) -> Acc Lex_Exp << x1, y >>).
+    intro; intros HInd; intros.
+    generalize (right_prefix x2 l (Cons x1 Nil) H1).
+    simple induction 1.
+    intro; apply (H0 x2 y1 H3).
+    
+    simple induction 1.
+    intro; simple induction 1.
+    clear H4 H2.
+    intro; generalize y1; clear y1.
+    rewrite H2.
+    apply rev_ind with
+      (A := A)
+      (P := fun x3:List =>
+        forall y1:Descl (l ++ x3),
+          ltl x3 (Cons x1 Nil) -> Acc Lex_Exp << l ++ x3, y1 >>).
+    intros.
+    generalize (app_nil_end l); intros Heq.
+    generalize y1.
+    clear y1.
+    rewrite <- Heq.
+    intro.
+    apply Acc_intro.
+    simple induction y2.
+    unfold lex_exp at 1 in |- *.
+    simpl in |- *; intros x4 y3. intros.
+    apply (H0 x4 y3); auto with sets.
+    
+    intros. 
+    generalize (dist_Desc_concat l (l0 ++ Cons x4 Nil) y1).
+    simple 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).
+    simple induction 1; intros.
+    generalize (H4 H12 H10); intro.
+    generalize (Acc_inv H14).
+    generalize (acc_app l l0 H12 H14).
+    intros f g.
+    generalize (HInd2 f); intro.
+    apply Acc_intro.
+    simple induction y3.
+    unfold lex_exp at 1 in |- *; simpl in |- *; intros.
+    apply H15; auto with sets.
+  Qed.
 
 
 End Wf_Lexicographic_Exponentiation.
diff --git a/theories/Wellfounded/Lexicographic_Product.v b/theories/Wellfounded/Lexicographic_Product.v
index 035c1e65..8ac0d546 100644
--- a/theories/Wellfounded/Lexicographic_Product.v
+++ b/theories/Wellfounded/Lexicographic_Product.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Lexicographic_Product.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Lexicographic_Product.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Authors: Bruno Barras, Cristina Cornes *)
 
@@ -18,58 +18,56 @@ Require Import Transitive_Closure.
      L. Paulson  JSC (1986) 2, 325-355 *)
 
 Section WfLexicographic_Product.
-Variable A : Set.
-Variable B : A -> Set.
-Variable leA : A -> A -> Prop.
-Variable leB : forall x:A, B x -> B x -> Prop.
-
-Notation LexProd := (lexprod A B leA leB).
-
-Hint Resolve t_step Acc_clos_trans wf_clos_trans.
-
-Lemma acc_A_B_lexprod :
- forall x:A,
-   Acc leA x ->
-   (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) ->
-   forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y).
-Proof.
- induction 1 as [x _ IHAcc]; intros H2 y.
- induction 1 as [x0 H IHAcc0]; intros.
- apply Acc_intro.
- destruct 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.
- destruct 2.
- injection H3.
- destruct 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 leA ->
- (forall x:A, well_founded (leB x)) -> well_founded LexProd.
-Proof.
- intros wfA wfB; unfold well_founded in |- *.
- destruct a.
- apply acc_A_B_lexprod; auto with sets; intros.
- red in wfB.
- auto with sets.
-Qed.
+  Variable A : Set.
+  Variable B : A -> Set.
+  Variable leA : A -> A -> Prop.
+  Variable leB : forall x:A, B x -> B x -> Prop.
+
+  Notation LexProd := (lexprod A B leA leB).
+  
+  Lemma acc_A_B_lexprod :
+    forall x:A,
+      Acc leA x ->
+      (forall x0:A, clos_trans A leA x0 x -> well_founded (leB x0)) ->
+      forall y:B x, Acc (leB x) y -> Acc LexProd (existS B x y).
+  Proof.
+    induction 1 as [x _ IHAcc]; intros H2 y.
+    induction 1 as [x0 H IHAcc0]; intros.
+    apply Acc_intro.
+    destruct 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.
+    destruct 2.
+    injection H3.
+    destruct 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 leA ->
+    (forall x:A, well_founded (leB x)) -> well_founded LexProd.
+  Proof.
+    intros wfA wfB; unfold well_founded in |- *.
+    destruct a.
+    apply acc_A_B_lexprod; auto with sets; intros.
+    red in wfB.
+    auto with sets.
+  Qed.
 
 
 End WfLexicographic_Product.
@@ -83,50 +81,31 @@ Section Wf_Symmetric_Product.
 
   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 :
-   forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y).
- Proof.
- induction 1 as [x _ IHAcc]; intros y H2.
- induction 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 leA -> well_founded leB -> well_founded Symprod.
-Proof.
- red in |- *.
- destruct a.
- apply Acc_symprod; auto with sets.
-Qed.
+    forall x:A, Acc leA x -> forall y:B, Acc leB y -> Acc Symprod (x, y).
+  Proof.
+    induction 1 as [x _ IHAcc]; intros y H2.
+    induction 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 leA -> well_founded leB -> well_founded Symprod.
+  Proof.
+    red in |- *.
+    destruct a.
+    apply Acc_symprod; auto with sets.
+  Qed.
 
 End Wf_Symmetric_Product.
 
 
 Section Swap.
-
+  
   Variable A : Set.
   Variable R : A -> A -> Prop.
 
@@ -134,59 +113,59 @@ Section Swap.
 
 
   Lemma swap_Acc : forall x y:A, Acc SwapProd (x, y) -> Acc SwapProd (y, x).
-Proof.
- intros.
- inversion_clear H.
- apply Acc_intro.
- destruct 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.
+  Proof.
+    intros.
+    inversion_clear H.
+    apply Acc_intro.
+    destruct 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 :
-   forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y).
-Proof.
- induction 1 as [x0 _ IHAcc0]; intros H2.
- cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)).
- clear IHAcc0.
- induction H2 as [x1 _ IHAcc1]; intros H4.
- cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)).
- clear IHAcc1.
- intro.
- apply Acc_intro.
- destruct 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.
-
-
+    forall x y:A, Acc R x -> Acc R y -> Acc SwapProd (x, y).
+  Proof.
+    induction 1 as [x0 _ IHAcc0]; intros H2.
+    cut (forall y0:A, R y0 x0 -> Acc SwapProd (y0, y)).
+    clear IHAcc0.
+    induction H2 as [x1 _ IHAcc1]; intros H4.
+    cut (forall y:A, R y x1 -> Acc SwapProd (x0, y)).
+    clear IHAcc1.
+    intro.
+    apply Acc_intro.
+    destruct 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 R -> well_founded SwapProd.
-Proof.
- red in |- *.
- destruct a; intros.
- apply Acc_swapprod; auto with sets.
-Qed.
+  Proof.
+    red in |- *.
+    destruct a; intros.
+    apply Acc_swapprod; auto with sets.
+  Qed.
 
 End Swap.
\ No newline at end of file
diff --git a/theories/Wellfounded/Union.v b/theories/Wellfounded/Union.v
index 269cfd9d..634576ad 100644
--- a/theories/Wellfounded/Union.v
+++ b/theories/Wellfounded/Union.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Union.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Union.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Bruno Barras *)
 
@@ -18,60 +18,58 @@ Section WfUnion.
   Variable A : Set.
   Variables R1 R2 : relation A.
   
- Notation Union := (union A R1 R2).
-
- Hint Resolve Acc_clos_trans wf_clos_trans.
-
-Remark strip_commut :
- commut A R1 R2 ->
- forall x y:A,
-   clos_trans A R1 y x ->
-   forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & clos_trans A R1 z y'.
-Proof.
- induction 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.
+  Notation Union := (union A R1 R2).
+  
+  Remark strip_commut :
+    commut A R1 R2 ->
+    forall x y:A,
+      clos_trans A R1 y x ->
+      forall z:A, R2 z y ->  exists2 y' : A, R2 y' x & clos_trans A R1 z y'.
+  Proof.
+    induction 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 ->
-   (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a.
-Proof.
- induction 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 (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 in |- *.
- 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.
+    commut A R1 R2 ->
+    (forall x:A, Acc R2 x -> Acc R1 x) -> forall a:A, Acc R2 a -> Acc Union a.
+  Proof.
+    induction 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 (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 in |- *.
+    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 R1 -> well_founded R2 -> well_founded Union.
-Proof.
- unfold well_founded in |- *.
- intros.
- apply Acc_union; auto with sets.
-Qed.
+    commut A R1 R2 -> well_founded R1 -> well_founded R2 -> well_founded Union.
+  Proof.
+    unfold well_founded in |- *.
+    intros.
+    apply Acc_union; auto with sets.
+  Qed.
 
 End WfUnion.
\ No newline at end of file
diff --git a/theories/Wellfounded/Well_Ordering.v b/theories/Wellfounded/Well_Ordering.v
index e9a18e74..69617de2 100644
--- a/theories/Wellfounded/Well_Ordering.v
+++ b/theories/Wellfounded/Well_Ordering.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Well_Ordering.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Well_Ordering.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Author: Cristina Cornes.
     From: Constructing Recursion Operators in Type Theory
@@ -15,58 +15,57 @@
 Require Import Eqdep.
 
 Section WellOrdering.
-Variable A : Set.
-Variable B : A -> Set. 
-
-Inductive WO : Set :=
+  Variable A : Set.
+  Variable B : A -> Set. 
+  
+  Inductive WO : Set :=
     sup : forall (a:A) (f:B a -> WO), WO.
 
 
-Inductive le_WO : WO -> WO -> Prop :=
+  Inductive le_WO : WO -> WO -> Prop :=
     le_sup : forall (a:A) (f:B a -> WO) (v:B a), le_WO (f v) (sup a f).
  
-
-Theorem wf_WO : well_founded le_WO.
-Proof.
- unfold well_founded in |- *; 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 (f = f1).
- intros E; rewrite E; auto.
- symmetry  in |- *.
- apply (inj_pair2 A (fun a0:A => B a0 -> WO) a0 f1 f H5).
-Qed.
+  Theorem wf_WO : well_founded le_WO.
+  Proof.
+    unfold well_founded in |- *; 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 (f = f1).
+    intros E; rewrite E; auto.
+    symmetry  in |- *.
+    apply (inj_pair2 A (fun 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                                          *)
+  (** Wellfounded relations are the inverse image of wellordering types *)
+  (*  in course of development                                          *)
 
 
-Variable A : Set.
-Variable leA : A -> A -> Prop.
+  Variable A : Set.
+  Variable leA : A -> A -> Prop.
 
-Definition B (a:A) := {x : A | leA x a}.
+  Definition B (a:A) := {x : A | leA x a}.
 
-Definition wof : well_founded leA -> A -> WO A B.
-Proof.
- intros.
- apply (well_founded_induction H (fun a:A => WO A B)); auto.
- intros.
- apply (sup A B x).
- unfold B at 1 in |- *.
- destruct 1 as [x0].
- apply (H1 x0); auto.
+  Definition wof : well_founded leA -> A -> WO A B.
+  Proof.
+    intros.
+    apply (well_founded_induction H (fun a:A => WO A B)); auto.
+    intros.
+    apply (sup A B x).
+    unfold B at 1 in |- *.
+    destruct 1 as [x0].
+    apply (H1 x0); auto.
 Qed.
 
 End Characterisation_wf_relations.
\ No newline at end of file
diff --git a/theories/ZArith/BinInt.v b/theories/ZArith/BinInt.v
index fda521de..71e48360 100644
--- a/theories/ZArith/BinInt.v
+++ b/theories/ZArith/BinInt.v
@@ -6,10 +6,10 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: BinInt.v 8883 2006-05-31 21:56:37Z letouzey $ i*)
+(*i $Id: BinInt.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (***********************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 (***********************************************************)
 
 Require Export BinPos.
@@ -19,190 +19,190 @@ Require Import Plus.
 Require Import Mult.
 
 Unset Boxed Definitions.
-(**********************************************************************)
-(** Binary integer numbers *)
+
+(*****************************)
+(** * Binary integer numbers *)
 
 Inductive Z : Set :=
   | Z0 : Z
   | Zpos : positive -> Z
   | Zneg : positive -> Z.
 
-(** Declare Scope Z_scope with Key Z *)
-Delimit Scope Z_scope with Z.
 
 (** Automatically open scope positive_scope for the constructors of Z *)
+Delimit Scope Z_scope with Z.
 Bind Scope Z_scope with Z.
 Arguments Scope Zpos [positive_scope].
 Arguments Scope Zneg [positive_scope].
 
-(** Subtraction of positive into Z *)
+(** ** Subtraction of positive into Z *)
 
 Definition Zdouble_plus_one (x:Z) :=
   match x with
-  | Z0 => Zpos 1
-  | Zpos p => Zpos (xI p)
-  | Zneg p => Zneg (Pdouble_minus_one p)
+    | Z0 => Zpos 1
+    | Zpos p => Zpos (xI p)
+    | Zneg p => Zneg (Pdouble_minus_one p)
   end.
 
 Definition Zdouble_minus_one (x:Z) :=
   match x with
-  | Z0 => Zneg 1
-  | Zneg p => Zneg (xI p)
-  | Zpos p => Zpos (Pdouble_minus_one p)
+    | Z0 => Zneg 1
+    | Zneg p => Zneg (xI p)
+    | Zpos p => Zpos (Pdouble_minus_one p)
   end.
 
 Definition Zdouble (x:Z) :=
   match x with
-  | Z0 => Z0
-  | Zpos p => Zpos (xO p)
-  | Zneg p => Zneg (xO p)
+    | Z0 => Z0
+    | Zpos p => Zpos (xO p)
+    | Zneg p => Zneg (xO p)
   end.
 
 Fixpoint ZPminus (x y:positive) {struct y} : Z :=
   match x, y with
-  | xI x', xI y' => Zdouble (ZPminus x' y')
-  | xI x', xO y' => Zdouble_plus_one (ZPminus x' y')
-  | xI x', xH => Zpos (xO x')
-  | xO x', xI y' => Zdouble_minus_one (ZPminus x' y')
-  | xO x', xO y' => Zdouble (ZPminus x' y')
-  | xO x', xH => Zpos (Pdouble_minus_one x')
-  | xH, xI y' => Zneg (xO y')
-  | xH, xO y' => Zneg (Pdouble_minus_one y')
-  | xH, xH => Z0
+    | xI x', xI y' => Zdouble (ZPminus x' y')
+    | xI x', xO y' => Zdouble_plus_one (ZPminus x' y')
+    | xI x', xH => Zpos (xO x')
+    | xO x', xI y' => Zdouble_minus_one (ZPminus x' y')
+    | xO x', xO y' => Zdouble (ZPminus x' y')
+    | xO x', xH => Zpos (Pdouble_minus_one x')
+    | xH, xI y' => Zneg (xO y')
+    | xH, xO y' => Zneg (Pdouble_minus_one y')
+    | xH, xH => Z0
   end.
 
-(** Addition on integers *)
+(** ** Addition on integers *)
 
 Definition Zplus (x y:Z) :=
   match x, y with
-  | Z0, y => y
-  | x, Z0 => x
-  | Zpos x', Zpos y' => Zpos (x' + y')
-  | Zpos x', Zneg y' =>
+    | Z0, y => y
+    | x, Z0 => x
+    | Zpos x', Zpos y' => Zpos (x' + y')
+    | Zpos x', Zneg y' =>
       match (x' ?= y')%positive Eq with
-      | Eq => Z0
-      | Lt => Zneg (y' - x')
-      | Gt => Zpos (x' - y')
+	| Eq => Z0
+	| Lt => Zneg (y' - x')
+	| Gt => Zpos (x' - y')
       end
-  | Zneg x', Zpos y' =>
+    | Zneg x', Zpos y' =>
       match (x' ?= y')%positive Eq with
-      | Eq => Z0
-      | Lt => Zpos (y' - x')
-      | Gt => Zneg (x' - y')
+	| Eq => Z0
+	| Lt => Zpos (y' - x')
+	| Gt => Zneg (x' - y')
       end
-  | Zneg x', Zneg y' => Zneg (x' + y')
+    | Zneg x', Zneg y' => Zneg (x' + y')
   end.
 
 Infix "+" := Zplus : Z_scope.
 
-(** Opposite *)
+(** ** Opposite *)
 
 Definition Zopp (x:Z) :=
   match x with
-  | Z0 => Z0
-  | Zpos x => Zneg x
-  | Zneg x => Zpos x
+    | Z0 => Z0
+    | Zpos x => Zneg x
+    | Zneg x => Zpos x
   end.
 
 Notation "- x" := (Zopp x) : Z_scope.
 
-(** Successor on integers *)
+(** ** Successor on integers *)
 
 Definition Zsucc (x:Z) := (x + Zpos 1)%Z.
 
-(** Predecessor on integers *)
+(** ** Predecessor on integers *)
 
 Definition Zpred (x:Z) := (x + Zneg 1)%Z.
 
-(** Subtraction on integers *)
+(** ** Subtraction on integers *)
 
 Definition Zminus (m n:Z) := (m + - n)%Z.
 
 Infix "-" := Zminus : Z_scope.
 
-(** Multiplication on integers *)
+(** ** Multiplication on integers *)
 
 Definition Zmult (x y:Z) :=
   match x, y with
-  | Z0, _ => Z0
-  | _, Z0 => Z0
-  | Zpos x', Zpos y' => Zpos (x' * y')
-  | Zpos x', Zneg y' => Zneg (x' * y')
-  | Zneg x', Zpos y' => Zneg (x' * y')
-  | Zneg x', Zneg y' => Zpos (x' * y')
+    | Z0, _ => Z0
+    | _, Z0 => Z0
+    | Zpos x', Zpos y' => Zpos (x' * y')
+    | Zpos x', Zneg y' => Zneg (x' * y')
+    | Zneg x', Zpos y' => Zneg (x' * y')
+    | Zneg x', Zneg y' => Zpos (x' * y')
   end.
 
 Infix "*" := Zmult : Z_scope.
 
-(** Comparison of integers *)
+(** ** Comparison of integers *)
 
 Definition Zcompare (x y:Z) :=
   match x, y with
-  | Z0, Z0 => Eq
-  | Z0, Zpos y' => Lt
-  | Z0, Zneg y' => Gt
-  | Zpos x', Z0 => Gt
-  | Zpos x', Zpos y' => (x' ?= y')%positive Eq
-  | Zpos x', Zneg y' => Gt
-  | Zneg x', Z0 => Lt
-  | Zneg x', Zpos y' => Lt
-  | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq)
+    | Z0, Z0 => Eq
+    | Z0, Zpos y' => Lt
+    | Z0, Zneg y' => Gt
+    | Zpos x', Z0 => Gt
+    | Zpos x', Zpos y' => (x' ?= y')%positive Eq
+    | Zpos x', Zneg y' => Gt
+    | Zneg x', Z0 => Lt
+    | Zneg x', Zpos y' => Lt
+    | Zneg x', Zneg y' => CompOpp ((x' ?= y')%positive Eq)
   end.
 
 Infix "?=" := Zcompare (at level 70, no associativity) : Z_scope.
 
 Ltac elim_compare com1 com2 :=
   case (Dcompare (com1 ?= com2)%Z);
-   [ idtac | let x := fresh "H" in
-             (intro x; case x; clear x) ].
+    [ idtac | let x := fresh "H" in
+      (intro x; case x; clear x) ].
 
-(** Sign function *)
+(** ** Sign function *)
 
 Definition Zsgn (z:Z) : Z :=
   match z with
-  | Z0 => Z0
-  | Zpos p => Zpos 1
-  | Zneg p => Zneg 1
+    | Z0 => Z0
+    | Zpos p => Zpos 1
+    | Zneg p => Zneg 1
   end.
 
-(** Direct, easier to handle variants of successor and addition *)
+(** ** Direct, easier to handle variants of successor and addition *)
 
 Definition Zsucc' (x:Z) :=
   match x with
-  | Z0 => Zpos 1
-  | Zpos x' => Zpos (Psucc x')
-  | Zneg x' => ZPminus 1 x'
+    | Z0 => Zpos 1
+    | Zpos x' => Zpos (Psucc x')
+    | Zneg x' => ZPminus 1 x'
   end.
 
 Definition Zpred' (x:Z) :=
   match x with
-  | Z0 => Zneg 1
-  | Zpos x' => ZPminus x' 1
-  | Zneg x' => Zneg (Psucc x')
+    | Z0 => Zneg 1
+    | Zpos x' => ZPminus x' 1
+    | Zneg x' => Zneg (Psucc x')
   end.
 
 Definition Zplus' (x y:Z) :=
   match x, y with
-  | Z0, y => y
-  | x, Z0 => x
-  | Zpos x', Zpos y' => Zpos (x' + y')
-  | Zpos x', Zneg y' => ZPminus x' y'
-  | Zneg x', Zpos y' => ZPminus y' x'
-  | Zneg x', Zneg y' => Zneg (x' + y')
+    | Z0, y => y
+    | x, Z0 => x
+    | Zpos x', Zpos y' => Zpos (x' + y')
+    | Zpos x', Zneg y' => ZPminus x' y'
+    | Zneg x', Zpos y' => ZPminus y' x'
+    | Zneg x', Zneg y' => Zneg (x' + y')
   end.
 
 Open Local Scope Z_scope.
 
 (**********************************************************************)
-(** Inductive specification of Z *)
+(** ** Inductive specification of Z *)
 
 Theorem Zind :
- forall P:Z -> Prop,
-   P Z0 ->
-   (forall x:Z, P x -> P (Zsucc' x)) ->
-   (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n.
+  forall P:Z -> Prop,
+    P Z0 ->
+    (forall x:Z, P x -> P (Zsucc' x)) ->
+    (forall x:Z, P x -> P (Zpred' x)) -> forall n:Z, P n.
 Proof.
-intros P H0 Hs Hp z; destruct z.
+  intros P H0 Hs Hp z; destruct z.
   assumption.
   apply Pind with (P := fun p => P (Zpos p)).
     change (P (Zsucc' Z0)) in |- *; apply Hs; apply H0.
@@ -213,52 +213,56 @@ intros P H0 Hs Hp z; destruct z.
 Qed.
 
 (**********************************************************************)
-(** Properties of opposite on binary integer numbers *)
+(** * Misc properties about binary integer operations *)
+
+
+(**********************************************************************)
+(** ** Properties of opposite on binary integer numbers *)
 
 Theorem Zopp_neg : forall p:positive, - Zneg p = Zpos p.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
 
 (** [opp] is involutive *)
 
 Theorem Zopp_involutive : forall n:Z, - - n = n.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
 (** Injectivity of the opposite *)
 
 Theorem Zopp_inj : forall n m:Z, - n = - m -> n = m.
 Proof.
-intros x y; case x; case y; simpl in |- *; intros;
- [ trivial
- | discriminate H
- | discriminate H
- | discriminate H
- | simplify_eq H; intro E; rewrite E; trivial
- | discriminate H
- | discriminate H
- | discriminate H
- | simplify_eq H; intro E; rewrite E; trivial ].
+  intros x y; case x; case y; simpl in |- *; intros;
+    [ trivial
+      | discriminate H
+      | discriminate H
+      | discriminate H
+      | simplify_eq H; intro E; rewrite E; trivial
+      | discriminate H
+      | discriminate H
+      | discriminate H
+      | simplify_eq H; intro E; rewrite E; trivial ].
 Qed.
 
-(**********************************************************************)
-(* Properties of the direct definition of successor and predecessor *)
+(*************************************************************************)
+(** **  Properties of the direct definition of successor and predecessor *)
 
 Lemma Zpred'_succ' : forall n:Z, Zpred' (Zsucc' n) = n.
 Proof.
-intro x; destruct x; simpl in |- *.
-  reflexivity.
-destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI;
- reflexivity.
-destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO;
- reflexivity.
+  intro x; destruct x; simpl in |- *.
+    reflexivity.
+  destruct p; simpl in |- *; try rewrite Pdouble_minus_one_o_succ_eq_xI;
+    reflexivity.
+  destruct p; simpl in |- *; try rewrite Psucc_o_double_minus_one_eq_xO;
+    reflexivity.
 Qed.
 
 Lemma Zsucc'_discr : forall n:Z, n <> Zsucc' n.
 Proof.
-intro x; destruct x; simpl in |- *.
+  intro x; destruct x; simpl in |- *.
   discriminate.
   injection; apply Psucc_discr.
   destruct p; simpl in |- *.
@@ -268,512 +272,517 @@ intro x; destruct x; simpl in |- *.
 Qed.
 
 (**********************************************************************)
-(** Other properties of binary integer numbers *)
+(** ** Other properties of binary integer numbers *)
 
 Lemma ZL0 : 2%nat = (1 + 1)%nat.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
 
 (**********************************************************************)
-(** Properties of the addition on integers *)
+(** * Properties of the addition on integers *)
 
-(** zero is left neutral for addition *)
+(** ** zero is left neutral for addition *)
 
 Theorem Zplus_0_l : forall n:Z, Z0 + n = n.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
-(** zero is right neutral for addition *)
+(** *** zero is right neutral for addition *)
 
 Theorem Zplus_0_r : forall n:Z, n + Z0 = n.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
-(** addition is commutative *)
+(** ** addition is commutative *)
 
 Theorem Zplus_comm : forall n m:Z, n + m = m + n.
 Proof.
-intro x; induction x as [| p| p]; intro y; destruct y as [| q| q];
- simpl in |- *; try reflexivity.
+  intro x; induction x as [| p| p]; intro y; destruct y as [| q| q];
+    simpl in |- *; try reflexivity.
   rewrite Pplus_comm; reflexivity.
   rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
   rewrite ZC4; destruct ((q ?= p)%positive Eq); reflexivity.
   rewrite Pplus_comm; reflexivity.
 Qed.
 
-(** opposite distributes over addition *)
+(** ** opposite distributes over addition *)
 
 Theorem Zopp_plus_distr : forall n m:Z, - (n + m) = - n + - m.
 Proof.
-intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q];
- simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq); 
- reflexivity.
+  intro x; destruct x as [| p| p]; intro y; destruct y as [| q| q];
+    simpl in |- *; reflexivity || destruct ((p ?= q)%positive Eq); 
+      reflexivity.
 Qed.
 
-(** opposite is inverse for addition *)
+(** ** opposite is inverse for addition *)
 
 Theorem Zplus_opp_r : forall n:Z, n + - n = Z0.
 Proof.
-intro x; destruct x as [| p| p]; simpl in |- *;
- [ reflexivity
- | rewrite (Pcompare_refl p); reflexivity
- | rewrite (Pcompare_refl p); reflexivity ].
+  intro x; destruct x as [| p| p]; simpl in |- *;
+    [ reflexivity
+      | rewrite (Pcompare_refl p); reflexivity
+      | rewrite (Pcompare_refl p); reflexivity ].
 Qed.
 
 Theorem Zplus_opp_l : forall n:Z, - n + n = Z0.
 Proof.
-intro; rewrite Zplus_comm; apply Zplus_opp_r.
+  intro; rewrite Zplus_comm; apply Zplus_opp_r.
 Qed.
 
 Hint Local Resolve Zplus_0_l Zplus_0_r.
 
-(** addition is associative *)
+(** ** addition is associative *)
 
 Lemma weak_assoc :
- forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n.
-Proof.
-intros x y z'; case z';
- [ auto with arith
- | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith
- | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0;
-    ElimPcompare (x + y)%positive z; intros E1; rewrite E1;
-    [ absurd ((x + y ?= z)%positive Eq = Eq);
-       [  (* Case 1 *)
-          rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-          [ discriminate
-          | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
-             elim (ZL4 x); intros k E2; rewrite E2; 
-             simpl in |- *; unfold gt, lt in |- *; 
-             apply le_n_S; apply le_plus_r ]
-       | assumption ]
-    | absurd ((x + y ?= z)%positive Eq = Lt);
-       [  (* Case 2 *)
-          rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-          [ discriminate
-          | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
-             elim (ZL4 x); intros k E2; rewrite E2; 
-             simpl in |- *; unfold gt, lt in |- *; 
-             apply le_n_S; apply le_plus_r ]
-       | assumption ]
-    | rewrite (Pcompare_Eq_eq y z E0);
-        (* Case 3 *)
-       elim (Pminus_mask_Gt (x + z) z);
-       [ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4;
-          unfold Pminus in |- *; rewrite H1; cut (x = t);
-          [ intros E; rewrite E; auto with arith
-          | apply Pplus_reg_r with (r := z); rewrite <- H3;
-             rewrite Pplus_comm; trivial with arith ]
-       | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0);
-          assumption ]
-    | elim (Pminus_mask_Gt z y);
-       [  (* Case 4 *)
-          intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-          unfold Pminus at 1 in |- *; rewrite H1; cut (x = k);
-          [ intros E; rewrite E; rewrite (Pcompare_refl k);
-             trivial with arith
-          | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y);
-             rewrite H3; apply Pcompare_Eq_eq; assumption ]
-       | apply ZC2; assumption ]
-    | elim (Pminus_mask_Gt z y);
-       [  (* Case 5 *)
-          intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-          unfold Pminus at 1 3 5 in |- *; rewrite H1;
-          cut ((x ?= k)%positive Eq = Lt);
-          [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x);
-             [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
-                elim (Pminus_mask_Gt z (x + y));
-                [ intros j H10; elim H10; intros H11 H12; elim H12;
-                   intros H13 H14; unfold Pminus in |- *; 
-                   rewrite H6; rewrite H11; cut (i = j);
-                   [ intros E; rewrite E; auto with arith
-                   | apply (Pplus_reg_l (x + y)); rewrite H13;
-                      rewrite (Pplus_comm x y); rewrite <- Pplus_assoc;
-                      rewrite H8; assumption ]
-                | apply ZC2; assumption ]
-             | apply ZC2; assumption ]
-          | apply nat_of_P_lt_Lt_compare_complement_morphism;
-             apply plus_lt_reg_l with (p := nat_of_P y);
-             do 2 rewrite <- nat_of_P_plus_morphism;
-             apply nat_of_P_lt_Lt_compare_morphism; 
-             rewrite H3; rewrite Pplus_comm; assumption ]
-       | apply ZC2; assumption ]
-    | elim (Pminus_mask_Gt z y);
-       [  (* Case 6 *)
-          intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
-          elim (Pminus_mask_Gt (x + y) z);
-          [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
-             unfold Pminus in |- *; rewrite H1; rewrite H6;
-             cut ((x ?= k)%positive Eq = Gt);
-             [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11;
-                elim H11; intros H12 H13; elim H13; 
-                intros H14 H15; rewrite H10; rewrite H12; 
-                cut (i = j);
-                [ intros H16; rewrite H16; auto with arith
-                | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j);
-                   rewrite H14; rewrite (Pplus_comm z k);
-                   rewrite <- Pplus_assoc; rewrite H8;
-                   rewrite (Pplus_comm x y); rewrite Pplus_assoc;
-                   rewrite (Pplus_comm k y); rewrite H3; 
-                   trivial with arith ]
-             | apply nat_of_P_gt_Gt_compare_complement_morphism;
-                unfold lt, gt in |- *;
-                apply plus_lt_reg_l with (p := nat_of_P y);
-                do 2 rewrite <- nat_of_P_plus_morphism;
-                apply nat_of_P_lt_Lt_compare_morphism; 
-                rewrite H3; rewrite Pplus_comm; apply ZC1; 
-                assumption ]
-          | assumption ]
-       | apply ZC2; assumption ]
-    | absurd ((x + y ?= z)%positive Eq = Eq);
-       [  (* Case 7 *)
-          rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-          [ discriminate
-          | rewrite nat_of_P_plus_morphism; unfold gt in |- *;
-             apply lt_le_trans with (m := nat_of_P y);
-             [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-             | apply le_plus_r ] ]
-       | assumption ]
-    | absurd ((x + y ?= z)%positive Eq = Lt);
-       [  (* Case 8 *)
-          rewrite nat_of_P_gt_Gt_compare_complement_morphism;
-          [ discriminate
-          | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y);
-             [ exact (nat_of_P_gt_Gt_compare_morphism y z E0)
-             | rewrite nat_of_P_plus_morphism; apply le_plus_r ] ]
-       | assumption ]
-    | elim Pminus_mask_Gt with (1 := E0); intros k H1;
-        (* Case 9 *)
-       elim Pminus_mask_Gt with (1 := E1); intros i H2; 
-       elim H1; intros H3 H4; elim H4; intros H5 H6; 
-       elim H2; intros H7 H8; elim H8; intros H9 H10; 
-       unfold Pminus in |- *; rewrite H3; rewrite H7;
-       cut ((x + k)%positive = i);
-       [ intros E; rewrite E; auto with arith
-       | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc;
-          rewrite H5; rewrite H9; rewrite Pplus_comm; 
-          trivial with arith ] ] ].
+  forall (p q:positive) (n:Z), Zpos p + (Zpos q + n) = Zpos p + Zpos q + n.
+Proof.
+  intros x y z'; case z';
+    [ auto with arith
+      | intros z; simpl in |- *; rewrite Pplus_assoc; auto with arith
+      | intros z; simpl in |- *; ElimPcompare y z; intros E0; rewrite E0;
+	ElimPcompare (x + y)%positive z; intros E1; rewrite E1;
+	  [ absurd ((x + y ?= z)%positive Eq = Eq);
+	    [  (* Case 1 *)
+              rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+		[ discriminate
+		  | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
+		    elim (ZL4 x); intros k E2; rewrite E2; 
+		      simpl in |- *; unfold gt, lt in |- *; 
+			apply le_n_S; apply le_plus_r ]
+	      | assumption ]
+	    | absurd ((x + y ?= z)%positive Eq = Lt);
+	      [  (* Case 2 *)
+		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+		  [ discriminate
+		    | rewrite nat_of_P_plus_morphism; rewrite (Pcompare_Eq_eq y z E0);
+		      elim (ZL4 x); intros k E2; rewrite E2; 
+			simpl in |- *; unfold gt, lt in |- *; 
+			  apply le_n_S; apply le_plus_r ]
+		| assumption ]
+	    | rewrite (Pcompare_Eq_eq y z E0);
+          (* Case 3 *)
+	      elim (Pminus_mask_Gt (x + z) z);
+		[ intros t H; elim H; intros H1 H2; elim H2; intros H3 H4;
+		  unfold Pminus in |- *; rewrite H1; cut (x = t);
+		    [ intros E; rewrite E; auto with arith
+		      | apply Pplus_reg_r with (r := z); rewrite <- H3;
+			rewrite Pplus_comm; trivial with arith ]
+		  | pattern z at 1 in |- *; rewrite <- (Pcompare_Eq_eq y z E0);
+		    assumption ]
+	    | elim (Pminus_mask_Gt z y);
+	      [  (* Case 4 *)
+		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+		  unfold Pminus at 1 in |- *; rewrite H1; cut (x = k);
+		    [ intros E; rewrite E; rewrite (Pcompare_refl k);
+		      trivial with arith
+		      | apply Pplus_reg_r with (r := y); rewrite (Pplus_comm k y);
+			rewrite H3; apply Pcompare_Eq_eq; assumption ]
+		| apply ZC2; assumption ]
+	    | elim (Pminus_mask_Gt z y);
+	      [  (* Case 5 *)
+		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+		  unfold Pminus at 1 3 5 in |- *; rewrite H1;
+		    cut ((x ?= k)%positive Eq = Lt);
+		      [ intros E2; rewrite E2; elim (Pminus_mask_Gt k x);
+			[ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
+			  elim (Pminus_mask_Gt z (x + y));
+			    [ intros j H10; elim H10; intros H11 H12; elim H12;
+			      intros H13 H14; unfold Pminus in |- *; 
+				rewrite H6; rewrite H11; cut (i = j);
+				  [ intros E; rewrite E; auto with arith
+				    | apply (Pplus_reg_l (x + y)); rewrite H13;
+				      rewrite (Pplus_comm x y); rewrite <- Pplus_assoc;
+					rewrite H8; assumption ]
+			      | apply ZC2; assumption ]
+			  | apply ZC2; assumption ]
+			| apply nat_of_P_lt_Lt_compare_complement_morphism;
+			  apply plus_lt_reg_l with (p := nat_of_P y);
+			    do 2 rewrite <- nat_of_P_plus_morphism;
+			      apply nat_of_P_lt_Lt_compare_morphism; 
+				rewrite H3; rewrite Pplus_comm; assumption ]
+		| apply ZC2; assumption ]
+	    | elim (Pminus_mask_Gt z y);
+	      [  (* Case 6 *)
+		intros k H; elim H; intros H1 H2; elim H2; intros H3 H4;
+		  elim (Pminus_mask_Gt (x + y) z);
+		    [ intros i H5; elim H5; intros H6 H7; elim H7; intros H8 H9;
+		      unfold Pminus in |- *; rewrite H1; rewrite H6;
+			cut ((x ?= k)%positive Eq = Gt);
+			  [ intros H10; elim (Pminus_mask_Gt x k H10); intros j H11;
+			    elim H11; intros H12 H13; elim H13; 
+			      intros H14 H15; rewrite H10; rewrite H12; 
+				cut (i = j);
+				  [ intros H16; rewrite H16; auto with arith
+				    | apply (Pplus_reg_l (z + k)); rewrite <- (Pplus_assoc z k j);
+				      rewrite H14; rewrite (Pplus_comm z k);
+					rewrite <- Pplus_assoc; rewrite H8;
+					  rewrite (Pplus_comm x y); rewrite Pplus_assoc;
+					    rewrite (Pplus_comm k y); rewrite H3; 
+					      trivial with arith ]
+			    | apply nat_of_P_gt_Gt_compare_complement_morphism;
+			      unfold lt, gt in |- *;
+				apply plus_lt_reg_l with (p := nat_of_P y);
+				  do 2 rewrite <- nat_of_P_plus_morphism;
+				    apply nat_of_P_lt_Lt_compare_morphism; 
+				      rewrite H3; rewrite Pplus_comm; apply ZC1; 
+					assumption ]
+		      | assumption ]
+		| apply ZC2; assumption ]
+	    | absurd ((x + y ?= z)%positive Eq = Eq);
+	      [  (* Case 7 *)
+		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+		  [ discriminate
+		    | rewrite nat_of_P_plus_morphism; unfold gt in |- *;
+		      apply lt_le_trans with (m := nat_of_P y);
+			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+			  | apply le_plus_r ] ]
+		| assumption ]
+	    | absurd ((x + y ?= z)%positive Eq = Lt);
+	      [  (* Case 8 *)
+		rewrite nat_of_P_gt_Gt_compare_complement_morphism;
+		  [ discriminate
+		    | unfold gt in |- *; apply lt_le_trans with (m := nat_of_P y);
+		      [ exact (nat_of_P_gt_Gt_compare_morphism y z E0)
+			| rewrite nat_of_P_plus_morphism; apply le_plus_r ] ]
+		| assumption ]
+	    | elim Pminus_mask_Gt with (1 := E0); intros k H1;
+          (* Case 9 *)
+	      elim Pminus_mask_Gt with (1 := E1); intros i H2; 
+		elim H1; intros H3 H4; elim H4; intros H5 H6; 
+		  elim H2; intros H7 H8; elim H8; intros H9 H10; 
+		    unfold Pminus in |- *; rewrite H3; rewrite H7;
+		      cut ((x + k)%positive = i);
+			[ intros E; rewrite E; auto with arith
+			  | apply (Pplus_reg_l z); rewrite (Pplus_comm x k); rewrite Pplus_assoc;
+			    rewrite H5; rewrite H9; rewrite Pplus_comm; 
+			      trivial with arith ] ] ].
 Qed.
 
 Hint Local Resolve weak_assoc.
 
 Theorem Zplus_assoc : forall n m p:Z, n + (m + p) = n + m + p.
 Proof.
-intros x y z; case x; case y; case z; auto with arith; intros;
- [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc;
-    rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc;
-    rewrite (Zplus_comm (Zpos p1)); trivial with arith
- | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-    rewrite Zplus_comm; rewrite <- weak_assoc;
-    rewrite (Zplus_comm (- Zpos p1));
-    rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p);
-    rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); 
-    trivial with arith
- | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p));
-    rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0));
-    trivial with arith
- | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-    rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc;
-    rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc;
-    rewrite (Zplus_comm (Zpos p)); trivial with arith
- | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-    apply weak_assoc
- | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
-    apply weak_assoc ].
+  intros x y z; case x; case y; case z; auto with arith; intros;
+    [ rewrite (Zplus_comm (Zneg p0)); rewrite weak_assoc;
+      rewrite (Zplus_comm (Zpos p1 + Zneg p0)); rewrite weak_assoc;
+	rewrite (Zplus_comm (Zpos p1)); trivial with arith
+      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+	rewrite Zplus_comm; rewrite <- weak_assoc;
+	  rewrite (Zplus_comm (- Zpos p1));
+	    rewrite (Zplus_comm (Zpos p0 + - Zpos p1)); rewrite (weak_assoc p);
+	      rewrite weak_assoc; rewrite (Zplus_comm (Zpos p0)); 
+		trivial with arith
+      | rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0) (Zpos p));
+	rewrite <- weak_assoc; rewrite Zplus_comm; rewrite (Zplus_comm (Zpos p0));
+	  trivial with arith
+      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+	rewrite (Zplus_comm (- Zpos p0)); rewrite weak_assoc;
+	  rewrite (Zplus_comm (Zpos p1 + - Zpos p0)); rewrite weak_assoc;
+	    rewrite (Zplus_comm (Zpos p)); trivial with arith
+      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+	apply weak_assoc
+      | apply Zopp_inj; do 4 rewrite Zopp_plus_distr; do 2 rewrite Zopp_neg;
+	apply weak_assoc ].
 Qed.
 
 
 Lemma Zplus_assoc_reverse : forall n m p:Z, n + m + p = n + (m + p).
 Proof.
-intros; symmetry  in |- *; apply Zplus_assoc.
+  intros; symmetry  in |- *; apply Zplus_assoc.
 Qed.
 
-(** Associativity mixed with commutativity *)
+(** ** Associativity mixed with commutativity *)
 
 Theorem Zplus_permute : forall n m p:Z, n + (m + p) = m + (n + p).
 Proof.
-intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc;
- rewrite (Zplus_comm p n); trivial with arith.
+  intros n m p; rewrite Zplus_comm; rewrite <- Zplus_assoc;
+    rewrite (Zplus_comm p n); trivial with arith.
 Qed.
 
-(** addition simplifies *)
+(** ** addition simplifies *)
 
 Theorem Zplus_reg_l : forall n m p:Z, n + m = n + p -> m = p.
-intros n m p H; cut (- n + (n + m) = - n + (n + p));
- [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n);
-    rewrite Zplus_opp_r; simpl in |- *; trivial with arith
- | rewrite H; trivial with arith ].
+  intros n m p H; cut (- n + (n + m) = - n + (n + p));
+    [ do 2 rewrite Zplus_assoc; rewrite (Zplus_comm (- n) n);
+      rewrite Zplus_opp_r; simpl in |- *; trivial with arith
+      | rewrite H; trivial with arith ].
 Qed.
 
-(** addition and successor permutes *)
+(** ** addition and successor permutes *)
 
 Lemma Zplus_succ_l : forall n m:Z, Zsucc n + m = Zsucc (n + m).
 Proof.
-intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y));
- rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); 
- trivial with arith.
+  intros x y; unfold Zsucc in |- *; rewrite (Zplus_comm (x + y));
+    rewrite Zplus_assoc; rewrite (Zplus_comm (Zpos 1)); 
+      trivial with arith.
 Qed.
 
 Lemma Zplus_succ_r : forall n m:Z, Zsucc (n + m) = n + Zsucc m.
 Proof.
-intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith.
+  intros n m; unfold Zsucc in |- *; rewrite Zplus_assoc; trivial with arith.
 Qed.
 
 Lemma Zplus_succ_comm : forall n m:Z, Zsucc n + m = n + Zsucc m.
 Proof.
-unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc;
- rewrite (Zplus_comm (Zpos 1)); trivial with arith.
+  unfold Zsucc in |- *; intros n m; rewrite <- Zplus_assoc;
+    rewrite (Zplus_comm (Zpos 1)); trivial with arith.
 Qed.
 
-(** Misc properties, usually redundant or non natural *)
+(** ** Misc properties, usually redundant or non natural *)
 
 Lemma Zplus_0_r_reverse : forall n:Z, n = n + Z0.
 Proof.
-symmetry  in |- *; apply Zplus_0_r.
+  symmetry  in |- *; apply Zplus_0_r.
 Qed.
 
 Lemma Zplus_0_simpl_l : forall n m:Z, n + Z0 = m -> n = m.
 Proof.
-intros n m; rewrite Zplus_0_r; intro; assumption.
+  intros n m; rewrite Zplus_0_r; intro; assumption.
 Qed.
 
 Lemma Zplus_0_simpl_l_reverse : forall n m:Z, n = m + Z0 -> n = m.
 Proof.
-intros n m; rewrite Zplus_0_r; intro; assumption.
+  intros n m; rewrite Zplus_0_r; intro; assumption.
 Qed.
 
 Lemma Zplus_eq_compat : forall n m p q:Z, n = m -> p = q -> n + p = m + q.
 Proof.
-intros; rewrite H; rewrite H0; reflexivity.
+  intros; rewrite H; rewrite H0; reflexivity.
 Qed.
 
 Lemma Zplus_opp_expand : forall n m p:Z, n + - m = n + - p + (p + - m).
 Proof.
-intros x y z.
-rewrite <- (Zplus_assoc x).
-rewrite (Zplus_assoc (- z)).
-rewrite Zplus_opp_l.
-reflexivity.
+  intros x y z.
+  rewrite <- (Zplus_assoc x).
+  rewrite (Zplus_assoc (- z)).
+  rewrite Zplus_opp_l.
+  reflexivity.
 Qed.
 
-(**********************************************************************)
-(** Properties of successor and predecessor on binary integer numbers *)
+(************************************************************************)
+(** * Properties of successor and predecessor on binary integer numbers *)
 
 Theorem Zsucc_discr : forall n:Z, n <> Zsucc n.
 Proof.
-intros n; cut (Z0 <> Zpos 1);
- [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n);
-    rewrite Zplus_0_r; exact H2
- | discriminate ].
+  intros n; cut (Z0 <> Zpos 1);
+    [ unfold not in |- *; intros H1 H2; apply H1; apply (Zplus_reg_l n);
+      rewrite Zplus_0_r; exact H2
+      | discriminate ].
 Qed.
 
 Theorem Zpos_succ_morphism :
- forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p).
+  forall p:positive, Zpos (Psucc p) = Zsucc (Zpos p).
 Proof.
-intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *;
- trivial with arith.
+  intro; rewrite Pplus_one_succ_r; unfold Zsucc in |- *; simpl in |- *;
+    trivial with arith.
 Qed.
 
 (** successor and predecessor are inverse functions *)
 
 Theorem Zsucc_pred : forall n:Z, n = Zsucc (Zpred n).
 Proof.
-intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *;
- rewrite Zplus_0_r; trivial with arith.
+  intros n; unfold Zsucc, Zpred in |- *; rewrite <- Zplus_assoc; simpl in |- *;
+    rewrite Zplus_0_r; trivial with arith.
 Qed. 
 
 Hint Immediate Zsucc_pred: zarith.
  
 Theorem Zpred_succ : forall n:Z, n = Zpred (Zsucc n).
 Proof.
-intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *;
- rewrite Zplus_comm; auto with arith.
+  intros m; unfold Zpred, Zsucc in |- *; rewrite <- Zplus_assoc; simpl in |- *;
+    rewrite Zplus_comm; auto with arith.
 Qed.
 
 Theorem Zsucc_inj : forall n m:Z, Zsucc n = Zsucc m -> n = m.
 Proof.
-intros n m H.
-change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *;
- do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1));
- unfold Zsucc in H; rewrite H; trivial with arith.
+  intros n m H.
+  change (Zneg 1 + Zpos 1 + n = Zneg 1 + Zpos 1 + m) in |- *;
+    do 2 rewrite <- Zplus_assoc; do 2 rewrite (Zplus_comm (Zpos 1));
+      unfold Zsucc in H; rewrite H; trivial with arith.
 Qed.
  
 (** Misc properties, usually redundant or non natural *)
 
 Lemma Zsucc_eq_compat : forall n m:Z, n = m -> Zsucc n = Zsucc m.
 Proof.
-intros n m H; rewrite H; reflexivity.
+  intros n m H; rewrite H; reflexivity.
 Qed.
 
 Lemma Zsucc_inj_contrapositive : forall n m:Z, n <> m -> Zsucc n <> Zsucc m.
 Proof.
-unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption.
+  unfold not in |- *; intros n m H1 H2; apply H1; apply Zsucc_inj; assumption.
 Qed.
 
 (**********************************************************************)
-(** Properties of subtraction on binary integer numbers *)
+(** * Properties of subtraction on binary integer numbers *)
+
+(** ** [minus] and [Z0] *)
 
 Lemma Zminus_0_r : forall n:Z, n - Z0 = n.
 Proof.
-intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r;
- trivial with arith.
+  intro; unfold Zminus in |- *; simpl in |- *; rewrite Zplus_0_r;
+    trivial with arith.
 Qed.
 
 Lemma Zminus_0_l_reverse : forall n:Z, n = n - Z0.
 Proof.
-intro; symmetry  in |- *; apply Zminus_0_r.
+  intro; symmetry  in |- *; apply Zminus_0_r.
 Qed.
 
 Lemma Zminus_diag : forall n:Z, n - n = Z0.
 Proof.
-intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith.
+  intro; unfold Zminus in |- *; rewrite Zplus_opp_r; trivial with arith.
 Qed.
 
 Lemma Zminus_diag_reverse : forall n:Z, Z0 = n - n.
 Proof.
-intro; symmetry  in |- *; apply Zminus_diag.
+  intro; symmetry  in |- *; apply Zminus_diag.
 Qed.
 
+
+(** ** Relating [minus] with [plus] and [Zsucc] *)
+
 Lemma Zplus_minus_eq : forall n m p:Z, n = m + p -> p = n - m.
 Proof.
-intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m);
- rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc;
- rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; 
- trivial with arith.
+  intros n m p H; unfold Zminus in |- *; apply (Zplus_reg_l m);
+    rewrite (Zplus_comm m (n + - m)); rewrite <- Zplus_assoc;
+      rewrite Zplus_opp_l; rewrite Zplus_0_r; rewrite H; 
+	trivial with arith.
 Qed.
 
 Lemma Zminus_plus : forall n m:Z, n + m - n = m.
 Proof.
-intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m);
- rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r.
+  intros n m; unfold Zminus in |- *; rewrite (Zplus_comm n m);
+    rewrite <- Zplus_assoc; rewrite Zplus_opp_r; apply Zplus_0_r.
 Qed.
 
 Lemma Zplus_minus : forall n m:Z, n + (m - n) = m.
 Proof.
-unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r;
- apply Zplus_0_r.
+  unfold Zminus in |- *; intros n m; rewrite Zplus_permute; rewrite Zplus_opp_r;
+    apply Zplus_0_r.
 Qed.
 
 Lemma Zminus_succ_l : forall n m:Z, Zsucc (n - m) = Zsucc n - m.
 Proof.
-intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m));
- rewrite <- Zplus_assoc; apply Zplus_comm.
+  intros n m; unfold Zminus, Zsucc in |- *; rewrite (Zplus_comm n (- m));
+    rewrite <- Zplus_assoc; apply Zplus_comm.
 Qed.
 
 Lemma Zminus_plus_simpl_l : forall n m p:Z, p + n - (p + m) = n - m.
 Proof.
-intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr;
- rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p);
- rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith.
+  intros n m p; unfold Zminus in |- *; rewrite Zopp_plus_distr;
+    rewrite Zplus_assoc; rewrite (Zplus_comm p); rewrite <- (Zplus_assoc n p);
+      rewrite Zplus_opp_r; rewrite Zplus_0_r; trivial with arith.
 Qed.
 
 Lemma Zminus_plus_simpl_l_reverse : forall n m p:Z, n - m = p + n - (p + m).
 Proof.
-intros; symmetry  in |- *; apply Zminus_plus_simpl_l.
+  intros; symmetry  in |- *; apply Zminus_plus_simpl_l.
 Qed.
 
 Lemma Zminus_plus_simpl_r : forall n m p:Z, n + p - (m + p) = n - m.
-intros x y n.
-unfold Zminus in |- *.
-rewrite Zopp_plus_distr.
-rewrite (Zplus_comm (- y) (- n)).
-rewrite Zplus_assoc.
-rewrite <- (Zplus_assoc x n (- n)).
-rewrite (Zplus_opp_r n).
-rewrite <- Zplus_0_r_reverse.
-reflexivity.
+Proof.
+  intros x y n.
+  unfold Zminus in |- *.
+  rewrite Zopp_plus_distr.
+  rewrite (Zplus_comm (- y) (- n)).
+  rewrite Zplus_assoc.
+  rewrite <- (Zplus_assoc x n (- n)).
+  rewrite (Zplus_opp_r n).
+  rewrite <- Zplus_0_r_reverse.
+  reflexivity.
 Qed.
 
-(** Misc redundant properties *)
-
+(** ** Misc redundant properties *)
 
 Lemma Zeq_minus : forall n m:Z, n = m -> n - m = Z0.
 Proof.
-intros x y H; rewrite H; symmetry  in |- *; apply Zminus_diag_reverse.
+  intros x y H; rewrite H; symmetry  in |- *; apply Zminus_diag_reverse.
 Qed.
 
 Lemma Zminus_eq : forall n m:Z, n - m = Z0 -> n = m.
 Proof.
-intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r.
+  intros x y H; rewrite <- (Zplus_minus y x); rewrite H; apply Zplus_0_r.
 Qed.
 
 
 (**********************************************************************)
-(** Properties of multiplication on binary integer numbers *)
+(** * Properties of multiplication on binary integer numbers *)
 
 Theorem Zpos_mult_morphism : 
- forall p q:positive, Zpos (p*q) = Zpos p * Zpos q.
+  forall p q:positive, Zpos (p*q) = Zpos p * Zpos q.
 Proof.
-auto.
+  auto.
 Qed.
 
-(** One is neutral for multiplication *)
+(** ** One is neutral for multiplication *)
 
 Theorem Zmult_1_l : forall n:Z, Zpos 1 * n = n.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
 Theorem Zmult_1_r : forall n:Z, n * Zpos 1 = n.
 Proof.
-intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity.
+  intro x; destruct x; simpl in |- *; try rewrite Pmult_1_r; reflexivity.
 Qed.
 
-(** Zero property of multiplication *)
+(** ** Zero property of multiplication *)
 
 Theorem Zmult_0_l : forall n:Z, Z0 * n = Z0.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
 Theorem Zmult_0_r : forall n:Z, n * Z0 = Z0.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
 Hint Local Resolve Zmult_0_l Zmult_0_r.
 
 Lemma Zmult_0_r_reverse : forall n:Z, Z0 = n * Z0.
 Proof.
-intro x; destruct x; reflexivity.
+  intro x; destruct x; reflexivity.
 Qed.
 
-(** Commutativity of multiplication *)
+(** ** Commutativity of multiplication *)
 
 Theorem Zmult_comm : forall n m:Z, n * m = m * n.
 Proof.
-intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *;
- try rewrite (Pmult_comm p q); reflexivity.
+  intros x y; destruct x as [| p| p]; destruct y as [| q| q]; simpl in |- *;
+    try rewrite (Pmult_comm p q); reflexivity.
 Qed.
 
-(** Associativity of multiplication *)
+(** ** Associativity of multiplication *)
 
 Theorem Zmult_assoc : forall n m p:Z, n * (m * p) = n * m * p.
 Proof.
-intros x y z; destruct x; destruct y; destruct z; simpl in |- *;
- try rewrite Pmult_assoc; reflexivity.
+  intros x y z; destruct x; destruct y; destruct z; simpl in |- *;
+    try rewrite Pmult_assoc; reflexivity.
 Qed.
 
 Lemma Zmult_assoc_reverse : forall n m p:Z, n * m * p = n * (m * p).
 Proof.
-intros n m p; rewrite Zmult_assoc; trivial with arith.
+  intros n m p; rewrite Zmult_assoc; trivial with arith.
 Qed.
 
-(** Associativity mixed with commutativity *)
+(** ** Associativity mixed with commutativity *)
 
 Theorem Zmult_permute : forall n m p:Z, n * (m * p) = m * (n * p).
 Proof.
-intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x).
-apply Zmult_assoc.
+  intros x y z; rewrite (Zmult_assoc y x z); rewrite (Zmult_comm y x).
+  apply Zmult_assoc.
 Qed.
 
-(** Z is integral *)
+(** ** Z is integral *)
 
 Theorem Zmult_integral_l : forall n m:Z, n <> Z0 -> m * n = Z0 -> m = Z0.
 Proof.
-intros x y; destruct x as [| p| p].
+  intros x y; destruct x as [| p| p].
   intro H; absurd (Z0 = Z0); trivial.
   intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
   intros _ H; destruct y as [| q| q]; reflexivity || discriminate.
@@ -782,214 +791,220 @@ Qed.
 
 Theorem Zmult_integral : forall n m:Z, n * m = Z0 -> n = Z0 \/ m = Z0.
 Proof.
-intros x y; destruct x; destruct y; auto; simpl in |- *; intro H;
- discriminate H.
+  intros x y; destruct x; destruct y; auto; simpl in |- *; intro H;
+    discriminate H.
 Qed.
 
 
 Lemma Zmult_1_inversion_l :
- forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1.
+  forall n m:Z, n * m = Zpos 1 -> n = Zpos 1 \/ n = Zneg 1.
 Proof.
-intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ];
- (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H;
-   intro H; rewrite Pmult_1_inversion_l with (1 := H); 
-   reflexivity).
+  intros x y; destruct x as [| p| p]; intro; [ discriminate | left | right ];
+    (destruct y as [| q| q]; try discriminate; simpl in H; injection H; clear H;
+      intro H; rewrite Pmult_1_inversion_l with (1 := H); 
+	reflexivity).
 Qed.
 
-(** Multiplication and Opposite *)
+(** ** Multiplication and Opposite *)
 
 Theorem Zopp_mult_distr_l : forall n m:Z, - (n * m) = - n * m.
 Proof.
-intros x y; destruct x; destruct y; reflexivity.
+  intros x y; destruct x; destruct y; reflexivity.
 Qed.
 
 Theorem Zopp_mult_distr_r : forall n m:Z, - (n * m) = n * - m.
-intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l;
- apply Zmult_comm.
+Proof.
+  intros x y; rewrite (Zmult_comm x y); rewrite Zopp_mult_distr_l;
+    apply Zmult_comm.
 Qed.
 
 Lemma Zopp_mult_distr_l_reverse : forall n m:Z, - n * m = - (n * m).
 Proof.
-intros x y; symmetry  in |- *; apply Zopp_mult_distr_l.
+  intros x y; symmetry  in |- *; apply Zopp_mult_distr_l.
 Qed.
 
 Theorem Zmult_opp_comm : forall n m:Z, - n * m = n * - m.
-intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r;
- trivial with arith.
+Proof.
+  intros x y; rewrite Zopp_mult_distr_l_reverse; rewrite Zopp_mult_distr_r;
+    trivial with arith.
 Qed.
 
 Theorem Zmult_opp_opp : forall n m:Z, - n * - m = n * m.
 Proof.
-intros x y; destruct x; destruct y; reflexivity.
+  intros x y; destruct x; destruct y; reflexivity.
 Qed.
 
 Theorem Zopp_eq_mult_neg_1 : forall n:Z, - n = n * Zneg 1.
-intro x; induction x; intros; rewrite Zmult_comm; auto with arith.
+Proof.
+  intro x; induction x; intros; rewrite Zmult_comm; auto with arith.
 Qed.
 
-(** Distributivity of multiplication over addition *)
+(** ** Distributivity of multiplication over addition *)
 
 Lemma weak_Zmult_plus_distr_r :
- forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m.
-Proof.
-intros x y' z'; case y'; case z'; auto with arith; intros y z;
- (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) ||
-   (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0;
-     [ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y));
-        trivial with arith
-     | cut ((x * z ?= x * y)%positive Eq = Lt);
-        [ intros E; rewrite E; rewrite Pmult_minus_distr_l;
-           [ trivial with arith | apply ZC2; assumption ]
-        | apply nat_of_P_lt_Lt_compare_complement_morphism;
-           do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); 
-           intros h H1; rewrite H1; apply mult_S_lt_compat_l;
-           exact (nat_of_P_lt_Lt_compare_morphism z y E0) ]
-     | cut ((x * z ?= x * y)%positive Eq = Gt);
-        [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith
-        | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
-           do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); 
-           intros h H1; rewrite H1; apply mult_S_lt_compat_l;
-           exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]).
+  forall (p:positive) (n m:Z), Zpos p * (n + m) = Zpos p * n + Zpos p * m.
+Proof.
+  intros x y' z'; case y'; case z'; auto with arith; intros y z;
+    (simpl in |- *; rewrite Pmult_plus_distr_l; trivial with arith) ||
+      (simpl in |- *; ElimPcompare z y; intros E0; rewrite E0;
+	[ rewrite (Pcompare_Eq_eq z y E0); rewrite (Pcompare_refl (x * y));
+          trivial with arith
+	  | cut ((x * z ?= x * y)%positive Eq = Lt);
+            [ intros E; rewrite E; rewrite Pmult_minus_distr_l;
+              [ trivial with arith | apply ZC2; assumption ]
+              | apply nat_of_P_lt_Lt_compare_complement_morphism;
+		do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); 
+		  intros h H1; rewrite H1; apply mult_S_lt_compat_l;
+		    exact (nat_of_P_lt_Lt_compare_morphism z y E0) ]
+	  | cut ((x * z ?= x * y)%positive Eq = Gt);
+            [ intros E; rewrite E; rewrite Pmult_minus_distr_l; auto with arith
+              | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
+		do 2 rewrite nat_of_P_mult_morphism; elim (ZL4 x); 
+		  intros h H1; rewrite H1; apply mult_S_lt_compat_l;
+		    exact (nat_of_P_gt_Gt_compare_morphism z y E0) ] ]).
 Qed.
 
 Theorem Zmult_plus_distr_r : forall n m p:Z, n * (m + p) = n * m + n * p.
 Proof.
-intros x y z; case x;
- [ auto with arith
- | intros x'; apply weak_Zmult_plus_distr_r
- | intros p; apply Zopp_inj; rewrite Zopp_plus_distr;
-    do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg;
-    apply weak_Zmult_plus_distr_r ].
+  intros x y z; case x;
+    [ auto with arith
+      | intros x'; apply weak_Zmult_plus_distr_r
+      | intros p; apply Zopp_inj; rewrite Zopp_plus_distr;
+	do 3 rewrite <- Zopp_mult_distr_l_reverse; rewrite Zopp_neg;
+	  apply weak_Zmult_plus_distr_r ].
 Qed.
 
 Theorem Zmult_plus_distr_l : forall n m p:Z, (n + m) * p = n * p + m * p.
 Proof.
-intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r;
- do 2 rewrite (Zmult_comm p); trivial with arith.
+  intros n m p; rewrite Zmult_comm; rewrite Zmult_plus_distr_r;
+    do 2 rewrite (Zmult_comm p); trivial with arith.
 Qed.
 
-(** Distributivity of multiplication over subtraction *)
+(** ** Distributivity of multiplication over subtraction *)
 
 Lemma Zmult_minus_distr_r : forall n m p:Z, (n - m) * p = n * p - m * p.
 Proof.
-intros x y z; unfold Zminus in |- *.
-rewrite <- Zopp_mult_distr_l_reverse.
-apply Zmult_plus_distr_l.
+  intros x y z; unfold Zminus in |- *.
+  rewrite <- Zopp_mult_distr_l_reverse.
+  apply Zmult_plus_distr_l.
 Qed.
 
  
 Lemma Zmult_minus_distr_l : forall n m p:Z, p * (n - m) = p * n - p * m.
 Proof.
-intros x y z; rewrite (Zmult_comm z (x - y)).
-rewrite (Zmult_comm z x).
-rewrite (Zmult_comm z y).
-apply Zmult_minus_distr_r.
+  intros x y z; rewrite (Zmult_comm z (x - y)).
+  rewrite (Zmult_comm z x).
+  rewrite (Zmult_comm z y).
+  apply Zmult_minus_distr_r.
 Qed.
 
-(** Simplification of multiplication for non-zero integers *)
+(** ** Simplification of multiplication for non-zero integers *)
 
 Lemma Zmult_reg_l : forall n m p:Z, p <> Z0 -> p * n = p * m -> n = m.
 Proof.
-intros x y z H H0.
-generalize (Zeq_minus _ _ H0).
-intro.
-apply Zminus_eq.
-rewrite <- Zmult_minus_distr_l in H1.
-clear H0; destruct (Zmult_integral _ _ H1).
-contradiction.
-trivial.
+  intros x y z H H0.
+  generalize (Zeq_minus _ _ H0).
+  intro.
+  apply Zminus_eq.
+  rewrite <- Zmult_minus_distr_l in H1.
+  clear H0; destruct (Zmult_integral _ _ H1).
+  contradiction.
+  trivial.
 Qed.
 
 Lemma Zmult_reg_r : forall n m p:Z, p <> Z0 -> n * p = m * p -> n = m.
 Proof.
-intros x y z Hz.
-rewrite (Zmult_comm x z).
-rewrite (Zmult_comm y z).
-intro; apply Zmult_reg_l with z; assumption.
+  intros x y z Hz.
+  rewrite (Zmult_comm x z).
+  rewrite (Zmult_comm y z).
+  intro; apply Zmult_reg_l with z; assumption.
 Qed.
 
-(** Addition and multiplication by 2 *)
+(** ** Addition and multiplication by 2 *)
 
 Lemma Zplus_diag_eq_mult_2 : forall n:Z, n + n = n * Zpos 2.
 Proof.
-intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x);
- rewrite <- Zmult_plus_distr_r; reflexivity.
+  intros x; pattern x at 1 2 in |- *; rewrite <- (Zmult_1_r x);
+    rewrite <- Zmult_plus_distr_r; reflexivity.
 Qed.
 
-(** Multiplication and successor *)
+(** ** Multiplication and successor *)
 
 Lemma Zmult_succ_r : forall n m:Z, n * Zsucc m = n * m + n.
 Proof.
-intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r;
- rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; 
- trivial with arith.
+  intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_r;
+    rewrite (Zmult_comm n (Zpos 1)); rewrite Zmult_1_l; 
+      trivial with arith.
 Qed.
 
 Lemma Zmult_succ_r_reverse : forall n m:Z, n * m + n = n * Zsucc m.
 Proof.
-intros; symmetry  in |- *; apply Zmult_succ_r.
+  intros; symmetry  in |- *; apply Zmult_succ_r.
 Qed.
 
 Lemma Zmult_succ_l : forall n m:Z, Zsucc n * m = n * m + m.
 Proof.
-intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l;
- rewrite Zmult_1_l; trivial with arith.
+  intros n m; unfold Zsucc in |- *; rewrite Zmult_plus_distr_l;
+    rewrite Zmult_1_l; trivial with arith.
 Qed.
 
 Lemma Zmult_succ_l_reverse : forall n m:Z, n * m + m = Zsucc n * m.
 Proof.
-intros; symmetry  in |- *; apply Zmult_succ_l.
+  intros; symmetry  in |- *; apply Zmult_succ_l.
 Qed.
 
 
 
-(** Misc redundant properties *)
+(** ** Misc redundant properties *)
 
 Lemma Z_eq_mult : forall n m:Z, m = Z0 -> m * n = Z0.
-intros x y H; rewrite H; auto with arith.
+Proof.
+  intros x y H; rewrite H; auto with arith.
 Qed.
 
+
+
 (**********************************************************************)
-(** Relating binary positive numbers and binary integers *)
+(** * Relating binary positive numbers and binary integers *)
 
 Lemma Zpos_xI : forall p:positive, Zpos (xI p) = Zpos 2 * Zpos p + Zpos 1.
 Proof.
-intro; apply refl_equal.
+  intro; apply refl_equal.
 Qed.
 
 Lemma Zpos_xO : forall p:positive, Zpos (xO p) = Zpos 2 * Zpos p.
 Proof.
-intro; apply refl_equal.
+  intro; apply refl_equal.
 Qed.
 
 Lemma Zneg_xI : forall p:positive, Zneg (xI p) = Zpos 2 * Zneg p - Zpos 1.
 Proof.
-intro; apply refl_equal.
+  intro; apply refl_equal.
 Qed.
 
 Lemma Zneg_xO : forall p:positive, Zneg (xO p) = Zpos 2 * Zneg p.
 Proof.
-reflexivity.
+  reflexivity.
 Qed.
 
 Lemma Zpos_plus_distr : forall p q:positive, Zpos (p + q) = Zpos p + Zpos q.
 Proof.
-intros p p'; destruct p;
- [ destruct p' as [p0| p0| ]
- | destruct p' as [p0| p0| ]
- | destruct p' as [p| p| ] ]; reflexivity.
+  intros p p'; destruct p;
+    [ destruct p' as [p0| p0| ]
+      | destruct p' as [p0| p0| ]
+      | destruct p' as [p| p| ] ]; reflexivity.
 Qed.
 
 Lemma Zneg_plus_distr : forall p q:positive, Zneg (p + q) = Zneg p + Zneg q.
 Proof.
-intros p p'; destruct p;
- [ destruct p' as [p0| p0| ]
- | destruct p' as [p0| p0| ]
- | destruct p' as [p| p| ] ]; reflexivity.
+  intros p p'; destruct p;
+    [ destruct p' as [p0| p0| ]
+      | destruct p' as [p0| p0| ]
+      | destruct p' as [p| p| ] ]; reflexivity.
 Qed.
 
 (**********************************************************************)
-(** Order relations *)
+(** * Order relations *)
 
 Definition Zlt (x y:Z) := (x ?= y) = Lt.
 Definition Zgt (x y:Z) := (x ?= y) = Gt.
@@ -1008,41 +1023,41 @@ Notation "x < y < z" := (x < y /\ y < z) : Z_scope.
 Notation "x < y <= z" := (x < y /\ y <= z) : Z_scope.
 
 (**********************************************************************)
-(** Absolute value on integers *)
+(** * Absolute value on integers *)
 
 Definition Zabs_nat (x:Z) : nat :=
   match x with
-  | Z0 => 0%nat
-  | Zpos p => nat_of_P p
-  | Zneg p => nat_of_P p
+    | Z0 => 0%nat
+    | Zpos p => nat_of_P p
+    | Zneg p => nat_of_P p
   end.
 
 Definition Zabs (z:Z) : Z :=
   match z with
-  | Z0 => Z0
-  | Zpos p => Zpos p
-  | Zneg p => Zpos p
+    | Z0 => Z0
+    | Zpos p => Zpos p
+    | Zneg p => Zpos p
   end.
 
 (**********************************************************************)
-(** From [nat] to [Z] *)
+(** * From [nat] to [Z] *)
 
 Definition Z_of_nat (x:nat) :=
   match x with
-  | O => Z0
-  | S y => Zpos (P_of_succ_nat y)
+    | O => Z0
+    | S y => Zpos (P_of_succ_nat y)
   end.
 
 Require Import BinNat.
 
 Definition Zabs_N (z:Z) :=
   match z with
-  | Z0 => 0%N
-  | Zpos p => Npos p
-  | Zneg p => Npos p
+    | Z0 => 0%N
+    | Zpos p => Npos p
+    | Zneg p => Npos p
   end.
 
 Definition Z_of_N (x:N) := match x with
-                           | N0 => Z0
-                           | Npos p => Zpos p
+                             | N0 => Z0
+                             | Npos p => Zpos p
                            end.
diff --git a/theories/ZArith/Int.v b/theories/ZArith/Int.v
index cb51b9d2..3cee9190 100644
--- a/theories/ZArith/Int.v
+++ b/theories/ZArith/Int.v
@@ -7,120 +7,126 @@
 (***********************************************************************)
 
 (* Finite sets library.  
- * Authors: Pierre Letouzey and Jean-Christophe Filliâtre 
- * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
+ * Authors: Pierre Letouzey and Jean-Christophe Filliâtre 
+ * Institution: LRI, CNRS UMR 8623 - Université Paris Sud
  *              91405 Orsay, France *)
 
-(* $Id: Int.v 8933 2006-06-09 14:08:38Z herbelin $ *)
+(* $Id: Int.v 9319 2006-10-30 12:41:21Z barras $ *)
 
-(** * An axiomatization of integers. *) 
+(** An axiomatization of integers. *) 
 
 (** We define a signature for an integer datatype based on [Z]. 
-   The goal is to allow a switch after extraction to ocaml's 
-   [big_int] or even [int] when finiteness isn't a problem 
-   (typically : when mesuring the height of an AVL tree). 
+    The goal is to allow a switch after extraction to ocaml's 
+    [big_int] or even [int] when finiteness isn't a problem 
+    (typically : when mesuring the height of an AVL tree). 
 *)
 
 Require Import ZArith. 
 Require Import ROmega. 
 Delimit Scope Int_scope with I.
 
+
+(** * a specification of integers *)
+
 Module Type Int.
 
- Open Scope Int_scope.
-
- Parameter int : Set. 
-
- Parameter i2z : int -> Z.
- Arguments Scope i2z [ Int_scope ].
-
- Parameter _0 : int. 
- Parameter _1 : int. 
- Parameter _2 : int. 
- Parameter _3 : int.
- Parameter plus : int -> int -> int. 
- Parameter opp : int -> int.
- Parameter minus : int -> int -> int. 
- Parameter mult : int -> int -> int.
- Parameter max : int -> int -> int. 
-
- Notation "0" := _0 : Int_scope.
- Notation "1" := _1 : Int_scope. 
- Notation "2" := _2 : Int_scope. 
- Notation "3" := _3 : Int_scope.
- Infix "+" := plus : Int_scope.
- Infix "-" := minus : Int_scope.
- Infix "*" := mult : Int_scope.
- Notation "- x" := (opp x) : Int_scope.
-
-(** For logical relations, we can rely on their counterparts in Z, 
-   since they don't appear after extraction. Moreover, using tactics 
-   like omega is easier this way. *)
-
- Notation "x == y" := (i2z x = i2z y)
-   (at level 70, y at next level, no associativity) : Int_scope.
- Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope.
- Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope.
- Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope.
- Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope.
- Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope.
- Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope.
- Notation "x < y < z" := (x < y /\ y < z) : Int_scope.
- Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope.
-
- (** Some decidability fonctions (informative). *)
-
- Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}.
- Axiom ge_lt_dec :  forall x y : int, {x >= y} + {x < y}.
- Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }.
-
- (** Specifications *)
-
- (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality 
-    [==] and the generic [=] are in fact equivalent. We define [==] 
-    nonetheless since the translation to [Z] for using automatic tactic is easier. *)
-
- Axiom i2z_eq : forall n p : int, n == p -> n = p. 
-
- (** Then, we express the specifications of the above parameters using their 
-    Z counterparts. *)
-
- Open Scope Z_scope.
- Axiom i2z_0 : i2z _0 = 0.
- Axiom i2z_1 : i2z _1 = 1.
- Axiom i2z_2 : i2z _2 = 2.
- Axiom i2z_3 : i2z _3 = 3.
- Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.
- Axiom i2z_opp : forall n, i2z (-n) = -i2z n.
- Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p.
- Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p.
- Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p).
+  Open Scope Int_scope.
+  
+  Parameter int : Set. 
+  
+  Parameter i2z : int -> Z.
+  Arguments Scope i2z [ Int_scope ].
+  
+  Parameter _0 : int. 
+  Parameter _1 : int. 
+  Parameter _2 : int. 
+  Parameter _3 : int.
+  Parameter plus : int -> int -> int. 
+  Parameter opp : int -> int.
+  Parameter minus : int -> int -> int. 
+  Parameter mult : int -> int -> int.
+  Parameter max : int -> int -> int. 
+ 
+  Notation "0" := _0 : Int_scope.
+  Notation "1" := _1 : Int_scope. 
+  Notation "2" := _2 : Int_scope. 
+  Notation "3" := _3 : Int_scope.
+  Infix "+" := plus : Int_scope.
+  Infix "-" := minus : Int_scope.
+  Infix "*" := mult : Int_scope.
+  Notation "- x" := (opp x) : Int_scope.
+
+  (** For logical relations, we can rely on their counterparts in Z, 
+      since they don't appear after extraction. Moreover, using tactics 
+      like omega is easier this way. *)
+
+  Notation "x == y" := (i2z x = i2z y)
+    (at level 70, y at next level, no associativity) : Int_scope.
+  Notation "x <= y" := (Zle (i2z x) (i2z y)): Int_scope.
+  Notation "x < y" := (Zlt (i2z x) (i2z y)) : Int_scope.
+  Notation "x >= y" := (Zge (i2z x) (i2z y)) : Int_scope.
+  Notation "x > y" := (Zgt (i2z x) (i2z y)): Int_scope.
+  Notation "x <= y <= z" := (x <= y /\ y <= z) : Int_scope.
+  Notation "x <= y < z" := (x <= y /\ y < z) : Int_scope.
+  Notation "x < y < z" := (x < y /\ y < z) : Int_scope.
+  Notation "x < y <= z" := (x < y /\ y <= z) : Int_scope.
+  
+  (** Some decidability fonctions (informative). *)
+  
+  Axiom gt_le_dec : forall x y: int, {x > y} + {x <= y}.
+  Axiom ge_lt_dec :  forall x y : int, {x >= y} + {x < y}.
+  Axiom eq_dec : forall x y : int, { x == y } + {~ x==y }.
+
+  (** Specifications *)
+
+  (** First, we ask [i2z] to be injective. Said otherwise, our ad-hoc equality 
+      [==] and the generic [=] are in fact equivalent. We define [==] 
+      nonetheless since the translation to [Z] for using automatic tactic is easier. *)
+
+  Axiom i2z_eq : forall n p : int, n == p -> n = p. 
+  
+   (** Then, we express the specifications of the above parameters using their 
+       Z counterparts. *)
+
+  Open Scope Z_scope.
+  Axiom i2z_0 : i2z _0 = 0.
+  Axiom i2z_1 : i2z _1 = 1.
+  Axiom i2z_2 : i2z _2 = 2.
+  Axiom i2z_3 : i2z _3 = 3.
+  Axiom i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.
+  Axiom i2z_opp : forall n, i2z (-n) = -i2z n.
+  Axiom i2z_minus : forall n p, i2z (n - p) = i2z n - i2z p.
+  Axiom i2z_mult : forall n p, i2z (n * p) = i2z n * i2z p.
+  Axiom i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p).
 
 End Int. 
 
-Module MoreInt (I:Int).
- Import I.
 
- Open Scope Int_scope.
+(** * Facts and  tactics using [Int] *)
+
+Module MoreInt (I:Int).
+  Import I.
+  
+  Open Scope Int_scope.
 
- (** A magic (but costly) tactic that goes from [int] back to the [Z] 
-     friendly world ... *)
+  (** A magic (but costly) tactic that goes from [int] back to the [Z] 
+      friendly world ... *)
 
- Hint Rewrite -> 
-   i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z.
+  Hint Rewrite -> 
+    i2z_0 i2z_1 i2z_2 i2z_3 i2z_plus i2z_opp i2z_minus i2z_mult i2z_max : i2z.
 
- Ltac i2z := match goal with 
-  | H : (eq (A:=int) ?a ?b) |- _ => 
-       generalize (f_equal i2z H); 
-       try autorewrite with i2z; clear H; intro H; i2z
-  | |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z
-  | H : _ |- _ => progress autorewrite with i2z in H; i2z
-  | _ => try autorewrite with i2z
- end.
+  Ltac i2z := match goal with 
+		| H : (eq (A:=int) ?a ?b) |- _ => 
+		  generalize (f_equal i2z H); 
+		    try autorewrite with i2z; clear H; intro H; i2z
+		| |- (eq (A:=int) ?a ?b) => apply (i2z_eq a b); try autorewrite with i2z; i2z
+		| H : _ |- _ => progress autorewrite with i2z in H; i2z
+		| _ => try autorewrite with i2z
+	      end.
 
- (** A reflexive version of the [i2z] tactic *)
+  (** A reflexive version of the [i2z] tactic *)
 
- (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a 
+  (** this [i2z_refl] is actually weaker than [i2z]. For instance, if a 
       [i2z] is buried deep inside a subterm, [i2z_refl] may miss it. 
       See also the limitation about [Set] or [Type] part below. 
       Anyhow, [i2z_refl] is enough for applying [romega]. *)
@@ -150,228 +156,228 @@ Module MoreInt (I:Int).
    end.
 
   Inductive ExprI : Set := 
-   | EI0 : ExprI
-   | EI1 : ExprI
-   | EI2 : ExprI 
-   | EI3 : ExprI
-   | EIplus : ExprI -> ExprI -> ExprI
-   | EIopp : ExprI -> ExprI
-   | EIminus : ExprI -> ExprI -> ExprI
-   | EImult : ExprI -> ExprI -> ExprI
-   | EImax : ExprI -> ExprI -> ExprI
-   | EIraw : int -> ExprI.
+    | EI0 : ExprI
+    | EI1 : ExprI
+    | EI2 : ExprI 
+    | EI3 : ExprI
+    | EIplus : ExprI -> ExprI -> ExprI
+    | EIopp : ExprI -> ExprI
+    | EIminus : ExprI -> ExprI -> ExprI
+    | EImult : ExprI -> ExprI -> ExprI
+    | EImax : ExprI -> ExprI -> ExprI
+    | EIraw : int -> ExprI.
 
   Inductive ExprZ : Set :=  
-   | EZplus : ExprZ -> ExprZ -> ExprZ
-   | EZopp : ExprZ -> ExprZ
-   | EZminus : ExprZ -> ExprZ -> ExprZ
-   | EZmult : ExprZ -> ExprZ -> ExprZ
-   | EZmax : ExprZ -> ExprZ -> ExprZ
-   | EZofI : ExprI -> ExprZ
-   | EZraw : Z -> ExprZ.
+    | EZplus : ExprZ -> ExprZ -> ExprZ
+    | EZopp : ExprZ -> ExprZ
+    | EZminus : ExprZ -> ExprZ -> ExprZ
+    | EZmult : ExprZ -> ExprZ -> ExprZ
+    | EZmax : ExprZ -> ExprZ -> ExprZ
+    | EZofI : ExprI -> ExprZ
+    | EZraw : Z -> ExprZ.
 
   Inductive ExprP : Type := 
-   | EPeq : ExprZ -> ExprZ -> ExprP 
-   | EPlt : ExprZ -> ExprZ -> ExprP 
-   | EPle : ExprZ -> ExprZ -> ExprP 
-   | EPgt : ExprZ -> ExprZ -> ExprP 
-   | EPge : ExprZ -> ExprZ -> ExprP 
-   | EPimpl : ExprP -> ExprP -> ExprP
-   | EPequiv : ExprP -> ExprP -> ExprP
-   | EPand : ExprP -> ExprP -> ExprP
-   | EPor : ExprP -> ExprP -> ExprP
-   | EPneg : ExprP -> ExprP
-   | EPraw : Prop -> ExprP.
-
- (** [int] to [ExprI] *)
-
- Ltac i2ei trm := 
-  match constr:trm with 
-    | 0 => constr:EI0
-    | 1 => constr:EI1
-    | 2 => constr:EI2
-    | 3 => constr:EI3
-    | ?x + ?y => let ex := i2ei x with ey := i2ei y in constr:(EIplus ex ey)
-    | ?x - ?y => let ex := i2ei x with ey := i2ei y in constr:(EIminus ex ey)
-    | ?x * ?y => let ex := i2ei x with ey := i2ei y in constr:(EImult ex ey)
-    | max ?x ?y => let ex := i2ei x with ey := i2ei y in constr:(EImax ex ey)
-    | - ?x => let ex := i2ei x in constr:(EIopp ex)
-    | ?x => constr:(EIraw x)
-   end
-
- (** [Z] to [ExprZ] *)
-
- with z2ez trm := 
-   match constr:trm with 
-    | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey)
-    | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey)
-    | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey)
-    | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey)
-    | (-?x)%Z =>  let ex := z2ez x in constr:(EZopp ex)
-    | i2z ?x => let ex := i2ei x in constr:(EZofI ex)
-    | ?x => constr:(EZraw x)
-   end.
+    | EPeq : ExprZ -> ExprZ -> ExprP 
+    | EPlt : ExprZ -> ExprZ -> ExprP 
+    | EPle : ExprZ -> ExprZ -> ExprP 
+    | EPgt : ExprZ -> ExprZ -> ExprP 
+    | EPge : ExprZ -> ExprZ -> ExprP 
+    | EPimpl : ExprP -> ExprP -> ExprP
+    | EPequiv : ExprP -> ExprP -> ExprP
+    | EPand : ExprP -> ExprP -> ExprP
+    | EPor : ExprP -> ExprP -> ExprP
+    | EPneg : ExprP -> ExprP
+    | EPraw : Prop -> ExprP.
+
+  (** [int] to [ExprI] *)
+
+  Ltac i2ei trm := 
+    match constr:trm with 
+      | 0 => constr:EI0
+      | 1 => constr:EI1
+      | 2 => constr:EI2
+      | 3 => constr:EI3
+      | ?x + ?y => let ex := i2ei x with ey := i2ei y in constr:(EIplus ex ey)
+      | ?x - ?y => let ex := i2ei x with ey := i2ei y in constr:(EIminus ex ey)
+      | ?x * ?y => let ex := i2ei x with ey := i2ei y in constr:(EImult ex ey)
+      | max ?x ?y => let ex := i2ei x with ey := i2ei y in constr:(EImax ex ey)
+      | - ?x => let ex := i2ei x in constr:(EIopp ex)
+      | ?x => constr:(EIraw x)
+    end
+
+  (** [Z] to [ExprZ] *)
+
+    with z2ez trm := 
+    match constr:trm with 
+      | (?x+?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZplus ex ey)
+      | (?x-?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZminus ex ey)
+      | (?x*?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EZmult ex ey)
+      | (Zmax ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EZmax ex ey)
+      | (-?x)%Z =>  let ex := z2ez x in constr:(EZopp ex)
+      | i2z ?x => let ex := i2ei x in constr:(EZofI ex)
+      | ?x => constr:(EZraw x)
+    end.
 
- (** [Prop] to [ExprP] *)
-
- Ltac p2ep trm :=
-  match constr:trm with
-    | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey)
-    | (?x -> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPimpl ex ey)
-    | (?x /\ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPand ex ey)
-    | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey)
-    | (~ ?x) => let ex := p2ep x in constr:(EPneg ex)
-    | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey)
-    | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey)
-    | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey)   
-    | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey)   
-    | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey)
-    | ?x =>  constr:(EPraw x)
-   end.   
-
- (** [ExprI] to [int] *)
-
- Fixpoint ei2i (e:ExprI) : int :=
-  match e with
-  | EI0 => 0
-  | EI1 => 1
-  | EI2 => 2
-  | EI3 => 3 
-  | EIplus e1 e2 => (ei2i e1)+(ei2i e2)
-  | EIminus e1 e2 => (ei2i e1)-(ei2i e2)
-  | EImult e1 e2 => (ei2i e1)*(ei2i e2)
-  | EImax e1 e2 => max (ei2i e1) (ei2i e2)
-  | EIopp e => -(ei2i e)
-  | EIraw i => i 
-  end. 
- 
- (** [ExprZ] to [Z] *)
-
- Fixpoint ez2z (e:ExprZ) : Z := 
-  match e with 
-  | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z
-  | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z
-  | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z
-  | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2)
-  | EZopp e => (-(ez2z e))%Z
-  | EZofI e => i2z (ei2i e)
-  | EZraw z => z
-  end.
-
- (** [ExprP] to [Prop] *)
-
- Fixpoint ep2p (e:ExprP) : Prop := 
-  match e with 
-   | EPeq e1 e2 => (ez2z e1) = (ez2z e2)
-   | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z
-   | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z
-   | EPgt e1 e2 => ((ez2z e1)>(ez2z e2))%Z
-   | EPge e1 e2 => ((ez2z e1)>=(ez2z e2))%Z
-   | EPimpl e1 e2 => (ep2p e1) -> (ep2p e2)
-   | EPequiv e1 e2 => (ep2p e1) <-> (ep2p e2)
-   | EPand e1 e2 => (ep2p e1) /\ (ep2p e2)
-   | EPor e1 e2 => (ep2p e1) \/ (ep2p e2)
-   | EPneg e => ~ (ep2p e)
-   | EPraw p => p
- end.
-
- (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *)
+  (** [Prop] to [ExprP] *)
+  
+  Ltac p2ep trm :=
+    match constr:trm with
+      | (?x <-> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPequiv ex ey)
+      | (?x -> ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPimpl ex ey)
+      | (?x /\ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPand ex ey)
+      | (?x \/ ?y) => let ex := p2ep x with ey := p2ep y in constr:(EPor ex ey)
+      | (~ ?x) => let ex := p2ep x in constr:(EPneg ex)
+      | (eq (A:=Z) ?x ?y) => let ex := z2ez x with ey := z2ez y in constr:(EPeq ex ey)
+      | (?x<?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPlt ex ey)
+      | (?x<=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPle ex ey)   
+      | (?x>?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPgt ex ey)   
+      | (?x>=?y)%Z => let ex := z2ez x with ey := z2ez y in constr:(EPge ex ey)
+      | ?x =>  constr:(EPraw x)
+    end.   
+
+  (** [ExprI] to [int] *)
+
+  Fixpoint ei2i (e:ExprI) : int :=
+    match e with
+      | EI0 => 0
+      | EI1 => 1
+      | EI2 => 2
+      | EI3 => 3 
+      | EIplus e1 e2 => (ei2i e1)+(ei2i e2)
+      | EIminus e1 e2 => (ei2i e1)-(ei2i e2)
+      | EImult e1 e2 => (ei2i e1)*(ei2i e2)
+      | EImax e1 e2 => max (ei2i e1) (ei2i e2)
+      | EIopp e => -(ei2i e)
+      | EIraw i => i 
+    end. 
+
+  (** [ExprZ] to [Z] *)
+
+  Fixpoint ez2z (e:ExprZ) : Z := 
+    match e with 
+      | EZplus e1 e2 => ((ez2z e1)+(ez2z e2))%Z
+      | EZminus e1 e2 => ((ez2z e1)-(ez2z e2))%Z
+      | EZmult e1 e2 => ((ez2z e1)*(ez2z e2))%Z
+      | EZmax e1 e2 => Zmax (ez2z e1) (ez2z e2)
+      | EZopp e => (-(ez2z e))%Z
+      | EZofI e => i2z (ei2i e)
+      | EZraw z => z
+    end.
+
+  (** [ExprP] to [Prop] *)
+
+  Fixpoint ep2p (e:ExprP) : Prop := 
+    match e with 
+      | EPeq e1 e2 => (ez2z e1) = (ez2z e2)
+      | EPlt e1 e2 => ((ez2z e1)<(ez2z e2))%Z
+      | EPle e1 e2 => ((ez2z e1)<=(ez2z e2))%Z
+      | EPgt e1 e2 => ((ez2z e1)>(ez2z e2))%Z
+      | EPge e1 e2 => ((ez2z e1)>=(ez2z e2))%Z
+      | EPimpl e1 e2 => (ep2p e1) -> (ep2p e2)
+      | EPequiv e1 e2 => (ep2p e1) <-> (ep2p e2)
+      | EPand e1 e2 => (ep2p e1) /\ (ep2p e2)
+      | EPor e1 e2 => (ep2p e1) \/ (ep2p e2)
+      | EPneg e => ~ (ep2p e)
+      | EPraw p => p
+    end.
+
+  (** [ExprI] (supposed under a [i2z]) to a simplified [ExprZ] *)
    
- Fixpoint norm_ei (e:ExprI) : ExprZ := 
- match e with 
-  | EI0 => EZraw (0%Z)
-  | EI1 => EZraw (1%Z)
-  | EI2 => EZraw (2%Z)
-  | EI3 => EZraw (3%Z) 
-  | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2)
-  | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2)
-  | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2)
-  | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2)
-  | EIopp e => EZopp (norm_ei e)
-  | EIraw i => EZofI (EIraw i) 
- end.
-
- (** [ExprZ] to a simplified [ExprZ] *)
-
- Fixpoint norm_ez (e:ExprZ) : ExprZ := 
-  match e with 
-  | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2)
-  | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2)
-  | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2)
-  | EZmax e1 e2 => EZmax (norm_ez e1) (norm_ez e2)
-  | EZopp e => EZopp (norm_ez e)
-  | EZofI e =>  norm_ei e
-  | EZraw z => EZraw z
- end.
-
- (** [ExprP] to a simplified [ExprP] *)
-
- Fixpoint norm_ep (e:ExprP) : ExprP := 
-  match e with 
-   | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2)
-   | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2)
-   | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2)
-   | EPgt e1 e2 => EPgt (norm_ez e1) (norm_ez e2)
-   | EPge e1 e2 => EPge (norm_ez e1) (norm_ez e2)
-   | EPimpl e1 e2 => EPimpl (norm_ep e1) (norm_ep e2)
-   | EPequiv e1 e2 => EPequiv (norm_ep e1) (norm_ep e2)
-   | EPand e1 e2 => EPand (norm_ep e1) (norm_ep e2)
-   | EPor e1 e2 => EPor (norm_ep e1) (norm_ep e2)
-   | EPneg e => EPneg (norm_ep e)
-   | EPraw p => EPraw p
- end.
-
- Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e).
- Proof. 
- induction e; simpl; intros; i2z; auto; try congruence.
- Qed.
-
- Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e.
- Proof.
- induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct.
- Qed. 
-
- Lemma norm_ep_correct : 
-  forall e:ExprP, ep2p (norm_ep e) <-> ep2p e.
- Proof.
-  induction e; simpl; repeat (rewrite norm_ez_correct); intuition.
- Qed.
-
- Lemma norm_ep_correct2 : 
-  forall e:ExprP, ep2p (norm_ep e) -> ep2p e.
- Proof.
-  intros; destruct (norm_ep_correct e); auto.
- Qed.
-
- Ltac i2z_refl := 
-  i2z_gen;
-  match goal with |- ?t => 
-     let e := p2ep t 
-     in 
-     (change (ep2p e); 
-      apply norm_ep_correct2; 
-      simpl)
-   end.
+  Fixpoint norm_ei (e:ExprI) : ExprZ := 
+    match e with 
+      | EI0 => EZraw (0%Z)
+      | EI1 => EZraw (1%Z)
+      | EI2 => EZraw (2%Z)
+      | EI3 => EZraw (3%Z) 
+      | EIplus e1 e2 => EZplus (norm_ei e1) (norm_ei e2)
+      | EIminus e1 e2 => EZminus (norm_ei e1) (norm_ei e2)
+      | EImult e1 e2 => EZmult (norm_ei e1) (norm_ei e2)
+      | EImax e1 e2 => EZmax (norm_ei e1) (norm_ei e2)
+      | EIopp e => EZopp (norm_ei e)
+      | EIraw i => EZofI (EIraw i) 
+    end.
+
+  (** [ExprZ] to a simplified [ExprZ] *)
+
+  Fixpoint norm_ez (e:ExprZ) : ExprZ := 
+    match e with 
+      | EZplus e1 e2 => EZplus (norm_ez e1) (norm_ez e2)
+      | EZminus e1 e2 => EZminus (norm_ez e1) (norm_ez e2)
+      | EZmult e1 e2 => EZmult (norm_ez e1) (norm_ez e2)
+      | EZmax e1 e2 => EZmax (norm_ez e1) (norm_ez e2)
+      | EZopp e => EZopp (norm_ez e)
+      | EZofI e =>  norm_ei e
+      | EZraw z => EZraw z
+    end.
+
+  (** [ExprP] to a simplified [ExprP] *)
+  
+  Fixpoint norm_ep (e:ExprP) : ExprP := 
+    match e with 
+      | EPeq e1 e2 => EPeq (norm_ez e1) (norm_ez e2)
+      | EPlt e1 e2 => EPlt (norm_ez e1) (norm_ez e2)
+      | EPle e1 e2 => EPle (norm_ez e1) (norm_ez e2)
+      | EPgt e1 e2 => EPgt (norm_ez e1) (norm_ez e2)
+      | EPge e1 e2 => EPge (norm_ez e1) (norm_ez e2)
+      | EPimpl e1 e2 => EPimpl (norm_ep e1) (norm_ep e2)
+      | EPequiv e1 e2 => EPequiv (norm_ep e1) (norm_ep e2)
+      | EPand e1 e2 => EPand (norm_ep e1) (norm_ep e2)
+      | EPor e1 e2 => EPor (norm_ep e1) (norm_ep e2)
+      | EPneg e => EPneg (norm_ep e)
+      | EPraw p => EPraw p
+    end.
+
+  Lemma norm_ei_correct : forall e:ExprI, ez2z (norm_ei e) = i2z (ei2i e).
+  Proof. 
+    induction e; simpl; intros; i2z; auto; try congruence.
+  Qed.
+
+  Lemma norm_ez_correct : forall e:ExprZ, ez2z (norm_ez e) = ez2z e.
+  Proof.
+    induction e; simpl; intros; i2z; auto; try congruence; apply norm_ei_correct.
+  Qed. 
+
+  Lemma norm_ep_correct : 
+    forall e:ExprP, ep2p (norm_ep e) <-> ep2p e.
+  Proof.
+    induction e; simpl; repeat (rewrite norm_ez_correct); intuition.
+  Qed.
+
+  Lemma norm_ep_correct2 : 
+    forall e:ExprP, ep2p (norm_ep e) -> ep2p e.
+  Proof.
+    intros; destruct (norm_ep_correct e); auto.
+  Qed.
+
+  Ltac i2z_refl := 
+    i2z_gen;
+    match goal with |- ?t => 
+      let e := p2ep t 
+	in 
+	(change (ep2p e); 
+	  apply norm_ep_correct2; 
+	    simpl)
+    end.
 
- Ltac iauto := i2z_refl; auto.
- Ltac iomega := i2z_refl; intros; romega.
+  Ltac iauto := i2z_refl; auto.
+  Ltac iomega := i2z_refl; intros; romega.
 
- Open Scope Z_scope.
+  Open Scope Z_scope.
 
- Lemma max_spec : forall (x y:Z), 
-  x >= y /\ Zmax x y = x  \/
-  x < y /\ Zmax x y = y.
- Proof.
-  intros; unfold Zmax, Zlt, Zge.
-  destruct (Zcompare x y); [ left | right | left ]; split; auto; discriminate.
- Qed.
+  Lemma max_spec : forall (x y:Z), 
+    x >= y /\ Zmax x y = x  \/
+    x < y /\ Zmax x y = y.
+  Proof.
+    intros; unfold Zmax, Zlt, Zge.
+    destruct (Zcompare x y); [ left | right | left ]; split; auto; discriminate.
+  Qed.
 
- Ltac omega_max_genspec x y := 
+  Ltac omega_max_genspec x y := 
     generalize (max_spec x y); 
-    let z := fresh "z" in let Hz := fresh "Hz" in 
-    (set (z:=Zmax x y); clearbody z).
+    (let z := fresh "z" in let Hz := fresh "Hz" in 
+     set (z:=Zmax x y); clearbody z).
 
- Ltac omega_max_loop := 
+  Ltac omega_max_loop := 
     match goal with 
       (* hack: we don't want [i2z (height ...)] to be reduced by romega later... *)
       | |- context [ i2z (?f ?x) ] => 
@@ -380,42 +386,45 @@ Module MoreInt (I:Int).
       | _ => intros
     end.
 
- Ltac omega_max := i2z_refl; omega_max_loop; try romega.
+  Ltac omega_max := i2z_refl; omega_max_loop; try romega.
+  
+  Ltac false_omega := i2z_refl; intros; romega.
+  Ltac false_omega_max := elimtype False; omega_max.
 
- Ltac false_omega := i2z_refl; intros; romega.
- Ltac false_omega_max := elimtype False; omega_max.
-
- Open Scope Int_scope.
+  Open Scope Int_scope.
 End MoreInt.
 
 
+
+(** * An implementation of [Int] *)
+
 (** It's always nice to know that our [Int] interface is realizable :-) *)
 
 Module Z_as_Int <: Int.
- Open Scope Z_scope.
- Definition int := Z.
- Definition _0 := 0.
- Definition _1 := 1.
- Definition _2 := 2.
- Definition _3 := 3.
- Definition plus := Zplus.
- Definition opp := Zopp.
- Definition minus := Zminus.
- Definition mult := Zmult.
- Definition max := Zmax.
- Definition gt_le_dec := Z_gt_le_dec. 
- Definition ge_lt_dec := Z_ge_lt_dec.
- Definition eq_dec := Z_eq_dec.
- Definition i2z : int -> Z := fun n => n.
- Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed.
- Lemma i2z_0 : i2z _0 = 0.  Proof. auto. Qed.
- Lemma i2z_1 : i2z _1 = 1.  Proof. auto. Qed.
- Lemma i2z_2 : i2z _2 = 2.  Proof. auto. Qed.
- Lemma i2z_3 : i2z _3 = 3.  Proof. auto. Qed.
- Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.  Proof. auto. Qed.
- Lemma i2z_opp : forall n, i2z (- n)  = - i2z n.  Proof. auto. Qed.
- Lemma i2z_minus : forall n p, i2z (n - p)  = i2z n - i2z p.  Proof. auto. Qed.
- Lemma i2z_mult : forall n p, i2z (n * p)  = i2z n * i2z p.  Proof. auto. Qed.
- Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed.
+  Open Scope Z_scope.
+  Definition int := Z.
+  Definition _0 := 0.
+  Definition _1 := 1.
+  Definition _2 := 2.
+  Definition _3 := 3.
+  Definition plus := Zplus.
+  Definition opp := Zopp.
+  Definition minus := Zminus.
+  Definition mult := Zmult.
+  Definition max := Zmax.
+  Definition gt_le_dec := Z_gt_le_dec. 
+  Definition ge_lt_dec := Z_ge_lt_dec.
+  Definition eq_dec := Z_eq_dec.
+  Definition i2z : int -> Z := fun n => n.
+  Lemma i2z_eq : forall n p, i2z n=i2z p -> n = p. Proof. auto. Qed.
+  Lemma i2z_0 : i2z _0 = 0.  Proof. auto. Qed.
+  Lemma i2z_1 : i2z _1 = 1.  Proof. auto. Qed.
+  Lemma i2z_2 : i2z _2 = 2.  Proof. auto. Qed.
+  Lemma i2z_3 : i2z _3 = 3.  Proof. auto. Qed.
+  Lemma i2z_plus : forall n p, i2z (n + p) = i2z n + i2z p.  Proof. auto. Qed.
+  Lemma i2z_opp : forall n, i2z (- n)  = - i2z n.  Proof. auto. Qed.
+  Lemma i2z_minus : forall n p, i2z (n - p)  = i2z n - i2z p.  Proof. auto. Qed.
+  Lemma i2z_mult : forall n p, i2z (n * p)  = i2z n * i2z p.  Proof. auto. Qed.
+  Lemma i2z_max : forall n p, i2z (max n p) = Zmax (i2z n) (i2z p). Proof. auto. Qed.
 End Z_as_Int.
 
diff --git a/theories/ZArith/Wf_Z.v b/theories/ZArith/Wf_Z.v
index af1fdd0b..1d7948a5 100644
--- a/theories/ZArith/Wf_Z.v
+++ b/theories/ZArith/Wf_Z.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Wf_Z.v 6984 2005-05-02 10:50:15Z herbelin $ i*)
+(*i $Id: Wf_Z.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import BinInt.
 Require Import Zcompare.
@@ -35,222 +35,229 @@ Open Local Scope Z_scope.
   Then the  diagram will be closed and the theorem proved. *)
 
 Lemma Z_of_nat_complete :
- forall x:Z, 0 <= x ->  exists n : nat, x = Z_of_nat n.
-intro x; destruct x; intros;
- [ exists 0%nat; auto with arith
- | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros;
-    simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); 
-    intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
-    apply nat_of_P_inj; auto with arith
- | absurd (0 <= Zneg p);
-    [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
-       auto with arith
-    | assumption ] ].
+  forall x:Z, 0 <= x ->  exists n : nat, x = Z_of_nat n.
+Proof.
+  intro x; destruct x; intros;
+    [ exists 0%nat; auto with arith
+      | specialize (ZL4 p); intros Hp; elim Hp; intros; exists (S x); intros;
+	simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x); 
+	  intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
+	    apply nat_of_P_inj; auto with arith
+      | absurd (0 <= Zneg p);
+	[ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
+	  auto with arith
+	  | assumption ] ].
 Qed.
 
 Lemma ZL4_inf : forall y:positive, {h : nat | nat_of_P y = S h}.
-intro y; induction y as [p H| p H1| ];
- [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *;
-    simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
-    unfold nat_of_P in H1; rewrite H1; auto with arith
- | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *;
-    simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
-    unfold nat_of_P in H2; rewrite H2; auto with arith
- | exists 0%nat; auto with arith ].
+Proof.
+  intro y; induction y as [p H| p H1| ];
+    [ elim H; intros x H1; exists (S x + S x)%nat; unfold nat_of_P in |- *;
+      simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
+	unfold nat_of_P in H1; rewrite H1; auto with arith
+      | elim H1; intros x H2; exists (x + S x)%nat; unfold nat_of_P in |- *;
+	simpl in |- *; rewrite ZL0; rewrite Pmult_nat_r_plus_morphism;
+	  unfold nat_of_P in H2; rewrite H2; auto with arith
+      | exists 0%nat; auto with arith ].
 Qed.
 
 Lemma Z_of_nat_complete_inf :
  forall x:Z, 0 <= x -> {n : nat | x = Z_of_nat n}.
-intro x; destruct x; intros;
- [ exists 0%nat; auto with arith
- | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0);
-    intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0);
-    intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
-    apply nat_of_P_inj; auto with arith
- | absurd (0 <= Zneg p);
-    [ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
-       auto with arith
-    | assumption ] ].
+Proof.
+  intro x; destruct x; intros;
+    [ exists 0%nat; auto with arith
+      | specialize (ZL4_inf p); intros Hp; elim Hp; intros x0 H0; exists (S x0);
+	intros; simpl in |- *; specialize (nat_of_P_o_P_of_succ_nat_eq_succ x0);
+	  intro Hx0; rewrite <- H0 in Hx0; apply f_equal with (f := Zpos);
+	    apply nat_of_P_inj; auto with arith
+      | absurd (0 <= Zneg p);
+	[ unfold Zle in |- *; simpl in |- *; do 2 unfold not in |- *;
+	  auto with arith
+	  | assumption ] ].
 Qed.
 
 Lemma Z_of_nat_prop :
- forall P:Z -> Prop,
-   (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
-intros P H x H0.
-specialize (Z_of_nat_complete x H0).
-intros Hn; elim Hn; intros.
-rewrite H1; apply H.
+  forall P:Z -> Prop,
+    (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
+Proof.
+  intros P H x H0.
+  specialize (Z_of_nat_complete x H0).
+  intros Hn; elim Hn; intros.
+  rewrite H1; apply H.
 Qed.
 
 Lemma Z_of_nat_set :
  forall P:Z -> Set,
    (forall n:nat, P (Z_of_nat n)) -> forall x:Z, 0 <= x -> P x.
-intros P H x H0.
-specialize (Z_of_nat_complete_inf x H0).
-intros Hn; elim Hn; intros.
-rewrite p; apply H.
+Proof.
+  intros P H x H0.
+  specialize (Z_of_nat_complete_inf x H0).
+  intros Hn; elim Hn; intros.
+  rewrite p; apply H.
 Qed.
 
 Lemma natlike_ind :
  forall P:Z -> Prop,
    P 0 ->
    (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
-intros P H H0 x H1; apply Z_of_nat_prop;
- [ simple induction n;
-    [ simpl in |- *; assumption
-    | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
- | assumption ].
+Proof.
+  intros P H H0 x H1; apply Z_of_nat_prop;
+    [ simple induction n;
+      [ simpl in |- *; assumption
+	| intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
+      | assumption ].
 Qed.
 
 Lemma natlike_rec :
  forall P:Z -> Set,
    P 0 ->
    (forall x:Z, 0 <= x -> P x -> P (Zsucc x)) -> forall x:Z, 0 <= x -> P x.
-intros P H H0 x H1; apply Z_of_nat_set;
- [ simple induction n;
-    [ simpl in |- *; assumption
-    | intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
- | assumption ].
+Proof.
+  intros P H H0 x H1; apply Z_of_nat_set;
+    [ simple induction n;
+      [ simpl in |- *; assumption
+	| intros; rewrite (inj_S n0); exact (H0 (Z_of_nat n0) (Zle_0_nat n0) H2) ]
+      | assumption ].
 Qed.
 
 Section Efficient_Rec. 
 
-(** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed 
-     to give a better extracted term. *)
+  (** [natlike_rec2] is the same as [natlike_rec], but with a different proof, designed 
+      to give a better extracted term. *)
 
-Let R (a b:Z) := 0 <= a /\ a < b.
+  Let R (a b:Z) := 0 <= a /\ a < b.
+  
+  Let R_wf : well_founded R.
+  Proof.
+    set
+      (f :=
+	fun z =>
+	  match z with
+	    | Zpos p => nat_of_P p
+	    | Z0 => 0%nat
+	    | Zneg _ => 0%nat
+	  end) in *.
+    apply well_founded_lt_compat with f.
+    unfold R, f in |- *; clear f R.
+    intros x y; case x; intros; elim H; clear H.
+    case y; intros; apply lt_O_nat_of_P || inversion H0.
+    case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto.
+    intros; elim H; auto.
+  Qed.
 
-Let R_wf : well_founded R.
-Proof.
-set
- (f :=
-  fun z =>
-    match z with
-    | Zpos p => nat_of_P p
-    | Z0 => 0%nat
-    | Zneg _ => 0%nat
-    end) in *.
-apply well_founded_lt_compat with f.
-unfold R, f in |- *; clear f R.
-intros x y; case x; intros; elim H; clear H.
-case y; intros; apply lt_O_nat_of_P || inversion H0.
-case y; intros; apply nat_of_P_lt_Lt_compare_morphism || inversion H0; auto.
-intros; elim H; auto.
-Qed.
+  Lemma natlike_rec2 :
+    forall P:Z -> Type,
+      P 0 ->
+      (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z.
+  Proof.
+    intros P Ho Hrec z; pattern z in |- *;
+      apply (well_founded_induction_type R_wf).
+    intro x; case x.
+    trivial.
+    intros.
+    assert (0 <= Zpred (Zpos p)).
+    apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
+    rewrite Zsucc_pred.
+    apply Hrec.
+    auto.
+    apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
+    intros; elim H; simpl in |- *; trivial.
+  Qed.
 
-Lemma natlike_rec2 :
- forall P:Z -> Type,
-   P 0 ->
-   (forall z:Z, 0 <= z -> P z -> P (Zsucc z)) -> forall z:Z, 0 <= z -> P z.
-Proof.
-intros P Ho Hrec z; pattern z in |- *;
- apply (well_founded_induction_type R_wf).
-intro x; case x.
-trivial.
-intros.
-assert (0 <= Zpred (Zpos p)).
-apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
-rewrite Zsucc_pred.
-apply Hrec.
-auto.
-apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
-intros; elim H; simpl in |- *; trivial.
-Qed.
+  (** A variant of the previous using [Zpred] instead of [Zs]. *)
 
-(** A variant of the previous using [Zpred] instead of [Zs]. *)
+  Lemma natlike_rec3 :
+    forall P:Z -> Type,
+      P 0 ->
+      (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z.
+  Proof.
+    intros P Ho Hrec z; pattern z in |- *;
+      apply (well_founded_induction_type R_wf).
+    intro x; case x.
+    trivial.
+    intros; apply Hrec.
+    unfold Zlt in |- *; trivial.
+    assert (0 <= Zpred (Zpos p)).
+    apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
+    apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
+    intros; elim H; simpl in |- *; trivial.
+  Qed.
 
-Lemma natlike_rec3 :
- forall P:Z -> Type,
-   P 0 ->
-   (forall z:Z, 0 < z -> P (Zpred z) -> P z) -> forall z:Z, 0 <= z -> P z.
-Proof.
-intros P Ho Hrec z; pattern z in |- *;
- apply (well_founded_induction_type R_wf).
-intro x; case x.
-trivial.
-intros; apply Hrec.
-unfold Zlt in |- *; trivial.
-assert (0 <= Zpred (Zpos p)).
-apply Zorder.Zlt_0_le_0_pred; unfold Zlt in |- *; simpl in |- *; trivial.
-apply X; auto; unfold R in |- *; intuition; apply Zlt_pred.
-intros; elim H; simpl in |- *; trivial.
-Qed.
+  (** A more general induction principle on non-negative numbers using [Zlt]. *)
 
-(** A more general induction principle on non-negative numbers using [Zlt]. *)
+  Lemma Zlt_0_rec :
+    forall P:Z -> Type,
+      (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
+      forall x:Z, 0 <= x -> P x.
+  Proof.
+    intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf).
+    intro x; case x; intros.
+    apply Hrec; intros.
+    assert (H2 : 0 < 0).
+    apply Zle_lt_trans with y; intuition.
+    inversion H2.
+    assumption.
+    firstorder.
+    unfold Zle, Zcompare in H; elim H; auto.
+  Defined.
 
-Lemma Zlt_0_rec :
- forall P:Z -> Type,
-   (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
-   forall x:Z, 0 <= x -> P x.
-Proof.
-intros P Hrec z; pattern z in |- *; apply (well_founded_induction_type R_wf).
-intro x; case x; intros.
-apply Hrec; intros.
-assert (H2 : 0 < 0).
-  apply Zle_lt_trans with y; intuition.
-inversion H2.
-assumption.
-firstorder.
-unfold Zle, Zcompare in H; elim H; auto.
-Defined.
+  Lemma Zlt_0_ind :
+    forall P:Z -> Prop,
+      (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
+      forall x:Z, 0 <= x -> P x.
+  Proof.
+    exact Zlt_0_rec.
+  Qed.
 
-Lemma Zlt_0_ind :
- forall P:Z -> Prop,
-   (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> 0 <= x -> P x) ->
-   forall x:Z, 0 <= x -> P x.
-Proof.
-exact Zlt_0_rec.
-Qed.
+  (** Obsolete version of [Zlt] induction principle on non-negative numbers *)
 
-(** Obsolete version of [Zlt] induction principle on non-negative numbers *)
+  Lemma Z_lt_rec :
+    forall P:Z -> Type,
+      (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
+      forall x:Z, 0 <= x -> P x.
+  Proof.
+    intros P Hrec; apply Zlt_0_rec; auto.
+  Qed.
 
-Lemma Z_lt_rec :
- forall P:Z -> Type,
-   (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
-   forall x:Z, 0 <= x -> P x.
-Proof.
-intros P Hrec; apply Zlt_0_rec; auto.
-Qed.
+  Lemma Z_lt_induction :
+    forall P:Z -> Prop,
+      (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
+      forall x:Z, 0 <= x -> P x.
+  Proof.
+    exact Z_lt_rec.
+  Qed.
 
-Lemma Z_lt_induction :
- forall P:Z -> Prop,
-   (forall x:Z, (forall y:Z, 0 <= y < x -> P y) -> P x) ->
-   forall x:Z, 0 <= x -> P x.
-Proof.
-exact Z_lt_rec.
-Qed.
+  (** An even more general induction principle using [Zlt]. *)
 
-(** An even more general induction principle using [Zlt]. *)
+  Lemma Zlt_lower_bound_rec :
+    forall P:Z -> Type, forall z:Z,
+      (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
+      forall x:Z, z <= x -> P x.
+  Proof.
+    intros P z Hrec x.
+    assert (Hexpand : forall x, x = x - z + z).
+    intro; unfold Zminus; rewrite <- Zplus_assoc; rewrite Zplus_opp_l;
+      rewrite Zplus_0_r; trivial.
+    intro Hz.
+    rewrite (Hexpand x); pattern (x - z) in |- *; apply Zlt_0_rec.
+    2: apply Zplus_le_reg_r with z; rewrite <- Hexpand; assumption.
+    intros x0 Hlt_x0 H.
+    apply Hrec.
+    2: change z with (0+z); apply Zplus_le_compat_r; assumption.
+    intro y; rewrite (Hexpand y); intros.
+    destruct H0.
+    apply Hlt_x0.
+    split.
+    apply Zplus_le_reg_r with z; assumption.
+    apply Zplus_lt_reg_r with z; assumption.
+  Qed.
 
-Lemma Zlt_lower_bound_rec :
- forall P:Z -> Type, forall z:Z,
-   (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
-   forall x:Z, z <= x -> P x.
-Proof.
-intros P z Hrec x.
-assert (Hexpand : forall x, x = x - z + z).
-  intro; unfold Zminus; rewrite <- Zplus_assoc; rewrite Zplus_opp_l;
-  rewrite Zplus_0_r; trivial.
-intro Hz.
-rewrite (Hexpand x); pattern (x - z) in |- *; apply Zlt_0_rec.
-2: apply Zplus_le_reg_r with z; rewrite <- Hexpand; assumption.
-intros x0 Hlt_x0 H.
-apply Hrec.
-  2: change z with (0+z); apply Zplus_le_compat_r; assumption.
-  intro y; rewrite (Hexpand y); intros.
-destruct H0.
-apply Hlt_x0.
-split.
-  apply Zplus_le_reg_r with z; assumption.
-  apply Zplus_lt_reg_r with z; assumption.
-Qed.
-
-Lemma Zlt_lower_bound_ind :
- forall P:Z -> Prop, forall z:Z,
-   (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
-   forall x:Z, z <= x -> P x.
-Proof.
-exact Zlt_lower_bound_rec.
-Qed.
+  Lemma Zlt_lower_bound_ind :
+    forall P:Z -> Prop, forall z:Z,
+      (forall x:Z, (forall y:Z, z <= y < x -> P y) -> z <= x -> P x) ->
+      forall x:Z, z <= x -> P x.
+  Proof.
+    exact Zlt_lower_bound_rec.
+  Qed.
 
 End Efficient_Rec.
diff --git a/theories/ZArith/ZArith.v b/theories/ZArith/ZArith.v
index 45749fa3..66e0bda8 100644
--- a/theories/ZArith/ZArith.v
+++ b/theories/ZArith/ZArith.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZArith.v 6013 2004-08-03 17:56:19Z herbelin $ i*)
+(*i $Id: ZArith.v 9210 2006-10-05 10:12:15Z barras $ i*)
 
 (** Library for manipulating integers based on binary encoding *)
 
@@ -19,3 +19,5 @@ Require Export Zsqrt.
 Require Export Zpower.
 Require Export Zdiv.
 Require Export Zlogarithm.
+
+Export ZArithRing.
diff --git a/theories/ZArith/ZArith_dec.v b/theories/ZArith/ZArith_dec.v
index 40c5860c..84249955 100644
--- a/theories/ZArith/ZArith_dec.v
+++ b/theories/ZArith/ZArith_dec.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: ZArith_dec.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: ZArith_dec.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Sumbool.
 
@@ -17,210 +17,210 @@ Open Local Scope Z_scope.
 
 Lemma Dcompare_inf : forall r:comparison, {r = Eq} + {r = Lt} + {r = Gt}.
 Proof.
-simple induction r; auto with arith. 
+  simple induction r; auto with arith. 
 Defined.
 
 Lemma Zcompare_rec :
- forall (P:Set) (n m:Z),
-   ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
+  forall (P:Set) (n m:Z),
+    ((n ?= m) = Eq -> P) -> ((n ?= m) = Lt -> P) -> ((n ?= m) = Gt -> P) -> P.
 Proof.
-intros P x y H1 H2 H3.
-elim (Dcompare_inf (x ?= y)).
-intro H. elim H; auto with arith. auto with arith.
+  intros P x y H1 H2 H3.
+  elim (Dcompare_inf (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 (n := x) (m := y).
-intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
-intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
-  rewrite (H2 H4) in H3. discriminate H3.
-intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
-  rewrite (H2 H4) in H3. discriminate H3.
-Defined. 
-
-(** Decidability of order on binary integers *)
-
-Definition Z_lt_dec : {x < y} + {~ x < y}.
-Proof.
-unfold Zlt in |- *.
-apply Zcompare_rec with (n := x) (m := y); intro H.
-right. rewrite H. discriminate.
-left; assumption.
-right. rewrite H. discriminate.
-Defined.
-
-Definition Z_le_dec : {x <= y} + {~ x <= y}.
-Proof.
-unfold Zle in |- *.
-apply Zcompare_rec with (n := x) (m := y); intro H.
-left. rewrite H. discriminate.
-left. rewrite H. discriminate.
-right. tauto.
-Defined.
-
-Definition Z_gt_dec : {x > y} + {~ x > y}.
-Proof.
-unfold Zgt in |- *.
-apply Zcompare_rec with (n := x) (m := y); intro H.
-right. rewrite H. discriminate.
-right. rewrite H. discriminate.
-left; assumption.
-Defined.
-
-Definition Z_ge_dec : {x >= y} + {~ x >= y}.
-Proof.
-unfold Zge in |- *.
-apply Zcompare_rec with (n := x) (m := y); intro H.
-left. rewrite H. discriminate.
-right. tauto.
-left. rewrite H. discriminate.
-Defined.
-
-Definition Z_lt_ge_dec : {x < y} + {x >= y}.
-Proof.
-exact Z_lt_dec.
-Defined.
-
-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 Znot_le_gt; 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 Znot_ge_lt; auto with arith.
-Defined.
-
-Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}.
-Proof.
-intro H.
-apply Zcompare_rec with (n := x) (m := y).
-intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith.
-intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
-intro H1. absurd (x > y); auto with arith.
-Defined.
+  Variables x y : Z.
+  
+  (** * Decidability of equality on binary integers *)
+
+  Definition Z_eq_dec : {x = y} + {x <> y}.
+  Proof.
+    apply Zcompare_rec with (n := x) (m := y).
+    intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+    intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
+    rewrite (H2 H4) in H3. discriminate H3.
+    intro H3. right. elim (Zcompare_Eq_iff_eq x y). intros H1 H2. unfold not in |- *. intro H4.
+    rewrite (H2 H4) in H3. discriminate H3.
+  Defined. 
+
+  (** * Decidability of order on binary integers *)
+
+  Definition Z_lt_dec : {x < y} + {~ x < y}.
+  Proof.
+    unfold Zlt in |- *.
+    apply Zcompare_rec with (n := x) (m := y); intro H.
+    right. rewrite H. discriminate.
+    left; assumption.
+    right. rewrite H. discriminate.
+  Defined.
+
+  Definition Z_le_dec : {x <= y} + {~ x <= y}.
+  Proof.
+    unfold Zle in |- *.
+    apply Zcompare_rec with (n := x) (m := y); intro H.
+    left. rewrite H. discriminate.
+    left. rewrite H. discriminate.
+    right. tauto.
+  Defined.
+  
+  Definition Z_gt_dec : {x > y} + {~ x > y}.
+  Proof.
+    unfold Zgt in |- *.
+    apply Zcompare_rec with (n := x) (m := y); intro H.
+    right. rewrite H. discriminate.
+    right. rewrite H. discriminate.
+    left; assumption.
+  Defined.
+
+  Definition Z_ge_dec : {x >= y} + {~ x >= y}.
+  Proof.
+    unfold Zge in |- *.
+    apply Zcompare_rec with (n := x) (m := y); intro H.
+    left. rewrite H. discriminate.
+    right. tauto.
+    left. rewrite H. discriminate.
+  Defined.
+
+  Definition Z_lt_ge_dec : {x < y} + {x >= y}.
+  Proof.
+    exact Z_lt_dec.
+  Defined.
+
+  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 Znot_le_gt; 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 Znot_ge_lt; auto with arith.
+  Defined.
+
+  Definition Z_le_lt_eq_dec : x <= y -> {x < y} + {x = y}.
+  Proof.
+    intro H.
+    apply Zcompare_rec with (n := x) (m := y).
+    intro. right. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+    intro. left. elim (Zcompare_Eq_iff_eq x y); auto with arith.
+    intro H1. absurd (x > y); auto with arith.
+  Defined.
 
 End decidability.
 
-(** Cotransitivity of order on binary integers *)
+(** * Cotransitivity of order on binary integers *)
 
 Lemma Zlt_cotrans : forall n m:Z, n < m -> forall 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.
+  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 : forall n m:Z, 0 < n + m -> {0 < n} + {0 < m}.
 Proof.
- intros x y H.
- case (Zlt_cotrans 0 (x + y) H x).
- intro.
- left.
- assumption.
- intro.
- right.
- apply Zplus_lt_reg_l with (p := x).
- rewrite Zplus_0_r.
- assumption.
+  intros x y H.
+  case (Zlt_cotrans 0 (x + y) H x).
+  intro.
+  left.
+  assumption.
+  intro.
+  right.
+  apply Zplus_lt_reg_l with (p := x).
+  rewrite Zplus_0_r.
+  assumption.
 Defined.
 
 Lemma Zlt_cotrans_neg : forall n m:Z, n + m < 0 -> {n < 0} + {m < 0}.
 Proof.
- intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy;
-  [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ];
-  assumption.
+  intros x y H; case (Zlt_cotrans (x + y) 0 H x); intro Hxy;
+    [ right; apply Zplus_lt_reg_l with (p := x); rewrite Zplus_0_r | left ];
+    assumption.
 Defined.
 
 Lemma not_Zeq_inf : forall n m:Z, n <> m -> {n < m} + {m < n}.
 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  in |- *.
- assumption.
+  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  in |- *.
+  assumption.
 Defined.
 
 Lemma Z_dec : forall n m:Z, {n < m} + {n > m} + {n = m}.
 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  in |- *.
- assumption.
+  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  in |- *.
+  assumption.
 Defined.
 
 
 Lemma Z_dec' : forall n m:Z, {n < m} + {m < n} + {n = m}.
 Proof.
- intros x y.
- case (Z_eq_dec x y); intro H;
-  [ right; assumption | left; apply (not_Zeq_inf _ _ H) ].
+  intros x y.
+  case (Z_eq_dec x y); intro H;
+    [ right; assumption | left; apply (not_Zeq_inf _ _ H) ].
 Defined.
 
 
 
 Definition Z_zerop : forall x:Z, {x = 0} + {x <> 0}.
 Proof.
-exact (fun x:Z => Z_eq_dec x 0).
+  exact (fun x:Z => Z_eq_dec x 0).
 Defined.
 
 Definition Z_notzerop (x:Z) := sumbool_not _ _ (Z_zerop x).
 
-Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y).
\ No newline at end of file
+Definition Z_noteq_dec (x y:Z) := sumbool_not _ _ (Z_eq_dec x y).
diff --git a/theories/ZArith/Zabs.v b/theories/ZArith/Zabs.v
index fed6ad76..ed641358 100644
--- a/theories/ZArith/Zabs.v
+++ b/theories/ZArith/Zabs.v
@@ -5,11 +5,11 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zabs.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zabs.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
 
-Require Import Arith.
+Require Import Arith_base.
 Require Import BinPos.
 Require Import BinInt.
 Require Import Zorder.
@@ -18,111 +18,113 @@ Require Import ZArith_dec.
 Open Local Scope Z_scope.
 
 (**********************************************************************)
-(** Properties of absolute value *)
+(** * Properties of absolute value *)
 
 Lemma Zabs_eq : forall n:Z, 0 <= n -> Zabs n = n.
-intro x; destruct x; auto with arith.
-compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
+Proof.
+  intro x; destruct x; auto with arith.
+  compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
 Qed.
 
 Lemma Zabs_non_eq : forall n:Z, n <= 0 -> Zabs n = - n.
 Proof.
-intro x; destruct x; auto with arith.
-compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
+  intro x; destruct x; auto with arith.
+  compute in |- *; intros; absurd (Gt = Gt); trivial with arith.
 Qed.
 
 Theorem Zabs_Zopp : forall n:Z, Zabs (- n) = Zabs n.
 Proof.
-intros z; case z; simpl in |- *; auto.
+  intros z; case z; simpl in |- *; auto.
 Qed.
 
-(** Proving a property of the absolute value by cases *)
+(** * Proving a property of the absolute value by cases *)
 
 Lemma Zabs_ind :
- forall (P:Z -> Prop) (n:Z),
-   (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n).
+  forall (P:Z -> Prop) (n:Z),
+    (n >= 0 -> P n) -> (n <= 0 -> P (- n)) -> P (Zabs n).
 Proof.
-intros P x H H0; elim (Z_lt_ge_dec x 0); intro.
-assert (x <= 0). apply Zlt_le_weak; assumption.
-rewrite Zabs_non_eq. apply H0. assumption. assumption.
-rewrite Zabs_eq. apply H; assumption. apply Zge_le. assumption.
+  intros 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.
 Qed.
 
 Theorem Zabs_intro : forall P (n:Z), P (- n) -> P n -> P (Zabs n).
-intros P z; case z; simpl in |- *; auto.
+Proof.
+  intros P z; case z; simpl in |- *; auto.
 Qed.
 
 Definition Zabs_dec : forall x:Z, {x = Zabs x} + {x = - Zabs x}.
 Proof.
-intro x; destruct x; auto with arith.
+  intro x; destruct x; auto with arith.
 Defined.
 
 Lemma Zabs_pos : forall n:Z, 0 <= Zabs n.
-intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H.
+  intro x; destruct x; auto with arith; compute in |- *; intros H; inversion H.
 Qed.
 
 Theorem Zabs_eq_case : forall n m:Z, Zabs n = Zabs m -> n = m \/ n = - m.
 Proof.
-intros z1 z2; case z1; case z2; simpl in |- *; auto;
- try (intros; discriminate); intros p1 p2 H1; injection H1;
- (intros H2; rewrite H2); auto.
+  intros z1 z2; case z1; case z2; simpl in |- *; auto;
+    try (intros; discriminate); intros p1 p2 H1; injection H1;
+      (intros H2; rewrite H2); auto.
 Qed.
 
-(** Triangular inequality *)
+(** * Triangular inequality *)
 
 Hint Local Resolve Zle_neg_pos: zarith.
 
 Theorem Zabs_triangle : forall n m:Z, Zabs (n + m) <= Zabs n + Zabs m.
 Proof.
-intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail).
-intros p1 p2;
- apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
- try rewrite Zopp_plus_distr; auto with zarith.
-apply Zplus_le_compat; simpl in |- *; auto with zarith.
-apply Zplus_le_compat; simpl in |- *; auto with zarith.
-intros p1 p2;
- apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
- try rewrite Zopp_plus_distr; auto with zarith.
-apply Zplus_le_compat; simpl in |- *; auto with zarith.
-apply Zplus_le_compat; simpl in |- *; auto with zarith.
+  intros z1 z2; case z1; case z2; try (simpl in |- *; auto with zarith; fail).
+  intros p1 p2;
+    apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
+      try rewrite Zopp_plus_distr; auto with zarith.
+  apply Zplus_le_compat; simpl in |- *; auto with zarith.
+  apply Zplus_le_compat; simpl in |- *; auto with zarith.
+  intros p1 p2;
+    apply Zabs_intro with (P := fun x => x <= Zabs (Zpos p2) + Zabs (Zneg p1));
+      try rewrite Zopp_plus_distr; auto with zarith.
+  apply Zplus_le_compat; simpl in |- *; auto with zarith.
+  apply Zplus_le_compat; simpl in |- *; auto with zarith.
 Qed.
 
-(** Absolute value and multiplication *)
+(** * Absolute value and multiplication *)
 
 Lemma Zsgn_Zabs : forall n:Z, n * Zsgn n = Zabs n.
 Proof.
-intro x; destruct x; rewrite Zmult_comm; auto with arith.
+  intro x; destruct x; rewrite Zmult_comm; auto with arith.
 Qed.
 
 Lemma Zabs_Zsgn : forall n:Z, Zabs n * Zsgn n = n.
 Proof.
-intro x; destruct x; rewrite Zmult_comm; auto with arith.
+  intro x; destruct x; rewrite Zmult_comm; auto with arith.
 Qed.
 
 Theorem Zabs_Zmult : forall n m:Z, Zabs (n * m) = Zabs n * Zabs m.
 Proof.
-intros z1 z2; case z1; case z2; simpl in |- *; auto.
+  intros z1 z2; case z1; case z2; simpl in |- *; auto.
 Qed.
 
-(** absolute value in nat is compatible with order *)
+(** * Absolute value in nat is compatible with order *)
 
 Lemma Zabs_nat_lt :
- forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat.
+  forall n m:Z, 0 <= n /\ n < m -> (Zabs_nat n < Zabs_nat m)%nat.
 Proof.
-intros x y. case x; simpl in |- *. case y; simpl in |- *.
-
-intro. absurd (0 < 0). compute in |- *. 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 in |- *.
-intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition.
-intros. change (nat_of_P p > nat_of_P p0)%nat in |- *.
-apply nat_of_P_gt_Gt_compare_morphism.
-elim H; auto with arith. intro. exact (ZC2 p0 p).
-
-intros. absurd (Zpos p0 < Zneg p).
-compute in |- *. intro H0. discriminate H0. intuition.
-
-intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition.
-Qed.
\ No newline at end of file
+  intros x y. case x; simpl in |- *. case y; simpl in |- *.
+
+  intro. absurd (0 < 0). compute in |- *. 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 in |- *.
+  intros. absurd (Zpos p < 0). compute in |- *. intro H0. discriminate H0. intuition.
+  intros. change (nat_of_P p > nat_of_P p0)%nat in |- *.
+  apply nat_of_P_gt_Gt_compare_morphism.
+  elim H; auto with arith. intro. exact (ZC2 p0 p).
+
+  intros. absurd (Zpos p0 < Zneg p).
+  compute in |- *. intro H0. discriminate H0. intuition.
+
+  intros. absurd (0 <= Zneg p). compute in |- *. auto with arith. intuition.
+Qed.
diff --git a/theories/ZArith/Zbinary.v b/theories/ZArith/Zbinary.v
index 353f0d5d..08f08e12 100644
--- a/theories/ZArith/Zbinary.v
+++ b/theories/ZArith/Zbinary.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zbinary.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zbinary.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (** Bit vectors interpreted as integers. 
     Contribution by Jean Duprat (ENS Lyon). *)
@@ -16,11 +16,10 @@ Require Import ZArith.
 Require Export Zpower.
 Require Import 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.
+(** 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
@@ -32,395 +31,322 @@ De plus, on utilise les fonctions 2^n où n est un naturel, ici la longueur.
 
 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.
+(** 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 :=
-  match b with
-  | true => 1%Z
-  | false => 0%Z
-  end.
-
-Lemma binary_value : forall n:nat, Bvector n -> Z.
-Proof.
-	simple induction n; intros.
-	exact 0%Z.
-
-	inversion H0.
-	exact (bit_value a + 2 * H H2)%Z.
-Defined.
-
-Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z.
-Proof.
-	simple induction n; intros.
-	inversion H.
-	exact (- bit_value a)%Z.
-
-	inversion H0.
-	exact (bit_value a + 2 * H H2)%Z.
-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
-*)
+  Definition bit_value (b:bool) : Z :=
+    match b with
+      | true => 1%Z
+      | false => 0%Z
+    end.
+  
+  Lemma binary_value : forall n:nat, Bvector n -> Z.
+  Proof.
+    simple induction n; intros.
+    exact 0%Z.
+    
+    inversion H0.
+    exact (bit_value a + 2 * H H2)%Z.
+  Defined.
+
+  Lemma two_compl_value : forall n:nat, Bvector (S n) -> Z.
+  Proof.
+    simple induction n; intros.
+    inversion H.
+    exact (- bit_value a)%Z.
+
+    inversion H0.
+    exact (bit_value a + 2 * H H2)%Z.
+  Defined.
 
 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) :=
-  match z with
-  | Z0 => 0%Z
-  | Zpos p => match p with
-              | xI q => Zpos q
-              | xO q => Zpos q
-              | xH => 0%Z
-              end
-  | Zneg p =>
-      match p with
-      | xI q => (Zneg q - 1)%Z
-      | xO q => Zneg q
-      | xH => (-1)%Z
-      end
-  end.
-
-
-Lemma Zmod2_twice :
- forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z.
-Proof.
-	destruct z; simpl in |- *.
-	trivial.
-
-	destruct p; simpl in |- *; trivial.
-
-	destruct p; simpl in |- *.
-	destruct p as [p| p| ]; simpl in |- *.
-	rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial.
-
-	trivial.
-
-	trivial.
-
-	trivial.
-
-	trivial.
-Qed.
-
-Lemma Z_to_binary : forall n:nat, Z -> Bvector n.
-Proof.
-	simple induction n; intros.
-	exact Bnil.
-
-	exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.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))
+(** 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.
 *)
 
-Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n).
-Proof.
-	simple induction n; intros.
-	exact (Bcons (Zeven.Zodd_bool H) 0 Bnil).
-
-	exact (Bcons (Zeven.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))
-*)	
+  Definition Zmod2 (z:Z) :=
+    match z with
+      | Z0 => 0%Z
+      | Zpos p => match p with
+		    | xI q => Zpos q
+		    | xO q => Zpos q
+		    | xH => 0%Z
+		  end
+      | Zneg p =>
+	match p with
+	  | xI q => (Zneg q - 1)%Z
+	  | xO q => Zneg q
+	  | xH => (-1)%Z
+	end
+    end.
+
+
+  Lemma Zmod2_twice :
+    forall z:Z, z = (2 * Zmod2 z + bit_value (Zeven.Zodd_bool z))%Z.
+  Proof.
+    destruct z; simpl in |- *.
+    trivial.
+    
+    destruct p; simpl in |- *; trivial.
+    
+    destruct p; simpl in |- *.
+    destruct p as [p| p| ]; simpl in |- *.
+    rewrite <- (Pdouble_minus_one_o_succ_eq_xI p); trivial.
+
+    trivial.
+    
+    trivial.
+    
+    trivial.
+    
+    trivial.
+  Qed.
+
+  Lemma Z_to_binary : forall n:nat, Z -> Bvector n.
+  Proof.
+    simple induction n; intros.
+    exact Bnil.
+    
+    exact (Bcons (Zeven.Zodd_bool H0) n0 (H (Zeven.Zdiv2 H0))).
+  Defined.
+
+  Lemma Z_to_two_compl : forall n:nat, Z -> Bvector (S n).
+  Proof.
+    simple induction n; intros.
+    exact (Bcons (Zeven.Zodd_bool H) 0 Bnil).
+    
+    exact (Bcons (Zeven.Zodd_bool H0) (S n0) (H (Zmod2 H0))).
+  Defined.
 
 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 :
- forall (n:nat) (b:bool) (bv:Bvector n),
-   binary_value (S n) (Vcons bool b n bv) =
-   (bit_value b + 2 * binary_value n bv)%Z.
-Proof.
-	intros; auto.
-Qed.
-
-Lemma Z_to_binary_Sn :
- forall (n:nat) (b:bool) (z:Z),
-   (z >= 0)%Z ->
-   Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z).
-Proof.
-	destruct b; destruct z; simpl in |- *; auto.
-	intro H; elim H; trivial.
-Qed.
-
-Lemma binary_value_pos :
- forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z.
-Proof.
-	induction bv as [| a n v IHbv]; simpl in |- *.
-	omega.
-
-	destruct a; destruct (binary_value n v); simpl in |- *; auto.
-	auto with zarith.
-Qed.
-
-
-Lemma two_compl_value_Sn :
- forall (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)%Z.
-Proof.
-	intros; auto.
-Qed.
-
-Lemma Z_to_two_compl_Sn :
- forall (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.
-	destruct b; destruct z as [| p| p]; auto.
-	destruct p as [p| p| ]; auto.
-	destruct p as [p| p| ]; simpl in |- *; auto.
-	intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial.
-Qed.
-
-Lemma Z_to_binary_Sn_z :
- forall (n:nat) (z:Z),
-   Z_to_binary (S n) z =
-   Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)).
-Proof.
-	intros; auto.
-Qed.
-
-Lemma Z_div2_value :
- forall z:Z,
-   (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z.
-Proof.
-	destruct z as [| p| p]; auto.
-	destruct p; auto.
-  intro H; elim H; trivial.
-Qed.
-
-Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z.
-Proof.
-	destruct z as [| p| p].
-	auto.
-
-	destruct p; auto.
-	simpl in |- *; intros; omega.
-
-  intro H; elim H; trivial.
-
-Qed.
-
-Lemma Zdiv2_two_power_nat :
- forall (z:Z) (n:nat),
-   (z >= 0)%Z ->
-   (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z.
-Proof.
-	intros.
-	cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros.
-	omega.
-
-	rewrite <- two_power_nat_S.
-	destruct (Zeven.Zeven_odd_dec z); intros.
-	rewrite <- Zeven.Zeven_div2; auto.
-
-	generalize (Zeven.Zodd_div2 z H z0); omega.
-Qed.
-
-(*
-
-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 :
- forall (n:nat) (z:Z),
-   Z_to_two_compl (S n) z =
-   Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)).
-Proof.
-	intros; auto.
-Qed.
-
-Lemma Zeven_bit_value :
- forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z.
-Proof.
-	destruct z; unfold bit_value in |- *; auto.
-	destruct p; tauto || (intro H; elim H).
- 	destruct p; tauto || (intro H; elim H).
-Qed.
-
-Lemma Zodd_bit_value :
- forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z.
-Proof.
-	destruct z; unfold bit_value in |- *; auto.
-  intros; elim H.
-  destruct p; tauto || (intros; elim H).
-  destruct p; tauto || (intros; elim H).
-Qed.
-
-Lemma Zge_minus_two_power_nat_S :
- forall (n:nat) (z:Z),
-   (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z.
-Proof.
-	intros n z; rewrite (two_power_nat_S n).
-	generalize (Zmod2_twice z).
-	destruct (Zeven.Zeven_odd_dec z) as [H| H].
-	rewrite (Zeven_bit_value z H); intros; omega.
-
-        rewrite (Zodd_bit_value z H); intros; omega.
-Qed.
-
-Lemma Zlt_two_power_nat_S :
- forall (n:nat) (z:Z),
-   (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z.
-Proof.
-	intros n z; rewrite (two_power_nat_S n).
-	generalize (Zmod2_twice z).
-	destruct (Zeven.Zeven_odd_dec z) as [H| H].
-	rewrite (Zeven_bit_value z H); intros; omega.
-
-	rewrite (Zodd_bit_value z H); intros; omega.
-Qed.
+  (** Bibliotheque de lemmes utiles dans la section suivante.
+      Utilise largement ZArith.
+      Mériterait d'être récrite.
+  *)
+
+  Lemma binary_value_Sn :
+    forall (n:nat) (b:bool) (bv:Bvector n),
+      binary_value (S n) (Vcons bool b n bv) =
+      (bit_value b + 2 * binary_value n bv)%Z.
+  Proof.
+    intros; auto.
+  Qed.
+
+  Lemma Z_to_binary_Sn :
+    forall (n:nat) (b:bool) (z:Z),
+      (z >= 0)%Z ->
+      Z_to_binary (S n) (bit_value b + 2 * z) = Bcons b n (Z_to_binary n z).
+  Proof.
+    destruct b; destruct z; simpl in |- *; auto.
+    intro H; elim H; trivial.
+  Qed.
+
+  Lemma binary_value_pos :
+    forall (n:nat) (bv:Bvector n), (binary_value n bv >= 0)%Z.
+  Proof.
+    induction bv as [| a n v IHbv]; simpl in |- *.
+    omega.
+
+    destruct a; destruct (binary_value n v); simpl in |- *; auto.
+    auto with zarith.
+  Qed.
+
+  Lemma two_compl_value_Sn :
+    forall (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)%Z.
+  Proof.
+    intros; auto.
+  Qed.
+
+  Lemma Z_to_two_compl_Sn :
+    forall (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.
+    destruct b; destruct z as [| p| p]; auto.
+    destruct p as [p| p| ]; auto.
+    destruct p as [p| p| ]; simpl in |- *; auto.
+    intros; rewrite (Psucc_o_double_minus_one_eq_xO p); trivial.
+  Qed.
+
+  Lemma Z_to_binary_Sn_z :
+    forall (n:nat) (z:Z),
+      Z_to_binary (S n) z =
+      Bcons (Zeven.Zodd_bool z) n (Z_to_binary n (Zeven.Zdiv2 z)).
+  Proof.
+    intros; auto.
+  Qed.
+
+  Lemma Z_div2_value :
+    forall z:Z,
+      (z >= 0)%Z -> (bit_value (Zeven.Zodd_bool z) + 2 * Zeven.Zdiv2 z)%Z = z.
+  Proof.
+    destruct z as [| p| p]; auto.
+    destruct p; auto.
+    intro H; elim H; trivial.
+  Qed.
+
+  Lemma Pdiv2 : forall z:Z, (z >= 0)%Z -> (Zeven.Zdiv2 z >= 0)%Z.
+  Proof.
+    destruct z as [| p| p].
+    auto.
+    
+    destruct p; auto.
+    simpl in |- *; intros; omega.
+    
+    intro H; elim H; trivial.
+  Qed.
+
+  Lemma Zdiv2_two_power_nat :
+    forall (z:Z) (n:nat),
+      (z >= 0)%Z ->
+      (z < two_power_nat (S n))%Z -> (Zeven.Zdiv2 z < two_power_nat n)%Z.
+  Proof.
+    intros.
+    cut (2 * Zeven.Zdiv2 z < 2 * two_power_nat n)%Z; intros.
+    omega.
+    
+    rewrite <- two_power_nat_S.
+    destruct (Zeven.Zeven_odd_dec z); intros.
+    rewrite <- Zeven.Zeven_div2; auto.
+    
+    generalize (Zeven.Zodd_div2 z H z0); omega.
+  Qed.
+
+  Lemma Z_to_two_compl_Sn_z :
+    forall (n:nat) (z:Z),
+      Z_to_two_compl (S n) z =
+      Bcons (Zeven.Zodd_bool z) (S n) (Z_to_two_compl n (Zmod2 z)).
+  Proof.
+    intros; auto.
+  Qed.
+  
+  Lemma Zeven_bit_value :
+    forall z:Z, Zeven.Zeven z -> bit_value (Zeven.Zodd_bool z) = 0%Z.
+  Proof.
+    destruct z; unfold bit_value in |- *; auto.
+    destruct p; tauto || (intro H; elim H).
+    destruct p; tauto || (intro H; elim H).
+  Qed.
+  
+  Lemma Zodd_bit_value :
+    forall z:Z, Zeven.Zodd z -> bit_value (Zeven.Zodd_bool z) = 1%Z.
+  Proof.
+    destruct z; unfold bit_value in |- *; auto.
+    intros; elim H.
+    destruct p; tauto || (intros; elim H).
+    destruct p; tauto || (intros; elim H).
+  Qed.
+  
+  Lemma Zge_minus_two_power_nat_S :
+    forall (n:nat) (z:Z),
+      (z >= - two_power_nat (S n))%Z -> (Zmod2 z >= - two_power_nat n)%Z.
+  Proof.
+    intros n z; rewrite (two_power_nat_S n).
+    generalize (Zmod2_twice z).
+    destruct (Zeven.Zeven_odd_dec z) as [H| H].
+    rewrite (Zeven_bit_value z H); intros; omega.
+
+    rewrite (Zodd_bit_value z H); intros; omega.
+  Qed.
+  
+  Lemma Zlt_two_power_nat_S :
+    forall (n:nat) (z:Z),
+      (z < two_power_nat (S n))%Z -> (Zmod2 z < two_power_nat n)%Z.
+  Proof.
+    intros n z; rewrite (two_power_nat_S n).
+    generalize (Zmod2_twice z).
+    destruct (Zeven.Zeven_odd_dec z) as [H| H].
+    rewrite (Zeven_bit_value z H); intros; omega.
+
+    rewrite (Zodd_bit_value z H); intros; omega.
+  Qed.
 
 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.
+(** 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 :
- forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv.
-Proof.
-	induction bv as [| a n bv IHbv].
-	auto.
-
-	rewrite binary_value_Sn.
-	rewrite Z_to_binary_Sn.
-	rewrite IHbv; trivial.
-
-	apply binary_value_pos.
-Qed.
-		
-Lemma two_compl_to_Z_to_two_compl :
- forall (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.
-	induction bv as [| a n bv IHbv]; intro b.
-	destruct b; auto.
-
-	rewrite two_compl_value_Sn.
-	rewrite Z_to_two_compl_Sn.
-	rewrite IHbv; trivial.
-Qed.
-
-Lemma Z_to_binary_to_Z :
- forall (n:nat) (z:Z),
-   (z >= 0)%Z ->
-   (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z.
-Proof.
-	induction n as [| n IHn].
-	unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega.
-
-	intros; rewrite Z_to_binary_Sn_z.
-	rewrite binary_value_Sn.
-	rewrite IHn.
-	apply Z_div2_value; auto.
-
-	apply Pdiv2; trivial.
-
-	apply Zdiv2_two_power_nat; trivial.
-Qed.
-
-Lemma Z_to_two_compl_to_Z :
- forall (n:nat) (z:Z),
-   (z >= - two_power_nat n)%Z ->
-   (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z.
-Proof.
-	induction n as [| n IHn].
-	unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros.
-	assert (z = (-1)%Z \/ z = 0%Z). 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.
-Qed.
+  Lemma binary_to_Z_to_binary :
+    forall (n:nat) (bv:Bvector n), Z_to_binary n (binary_value n bv) = bv.
+  Proof.
+    induction bv as [| a n bv IHbv].
+    auto.
+    
+    rewrite binary_value_Sn.
+    rewrite Z_to_binary_Sn.
+    rewrite IHbv; trivial.
+    
+    apply binary_value_pos.
+  Qed.
+  
+  Lemma two_compl_to_Z_to_two_compl :
+    forall (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.
+    induction bv as [| a n bv IHbv]; intro b.
+    destruct b; auto.
+    
+    rewrite two_compl_value_Sn.
+    rewrite Z_to_two_compl_Sn.
+    rewrite IHbv; trivial.
+  Qed.
+  
+  Lemma Z_to_binary_to_Z :
+    forall (n:nat) (z:Z),
+      (z >= 0)%Z ->
+      (z < two_power_nat n)%Z -> binary_value n (Z_to_binary n z) = z.
+  Proof.
+    induction n as [| n IHn].
+    unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros; omega.
+    
+    intros; rewrite Z_to_binary_Sn_z.
+    rewrite binary_value_Sn.
+    rewrite IHn.
+    apply Z_div2_value; auto.
+    
+    apply Pdiv2; trivial.
+    
+    apply Zdiv2_two_power_nat; trivial.
+  Qed.
+  
+  Lemma Z_to_two_compl_to_Z :
+    forall (n:nat) (z:Z),
+      (z >= - two_power_nat n)%Z ->
+      (z < two_power_nat n)%Z -> two_compl_value n (Z_to_two_compl n z) = z.
+  Proof.
+    induction n as [| n IHn].
+    unfold two_power_nat, shift_nat in |- *; simpl in |- *; intros.
+    assert (z = (-1)%Z \/ z = 0%Z). 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.
+  Qed.
 
 End COHERENT_VALUE.
diff --git a/theories/ZArith/Zbool.v b/theories/ZArith/Zbool.v
index a195b951..7da91c44 100644
--- a/theories/ZArith/Zbool.v
+++ b/theories/ZArith/Zbool.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zbool.v 6295 2004-11-12 16:40:39Z gregoire $ *)
+(* $Id: Zbool.v 9245 2006-10-17 12:53:34Z notin $ *)
 
 Require Import BinInt.
 Require Import Zeven.
@@ -17,6 +17,8 @@ Require Import Sumbool.
 
 Unset Boxed Definitions.
 
+
+(** * Boolean operations from decidabilty of order *)
 (** The decidability of equality and order relations over
     type [Z] give some boolean functions with the adequate specification. *)
 
@@ -32,65 +34,70 @@ 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 *)
+(** * Boolean comparisons of binary integers *)
 
 Definition Zle_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Gt => false
-  | _ => true
+    | Gt => false
+    | _ => true
   end.
+
 Definition Zge_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Lt => false
-  | _ => true
+    | Lt => false
+    | _ => true
   end.
+
 Definition Zlt_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Lt => true
-  | _ => false
+    | Lt => true
+    | _ => false
   end.
+
 Definition Zgt_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Gt => true
-  | _ => false
+    | Gt => true
+    | _ => false
   end.
+
 Definition Zeq_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Eq => true
-  | _ => false
+    | Eq => true
+    | _ => false
   end.
+
 Definition Zneq_bool (x y:Z) :=
   match (x ?= y)%Z with
-  | Eq => false
-  | _ => true
+    | Eq => false
+    | _ => true
   end.
 
 Lemma Zle_cases :
- forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z.
+  forall n m:Z, if Zle_bool n m then (n <= m)%Z else (n > m)%Z.
 Proof.
-intros x y; unfold Zle_bool, Zle, Zgt in |- *.
-case (x ?= y)%Z; auto; discriminate.
+  intros x y; unfold Zle_bool, Zle, Zgt in |- *.
+  case (x ?= y)%Z; auto; discriminate.
 Qed.
 
 Lemma Zlt_cases :
- forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z.
+  forall n m:Z, if Zlt_bool n m then (n < m)%Z else (n >= m)%Z.
 Proof.
-intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
-case (x ?= y)%Z; auto; discriminate.
+  intros x y; unfold Zlt_bool, Zlt, Zge in |- *.
+  case (x ?= y)%Z; auto; discriminate.
 Qed.
 
 Lemma Zge_cases :
- forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z.
+  forall n m:Z, if Zge_bool n m then (n >= m)%Z else (n < m)%Z.
 Proof.
-intros x y; unfold Zge_bool, Zge, Zlt in |- *.
-case (x ?= y)%Z; auto; discriminate.
+  intros x y; unfold Zge_bool, Zge, Zlt in |- *.
+  case (x ?= y)%Z; auto; discriminate.
 Qed.
 
 Lemma Zgt_cases :
- forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z.
+  forall n m:Z, if Zgt_bool n m then (n > m)%Z else (n <= m)%Z.
 Proof.
-intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
-case (x ?= y)%Z; auto; discriminate.
+  intros x y; unfold Zgt_bool, Zgt, Zle in |- *.
+  case (x ?= y)%Z; auto; discriminate.
 Qed.
 
 (** Lemmas on [Zle_bool] used in contrib/graphs *)
@@ -112,15 +119,15 @@ Proof.
 Qed.
 
 Lemma Zle_bool_antisym :
- forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m.
+  forall n m:Z, Zle_bool n m = true -> Zle_bool m n = true -> n = m.
 Proof.
   intros. apply Zle_antisym. apply Zle_bool_imp_le. assumption.
   apply Zle_bool_imp_le. assumption.
 Qed.
 
 Lemma Zle_bool_trans :
- forall n m p:Z,
-   Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true.
+  forall n m p:Z,
+    Zle_bool n m = true -> Zle_bool m p = true -> Zle_bool n p = true.
 Proof.
   intros x y z; intros. apply Zle_imp_le_bool. apply Zle_trans with (m := y). apply Zle_bool_imp_le. assumption.
   apply Zle_bool_imp_le. assumption.
@@ -137,9 +144,9 @@ Proof.
 Defined.
 
 Lemma Zle_bool_plus_mono :
- forall n m p q:Z,
-   Zle_bool n m = true ->
-   Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true.
+  forall n m p q:Z,
+    Zle_bool n m = true ->
+    Zle_bool p q = true -> Zle_bool (n + p) (m + q) = true.
 Proof.
   intros. apply Zle_imp_le_bool. apply Zplus_le_compat. apply Zle_bool_imp_le. assumption.
   apply Zle_bool_imp_le. assumption.
@@ -159,30 +166,30 @@ Proof.
 Qed.
 
 
- Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true.
-  Proof.
-    intros. split. intro. apply Zle_imp_le_bool. assumption.
-    intro. apply Zle_bool_imp_le. assumption.
-  Qed.
-
-  Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true.
-  Proof.
-    intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption.
-    intro. apply Zle_ge. apply Zle_bool_imp_le. assumption.
-  Qed.
-
-  Lemma Zlt_is_le_bool :
-   forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true.
-  Proof.
-    intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
-    assumption.
-    intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption.
-  Qed.
-
-  Lemma Zgt_is_le_bool :
-   forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true.
-  Proof.
-    intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y).
-    exact (Zlt_gt y x).
-    exact (Zlt_is_le_bool y x).
-  Qed.
+Lemma Zle_is_le_bool : forall n m:Z, (n <= m)%Z <-> Zle_bool n m = true.
+Proof.
+  intros. split. intro. apply Zle_imp_le_bool. assumption.
+  intro. apply Zle_bool_imp_le. assumption.
+Qed.
+
+Lemma Zge_is_le_bool : forall n m:Z, (n >= m)%Z <-> Zle_bool m n = true.
+Proof.
+  intros. split. intro. apply Zle_imp_le_bool. apply Zge_le. assumption.
+  intro. apply Zle_ge. apply Zle_bool_imp_le. assumption.
+Qed.
+
+Lemma Zlt_is_le_bool :
+  forall n m:Z, (n < m)%Z <-> Zle_bool n (m - 1) = true.
+Proof.
+  intros x y. split. intro. apply Zle_imp_le_bool. apply Zlt_succ_le. rewrite (Zsucc_pred y) in H.
+  assumption.
+  intro. rewrite (Zsucc_pred y). apply Zle_lt_succ. apply Zle_bool_imp_le. assumption.
+Qed.
+
+Lemma Zgt_is_le_bool :
+  forall n m:Z, (n > m)%Z <-> Zle_bool m (n - 1) = true.
+Proof.
+  intros x y. apply iff_trans with (y < x)%Z. split. exact (Zgt_lt x y).
+  exact (Zlt_gt y x).
+  exact (Zlt_is_le_bool y x).
+Qed.
diff --git a/theories/ZArith/Zcompare.v b/theories/ZArith/Zcompare.v
index 4003c338..6c5b07d2 100644
--- a/theories/ZArith/Zcompare.v
+++ b/theories/ZArith/Zcompare.v
@@ -8,6 +8,10 @@
 
 (*i $$ i*)
 
+(**********************************************************************)
+(** Binary Integers (Pierre Crégut, CNET, Lannion, France)            *)
+(**********************************************************************)
+
 Require Export BinPos.
 Require Export BinInt.
 Require Import Lt.
@@ -17,485 +21,480 @@ Require Import Mult.
 
 Open Local Scope Z_scope.
 
-(**********************************************************************)
-(** Binary Integers (Pierre Crégut, CNET, Lannion, France)            *)
-(**********************************************************************)
-
-(**********************************************************************)
-(** Comparison on integers *)
+(***************************)
+(** * Comparison on integers *)
 
 Lemma Zcompare_refl : forall n:Z, (n ?= n) = Eq.
 Proof.
-intro x; destruct x as [| p| p]; simpl in |- *;
- [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ].
+  intro x; destruct x as [| p| p]; simpl in |- *;
+    [ reflexivity | apply Pcompare_refl | rewrite Pcompare_refl; reflexivity ].
 Qed.
 
 Lemma Zcompare_Eq_eq : forall n m:Z, (n ?= m) = Eq -> n = m.
 Proof.
-intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *;
- intro H; reflexivity || (try discriminate H);
- [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity
- | rewrite (Pcompare_Eq_eq x' y');
-    [ reflexivity
-    | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
+  intros x y; destruct x as [| x'| x']; destruct y as [| y'| y']; simpl in |- *;
+    intro H; reflexivity || (try discriminate H);
+      [ rewrite (Pcompare_Eq_eq x' y' H); reflexivity
+	| rewrite (Pcompare_Eq_eq x' y');
+	  [ reflexivity
+	    | destruct ((x' ?= y')%positive Eq); reflexivity || discriminate ] ].
 Qed.
 
 Lemma Zcompare_Eq_iff_eq : forall n m:Z, (n ?= m) = Eq <-> n = m.
 Proof.
-intros x y; split; intro E;
- [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ].
+  intros x y; split; intro E;
+    [ apply Zcompare_Eq_eq; assumption | rewrite E; apply Zcompare_refl ].
 Qed.
 
 Lemma Zcompare_antisym : forall n m:Z, CompOpp (n ?= m) = (m ?= n).
 Proof.
-intros x y; destruct x; destruct y; simpl in |- *;
- reflexivity || discriminate H || rewrite Pcompare_antisym; 
- reflexivity.
+  intros x y; destruct x; destruct y; simpl in |- *;
+    reflexivity || discriminate H || rewrite Pcompare_antisym; 
+      reflexivity.
 Qed.
 
 Lemma Zcompare_Gt_Lt_antisym : forall n m:Z, (n ?= m) = Gt <-> (m ?= n) = Lt.
 Proof.
-intros x y; split; intro H;
- [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym;
-    rewrite H; reflexivity
- | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym;
-    rewrite H; reflexivity ].
+  intros x y; split; intro H;
+    [ change Lt with (CompOpp Gt) in |- *; rewrite <- Zcompare_antisym;
+      rewrite H; reflexivity
+      | change Gt with (CompOpp Lt) in |- *; rewrite <- Zcompare_antisym;
+	rewrite H; reflexivity ].
 Qed.
 
-(** Transitivity of comparison *)
+(** * Transitivity of comparison *)
 
 Lemma Zcompare_Gt_trans :
- forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt.
+  forall n m p:Z, (n ?= m) = Gt -> (m ?= p) = Gt -> (n ?= p) = Gt.
 Proof.
-intros x y z; case x; case y; case z; simpl in |- *;
- try (intros; discriminate H || discriminate H0); auto with arith;
- [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism;
-    unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
-    apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; 
-    assumption
- | intros p q r; do 3 rewrite <- ZC4; intros H H0;
-    apply nat_of_P_gt_Gt_compare_complement_morphism; 
-    unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
-    apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; 
-    assumption ].
+  intros x y z; case x; case y; case z; simpl in |- *;
+    try (intros; discriminate H || discriminate H0); auto with arith;
+      [ intros p q r H H0; apply nat_of_P_gt_Gt_compare_complement_morphism;
+	unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+	  apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; 
+	    assumption
+	| intros p q r; do 3 rewrite <- ZC4; intros H H0;
+	  apply nat_of_P_gt_Gt_compare_complement_morphism; 
+	    unfold gt in |- *; apply lt_trans with (m := nat_of_P q);
+	      apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; 
+		assumption ].
 Qed.
 
-(** Comparison and opposite *)
+(** * Comparison and opposite *)
 
 Lemma Zcompare_opp : forall n m:Z, (n ?= m) = (- m ?= - n).
 Proof.
-intros x y; case x; case y; simpl in |- *; auto with arith; intros;
- rewrite <- ZC4; trivial with arith.
+  intros x y; case x; case y; simpl in |- *; auto with arith; intros;
+    rewrite <- ZC4; trivial with arith.
 Qed.
 
 Hint Local Resolve Pcompare_refl.
 
-(** Comparison first-order specification *)
+(** * Comparison first-order specification *)
 
 Lemma Zcompare_Gt_spec :
- forall n m:Z, (n ?= m) = Gt ->  exists h : positive, n + - m = Zpos h.
+  forall n m:Z, (n ?= m) = Gt ->  exists h : positive, n + - m = Zpos h.
 Proof.
-intros x y; case x; case y;
- [ simpl in |- *; intros H; discriminate H
- | simpl in |- *; intros p H; discriminate H
- | intros p H; exists p; simpl in |- *; auto with arith
- | intros p H; exists p; simpl in |- *; auto with arith
- | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *;
-    unfold Zcompare in H; rewrite H; trivial with arith
- | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith
- | simpl in |- *; intros p H; discriminate H
- | simpl in |- *; intros q p H; discriminate H
- | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H;
-    exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H);
-    trivial with arith ].
+  intros x y; case x; case y;
+    [ simpl in |- *; intros H; discriminate H
+      | simpl in |- *; intros p H; discriminate H
+      | intros p H; exists p; simpl in |- *; auto with arith
+      | intros p H; exists p; simpl in |- *; auto with arith
+      | intros q p H; exists (p - q)%positive; unfold Zplus, Zopp in |- *;
+	unfold Zcompare in H; rewrite H; trivial with arith
+      | intros q p H; exists (p + q)%positive; simpl in |- *; trivial with arith
+      | simpl in |- *; intros p H; discriminate H
+      | simpl in |- *; intros q p H; discriminate H
+      | unfold Zcompare in |- *; intros q p; rewrite <- ZC4; intros H;
+	exists (q - p)%positive; simpl in |- *; rewrite (ZC1 q p H);
+	  trivial with arith ].
 Qed.
 
-(** Comparison and addition *)
+(** * Comparison and addition *)
 
 Lemma weaken_Zcompare_Zplus_compatible :
- (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) ->
- forall n m p:Z, (p + n ?= p + m) = (n ?= m).
+  (forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m)) ->
+  forall n m p:Z, (p + n ?= p + m) = (n ?= m).
 Proof.
-intros H x y z; destruct z;
- [ reflexivity
- | apply H
- | rewrite (Zcompare_opp x y); rewrite Zcompare_opp;
-    do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; 
-    apply H ].
+  intros H x y z; destruct z;
+    [ reflexivity
+      | apply H
+      | rewrite (Zcompare_opp x y); rewrite Zcompare_opp;
+	do 2 rewrite Zopp_plus_distr; rewrite Zopp_neg; 
+	  apply H ].
 Qed.
 
 Hint Local Resolve ZC4.
 
 Lemma weak_Zcompare_Zplus_compatible :
- forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m).
+  forall (n m:Z) (p:positive), (Zpos p + n ?= Zpos p + m) = (n ?= m).
 Proof.
-intros x y z; case x; case y; simpl in |- *; auto with arith;
- [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17
- | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
-    apply nat_of_P_gt_Gt_compare_complement_morphism;
-    rewrite nat_of_P_minus_morphism;
-    [ unfold gt in |- *; apply ZL16 | assumption ]
- | intros p; ElimPcompare z p; intros E; auto with arith;
-    apply nat_of_P_gt_Gt_compare_complement_morphism; 
-    unfold gt in |- *; apply ZL17
- | intros p q; ElimPcompare q p; intros E; rewrite E;
-    [ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl
-    | apply nat_of_P_lt_Lt_compare_complement_morphism;
-       do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
-       apply nat_of_P_lt_Lt_compare_morphism with (1 := E)
-    | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
-       do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
-       exact (nat_of_P_gt_Gt_compare_morphism q p E) ]
- | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith;
-    apply nat_of_P_gt_Gt_compare_complement_morphism;
-    rewrite nat_of_P_minus_morphism;
-    [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-       [ apply ZL16 | apply ZL17 ]
-    | assumption ]
- | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
-    simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-    rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ]
- | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith;
-    simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-    rewrite nat_of_P_minus_morphism;
-    [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ]
-    | assumption ]
- | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p;
-    intros E1; rewrite E1; ElimPcompare q p; intros E2; 
-    rewrite E2; auto with arith;
-    [ absurd ((q ?= p)%positive Eq = Lt);
-       [ rewrite <- (Pcompare_Eq_eq z q E0);
-          rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
-          discriminate
-       | assumption ]
-    | absurd ((q ?= p)%positive Eq = Gt);
-       [ rewrite <- (Pcompare_Eq_eq z q E0);
-          rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
-          discriminate
-       | assumption ]
-    | absurd ((z ?= p)%positive Eq = Lt);
-       [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
-          rewrite (Pcompare_refl q); discriminate
-       | assumption ]
-    | absurd ((z ?= p)%positive Eq = Lt);
-       [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
-       | assumption ]
-    | absurd ((z ?= p)%positive Eq = Gt);
-       [ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
-          rewrite (Pcompare_refl q); discriminate
-       | assumption ]
-    | absurd ((z ?= p)%positive Eq = Gt);
-       [ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
-       | assumption ]
-    | absurd ((z ?= q)%positive Eq = Lt);
-       [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
-          rewrite (Pcompare_refl p); discriminate
-       | assumption ]
-    | absurd ((p ?= q)%positive Eq = Gt);
-       [ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate
-       | apply ZC2; assumption ]
-    | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2);
-       rewrite (Pcompare_refl (p - z)); auto with arith
-    | simpl in |- *; rewrite <- ZC4;
-       apply nat_of_P_gt_Gt_compare_complement_morphism;
-       rewrite nat_of_P_minus_morphism;
-       [ rewrite nat_of_P_minus_morphism;
-          [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
-             rewrite le_plus_minus_r;
-             [ rewrite le_plus_minus_r;
-                [ apply nat_of_P_lt_Lt_compare_morphism; assumption
-                | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                   assumption ]
-             | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                assumption ]
-          | apply ZC2; assumption ]
-       | apply ZC2; assumption ]
-    | simpl in |- *; rewrite <- ZC4;
-       apply nat_of_P_lt_Lt_compare_complement_morphism;
-       rewrite nat_of_P_minus_morphism;
-       [ rewrite nat_of_P_minus_morphism;
-          [ apply plus_lt_reg_l with (p := nat_of_P z);
-             rewrite le_plus_minus_r;
-             [ rewrite le_plus_minus_r;
-                [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
-                   assumption
-                | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                   assumption ]
-             | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                assumption ]
-          | apply ZC2; assumption ]
-       | apply ZC2; assumption ]
-    | absurd ((z ?= q)%positive Eq = Lt);
-       [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
-       | assumption ]
-    | absurd ((q ?= p)%positive Eq = Lt);
-       [ cut ((q ?= p)%positive Eq = Gt);
-          [ intros E; rewrite E; discriminate
-          | apply nat_of_P_gt_Gt_compare_complement_morphism;
-             unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-             [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-             | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
-       | assumption ]
-    | absurd ((z ?= q)%positive Eq = Gt);
-       [ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
-          rewrite (Pcompare_refl p); discriminate
-       | assumption ]
-    | absurd ((z ?= q)%positive Eq = Gt);
-       [ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1;
-          [ discriminate | assumption ]
-       | assumption ]
-    | absurd ((z ?= q)%positive Eq = Gt);
-       [ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
-       | assumption ]
-    | absurd ((q ?= p)%positive Eq = Gt);
-       [ rewrite ZC1;
-          [ discriminate
-          | apply nat_of_P_gt_Gt_compare_complement_morphism;
-             unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
-             [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
-             | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
-       | assumption ]
-    | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl
-    | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism;
-       unfold gt in |- *; rewrite nat_of_P_minus_morphism;
-       [ rewrite nat_of_P_minus_morphism;
-          [ apply plus_lt_reg_l with (p := nat_of_P p);
-             rewrite le_plus_minus_r;
-             [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q);
-                rewrite plus_assoc; rewrite le_plus_minus_r;
-                [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l;
-                   apply nat_of_P_lt_Lt_compare_morphism; 
-                   assumption
-                | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                   apply ZC1; assumption ]
-             | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                apply ZC1; assumption ]
-          | assumption ]
-       | assumption ]
-    | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
-       rewrite nat_of_P_minus_morphism;
-       [ rewrite nat_of_P_minus_morphism;
-          [ apply plus_lt_reg_l with (p := nat_of_P q);
-             rewrite le_plus_minus_r;
-             [ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
-                rewrite plus_assoc; rewrite le_plus_minus_r;
-                [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
-                   apply nat_of_P_lt_Lt_compare_morphism; 
-                   apply ZC1; assumption
-                | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                   apply ZC1; assumption ]
-             | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
-                apply ZC1; assumption ]
-          | assumption ]
-       | assumption ] ] ].
+  intros x y z; case x; case y; simpl in |- *; auto with arith;
+    [ intros p; apply nat_of_P_lt_Lt_compare_complement_morphism; apply ZL17
+      | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+	apply nat_of_P_gt_Gt_compare_complement_morphism;
+	  rewrite nat_of_P_minus_morphism;
+	    [ unfold gt in |- *; apply ZL16 | assumption ]
+      | intros p; ElimPcompare z p; intros E; auto with arith;
+	apply nat_of_P_gt_Gt_compare_complement_morphism; 
+	  unfold gt in |- *; apply ZL17
+      | intros p q; ElimPcompare q p; intros E; rewrite E;
+	[ rewrite (Pcompare_Eq_eq q p E); apply Pcompare_refl
+	  | apply nat_of_P_lt_Lt_compare_complement_morphism;
+	    do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+	      apply nat_of_P_lt_Lt_compare_morphism with (1 := E)
+	  | apply nat_of_P_gt_Gt_compare_complement_morphism; unfold gt in |- *;
+	    do 2 rewrite nat_of_P_plus_morphism; apply plus_lt_compat_l;
+	      exact (nat_of_P_gt_Gt_compare_morphism q p E) ]
+      | intros p q; ElimPcompare z p; intros E; rewrite E; auto with arith;
+	apply nat_of_P_gt_Gt_compare_complement_morphism;
+	  rewrite nat_of_P_minus_morphism;
+	    [ unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+	      [ apply ZL16 | apply ZL17 ]
+	      | assumption ]
+      | intros p; ElimPcompare z p; intros E; rewrite E; auto with arith;
+	simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+	  rewrite nat_of_P_minus_morphism; [ apply ZL16 | assumption ]
+      | intros p q; ElimPcompare z q; intros E; rewrite E; auto with arith;
+	simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+	  rewrite nat_of_P_minus_morphism;
+	    [ apply lt_trans with (m := nat_of_P z); [ apply ZL16 | apply ZL17 ]
+	      | assumption ]
+      | intros p q; ElimPcompare z q; intros E0; rewrite E0; ElimPcompare z p;
+	intros E1; rewrite E1; ElimPcompare q p; intros E2; 
+	  rewrite E2; auto with arith;
+	    [ absurd ((q ?= p)%positive Eq = Lt);
+	      [ rewrite <- (Pcompare_Eq_eq z q E0);
+		rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+		  discriminate
+		| assumption ]
+	      | absurd ((q ?= p)%positive Eq = Gt);
+		[ rewrite <- (Pcompare_Eq_eq z q E0);
+		  rewrite <- (Pcompare_Eq_eq z p E1); rewrite (Pcompare_refl z);
+		    discriminate
+		  | assumption ]
+	      | absurd ((z ?= p)%positive Eq = Lt);
+		[ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+		  rewrite (Pcompare_refl q); discriminate
+		  | assumption ]
+	      | absurd ((z ?= p)%positive Eq = Lt);
+		[ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+		  | assumption ]
+	      | absurd ((z ?= p)%positive Eq = Gt);
+		[ rewrite (Pcompare_Eq_eq z q E0); rewrite <- (Pcompare_Eq_eq q p E2);
+		  rewrite (Pcompare_refl q); discriminate
+		  | assumption ]
+	      | absurd ((z ?= p)%positive Eq = Gt);
+		[ rewrite (Pcompare_Eq_eq z q E0); rewrite E2; discriminate
+		  | assumption ]
+	      | absurd ((z ?= q)%positive Eq = Lt);
+		[ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+		  rewrite (Pcompare_refl p); discriminate
+		  | assumption ]
+	      | absurd ((p ?= q)%positive Eq = Gt);
+		[ rewrite <- (Pcompare_Eq_eq z p E1); rewrite E0; discriminate
+		  | apply ZC2; assumption ]
+	      | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2);
+		rewrite (Pcompare_refl (p - z)); auto with arith
+	      | simpl in |- *; rewrite <- ZC4;
+		apply nat_of_P_gt_Gt_compare_complement_morphism;
+		  rewrite nat_of_P_minus_morphism;
+		    [ rewrite nat_of_P_minus_morphism;
+		      [ unfold gt in |- *; apply plus_lt_reg_l with (p := nat_of_P z);
+			rewrite le_plus_minus_r;
+			  [ rewrite le_plus_minus_r;
+			    [ apply nat_of_P_lt_Lt_compare_morphism; assumption
+			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+				assumption ]
+			    | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+			      assumption ]
+			| apply ZC2; assumption ]
+		      | apply ZC2; assumption ]
+	      | simpl in |- *; rewrite <- ZC4;
+		apply nat_of_P_lt_Lt_compare_complement_morphism;
+		  rewrite nat_of_P_minus_morphism;
+		    [ rewrite nat_of_P_minus_morphism;
+		      [ apply plus_lt_reg_l with (p := nat_of_P z);
+			rewrite le_plus_minus_r;
+			  [ rewrite le_plus_minus_r;
+			    [ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1;
+			      assumption
+			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+				assumption ]
+			    | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+			      assumption ]
+			| apply ZC2; assumption ]
+		      | apply ZC2; assumption ]
+	      | absurd ((z ?= q)%positive Eq = Lt);
+		[ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+		  | assumption ]
+	      | absurd ((q ?= p)%positive Eq = Lt);
+		[ cut ((q ?= p)%positive Eq = Gt);
+		  [ intros E; rewrite E; discriminate
+		    | apply nat_of_P_gt_Gt_compare_complement_morphism;
+		      unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+			  | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+		  | assumption ]
+	      | absurd ((z ?= q)%positive Eq = Gt);
+		[ rewrite (Pcompare_Eq_eq z p E1); rewrite (Pcompare_Eq_eq q p E2);
+		  rewrite (Pcompare_refl p); discriminate
+		  | assumption ]
+	      | absurd ((z ?= q)%positive Eq = Gt);
+		[ rewrite (Pcompare_Eq_eq z p E1); rewrite ZC1;
+		  [ discriminate | assumption ]
+		  | assumption ]
+	      | absurd ((z ?= q)%positive Eq = Gt);
+		[ rewrite (Pcompare_Eq_eq q p E2); rewrite E1; discriminate
+		  | assumption ]
+	      | absurd ((q ?= p)%positive Eq = Gt);
+		[ rewrite ZC1;
+		  [ discriminate
+		    | apply nat_of_P_gt_Gt_compare_complement_morphism;
+		      unfold gt in |- *; apply lt_trans with (m := nat_of_P z);
+			[ apply nat_of_P_lt_Lt_compare_morphism; apply ZC1; assumption
+			  | apply nat_of_P_lt_Lt_compare_morphism; assumption ] ]
+		  | assumption ]
+	      | simpl in |- *; rewrite (Pcompare_Eq_eq q p E2); apply Pcompare_refl
+	      | simpl in |- *; apply nat_of_P_gt_Gt_compare_complement_morphism;
+		unfold gt in |- *; rewrite nat_of_P_minus_morphism;
+		  [ rewrite nat_of_P_minus_morphism;
+		    [ apply plus_lt_reg_l with (p := nat_of_P p);
+		      rewrite le_plus_minus_r;
+			[ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P q);
+			  rewrite plus_assoc; rewrite le_plus_minus_r;
+			    [ rewrite (plus_comm (nat_of_P q)); apply plus_lt_compat_l;
+			      apply nat_of_P_lt_Lt_compare_morphism; 
+				assumption
+			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+				apply ZC1; assumption ]
+			  | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+			    apply ZC1; assumption ]
+		      | assumption ]
+		    | assumption ]
+	      | simpl in |- *; apply nat_of_P_lt_Lt_compare_complement_morphism;
+		rewrite nat_of_P_minus_morphism;
+		  [ rewrite nat_of_P_minus_morphism;
+		    [ apply plus_lt_reg_l with (p := nat_of_P q);
+		      rewrite le_plus_minus_r;
+			[ rewrite plus_comm; apply plus_lt_reg_l with (p := nat_of_P p);
+			  rewrite plus_assoc; rewrite le_plus_minus_r;
+			    [ rewrite (plus_comm (nat_of_P p)); apply plus_lt_compat_l;
+			      apply nat_of_P_lt_Lt_compare_morphism; 
+				apply ZC1; assumption
+			      | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+				apply ZC1; assumption ]
+			  | apply lt_le_weak; apply nat_of_P_lt_Lt_compare_morphism;
+			    apply ZC1; assumption ]
+		      | assumption ]
+		    | assumption ] ] ].
 Qed.
 
 Lemma Zcompare_plus_compat : forall n m p:Z, (p + n ?= p + m) = (n ?= m).
 Proof.
-exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
+  exact (weaken_Zcompare_Zplus_compatible weak_Zcompare_Zplus_compatible).
 Qed.
 
 Lemma Zplus_compare_compat :
- forall (r:comparison) (n m p q:Z),
-   (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
+  forall (r:comparison) (n m p q:Z),
+    (n ?= m) = r -> (p ?= q) = r -> (n + p ?= m + q) = r.
 Proof.
-intros r x y z t; case r;
- [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t);
-    intros H3 H4 H5 H6; rewrite H3;
-    [ rewrite H5;
-       [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith
-       | auto with arith ]
-    | auto with arith ]
- | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4;
-    apply H3; apply Zcompare_Gt_trans with (m := y + z);
-    [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z);
-       auto with arith
-    | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat;
-       elim (Zcompare_Gt_Lt_antisym y x); auto with arith ]
- | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t);
-    [ rewrite Zcompare_plus_compat; assumption
-    | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat;
-       assumption ] ].
+  intros r x y z t; case r;
+    [ intros H1 H2; elim (Zcompare_Eq_iff_eq x y); elim (Zcompare_Eq_iff_eq z t);
+      intros H3 H4 H5 H6; rewrite H3;
+	[ rewrite H5;
+	  [ elim (Zcompare_Eq_iff_eq (y + t) (y + t)); auto with arith
+	    | auto with arith ]
+	  | auto with arith ]
+      | intros H1 H2; elim (Zcompare_Gt_Lt_antisym (y + t) (x + z)); intros H3 H4;
+	apply H3; apply Zcompare_Gt_trans with (m := y + z);
+	  [ rewrite Zcompare_plus_compat; elim (Zcompare_Gt_Lt_antisym t z);
+	    auto with arith
+	    | do 2 rewrite <- (Zplus_comm z); rewrite Zcompare_plus_compat;
+	      elim (Zcompare_Gt_Lt_antisym y x); auto with arith ]
+      | intros H1 H2; apply Zcompare_Gt_trans with (m := x + t);
+	[ rewrite Zcompare_plus_compat; assumption
+	  | do 2 rewrite <- (Zplus_comm t); rewrite Zcompare_plus_compat;
+	    assumption ] ].
 Qed.
 
 Lemma Zcompare_succ_Gt : forall n:Z, (Zsucc n ?= n) = Gt.
 Proof.
-intro x; unfold Zsucc in |- *; pattern x at 2 in |- *;
- rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; 
- reflexivity.
+  intro x; unfold Zsucc in |- *; pattern x at 2 in |- *;
+    rewrite <- (Zplus_0_r x); rewrite Zcompare_plus_compat; 
+      reflexivity.
 Qed.
 
 Lemma Zcompare_Gt_not_Lt : forall n m:Z, (n ?= m) = Gt <-> (n ?= m + 1) <> Lt.
 Proof.
-intros x y; split;
- [ intro H; elim_compare x (y + 1);
-    [ intro H1; rewrite H1; discriminate
-    | intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2;
-       absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat);
-       [ unfold not in |- *; intros H3; elim H3; intros H4 H5;
-          absurd (nat_of_P h > 0)%nat;
-          [ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5
-          | assumption ]
-       | split;
-          [ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O
-          | change (nat_of_P h < nat_of_P 1)%nat in |- *;
-             apply nat_of_P_lt_Lt_compare_morphism;
-             change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2;
-             rewrite <- (fun m n:Z => Zcompare_plus_compat m n y);
-             rewrite (Zplus_comm x); rewrite Zplus_assoc; 
-             rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ]
-    | intros H1; rewrite H1; discriminate ]
- | intros H; elim_compare x (y + 1);
-    [ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3;
-       rewrite (H2 H1); exact (Zcompare_succ_Gt y)
-    | intros H1; absurd ((x ?= y + 1) = Lt); assumption
-    | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y);
-       [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ].
+  intros x y; split;
+    [ intro H; elim_compare x (y + 1);
+      [ intro H1; rewrite H1; discriminate
+	| intros H1; elim Zcompare_Gt_spec with (1 := H); intros h H2;
+	  absurd ((nat_of_P h > 0)%nat /\ (nat_of_P h < 1)%nat);
+	    [ unfold not in |- *; intros H3; elim H3; intros H4 H5;
+              absurd (nat_of_P h > 0)%nat;
+		[ unfold gt in |- *; apply le_not_lt; apply le_S_n; exact H5
+		  | assumption ]
+	      | split;
+		[ elim (ZL4 h); intros i H3; rewrite H3; apply gt_Sn_O
+		  | change (nat_of_P h < nat_of_P 1)%nat in |- *;
+		    apply nat_of_P_lt_Lt_compare_morphism;
+		      change ((Zpos h ?= 1) = Lt) in |- *; rewrite <- H2;
+			rewrite <- (fun m n:Z => Zcompare_plus_compat m n y);
+			  rewrite (Zplus_comm x); rewrite Zplus_assoc; 
+			    rewrite Zplus_opp_r; simpl in |- *; exact H1 ] ]
+	| intros H1; rewrite H1; discriminate ]
+      | intros H; elim_compare x (y + 1);
+	[ intros H1; elim (Zcompare_Eq_iff_eq x (y + 1)); intros H2 H3;
+	  rewrite (H2 H1); exact (Zcompare_succ_Gt y)
+	  | intros H1; absurd ((x ?= y + 1) = Lt); assumption
+	  | intros H1; apply Zcompare_Gt_trans with (m := Zsucc y);
+	    [ exact H1 | exact (Zcompare_succ_Gt y) ] ] ].
 Qed.
 
-(** Successor and comparison *)
+(** * Successor and comparison *)
 
 Lemma Zcompare_succ_compat : forall n m:Z, (Zsucc n ?= Zsucc m) = (n ?= m).
 Proof.
-intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1);
- rewrite Zcompare_plus_compat; auto with arith.
+  intros n m; unfold Zsucc in |- *; do 2 rewrite (fun t:Z => Zplus_comm t 1);
+    rewrite Zcompare_plus_compat; auto with arith.
 Qed.
  
-(** Multiplication and comparison *)
+(** * Multiplication and comparison *)
 
 Lemma Zcompare_mult_compat :
- forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m).
+  forall (p:positive) (n m:Z), (Zpos p * n ?= Zpos p * m) = (n ?= m).
 Proof.
-intros x; induction x as [p H| p H| ];
- [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1);
-    [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l;
-       do 2 rewrite Zmult_1_l; apply Zplus_compare_compat;
-       [ apply Zplus_compare_compat; apply H | trivial with arith ]
-    | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
- | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p);
-    [ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l;
-       apply Zplus_compare_compat; apply H
-    | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
- | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ].
+  intros x; induction x as [p H| p H| ];
+    [ intros y z; cut (Zpos (xI p) = Zpos p + Zpos p + 1);
+      [ intros E; rewrite E; do 4 rewrite Zmult_plus_distr_l;
+	do 2 rewrite Zmult_1_l; apply Zplus_compare_compat;
+	  [ apply Zplus_compare_compat; apply H | trivial with arith ]
+	| simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+      | intros y z; cut (Zpos (xO p) = Zpos p + Zpos p);
+	[ intros E; rewrite E; do 2 rewrite Zmult_plus_distr_l;
+	  apply Zplus_compare_compat; apply H
+	  | simpl in |- *; rewrite (Pplus_diag p); trivial with arith ]
+      | intros y z; do 2 rewrite Zmult_1_l; trivial with arith ].
 Qed.
 
 
-(** Reverting [x ?= y] to trichotomy *)
+(** * Reverting [x ?= y] to trichotomy *)
 
 Lemma rename :
- forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x.
+  forall (A:Type) (P:A -> Prop) (x:A), (forall y:A, x = y -> P y) -> P x.
 Proof.
-auto with arith. 
+  auto with arith. 
 Qed.
 
 Lemma Zcompare_elim :
- forall (c1 c2 c3:Prop) (n m:Z),
-   (n = m -> c1) ->
-   (n < m -> c2) ->
-   (n > m -> c3) -> match n ?= m with
-                    | Eq => c1
-                    | Lt => c2
-                    | Gt => c3
-                    end.
+  forall (c1 c2 c3:Prop) (n m:Z),
+    (n = m -> c1) ->
+    (n < m -> c2) ->
+    (n > m -> c3) -> match n ?= m with
+                       | Eq => c1
+                       | Lt => c2
+                       | Gt => c3
+                     end.
 Proof.
-intros c1 c2 c3 x y; intros.
-apply rename with (x := x ?= y); intro r; elim r;
- [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption
- | unfold Zlt in H0; assumption
- | unfold Zgt in H1; assumption ].
+  intros c1 c2 c3 x y; intros.
+  apply rename with (x := x ?= y); intro r; elim r;
+    [ intro; apply H; apply (Zcompare_Eq_eq x y); assumption
+      | unfold Zlt in H0; assumption
+      | unfold Zgt in H1; assumption ].
 Qed.
 
 Lemma Zcompare_eq_case :
- forall (c1 c2 c3:Prop) (n m:Z),
-   c1 -> n = m -> match n ?= m with
-                  | Eq => c1
-                  | Lt => c2
-                  | Gt => c3
-                  end.
+  forall (c1 c2 c3:Prop) (n m:Z),
+    c1 -> n = m -> match n ?= m with
+                     | Eq => c1
+                     | Lt => c2
+                     | Gt => c3
+                   end.
 Proof.
-intros c1 c2 c3 x y; intros.
-rewrite H0; rewrite Zcompare_refl.
-assumption.
+  intros c1 c2 c3 x y; intros.
+  rewrite H0; rewrite Zcompare_refl.
+  assumption.
 Qed.
 
-(** Decompose an egality between two [?=] relations into 3 implications *)
+(** * Decompose an egality between two [?=] relations into 3 implications *)
 
 Lemma Zcompare_egal_dec :
- forall n m p q:Z,
-   (n < m -> p < q) ->
-   ((n ?= m) = Eq -> (p ?= q) = Eq) ->
-   (n > m -> p > q) -> (n ?= m) = (p ?= q).
+  forall n m p q:Z,
+    (n < m -> p < q) ->
+    ((n ?= m) = Eq -> (p ?= q) = Eq) ->
+    (n > m -> p > q) -> (n ?= m) = (p ?= q).
 Proof.
-intros x1 y1 x2 y2.
-unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2);
- auto with arith; symmetry  in |- *; auto with arith.
+  intros x1 y1 x2 y2.
+  unfold Zgt in |- *; unfold Zlt in |- *; case (x1 ?= y1); case (x2 ?= y2);
+    auto with arith; symmetry  in |- *; auto with arith.
 Qed.
 
-(** Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
+(** * Relating [x ?= y] to [Zle], [Zlt], [Zge] or [Zgt] *)
 
 Lemma Zle_compare :
- forall n m:Z,
-   n <= m -> match n ?= m with
-             | Eq => True
-             | Lt => True
-             | Gt => False
-             end.
+  forall n m:Z,
+    n <= m -> match n ?= m with
+		| Eq => True
+		| Lt => True
+		| Gt => False
+              end.
 Proof.
-intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith.
+  intros x y; unfold Zle in |- *; elim (x ?= y); auto with arith.
 Qed.
 
 Lemma Zlt_compare :
- forall n m:Z,
+  forall n m:Z,
    n < m -> match n ?= m with
-            | Eq => False
-            | Lt => True
-            | Gt => False
+              | Eq => False
+              | Lt => True
+              | Gt => False
             end.
 Proof.
-intros x y; unfold Zlt in |- *; elim (x ?= y); intros;
- discriminate || trivial with arith.
+  intros x y; unfold Zlt in |- *; elim (x ?= y); intros;
+    discriminate || trivial with arith.
 Qed.
 
 Lemma Zge_compare :
- forall n m:Z,
-   n >= m -> match n ?= m with
-             | Eq => True
-             | Lt => False
-             | Gt => True
-             end.
+  forall n m:Z,
+    n >= m -> match n ?= m with
+		| Eq => True
+		| Lt => False
+		| Gt => True
+              end.
 Proof.
-intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. 
+  intros x y; unfold Zge in |- *; elim (x ?= y); auto with arith. 
 Qed.
 
 Lemma Zgt_compare :
- forall n m:Z,
-   n > m -> match n ?= m with
-            | Eq => False
-            | Lt => False
-            | Gt => True
-            end.
+  forall n m:Z,
+    n > m -> match n ?= m with
+               | Eq => False
+               | Lt => False
+               | Gt => True
+             end.
 Proof.
-intros x y; unfold Zgt in |- *; elim (x ?= y); intros;
- discriminate || trivial with arith.
+  intros x y; unfold Zgt in |- *; elim (x ?= y); intros;
+    discriminate || trivial with arith.
 Qed.
 
-(**********************************************************************)
-(* Other properties *)
-
+(*********************)
+(** * Other properties *)
 
 Lemma Zmult_compare_compat_l :
- forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m).
+  forall n m p:Z, p > 0 -> (n ?= m) = (p * n ?= p * m).
 Proof.
-intros x y z H; destruct z.
+  intros x y z H; destruct z.
   discriminate H.
   rewrite Zcompare_mult_compat; reflexivity.
   discriminate H.
 Qed.
 
 Lemma Zmult_compare_compat_r :
- forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p).
+  forall n m p:Z, p > 0 -> (n ?= m) = (n * p ?= m * p).
 Proof.
-intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z);
- apply Zmult_compare_compat_l; assumption.
+  intros x y z H; rewrite (Zmult_comm x z); rewrite (Zmult_comm y z);
+    apply Zmult_compare_compat_l; assumption.
 Qed.
 
diff --git a/theories/ZArith/Zcomplements.v b/theories/ZArith/Zcomplements.v
index 817fbc1b..78c8a976 100644
--- a/theories/ZArith/Zcomplements.v
+++ b/theories/ZArith/Zcomplements.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zcomplements.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zcomplements.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import ZArithRing.
 Require Import ZArith_base.
@@ -19,27 +19,27 @@ Open Local Scope Z_scope.
 (** About parity *)
 
 Lemma two_or_two_plus_one :
- forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. 
+  forall n:Z, {y : Z | n = 2 * y} + {y : Z | n = 2 * y + 1}. 
 Proof.
-intro x; destruct x.
-left; split with 0; reflexivity.
-
-destruct p.
-right; split with (Zpos p); reflexivity.
-
-left; split with (Zpos p); reflexivity.
-
-right; split with 0; reflexivity.
-
-destruct p.
-right; split with (Zneg (1 + p)).
-rewrite BinInt.Zneg_xI.
-rewrite BinInt.Zneg_plus_distr.
-omega.
-
-left; split with (Zneg p); reflexivity.
-
-right; split with (-1); reflexivity.
+  intro x; destruct x.
+  left; split with 0; reflexivity.
+  
+  destruct p.
+  right; split with (Zpos p); reflexivity.
+  
+  left; split with (Zpos p); reflexivity.
+  
+  right; split with 0; reflexivity.
+  
+  destruct p.
+  right; split with (Zneg (1 + p)).
+  rewrite BinInt.Zneg_xI.
+  rewrite BinInt.Zneg_plus_distr.
+  omega.
+  
+  left; split with (Zneg p); reflexivity.
+  
+  right; split with (-1); reflexivity.
 Qed.
 
 (**********************************************************************)
@@ -50,109 +50,109 @@ Qed.
 
 Fixpoint floor_pos (a:positive) : positive :=
   match a with
-  | xH => 1%positive
-  | xO a' => xO (floor_pos a')
-  | xI b' => xO (floor_pos b')
+    | xH => 1%positive
+    | xO a' => xO (floor_pos a')
+    | xI b' => xO (floor_pos b')
   end.
 
 Definition floor (a:positive) := Zpos (floor_pos a).
 
 Lemma floor_gt0 : forall p:positive, floor p > 0.
 Proof.
-intro.
-compute in |- *.
-trivial.
+  intro.
+  compute in |- *.
+  trivial.
 Qed.
 
 Lemma floor_ok : forall p:positive, floor p <= Zpos p < 2 * floor p. 
 Proof.
-unfold floor in |- *.
-intro a; induction a as [p| p| ].
-
-simpl in |- *.
-repeat rewrite BinInt.Zpos_xI.
-rewrite (BinInt.Zpos_xO (xO (floor_pos p))). 
-rewrite (BinInt.Zpos_xO (floor_pos p)).
-omega.
-
-simpl in |- *.
-repeat rewrite BinInt.Zpos_xI.
-rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
-rewrite (BinInt.Zpos_xO (floor_pos p)).
-rewrite (BinInt.Zpos_xO p).
-omega.
-
-simpl in |- *; omega.
+  unfold floor in |- *.
+  intro a; induction a as [p| p| ].
+  
+  simpl in |- *.
+  repeat rewrite BinInt.Zpos_xI.
+  rewrite (BinInt.Zpos_xO (xO (floor_pos p))). 
+  rewrite (BinInt.Zpos_xO (floor_pos p)).
+  omega.
+  
+  simpl in |- *.
+  repeat rewrite BinInt.Zpos_xI.
+  rewrite (BinInt.Zpos_xO (xO (floor_pos p))).
+  rewrite (BinInt.Zpos_xO (floor_pos p)).
+  rewrite (BinInt.Zpos_xO p).
+  omega.
+  
+  simpl in |- *; omega.
 Qed.
 
 (**********************************************************************)
 (** Two more induction principles over [Z]. *)
 
 Theorem Z_lt_abs_rec :
- forall P:Z -> Set,
-   (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
-   forall n:Z, P n.
+  forall P:Z -> Set,
+    (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+    forall n:Z, P n.
 Proof.
-intros P HP p.
-set (Q := fun z => 0 <= z -> P z * P (- z)) in *.
-cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
-elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
-unfold Q in |- *; clear Q; intros.
-apply pair; apply HP.
-rewrite Zabs_eq; auto; intros.
-elim (H (Zabs m)); intros; auto with zarith.
-elim (Zabs_dec m); intro eq; rewrite eq; trivial.
-rewrite Zabs_non_eq; auto with zarith.
-rewrite Zopp_involutive; intros.
-elim (H (Zabs m)); intros; auto with zarith.
-elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+  intros P HP p.
+  set (Q := fun z => 0 <= z -> P z * P (- z)) in *.
+  cut (Q (Zabs p)); [ intros | apply (Z_lt_rec Q); auto with zarith ].
+  elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
+  unfold Q in |- *; clear Q; intros.
+  apply pair; apply HP.
+  rewrite Zabs_eq; auto; intros.
+  elim (H (Zabs m)); intros; auto with zarith.
+  elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+  rewrite Zabs_non_eq; auto with zarith.
+  rewrite Zopp_involutive; intros.
+  elim (H (Zabs m)); intros; auto with zarith.
+  elim (Zabs_dec m); intro eq; rewrite eq; trivial.
 Qed.
 
 Theorem Z_lt_abs_induction :
- forall P:Z -> Prop,
-   (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
-   forall n:Z, P n.
+  forall P:Z -> Prop,
+    (forall n:Z, (forall m:Z, Zabs m < Zabs n -> P m) -> P n) ->
+    forall n:Z, P n.
 Proof.
-intros P HP p.
-set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *.
-cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
-elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
-unfold Q in |- *; clear Q; intros.
-split; apply HP.
-rewrite Zabs_eq; auto; intros.
-elim (H (Zabs m)); intros; auto with zarith.
-elim (Zabs_dec m); intro eq; rewrite eq; trivial.
-rewrite Zabs_non_eq; auto with zarith.
-rewrite Zopp_involutive; intros.
-elim (H (Zabs m)); intros; auto with zarith.
-elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+  intros P HP p.
+  set (Q := fun z => 0 <= z -> P z /\ P (- z)) in *.
+  cut (Q (Zabs p)); [ intros | apply (Z_lt_induction Q); auto with zarith ].
+  elim (Zabs_dec p); intro eq; rewrite eq; elim H; auto with zarith.
+  unfold Q in |- *; clear Q; intros.
+  split; apply HP.
+  rewrite Zabs_eq; auto; intros.
+  elim (H (Zabs m)); intros; auto with zarith.
+  elim (Zabs_dec m); intro eq; rewrite eq; trivial.
+  rewrite Zabs_non_eq; auto with zarith.
+  rewrite Zopp_involutive; intros.
+  elim (H (Zabs m)); intros; auto with zarith.
+  elim (Zabs_dec m); intro eq; rewrite eq; trivial.
 Qed.
 
 (** To do case analysis over the sign of [z] *) 
 
 Lemma Zcase_sign :
- forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P.
+  forall (n:Z) (P:Prop), (n = 0 -> P) -> (n > 0 -> P) -> (n < 0 -> P) -> P.
 Proof.
-intros x P Hzero Hpos Hneg.
-induction  x as [| p| p].
-apply Hzero; trivial.
-apply Hpos; apply Zorder.Zgt_pos_0.
-apply Hneg; apply Zorder.Zlt_neg_0.
+  intros x P Hzero Hpos Hneg.
+  induction  x as [| p| p].
+  apply Hzero; trivial.
+  apply Hpos; apply Zorder.Zgt_pos_0.
+  apply Hneg; apply Zorder.Zlt_neg_0.
 Qed.
 
 Lemma sqr_pos : forall n:Z, n * n >= 0.
 Proof.
-intro x.
-apply (Zcase_sign x (x * x >= 0)).
-intros H; rewrite H; omega.
-intros H; replace 0 with (0 * 0).
-apply Zmult_ge_compat; omega.
-omega.
-intros H; replace 0 with (0 * 0).
-replace (x * x) with (- x * - x).
-apply Zmult_ge_compat; omega.
-ring.
-omega.
+  intro x.
+  apply (Zcase_sign x (x * x >= 0)).
+  intros H; rewrite H; omega.
+  intros H; replace 0 with (0 * 0).
+  apply Zmult_ge_compat; omega.
+  omega.
+  intros H; replace 0 with (0 * 0).
+  replace (x * x) with (- x * - x).
+  apply Zmult_ge_compat; omega.
+  ring.
+  omega.
 Qed.
 
 (**********************************************************************)
@@ -162,8 +162,8 @@ Require Import List.
 
 Fixpoint Zlength_aux (acc:Z) (A:Set) (l:list A) {struct l} : Z :=
   match l with
-  | nil => acc
-  | _ :: l => Zlength_aux (Zsucc acc) A l
+    | nil => acc
+    | _ :: l => Zlength_aux (Zsucc acc) A l
   end. 
 
 Definition Zlength := Zlength_aux 0.
@@ -171,42 +171,42 @@ Implicit Arguments Zlength [A].
 
 Section Zlength_properties.
 
-Variable A : Set.
-
-Implicit Type l : list A.
-
-Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l).
-Proof.
-assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). 
-simple induction l.
-simpl in |- *; auto with zarith.
-intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S.
-simpl in |- *; rewrite H; auto with zarith.
-unfold Zlength in |- *; intros; rewrite H; auto.
-Qed.
-
-Lemma Zlength_nil : Zlength (A:=A) nil = 0.
-Proof.
-auto.
-Qed.
-
-Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l).
-Proof.
-intros; do 2 rewrite Zlength_correct.
-simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto.
-Qed.
-
-Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil.
-Proof.
-intro l; rewrite Zlength_correct.
-case l; auto.
-intros x l'; simpl (length (x :: l')) in |- *.
-rewrite Znat.inj_S.
-intros; elimtype False; generalize (Zle_0_nat (length l')); omega.
-Qed.
+  Variable A : Set.
+
+  Implicit Type l : list A.
+
+  Lemma Zlength_correct : forall l, Zlength l = Z_of_nat (length l).
+  Proof.
+    assert (forall l (acc:Z), Zlength_aux acc A l = acc + Z_of_nat (length l)). 
+    simple induction l.
+    simpl in |- *; auto with zarith.
+    intros; simpl (length (a :: l0)) in |- *; rewrite Znat.inj_S.
+    simpl in |- *; rewrite H; auto with zarith.
+    unfold Zlength in |- *; intros; rewrite H; auto.
+  Qed.
+
+  Lemma Zlength_nil : Zlength (A:=A) nil = 0.
+  Proof.
+    auto.
+  Qed.
+
+  Lemma Zlength_cons : forall (x:A) l, Zlength (x :: l) = Zsucc (Zlength l).
+  Proof.
+    intros; do 2 rewrite Zlength_correct.
+    simpl (length (x :: l)) in |- *; rewrite Znat.inj_S; auto.
+  Qed.
+
+  Lemma Zlength_nil_inv : forall l, Zlength l = 0 -> l = nil.
+  Proof.
+    intro l; rewrite Zlength_correct.
+    case l; auto.
+    intros x l'; simpl (length (x :: l')) in |- *.
+    rewrite Znat.inj_S.
+    intros; elimtype False; generalize (Zle_0_nat (length l')); omega.
+  Qed.
 
 End Zlength_properties.
 
 Implicit Arguments Zlength_correct [A].
 Implicit Arguments Zlength_cons [A].
-Implicit Arguments Zlength_nil_inv [A].
\ No newline at end of file
+Implicit Arguments Zlength_nil_inv [A].
diff --git a/theories/ZArith/Zdiv.v b/theories/ZArith/Zdiv.v
index e391d087..31f68207 100644
--- a/theories/ZArith/Zdiv.v
+++ b/theories/ZArith/Zdiv.v
@@ -6,17 +6,14 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zdiv.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
+(*i $Id: Zdiv.v 9245 2006-10-17 12:53:34Z notin $ 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.
+(** Euclidean Division
 
+    Defines first of function that allows Coq to normalize. 
+    Then only after proves the main required property.
 *)
 
 Require Export ZArith_base.
@@ -26,40 +23,37 @@ Require Import ZArithRing.
 Require Import Zcomplements.
 Open Local Scope Z_scope.
 
-(**
+(** * Definitions of Euclidian operations *)
 
-  Euclidean division of a positive by a integer 
-  (that is supposed to be positive).
+(** 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
+    Total function than returns an arbitrary value when
+    divisor is not positive
   
 *)
 
 Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} : 
- Z * Z :=
+  Z * Z :=
   match a with
-  | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
-  | xO a' =>
+    | xH => if Zge_bool b 2 then (0, 1) else (1, 0)
+    | xO a' =>
       let (q, r) := Zdiv_eucl_POS a' b in
-      let r' := 2 * r in
-      if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
-  | xI a' =>
+	let r' := 2 * r in
+	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
+    | xI a' =>
       let (q, r) := Zdiv_eucl_POS a' b in
-      let r' := 2 * r + 1 in
-      if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
+	let r' := 2 * r + 1 in
+	  if Zgt_bool b r' then (2 * q, r') else (2 * q + 1, r' - b)
   end.
 
 
-(**
-
-  Euclidean division of integers.
+(** Euclidean division of integers.
  
-  Total function than returns (0,0) when dividing by 0. 
-
+    Total function than returns (0,0) when dividing by 0. 
 *) 
     
-(* 
+(** 
 
   The pseudo-code is:
   
@@ -82,22 +76,22 @@ Unboxed Fixpoint Zdiv_eucl_POS (a:positive) (b:Z) {struct a} :
 
 Definition Zdiv_eucl (a b:Z) : Z * Z :=
   match a, b with
-  | Z0, _ => (0, 0)
-  | _, Z0 => (0, 0)
-  | Zpos a', Zpos _ => Zdiv_eucl_POS a' b
-  | Zneg a', Zpos _ =>
+    | Z0, _ => (0, 0)
+    | _, Z0 => (0, 0)
+    | Zpos a', Zpos _ => Zdiv_eucl_POS a' b
+    | Zneg a', Zpos _ =>
       let (q, r) := Zdiv_eucl_POS a' b in
-      match r with
-      | Z0 => (- q, 0)
-      | _ => (- (q + 1), b - r)
-      end
-  | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r)
-  | Zpos a', Zneg b' =>
+	match r with
+	  | Z0 => (- q, 0)
+	  | _ => (- (q + 1), b - r)
+	end
+    | Zneg a', Zneg b' => let (q, r) := Zdiv_eucl_POS a' (Zpos b') in (q, - r)
+    | Zpos a', Zneg b' =>
       let (q, r) := Zdiv_eucl_POS a' (Zpos b') in
-      match r with
-      | Z0 => (- q, 0)
-      | _ => (- (q + 1), b + r)
-      end
+	match r with
+	  | Z0 => (- q, 0)
+	  | _ => (- (q + 1), b + r)
+	end
   end.
 
 
@@ -107,6 +101,11 @@ Definition Zdiv (a b:Z) : Z := let (q, _) := Zdiv_eucl a b in q.
 
 Definition Zmod (a b:Z) : Z := let (_, r) := Zdiv_eucl a b in r. 
 
+(** Syntax *)
+
+Infix "/" := Zdiv : Z_scope.
+Infix "mod" := Zmod (at level 40, no associativity) : Z_scope.
+
 (* Tests:
 
 Eval Compute in `(Zdiv_eucl 7 3)`. 
@@ -120,19 +119,15 @@ Eval Compute in `(Zdiv_eucl (-7) (-3))`.
 *)
 
 
-(**
-
-  Main division theorem. 
-
-  First a lemma for positive
+(** * Main division theorem *) 
 
-*)
+(** First a lemma for positive *)
 
 Lemma Z_div_mod_POS :
- forall b:Z,
-   b > 0 ->
-   forall a:positive,
-     let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b.
+  forall b:Z,
+    b > 0 ->
+    forall a:positive,
+      let (q, r) := Zdiv_eucl_POS a b in Zpos a = b * q + r /\ 0 <= r < b.
 Proof.
 simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *.
 
@@ -148,276 +143,269 @@ case (Zgt_bool b (2 * r)); rewrite BinInt.Zpos_xO;
  (split; [ ring | omega ]).
 
 generalize (Zge_cases b 2).
-case (Zge_bool b 2); (intros; split; [ ring | omega ]).
+case (Zge_bool b 2); (intros; split; [ try ring | omega ]).
 omega.
 Qed.
 
 
 Theorem Z_div_mod :
- forall a b:Z,
-   b > 0 -> let (q, r) := Zdiv_eucl a b in a = b * q + r /\ 0 <= r < b.
+  forall 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 in |- *; intros; omega).
-unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial.
-
-intros; discriminate.
-
-intros.
-generalize (Z_div_mod_POS (Zpos p) H p0).
-unfold Zdiv_eucl in |- *.
-case (Zdiv_eucl_POS p0 (Zpos p)).
-intros z z0.
-case z0.
-
-intros [H1 H2].
-split; trivial.
-replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
-
-intros p1 [H1 H2].
-split; trivial.
-replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
-generalize (Zorder.Zgt_pos_0 p1); omega.
-
-intros p1 [H1 H2].
-split; trivial.
-replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
-generalize (Zorder.Zlt_neg_0 p1); omega.
-
-intros; discriminate.
+  intros a b; case a; case b; try (simpl in |- *; intros; omega).
+  unfold Zdiv_eucl in |- *; intros; apply Z_div_mod_POS; trivial.
+  
+  intros; discriminate.
+
+  intros.
+  generalize (Z_div_mod_POS (Zpos p) H p0).
+  unfold Zdiv_eucl in |- *.
+  case (Zdiv_eucl_POS p0 (Zpos p)).
+  intros z z0.
+  case z0.
+  
+  intros [H1 H2].
+  split; trivial.
+  replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
+  
+  intros p1 [H1 H2].
+  split; trivial.
+  replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
+  generalize (Zorder.Zgt_pos_0 p1); omega.
+  
+  intros p1 [H1 H2].
+  split; trivial.
+  replace (Zneg p0) with (- Zpos p0); [ rewrite H1; ring | trivial ].
+  generalize (Zorder.Zlt_neg_0 p1); omega.
+  
+  intros; discriminate.
 Qed.
 
 (** Existence theorems *)
 
 Theorem Zdiv_eucl_exist :
- forall b:Z,
-   b > 0 ->
-   forall a:Z, {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < b}.
+  forall b:Z,
+    b > 0 ->
+    forall 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).
+  intros b Hb a.
+  exists (Zdiv_eucl a b).
+  exact (Z_div_mod a b Hb).
 Qed.
 
 Implicit Arguments Zdiv_eucl_exist.
 
 Theorem Zdiv_eucl_extended :
- forall b:Z,
-   b <> 0 ->
-   forall a:Z,
-     {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs b}.
+  forall b:Z,
+    b <> 0 ->
+    forall a:Z,
+      {qr : Z * Z | let (q, r) := qr in a = b * q + r /\ 0 <= r < Zabs 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 (- q, r).
-elim Hqr; intros.
-split.
-rewrite <- Zmult_opp_comm; assumption.
-rewrite Zabs_non_eq; [ assumption | omega ].
+  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 (- q, r).
+  elim Hqr; intros.
+  split.
+  rewrite <- Zmult_opp_comm; assumption.
+  rewrite Zabs_non_eq; [ assumption | omega ].
 Qed.
 
 Implicit Arguments Zdiv_eucl_extended.
 
-(** Auxiliary lemmas about [Zdiv] and [Zmod] *)
+(** * Auxiliary lemmas about [Zdiv] and [Zmod] *)
 
 Lemma Z_div_mod_eq : forall a b:Z, b > 0 -> a = b * Zdiv a b + Zmod a b.
 Proof.
-unfold Zdiv, Zmod in |- *.
-intros a b Hb.
-generalize (Z_div_mod a b Hb).
-case Zdiv_eucl; tauto.
+  unfold Zdiv, Zmod in |- *.
+  intros a b Hb.
+  generalize (Z_div_mod a b Hb).
+  case Zdiv_eucl; tauto.
 Qed.
 
 Lemma Z_mod_lt : forall a b:Z, b > 0 -> 0 <= Zmod a b < b.
 Proof.
-unfold Zmod in |- *.
-intros a b Hb.
-generalize (Z_div_mod a b Hb).
-case (Zdiv_eucl a b); tauto.
+  unfold Zmod in |- *.
+  intros a b Hb.
+  generalize (Z_div_mod a b Hb).
+  case (Zdiv_eucl a b); tauto.
 Qed.
 
 Lemma Z_div_POS_ge0 :
- forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0.
+  forall (b:Z) (a:positive), let (q, _) := Zdiv_eucl_POS a b in q >= 0.
 Proof.
-simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *.
-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 in |- *; omega.
+  simple induction a; unfold Zdiv_eucl_POS in |- *; fold Zdiv_eucl_POS in |- *.
+  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 in |- *; omega.
 Qed.
 
 Lemma Z_div_ge0 : forall a b:Z, b > 0 -> a >= 0 -> Zdiv a b >= 0.
 Proof.
-intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros.
-case b; simpl in |- *; trivial.
-generalize Hb; case b; try trivial.
-auto with zarith.
-intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p).
-case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto.
-intros; discriminate.
-elim H; trivial.
+  intros a b Hb; unfold Zdiv, Zdiv_eucl in |- *; case a; simpl in |- *; intros.
+  case b; simpl in |- *; trivial.
+  generalize Hb; case b; try trivial.
+  auto with zarith.
+  intros p0 Hp0; generalize (Z_div_POS_ge0 (Zpos p0) p).
+  case (Zdiv_eucl_POS p (Zpos p0)); simpl in |- *; tauto.
+  intros; discriminate.
+  elim H; trivial.
 Qed.
 
 Lemma Z_div_lt : forall 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 in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3].
-cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ].
-apply Zge_trans with (b * q).
-omega.
-auto with zarith.
+  intros. cut (b > 0); [ intro Hb | omega ].
+  generalize (Z_div_mod a b Hb).
+  cut (a >= 0); [ intro Ha | omega ].
+  generalize (Z_div_ge0 a b Hb Ha).
+  unfold Zdiv in |- *; case (Zdiv_eucl a b); intros q r H1 [H2 H3].
+  cut (a >= 2 * q -> q < a); [ intro h; apply h; clear h | intros; omega ].
+  apply Zge_trans with (b * q).
+  omega.
+  auto with zarith.
 Qed.
 
-(** Syntax *)
-
-
-
-Infix "/" := Zdiv : Z_scope.
-Infix "mod" := Zmod (at level 40, no associativity) : Z_scope.
-
-(** Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *)
+(** * Other lemmas (now using the syntax for [Zdiv] and [Zmod]). *)
 
 Lemma Z_div_ge : forall a b c:Z, c > 0 -> a >= b -> a / c >= b / c.
 Proof.
-intros a b c cPos aGeb.
-generalize (Z_div_mod_eq a c cPos).
-generalize (Z_mod_lt a c cPos).
-generalize (Z_div_mod_eq b c cPos).
-generalize (Z_mod_lt b c cPos).
-intros.
-elim (Z_ge_lt_dec (a / c) (b / c)); trivial.
-intro.
-absurd (b - a >= 1).
-omega.
-rewrite H0.
-rewrite H2.
-assert
- (c * (b / c) + b mod c - (c * (a / c) + a mod c) =
-  c * (b / c - a / c) + b mod c - a mod c).
-ring.
-rewrite H3.
-assert (c * (b / c - a / c) >= c * 1).
-apply Zmult_ge_compat_l.
-omega.
-omega.
-assert (c * 1 = c).
-ring.
-omega.
+  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 mod c - (c * (a / c) + a mod c) =
+      c * (b / c - a / c) + b mod c - a mod c).
+  ring.
+  rewrite H3.
+  assert (c * (b / c - a / c) >= c * 1).
+  apply Zmult_ge_compat_l.
+  omega.
+  omega.
+  assert (c * 1 = c).
+  ring.
+  omega.
 Qed.
 
 Lemma Z_mod_plus : forall a b c:Z, c > 0 -> (a + b * c) mod c = a mod 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) mod c - a mod c = c * (b + a / c - (a + b * c) / c)).
-replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)).
-replace (a mod c) with (a - c * (a / c)).
-ring.
-omega.
-omega.
-set (q := b + a / c - (a + b * c) / c) in *.
-apply (Zcase_sign q); intros.
-assert (c * q = 0).
-rewrite H4; ring.
-rewrite H5 in H3.
-omega.
-
-assert (c * q >= c).
-pattern c at 2 in |- *; replace c with (c * 1).
-apply Zmult_ge_compat_l; omega.
-ring.
-omega.
-
-assert (c * q <= - c).
-replace (- c) with (c * -1).
-apply Zmult_le_compat_l; omega.
-ring.
-omega.
+  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) mod c - a mod c = c * (b + a / c - (a + b * c) / c)).
+  replace ((a + b * c) mod c) with (a + b * c - c * ((a + b * c) / c)).
+  replace (a mod c) with (a - c * (a / c)).
+  ring.
+  omega.
+  omega.
+  set (q := b + a / c - (a + b * c) / c) in *.
+  apply (Zcase_sign q); intros.
+  assert (c * q = 0).
+  rewrite H4; ring.
+  rewrite H5 in H3.
+  omega.
+
+  assert (c * q >= c).
+  pattern c at 2 in |- *; replace c with (c * 1).
+  apply Zmult_ge_compat_l; omega.
+  ring.
+  omega.
+
+  assert (c * q <= - c).
+  replace (- c) with (c * -1).
+  apply Zmult_le_compat_l; omega.
+  ring.
+  omega.
 Qed.
 
 Lemma Z_div_plus : forall 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_l with c. omega.
-replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c).
-rewrite (Z_mod_plus a b c cPos).
-pattern a at 1 in |- *; rewrite H2.
-ring.
-pattern (a + b * c) at 1 in |- *; rewrite H0.
-ring.
+  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_l with c. omega.
+  replace (c * ((a + b * c) / c)) with (a + b * c - (a + b * c) mod c).
+  rewrite (Z_mod_plus a b c cPos).
+  pattern a at 1 in |- *; rewrite H2.
+  ring.
+  pattern (a + b * c) at 1 in |- *; rewrite H0.
+  ring.
 Qed.
 
 Lemma Z_div_mult : forall a b:Z, b > 0 -> a * b / b = a.
-intros; replace (a * b) with (0 + a * b); auto.
-rewrite Z_div_plus; auto.
+  intros; replace (a * b) with (0 + a * b); auto.
+  rewrite Z_div_plus; auto.
 Qed.
 
 Lemma Z_mult_div_ge : forall 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 a at 2 in |- *; rewrite H.
-omega.
+  intros a b bPos.
+  generalize (Z_div_mod_eq a _ bPos); intros.
+  generalize (Z_mod_lt a _ bPos); intros.
+  pattern a at 2 in |- *; rewrite H.
+  omega.
 Qed.
 
 Lemma Z_mod_same : forall a:Z, a > 0 -> a mod a = 0.
 Proof.
-intros a aPos.
-generalize (Z_mod_plus 0 1 a aPos).
-replace (0 + 1 * a) with a.
-intros.
-rewrite H.
-compute in |- *.
-trivial.
-ring.
+  intros a aPos.
+  generalize (Z_mod_plus 0 1 a aPos).
+  replace (0 + 1 * a) with a.
+  intros.
+  rewrite H.
+  compute in |- *.
+  trivial.
+  ring.
 Qed.
 
 Lemma Z_div_same : forall 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 in |- *.
-trivial.
-ring.
+  intros a aPos.
+  generalize (Z_div_plus 0 1 a aPos).
+  replace (0 + 1 * a) with a.
+  intros.
+  rewrite H.
+  compute in |- *.
+  trivial.
+  ring.
 Qed.
 
 Lemma Z_div_exact_1 : forall a b:Z, b > 0 -> a = b * (a / b) -> a mod b = 0.
-intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
-case (Zdiv_eucl a b); intros q r; omega.
+  intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
+  case (Zdiv_eucl a b); intros q r; omega.
 Qed.
 
 Lemma Z_div_exact_2 : forall a b:Z, b > 0 -> a mod b = 0 -> a = b * (a / b).
-intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
-case (Zdiv_eucl a b); intros q r; omega.
+  intros a b Hb; generalize (Z_div_mod a b Hb); unfold Zmod, Zdiv in |- *.
+  case (Zdiv_eucl a b); intros q r; omega.
 Qed.
 
 Lemma Z_mod_zero_opp : forall a b:Z, b > 0 -> a mod b = 0 -> - a mod 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.
+  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.
 Qed.
diff --git a/theories/ZArith/Zeven.v b/theories/ZArith/Zeven.v
index 72d2d828..6fab4461 100644
--- a/theories/ZArith/Zeven.v
+++ b/theories/ZArith/Zeven.v
@@ -6,199 +6,203 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zeven.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zeven.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import BinInt.
 
-(**********************************************************************)
+(*******************************************************************)
 (** About parity: even and odd predicates on Z, division by 2 on Z *)
 
-(**********************************************************************)
-(** [Zeven], [Zodd], [Zdiv2] and their related properties *)
+(***************************************************)
+(** * [Zeven], [Zodd] and their related properties *)
 
 Definition Zeven (z:Z) :=
   match z with
-  | Z0 => True
-  | Zpos (xO _) => True
-  | Zneg (xO _) => True
-  | _ => False
+    | Z0 => True
+    | Zpos (xO _) => True
+    | Zneg (xO _) => True
+    | _ => False
   end.
 
 Definition Zodd (z:Z) :=
   match z with
-  | Zpos xH => True
-  | Zneg xH => True
-  | Zpos (xI _) => True
-  | Zneg (xI _) => True
-  | _ => False
+    | Zpos xH => True
+    | Zneg xH => True
+    | Zpos (xI _) => True
+    | Zneg (xI _) => True
+    | _ => False
   end.
 
 Definition Zeven_bool (z:Z) :=
   match z with
-  | Z0 => true
-  | Zpos (xO _) => true
-  | Zneg (xO _) => true
-  | _ => false
+    | Z0 => true
+    | Zpos (xO _) => true
+    | Zneg (xO _) => true
+    | _ => false
   end.
 
 Definition Zodd_bool (z:Z) :=
   match z with
-  | Z0 => false
-  | Zpos (xO _) => false
-  | Zneg (xO _) => false
-  | _ => true
+    | Z0 => false
+    | Zpos (xO _) => false
+    | Zneg (xO _) => false
+    | _ => true
   end.
 
 Definition Zeven_odd_dec : forall z:Z, {Zeven z} + {Zodd z}.
 Proof.
   intro z. case z;
   [ left; compute in |- *; trivial
-  | intro p; case p; intros;
-     (right; compute in |- *; exact I) || (left; compute in |- *; exact I)
-  | intro p; case p; intros;
-     (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ].
+    | intro p; case p; intros;
+      (right; compute in |- *; exact I) || (left; compute in |- *; exact I)
+    | intro p; case p; intros;
+      (right; compute in |- *; exact I) || (left; compute in |- *; exact I) ].
 Defined.
 
 Definition Zeven_dec : forall z:Z, {Zeven z} + {~ Zeven z}.
 Proof.
   intro z. case z;
   [ left; compute in |- *; trivial
-  | intro p; case p; intros;
-     (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
-  | intro p; case p; intros;
-     (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
+    | intro p; case p; intros;
+      (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
+    | intro p; case p; intros;
+      (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
 Defined.
 
 Definition Zodd_dec : forall z:Z, {Zodd z} + {~ Zodd z}.
 Proof.
   intro z. case z;
   [ right; compute in |- *; trivial
-  | intro p; case p; intros;
-     (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
-  | intro p; case p; intros;
-     (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
+    | intro p; case p; intros;
+      (left; compute in |- *; exact I) || (right; compute in |- *; trivial)
+    | intro p; case p; intros;
+      (left; compute in |- *; exact I) || (right; compute in |- *; trivial) ].
 Defined.
 
 Lemma Zeven_not_Zodd : forall n:Z, Zeven n -> ~ Zodd n.
 Proof.
   intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
-   trivial.
+    trivial.
 Qed.
 
 Lemma Zodd_not_Zeven : forall n:Z, Zodd n -> ~ Zeven n.
 Proof.
   intro z; destruct z; [ idtac | destruct p | destruct p ]; compute in |- *;
-   trivial.
+    trivial.
 Qed.
 
 Lemma Zeven_Sn : forall n:Z, Zodd n -> Zeven (Zsucc n).
 Proof.
- intro z; destruct z; unfold Zsucc in |- *;
-  [ idtac | destruct p | destruct p ]; simpl in |- *; 
-  trivial. 
- unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+  intro z; destruct z; unfold Zsucc in |- *;
+    [ idtac | destruct p | destruct p ]; simpl in |- *; 
+      trivial. 
+  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
 Qed.
 
 Lemma Zodd_Sn : forall n:Z, Zeven n -> Zodd (Zsucc n).
 Proof.
- intro z; destruct z; unfold Zsucc in |- *;
-  [ idtac | destruct p | destruct p ]; simpl in |- *; 
-  trivial. 
- unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+  intro z; destruct z; unfold Zsucc in |- *;
+    [ idtac | destruct p | destruct p ]; simpl in |- *; 
+      trivial. 
+  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
 Qed.
 
 Lemma Zeven_pred : forall n:Z, Zodd n -> Zeven (Zpred n).
 Proof.
- intro z; destruct z; unfold Zpred in |- *;
-  [ idtac | destruct p | destruct p ]; simpl in |- *; 
-  trivial. 
- unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+  intro z; destruct z; unfold Zpred in |- *;
+    [ idtac | destruct p | destruct p ]; simpl in |- *; 
+      trivial. 
+  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
 Qed.
 
 Lemma Zodd_pred : forall n:Z, Zeven n -> Zodd (Zpred n).
 Proof.
- intro z; destruct z; unfold Zpred in |- *;
-  [ idtac | destruct p | destruct p ]; simpl in |- *; 
-  trivial. 
- unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
+  intro z; destruct z; unfold Zpred in |- *;
+    [ idtac | destruct p | destruct p ]; simpl in |- *; 
+      trivial. 
+  unfold Pdouble_minus_one in |- *; case p; simpl in |- *; auto.
 Qed.
 
 Hint Unfold Zeven Zodd: zarith.
 
-(**********************************************************************)
+
+(******************************************************************)
+(** * Definition of [Zdiv2] and properties wrt [Zeven] and [Zodd] *)
+
 (** [Zdiv2] is defined on all [Z], but notice that for odd negative
-    integers it is not the euclidean quotient: in that case we have [n =
-    2*(n/2)-1] *)
+    integers it is not the euclidean quotient: in that case we have 
+      [n = 2*(n/2)-1] *)
 
 Definition Zdiv2 (z:Z) :=
   match z with
-  | Z0 => 0%Z
-  | Zpos xH => 0%Z
-  | Zpos p => Zpos (Pdiv2 p)
-  | Zneg xH => 0%Z
-  | Zneg p => Zneg (Pdiv2 p)
+    | Z0 => 0%Z
+    | Zpos xH => 0%Z
+    | Zpos p => Zpos (Pdiv2 p)
+    | Zneg xH => 0%Z
+    | Zneg p => Zneg (Pdiv2 p)
   end.
 
 Lemma Zeven_div2 : forall n:Z, Zeven n -> n = (2 * Zdiv2 n)%Z.
 Proof.
-intro x; destruct x.
-auto with arith.
-destruct p; auto with arith.
-intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith.
-intros. absurd (Zeven 1); red in |- *; auto with arith.
-destruct p; auto with arith.
-intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith.
-intros. absurd (Zeven (-1)); red in |- *; auto with arith.
+  intro x; destruct x.
+  auto with arith.
+  destruct p; auto with arith.
+  intros. absurd (Zeven (Zpos (xI p))); red in |- *; auto with arith.
+  intros. absurd (Zeven 1); red in |- *; auto with arith.
+  destruct p; auto with arith.
+  intros. absurd (Zeven (Zneg (xI p))); red in |- *; auto with arith.
+  intros. absurd (Zeven (-1)); red in |- *; auto with arith.
 Qed.
 
 Lemma Zodd_div2 : forall n:Z, (n >= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n + 1)%Z.
 Proof.
-intro x; destruct x.
-intros. absurd (Zodd 0); red in |- *; auto with arith.
-destruct p; auto with arith.
-intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith.
-intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
+  intro x; destruct x.
+  intros. absurd (Zodd 0); red in |- *; auto with arith.
+  destruct p; auto with arith.
+  intros. absurd (Zodd (Zpos (xO p))); red in |- *; auto with arith.
+  intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
 Qed.
 
 Lemma Zodd_div2_neg :
- forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z.
+  forall n:Z, (n <= 0)%Z -> Zodd n -> n = (2 * Zdiv2 n - 1)%Z.
 Proof.
-intro x; destruct x.
-intros. absurd (Zodd 0); red in |- *; auto with arith.
-intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
-destruct p; auto with arith.
-intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith.
+  intro x; destruct x.
+  intros. absurd (Zodd 0); red in |- *; auto with arith.
+  intros. absurd (Zneg p >= 0)%Z; red in |- *; auto with arith.
+  destruct p; auto with arith.
+  intros. absurd (Zodd (Zneg (xO p))); red in |- *; auto with arith.
 Qed.
 
 Lemma Z_modulo_2 :
- forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}.
+  forall n:Z, {y : Z | n = (2 * y)%Z} + {y : Z | n = (2 * y + 1)%Z}.
 Proof.
-intros x.
-elim (Zeven_odd_dec x); intro.
-left. split with (Zdiv2 x). exact (Zeven_div2 x a).
-right. generalize b; clear b; case x.
-intro b; inversion b.
-intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial.
-unfold Zge, Zcompare in |- *; simpl in |- *; discriminate.
-intro p; split with (Zdiv2 (Zpred (Zneg p))).
-pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)).
-pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))).
-reflexivity.
-apply Zeven_pred; assumption.
+  intros x.
+  elim (Zeven_odd_dec x); intro.
+  left. split with (Zdiv2 x). exact (Zeven_div2 x a).
+  right. generalize b; clear b; case x.
+  intro b; inversion b.
+  intro p; split with (Zdiv2 (Zpos p)). apply (Zodd_div2 (Zpos p)); trivial.
+  unfold Zge, Zcompare in |- *; simpl in |- *; discriminate.
+  intro p; split with (Zdiv2 (Zpred (Zneg p))).
+  pattern (Zneg p) at 1 in |- *; rewrite (Zsucc_pred (Zneg p)).
+  pattern (Zpred (Zneg p)) at 1 in |- *; rewrite (Zeven_div2 (Zpred (Zneg p))).
+  reflexivity.
+  apply Zeven_pred; assumption.
 Qed.
 
 Lemma Zsplit2 :
- forall n:Z,
-   {p : Z * Z |
-   let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}.
+  forall n:Z,
+    {p : Z * Z |
+      let (x1, x2) := p in n = (x1 + x2)%Z /\ (x1 = x2 \/ x2 = (x1 + 1)%Z)}.
 Proof.
-intros x.
-elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy;
- rewrite <- Zplus_diag_eq_mult_2 in Hy.
-exists (y, y); split. 
-assumption.
-left; reflexivity.
-exists (y, (y + 1)%Z); split.
-rewrite Zplus_assoc; assumption.
-right; reflexivity.
-Qed.
\ No newline at end of file
+  intros x.
+  elim (Z_modulo_2 x); intros [y Hy]; rewrite Zmult_comm in Hy;
+    rewrite <- Zplus_diag_eq_mult_2 in Hy.
+  exists (y, y); split. 
+  assumption.
+  left; reflexivity.
+  exists (y, (y + 1)%Z); split.
+  rewrite Zplus_assoc; assumption.
+  right; reflexivity.
+Qed.
+
diff --git a/theories/ZArith/Zhints.v b/theories/ZArith/Zhints.v
index d0a2d2a0..b8f8ba30 100644
--- a/theories/ZArith/Zhints.v
+++ b/theories/ZArith/Zhints.v
@@ -6,26 +6,24 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zhints.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zhints.v 9245 2006-10-17 12:53:34Z notin $ 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 *)
 
-(* 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   *)
 
-(* 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 *)
+(** Lemmas involving positive and compare are not taken into account *)
 
 Require Import BinInt.
 Require Import Zorder.
@@ -37,32 +35,33 @@ Require Import auxiliary.
 Require Import Zmisc.
 Require Import Wf_Z.
 
-(**********************************************************************)
-(*                  Simplification lemmas                             *)
-(* No subgoal or smaller subgoals                                     *)
+(************************************************************************)
+(** *                 Simplification lemmas                             *)
+
+(** No subgoal or smaller subgoals                                     *)
 
 Hint Resolve 
-  (* A) Reversible simplification lemmas (no loss of information)      *)
-  (* Should clearly declared as hints                                  *)
+  (** ** Reversible simplification lemmas (no loss of information)      *)
+  (** Should clearly be declared as hints                               *)
   
-  (* Lemmas ending by eq *)
+  (** Lemmas ending by eq *)
   Zsucc_eq_compat (* :(n,m:Z)`n = m`->`(Zs n) = (Zs m)` *)
   
-  (* Lemmas ending by Zgt *)
+  (** Lemmas ending by Zgt *)
   Zsucc_gt_compat (* :(n,m:Z)`m > n`->`(Zs m) > (Zs n)` *)
   Zgt_succ (* :(n:Z)`(Zs n) > n` *)
   Zorder.Zgt_pos_0 (* :(p:positive)`(POS p) > 0` *)
   Zplus_gt_compat_l (* :(n,m,p:Z)`n > m`->`p+n > p+m` *)
   Zplus_gt_compat_r (* :(n,m,p:Z)`n > m`->`n+p > m+p` *)
   
-  (* Lemmas ending by Zlt *)
+  (** Lemmas ending by Zlt *)
   Zlt_succ (* :(n:Z)`n < (Zs n)` *)
   Zsucc_lt_compat (* :(n,m:Z)`n < m`->`(Zs n) < (Zs m)` *)
   Zlt_pred (* :(n:Z)`(Zpred n) < n` *)
   Zplus_lt_compat_l (* :(n,m,p:Z)`n < m`->`p+n < p+m` *)
   Zplus_lt_compat_r (* :(n,m,p:Z)`n < m`->`n+p < m+p` *)
   
-  (* Lemmas ending by Zle *)
+  (** Lemmas ending by Zle *)
   Zle_0_nat (* :(n:nat)`0 <= (inject_nat n)` *)
   Zorder.Zle_0_pos (* :(p:positive)`0 <= (POS p)` *)
   Zle_refl (* :(n:Z)`n <= n` *)
@@ -75,24 +74,24 @@ Hint Resolve
   Zplus_le_compat_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 *)
+  (** ** Irreversible simplification lemmas *)
+  (** Probably to be declared as hints, when no other simplification is possible *)
   
-  (* Lemmas ending by eq *)
+  (** Lemmas ending by eq *)
   BinInt.Z_eq_mult (* :(x,y:Z)`y = 0`->`y*x = 0` *)
   Zplus_eq_compat (* :(n,m,p,q:Z)`n = m`->`p = q`->`n+p = m+q` *)
   
-  (* Lemmas ending by Zge *)
+  (** Lemmas ending by Zge *)
   Zorder.Zmult_ge_compat_r (* :(a,b,c:Z)`a >= b`->`c >= 0`->`a*c >= b*c` *)
   Zorder.Zmult_ge_compat_l (* :(a,b,c:Z)`a >= b`->`c >= 0`->`c*a >= c*b` *)
   Zorder.Zmult_ge_compat (* :
       (a,b,c,d:Z)`a >= c`->`b >= d`->`c >= 0`->`d >= 0`->`a*b >= c*d` *)
   
-  (* Lemmas ending by Zlt *)
+  (** Lemmas ending by Zlt *)
   Zorder.Zmult_gt_0_compat (* :(a,b:Z)`a > 0`->`b > 0`->`a*b > 0` *)
   Zlt_lt_succ (* :(n,m:Z)`n < m`->`n < (Zs m)` *)
   
-  (* Lemmas ending by Zle *)
+  (** Lemmas ending by Zle *)
   Zorder.Zmult_le_0_compat (* :(x,y:Z)`0 <= x`->`0 <= y`->`0 <= x*y` *)
   Zorder.Zmult_le_compat_r (* :(a,b,c:Z)`a <= b`->`0 <= c`->`a*c <= b*c` *)
   Zorder.Zmult_le_compat_l (* :(a,b,c:Z)`a <= b`->`0 <= c`->`c*a <= c*b` *)
@@ -103,68 +102,118 @@ Hint Resolve
   : zarith.
   
 (**********************************************************************)
-(*         Reversible lemmas relating operators                       *)
-(* Probably to be declared as hints but need to define precedences    *)
+(** *        Reversible lemmas relating operators                     *)
+(** Probably to be declared as hints but need to define precedences   *)
 
-(* A) Conversion between comparisons/predicates and arithmetic operators
+(** ** Conversion between comparisons/predicates and arithmetic operators *)
 
-(* Lemmas ending by eq *)
+(** 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 *)
+(** 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 *)
+(** 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 *)
+(** 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 *)
+(** ** Conversion between nat comparisons and Z comparisons *)
 
-(* Lemmas ending by eq *)
+(** Lemmas ending by eq *)
+(** 
+<<
 inj_eq: (x,y:nat)x=y->`(inject_nat x) = (inject_nat y)`
+>>
+*)
 
-(* Lemmas ending by Zge *)
+(** Lemmas ending by Zge *)
+(** 
+<<
 inj_ge: (x,y:nat)(ge x y)->`(inject_nat x) >= (inject_nat y)`
+>>
+*)
 
-(* Lemmas ending by Zgt *)
+(** Lemmas ending by Zgt *)
+(** 
+<<
 inj_gt: (x,y:nat)(gt x y)->`(inject_nat x) > (inject_nat y)`
+>>
+*)
 
-(* Lemmas ending by Zlt *)
+(** Lemmas ending by Zlt *)
+(** 
+<<
 inj_lt: (x,y:nat)(lt x y)->`(inject_nat x) < (inject_nat y)`
+>>
+*)
 
-(* Lemmas ending by Zle *)
+(** Lemmas ending by Zle *)
+(** 
+<<
 inj_le: (x,y:nat)(le x y)->`(inject_nat x) <= (inject_nat y)`
+>>
+*)
 
-(* C) Conversion between comparisons *)
+(** ** Conversion between comparisons *)
 
-(* Lemmas ending by Zge *)
+(** 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 *)
+(** 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 *)
+(** 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 *)
+(** 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`
@@ -174,138 +223,226 @@ 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 *)
+(** ** Irreversible simplification involving several comparaisons *)
+(**    useful with clear precedences *)
 
-(* Lemmas ending by Zlt *)
+(** 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 ? *)
+(** ** What is decreasing here ? *)
 
-(* Lemmas ending by eq *)
+(** Lemmas ending by eq *)
+(** 
+<<
 Zplus_minus: (n,m,p:Z)`n = m+p`->`p = n-m`
+>>
+*)
 
-(* Lemmas ending by Zgt *)
+(** Lemmas ending by Zgt *)
+(** 
+<<
 Zgt_pred: (n,p:Z)`p > (Zs n)`->`(Zpred p) > n`
+>>
+*)
 
-(* Lemmas ending by Zlt *)
+(** Lemmas ending by Zlt *)
+(** 
+<<
 Zlt_pred: (n,p:Z)`(Zs n) < p`->`n < (Zpred p)`
-
+>>
 *)
 
 (**********************************************************************)
-(*                 Useful Bottom-up lemmas                            *)
+(** *                Useful Bottom-up lemmas                          *)
 
-(* A) Bottom-up simplification: should be used 
+(** ** Bottom-up simplification: should be used *)
 
-(* Lemmas ending by eq *)
+(** 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 *)
+(** 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`
+Zgt_S_n: (n,p:Z)`(Zs p) > (Zs n)`->`p > n` 
+>> 
+*)
 
-(* Lemmas ending by Zlt *)
+(** 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`
+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`
+(** 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`
+Zle_S_n: (n,m:Z)`(Zs m) <= (Zs n)`->`m <= n` >> *)
 
-(* B) Bottom-up irreversible (syntactic) simplification *)
+(** ** Bottom-up irreversible (syntactic) simplification *)
 
-(* Lemmas ending by Zle *)
+(** Lemmas ending by Zle *)
+(** 
+<<
 Zle_trans_S: (n,m:Z)`(Zs n) <= m`->`n <= m`
+>>
+*)
 
-(* C) Other unclearly simplifying lemmas *)
+(** ** Other unclearly simplifying lemmas *)
 
-(* Lemmas ending by Zeq *)
-Zmult_eq: (x,y:Z)`x <> 0`->`y*x = 0`->`y = 0`
+(** 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                                                
+(** *        Irreversible lemmas with meta-variables                  *)
+(** To be used by EAuto                                               *) 
 
-Hints Immediate
-(* Lemmas ending by eq *)
+(* Hints Immediate *)
+(** Lemmas ending by eq *)
+(** 
+<< 
 Zle_antisym: (n,m:Z)`n <= m`->`m <= n`->`n = m`
+>>
+*)
 
-(* Lemmas ending by Zge *)
+(** Lemmas ending by Zge *)
+(** 
+<< 
 Zge_trans: (n,m,p:Z)`n >= m`->`m >= p`->`n >= p`
+>> 
+*)
 
-(* Lemmas ending by Zgt *)
+(** 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 *)
+(** 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 *)
+(** 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 ??                                                  *)
+(** *               Unclear or too specific lemmas                    *)
+(** Not to be used ?                                                  *)
 
-(* A) Irreversible and too specific (not enough regular) 
+(** ** Irreversible and too specific (not enough regular) *)
 
-(* Lemmas ending by Zle *)
+(** Lemmas ending by Zle *)
+(**
+<<
 Zle_mult: (x,y:Z)`x > 0`->`0 <= y`->`0 <= y*x`
 Zle_mult_approx: (x,y,z:Z)`x > 0`->`z > 0`->`0 <= y`->`0 <= y*x+z`
 OMEGA6: (x,y,z:Z)`0 <= x`->`y = 0`->`0 <= x+y*z`
 OMEGA7: (x,y,z,t:Z)`z > 0`->`t > 0`->`0 <= x`->`0 <= y`->`0 <= x*z+y*t`
+>>
+*)
 
+(** ** Expansion and too specific ? *)
 
-(* B) Expansion and too specific ? *)
-
-(* Lemmas ending by Zge *)
+(** Lemmas ending by Zge *)
+(**
+<<
 Zge_mult_simpl: (a,b,c:Z)`c > 0`->`a*c >= b*c`->`a >= b`
+>>
+*)
 
-(* Lemmas ending by Zgt *)
+(** 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 *)
+(** 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 ? *)
+(** ** Reversible but too specific ? *)
 
-(* Lemmas ending by Zlt *)
+(** 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                                      
+(** *               Lemmas to be used as rewrite rules                *)
+(** but can also be used as hints                                     *)
 
-(* Left-to-right simplification lemmas (a symbol disappears) *)
+(** 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`
@@ -322,9 +459,13 @@ 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) *)
+(** 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`
@@ -333,9 +474,13 @@ 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) *)
+(** 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))`
@@ -370,17 +515,25 @@ 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 *)
+(** 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 ? *)
+(** Too specific ? *)
+(**
+<<
 Zred_factor5: (x,y:Z)`x*0+y = y`
+>>
 *)
 
-(*i*)
\ No newline at end of file
diff --git a/theories/ZArith/Zlogarithm.v b/theories/ZArith/Zlogarithm.v
index 653ee951..d8f4f236 100644
--- a/theories/ZArith/Zlogarithm.v
+++ b/theories/ZArith/Zlogarithm.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zlogarithm.v 6295 2004-11-12 16:40:39Z gregoire $ i*)
+(*i $Id: Zlogarithm.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 (**********************************************************************)
 (** The integer logarithms with base 2. 
@@ -27,235 +27,221 @@ Require Import Zpower.
 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 :=
-  match p with
-  | xH => 0	(* 1 *)
-  | xO q => Zsucc (log_inf q)	(* 2n *)
-  | xI q => Zsucc (log_inf q)	(* 2n+1 *)
-  end.
-
-Fixpoint log_sup (p:positive) : Z :=
-  match p with
-  | xH => 0	(* 1 *)
-  | xO n => Zsucc (log_sup n) (* 2n *)
-  | xI n => Zsucc (Zsucc (log_inf n))	(* 2n+1 *)
-  end.
-
-Hint Unfold log_inf log_sup.
-
-(** Then we give the specifications of [log_inf] and [log_sup] 
+  
+  (** First we build [log_inf] and [log_sup] *)
+
+  Fixpoint log_inf (p:positive) : Z :=
+    match p with
+      | xH => 0	(* 1 *)
+      | xO q => Zsucc (log_inf q)	(* 2n *)
+      | xI q => Zsucc (log_inf q)	(* 2n+1 *)
+    end.
+
+  Fixpoint log_sup (p:positive) : Z :=
+    match p with
+      | xH => 0	(* 1 *)
+      | xO n => Zsucc (log_sup n) (* 2n *)
+      | xI n => Zsucc (Zsucc (log_inf n))	(* 2n+1 *)
+    end.
+  
+  Hint 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*)
-Hint Resolve Zle_trans: zarith.
-
-Theorem log_inf_correct :
- forall x:positive,
-   0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)).
-simple induction x; intros; simpl in |- *;
- [ elim H; intros Hp HR; clear H; split;
-    [ auto with zarith
-    | conditional apply Zle_le_succ; trivial rewrite
-       two_p_S with (x := Zsucc (log_inf p));
-       conditional trivial rewrite two_p_S;
-       conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p);
-       omega ]
- | elim H; intros Hp HR; clear H; split;
-    [ auto with zarith
-    | conditional apply Zle_le_succ; trivial rewrite
-       two_p_S with (x := Zsucc (log_inf p));
-       conditional trivial rewrite two_p_S;
-       conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p);
-       omega ]
- | unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *;
-    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.
-
-Hint Resolve log_inf_correct1 log_inf_correct2: zarith.
-
-Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p.
-simple induction p; intros; simpl in |- *; 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 :
- forall p:positive,
-    IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p)
-   else log_sup p = Zsucc (log_inf p).
-
-simple induction p; intros;
- [ elim H; right; simpl in |- *;
-    rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-    rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega
- | elim H; clear H; intro Hif;
-    [ left; simpl in |- *;
-       rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-       rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
-       rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); 
-       auto
-    | right; simpl in |- *;
-       rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
-       rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; 
-       omega ]
- | left; auto ].
-Qed.
-
-Theorem log_sup_correct2 :
- forall x:positive, two_p (Zpred (log_sup x)) < Zpos 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_refl ].
-intros [E1 E2]; rewrite E2.
-rewrite <- (Zpred_succ (log_inf x)).
-generalize (log_inf_correct2 x); omega.
-Qed.
-
-Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p.
-simple induction p; simpl in |- *; intros; omega.
-Qed.
-
-Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p).
-simple induction p; simpl in |- *; intros; omega.
-Qed.
-
-(** Now it's possible to specify and build the [Log] rounded to the nearest *)
-
-Fixpoint log_near (x:positive) : Z :=
-  match x with
-  | xH => 0
-  | xO xH => 1
-  | xI xH => 2
-  | xO y => Zsucc (log_near y)
-  | xI y => Zsucc (log_near y)
-  end.    
-
-Theorem log_near_correct1 : forall p:positive, 0 <= log_near p.
-simple induction p; simpl in |- *; intros;
- [ elim p0; auto with zarith
- | elim p0; auto with zarith
- | trivial with zarith ].
-intros; apply Zle_le_succ.
-generalize H0; elim p1; intros; simpl in |- *;
- [ assumption | assumption | apply Zorder.Zle_0_pos ].
-intros; apply Zle_le_succ.
-generalize H0; elim p1; intros; simpl in |- *;
- [ assumption | assumption | apply Zorder.Zle_0_pos ].
-Qed.
-
-Theorem log_near_correct2 :
- forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p.
-simple induction p.
-intros p0 [Einf| Esup].
-simpl in |- *. rewrite Einf.
-case p0; [ left | left | right ]; reflexivity.
-simpl in |- *; 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 in |- *.
-repeat rewrite Einf.
-case p0; intros; auto with zarith.
-simpl in |- *.
-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*)
+  
+  Hint Resolve Zle_trans: zarith.
+
+  Theorem log_inf_correct :
+    forall x:positive,
+      0 <= log_inf x /\ two_p (log_inf x) <= Zpos x < two_p (Zsucc (log_inf x)).
+    simple induction x; intros; simpl in |- *;
+      [ elim H; intros Hp HR; clear H; split;
+	[ auto with zarith
+	  | conditional apply Zle_le_succ; trivial rewrite
+	    two_p_S with (x := Zsucc (log_inf p));
+	    conditional trivial rewrite two_p_S;
+	      conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xI p);
+		omega ]
+	| elim H; intros Hp HR; clear H; split;
+	  [ auto with zarith
+	    | conditional apply Zle_le_succ; trivial rewrite
+	      two_p_S with (x := Zsucc (log_inf p));
+	      conditional trivial rewrite two_p_S;
+		conditional trivial rewrite two_p_S in HR; rewrite (BinInt.Zpos_xO p);
+		  omega ]
+	| unfold two_power_pos in |- *; unfold shift_pos in |- *; simpl in |- *;
+	  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.
+
+  Hint Resolve log_inf_correct1 log_inf_correct2: zarith.
+
+  Lemma log_sup_correct1 : forall p:positive, 0 <= log_sup p.
+  Proof.
+    simple induction p; intros; simpl in |- *; 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 :
+    forall p:positive,
+      IF Zpos p = two_p (log_inf p) then Zpos p = two_p (log_sup p)
+    else log_sup p = Zsucc (log_inf p).
+  Proof.
+    simple induction p; intros;
+      [ elim H; right; simpl in |- *;
+	rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+	  rewrite BinInt.Zpos_xI; unfold Zsucc in |- *; omega
+	| elim H; clear H; intro Hif;
+	  [ left; simpl in |- *;
+	    rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+	      rewrite (two_p_S (log_sup p0) (log_sup_correct1 p0));
+		rewrite <- (proj1 Hif); rewrite <- (proj2 Hif); 
+		  auto
+	    | right; simpl in |- *;
+	      rewrite (two_p_S (log_inf p0) (log_inf_correct1 p0));
+		rewrite BinInt.Zpos_xO; unfold Zsucc in |- *; 
+		  omega ]
+	| left; auto ].
+  Qed.
+
+  Theorem log_sup_correct2 :
+    forall x:positive, two_p (Zpred (log_sup x)) < Zpos x <= two_p (log_sup x).
+  Proof.
+    intro.
+    elim (log_sup_log_inf x).
+    (* x is a power of two and [log_sup = log_inf] *)
+    intros [E1 E2]; rewrite E2.
+    split; [ apply two_p_pred; apply log_sup_correct1 | apply Zle_refl ].
+    intros [E1 E2]; rewrite E2.
+    rewrite <- (Zpred_succ (log_inf x)).
+    generalize (log_inf_correct2 x); omega.
+  Qed.
+
+  Lemma log_inf_le_log_sup : forall p:positive, log_inf p <= log_sup p.
+  Proof.
+    simple induction p; simpl in |- *; intros; omega.
+  Qed.
+
+  Lemma log_sup_le_Slog_inf : forall p:positive, log_sup p <= Zsucc (log_inf p).
+  Proof.
+    simple induction p; simpl in |- *; intros; omega.
+  Qed.
+
+  (** Now it's possible to specify and build the [Log] rounded to the nearest *)
+
+  Fixpoint log_near (x:positive) : Z :=
+    match x with
+      | xH => 0
+      | xO xH => 1
+      | xI xH => 2
+      | xO y => Zsucc (log_near y)
+      | xI y => Zsucc (log_near y)
+    end.    
+
+  Theorem log_near_correct1 : forall p:positive, 0 <= log_near p.
+  Proof.
+    simple induction p; simpl in |- *; intros;
+      [ elim p0; auto with zarith
+	| elim p0; auto with zarith
+	| trivial with zarith ].
+    intros; apply Zle_le_succ.
+    generalize H0; elim p1; intros; simpl in |- *;
+      [ assumption | assumption | apply Zorder.Zle_0_pos ].
+    intros; apply Zle_le_succ.
+    generalize H0; elim p1; intros; simpl in |- *;
+      [ assumption | assumption | apply Zorder.Zle_0_pos ].
+  Qed.
+
+  Theorem log_near_correct2 :
+    forall p:positive, log_near p = log_inf p \/ log_near p = log_sup p.
+  Proof.
+    simple induction p.
+    intros p0 [Einf| Esup].
+    simpl in |- *. rewrite Einf.
+    case p0; [ left | left | right ]; reflexivity.
+    simpl in |- *; 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 in |- *.
+    repeat rewrite Einf.
+    case p0; intros; auto with zarith.
+    simpl in |- *.
+    repeat rewrite Esup.
+    case p0; intros; auto with zarith.
+    auto.
+  Qed.
 
 End Log_pos.
 
 Section divers.
 
-(** Number of significative digits. *)
-
-Definition N_digits (x:Z) :=
-  match x with
-  | Zpos p => log_inf p
-  | Zneg p => log_inf p
-  | Z0 => 0
-  end.
-
-Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x.
-simple induction x; simpl in |- *;
- [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ].
-Qed.
-
-Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n.
-simple induction n; intros;
- [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
-Qed.
-
-Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n.
-simple induction n; intros;
- [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
-Qed.
-
-(** [Is_power p] means that p is a power of two *)
-Fixpoint Is_power (p:positive) : Prop :=
-  match p with
-  | xH => True
-  | xO q => Is_power q
-  | xI q => False
-  end.
-
-Lemma Is_power_correct :
- forall p:positive, Is_power p <-> (exists y : nat, p = shift_nat y 1).
-
-split;
- [ elim p;
-    [ simpl in |- *; tauto
-    | simpl in |- *; intros; generalize (H H0); intro H1; elim H1;
-       intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity
-    | intro; exists 0%nat; reflexivity ]
- | intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ].
-Qed.
-
-Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p.
-simple induction p;
- [ intros; right; simpl in |- *; tauto
- | intros; elim H;
-    [ intros; left; simpl in |- *; exact H0
-    | intros; right; simpl in |- *; exact H0 ]
- | left; simpl in |- *; trivial ].
-Qed.
+  (** Number of significative digits. *)
+  
+  Definition N_digits (x:Z) :=
+    match x with
+      | Zpos p => log_inf p
+      | Zneg p => log_inf p
+      | Z0 => 0
+    end.
+
+  Lemma ZERO_le_N_digits : forall x:Z, 0 <= N_digits x.
+  Proof.
+    simple induction x; simpl in |- *;
+      [ apply Zle_refl | exact log_inf_correct1 | exact log_inf_correct1 ].
+  Qed.
+
+  Lemma log_inf_shift_nat : forall n:nat, log_inf (shift_nat n 1) = Z_of_nat n.
+  Proof.
+    simple induction n; intros;
+      [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
+  Qed.
+
+  Lemma log_sup_shift_nat : forall n:nat, log_sup (shift_nat n 1) = Z_of_nat n.
+  Proof.
+    simple induction n; intros;
+      [ try trivial | rewrite Znat.inj_S; rewrite <- H; reflexivity ].
+  Qed.
+
+  (** [Is_power p] means that p is a power of two *)
+  Fixpoint Is_power (p:positive) : Prop :=
+    match p with
+      | xH => True
+      | xO q => Is_power q
+      | xI q => False
+    end.
+
+  Lemma Is_power_correct :
+    forall p:positive, Is_power p <-> (exists y : nat, p = shift_nat y 1).
+  Proof.
+    split;
+      [ elim p;
+	[ simpl in |- *; tauto
+	  | simpl in |- *; intros; generalize (H H0); intro H1; elim H1;
+	    intros y0 Hy0; exists (S y0); rewrite Hy0; reflexivity
+	  | intro; exists 0%nat; reflexivity ]
+	| intros; elim H; intros; rewrite H0; elim x; intros; simpl in |- *; trivial ].
+  Qed.
+
+  Lemma Is_power_or : forall p:positive, Is_power p \/ ~ Is_power p.
+  Proof.
+    simple induction p;
+      [ intros; right; simpl in |- *; tauto
+	| intros; elim H;
+	  [ intros; left; simpl in |- *; exact H0
+	    | intros; right; simpl in |- *; exact H0 ]
+	| left; simpl in |- *; trivial ].
+  Qed.
 
 End divers.
 
diff --git a/theories/ZArith/Zmax.v b/theories/ZArith/Zmax.v
index ae3bbf41..8af9b891 100644
--- a/theories/ZArith/Zmax.v
+++ b/theories/ZArith/Zmax.v
@@ -5,104 +5,104 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zmax.v 8032 2006-02-12 21:20:48Z herbelin $ i*)
+(*i $Id: Zmax.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
-Require Import Arith.
+Require Import Arith_base.
 Require Import BinInt.
 Require Import Zcompare.
 Require Import Zorder.
 
 Open Local Scope Z_scope.
 
-(**********************************************************************)
-(** *** Maximum of two binary integer numbers *)
+(******************************************)
+(** Maximum of two binary integer numbers *)
 
 Definition Zmax m n :=
-   match m ?= n with
+  match m ?= n with
     | Eq | Gt => m
     | Lt => n
-    end.
+  end.
 
-(** Characterization of maximum on binary integer numbers *)
+(** * Characterization of maximum on binary integer numbers *)
 
 Lemma Zmax_case : forall (n m:Z) (P:Z -> Type), P n -> P m -> P (Zmax n m).
 Proof.
-intros n m P H1 H2; unfold Zmax in |- *; case (n ?= m); auto with arith.
+  intros n m P H1 H2; unfold Zmax in |- *; case (n ?= m); auto with arith.
 Qed.
 
 Lemma Zmax_case_strong : forall (n m:Z) (P:Z -> Type), 
   (m<=n -> P n) -> (n<=m -> P m) -> P (Zmax n m).
 Proof.
-intros n m P H1 H2; unfold Zmax, Zle, Zge in *.
-rewrite <- (Zcompare_antisym n m) in H1.
-destruct (n ?= m); (apply H1|| apply H2); discriminate. 
+  intros n m P H1 H2; unfold Zmax, Zle, Zge in *.
+  rewrite <- (Zcompare_antisym n m) in H1.
+  destruct (n ?= m); (apply H1|| apply H2); discriminate. 
 Qed.
 
-(** Least upper bound properties of max *)
+(** * Least upper bound properties of max *)
 
 Lemma Zle_max_l : forall n m:Z, n <= Zmax n m.
 Proof.
-intros; apply Zmax_case_strong; auto with zarith.
+  intros; apply Zmax_case_strong; auto with zarith.
 Qed.
 
 Notation Zmax1 := Zle_max_l (only parsing).
 
 Lemma Zle_max_r : forall n m:Z, m <= Zmax n m.
 Proof.
-intros; apply Zmax_case_strong; auto with zarith.
+  intros; apply Zmax_case_strong; auto with zarith.
 Qed.
 
 Notation Zmax2 := Zle_max_r (only parsing).
 
 Lemma Zmax_lub : forall n m p:Z, n <= p -> m <= p -> Zmax n m <= p.
 Proof.
-intros; apply Zmax_case; assumption.
+  intros; apply Zmax_case; assumption.
 Qed.
 
-(** Semi-lattice properties of max *)
+(** * Semi-lattice properties of max *)
 
 Lemma Zmax_idempotent : forall n:Z, Zmax n n = n.
 Proof.
-intros; apply Zmax_case; auto.
+  intros; apply Zmax_case; auto.
 Qed.
 
 Lemma Zmax_comm : forall n m:Z, Zmax n m = Zmax m n.
 Proof.
-intros; do 2 apply Zmax_case_strong; intros; 
-  apply Zle_antisym; auto with zarith.
+  intros; do 2 apply Zmax_case_strong; intros; 
+    apply Zle_antisym; auto with zarith.
 Qed.
 
 Lemma Zmax_assoc : forall n m p:Z, Zmax n (Zmax m p) = Zmax (Zmax n m) p.
 Proof.
-intros n m p; repeat apply Zmax_case_strong; intros; 
-  reflexivity || (try apply Zle_antisym); eauto with zarith.
+  intros n m p; repeat apply Zmax_case_strong; intros; 
+    reflexivity || (try apply Zle_antisym); eauto with zarith.
 Qed.
 
-(** Additional properties of max *)
+(** * Additional properties of max *)
 
 Lemma Zmax_irreducible_inf : forall n m:Z, Zmax n m = n \/ Zmax n m = m.
 Proof.
-intros; apply Zmax_case; auto.
+  intros; apply Zmax_case; auto.
 Qed.
 
 Lemma Zmax_le_prime_inf : forall n m p:Z, p <= Zmax n m -> p <= n \/ p <= m.
 Proof.
-intros n m p; apply Zmax_case; auto.
+  intros n m p; apply Zmax_case; auto.
 Qed.
 
-(** Operations preserving max *)
+(** * Operations preserving max *)
 
 Lemma Zsucc_max_distr : 
   forall n m:Z, Zsucc (Zmax n m) = Zmax (Zsucc n) (Zsucc m).
 Proof.
-intros n m; unfold Zmax in |- *; rewrite (Zcompare_succ_compat n m);
- elim_compare n m; intros E; rewrite E; auto with arith.
+  intros n m; unfold Zmax in |- *; rewrite (Zcompare_succ_compat n m);
+    elim_compare n m; intros E; rewrite E; auto with arith.
 Qed.
 
 Lemma Zplus_max_distr_r : forall n m p:Z, Zmax (n + p) (m + p) = Zmax n m + p.
 Proof.
-intros x y n; unfold Zmax in |- *.
-rewrite (Zplus_comm x n); rewrite (Zplus_comm y n);
- rewrite (Zcompare_plus_compat x y n).
-case (x ?= y); apply Zplus_comm.
+  intros x y n; unfold Zmax in |- *.
+  rewrite (Zplus_comm x n); rewrite (Zplus_comm y n);
+    rewrite (Zcompare_plus_compat x y n).
+  case (x ?= y); apply Zplus_comm.
 Qed.
diff --git a/theories/ZArith/Zmin.v b/theories/ZArith/Zmin.v
index d79ebe98..37d78a74 100644
--- a/theories/ZArith/Zmin.v
+++ b/theories/ZArith/Zmin.v
@@ -5,126 +5,126 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zmin.v 8032 2006-02-12 21:20:48Z herbelin $ i*)
+(*i $Id: Zmin.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Initial version from Pierre Crégut (CNET, Lannion, France), 1996.
     Further extensions by the Coq development team, with suggestions
     from Russell O'Connor (Radbout U., Nijmegen, The Netherlands).
  *)
 
-Require Import Arith.
+Require Import Arith_base.
 Require Import BinInt.
 Require Import Zcompare.
 Require Import Zorder.
 
 Open Local Scope Z_scope.
 
-(**********************************************************************)
-(** *** Minimum on binary integer numbers *)
+(**************************************)
+(** Minimum on binary integer numbers *)
 
 Unboxed Definition Zmin (n m:Z) :=
   match n ?= m with
-  | Eq | Lt => n
-  | Gt => m
+    | Eq | Lt => n
+    | Gt => m
   end.
 
-(** Characterization of the minimum on binary integer numbers *)
+(** * Characterization of the minimum on binary integer numbers *)
 
 Lemma Zmin_case_strong : forall (n m:Z) (P:Z -> Type), 
   (n<=m -> P n) -> (m<=n -> P m) -> P (Zmin n m).
 Proof.
-intros n m P H1 H2; unfold Zmin, Zle, Zge in *.
-rewrite <- (Zcompare_antisym n m) in H2.
-destruct (n ?= m); (apply H1|| apply H2); discriminate. 
+  intros n m P H1 H2; unfold Zmin, Zle, Zge in *.
+  rewrite <- (Zcompare_antisym n m) in H2.
+  destruct (n ?= m); (apply H1|| apply H2); discriminate. 
 Qed.
 
 Lemma Zmin_case : forall (n m:Z) (P:Z -> Type), P n -> P m -> P (Zmin n m).
 Proof.
-intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith.
+  intros n m P H1 H2; unfold Zmin in |- *; case (n ?= m); auto with arith.
 Qed.
 
-(** Greatest lower bound properties of min *)
+(** * Greatest lower bound properties of min *)
 
 Lemma Zle_min_l : forall n m:Z, Zmin n m <= n.
 Proof.
-intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
- [ apply Zle_refl
- | apply Zle_refl
- | apply Zlt_le_weak; apply Zgt_lt; exact E ].
+  intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
+    [ apply Zle_refl
+      | apply Zle_refl
+      | apply Zlt_le_weak; apply Zgt_lt; exact E ].
 Qed.
 
 Lemma Zle_min_r : forall n m:Z, Zmin n m <= m.
 Proof.
-intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
- [ unfold Zle in |- *; rewrite E; discriminate
- | unfold Zle in |- *; rewrite E; discriminate
- | apply Zle_refl ].
+  intros n m; unfold Zmin in |- *; elim_compare n m; intros E; rewrite E;
+    [ unfold Zle in |- *; rewrite E; discriminate
+      | unfold Zle in |- *; rewrite E; discriminate
+      | apply Zle_refl ].
 Qed.
 
 Lemma Zmin_glb : forall n m p:Z, p <= n -> p <= m -> p <= Zmin n m.
 Proof.
-intros; apply Zmin_case; assumption.
+  intros; apply Zmin_case; assumption.
 Qed.
 
-(** Semi-lattice properties of min *)
+(** * Semi-lattice properties of min *)
 
 Lemma Zmin_idempotent : forall n:Z, Zmin n n = n.
 Proof.
-unfold Zmin in |- *; intros; elim (n ?= n); auto.
+  unfold Zmin in |- *; intros; elim (n ?= n); auto.
 Qed.
 
 Notation Zmin_n_n := Zmin_idempotent (only parsing).
 
 Lemma Zmin_comm : forall n m:Z, Zmin n m = Zmin m n.
 Proof.
-intros n m; unfold Zmin.
-rewrite <- (Zcompare_antisym n m).
-assert (H:=Zcompare_Eq_eq n m).
-destruct (n ?= m); simpl; auto.
+  intros n m; unfold Zmin.
+  rewrite <- (Zcompare_antisym n m).
+  assert (H:=Zcompare_Eq_eq n m).
+  destruct (n ?= m); simpl; auto.
 Qed.
 
 Lemma Zmin_assoc : forall n m p:Z, Zmin n (Zmin m p) = Zmin (Zmin n m) p.
 Proof.
-intros n m p; repeat apply Zmin_case_strong; intros; 
-  reflexivity || (try apply Zle_antisym); eauto with zarith.
+  intros n m p; repeat apply Zmin_case_strong; intros; 
+    reflexivity || (try apply Zle_antisym); eauto with zarith.
 Qed.
 
-(** Additional properties of min *)
+(** * Additional properties of min *)
 
 Lemma Zmin_irreducible_inf : forall n m:Z, {Zmin n m = n} + {Zmin n m = m}.
 Proof.
-unfold Zmin in |- *; intros; elim (n ?= m); auto.
+  unfold Zmin in |- *; intros; elim (n ?= m); auto.
 Qed.
 
 Lemma Zmin_irreducible : forall n m:Z, Zmin n m = n \/ Zmin n m = m.
 Proof.
-intros n m; destruct (Zmin_irreducible_inf n m); [left|right]; trivial.
+  intros n m; destruct (Zmin_irreducible_inf n m); [left|right]; trivial.
 Qed.
 
 Notation Zmin_or := Zmin_irreducible (only parsing).
 
 Lemma Zmin_le_prime_inf : forall n m p:Z, Zmin n m <= p -> {n <= p} + {m <= p}.
 Proof.
-intros n m p; apply Zmin_case; auto.
+  intros n m p; apply Zmin_case; auto.
 Qed.
 
-(** Operations preserving min *)
+(** * Operations preserving min *)
 
 Lemma Zsucc_min_distr : 
   forall n m:Z, Zsucc (Zmin n m) = Zmin (Zsucc n) (Zsucc m).
 Proof.
-intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m);
- elim_compare n m; intros E; rewrite E; auto with arith.
+  intros n m; unfold Zmin in |- *; rewrite (Zcompare_succ_compat n m);
+    elim_compare n m; intros E; rewrite E; auto with arith.
 Qed.
 
 Notation Zmin_SS := Zsucc_min_distr (only parsing).
 
 Lemma Zplus_min_distr_r : forall n m p:Z, Zmin (n + p) (m + p) = Zmin n m + p.
 Proof.
-intros x y n; unfold Zmin in |- *.
-rewrite (Zplus_comm x n); rewrite (Zplus_comm y n);
- rewrite (Zcompare_plus_compat x y n).
-case (x ?= y); apply Zplus_comm.
+  intros x y n; unfold Zmin in |- *.
+  rewrite (Zplus_comm x n); rewrite (Zplus_comm y n);
+    rewrite (Zcompare_plus_compat x y n).
+  case (x ?= y); apply Zplus_comm.
 Qed.
 
 Notation Zmin_plus := Zplus_min_distr_r (only parsing).
diff --git a/theories/ZArith/Zminmax.v b/theories/ZArith/Zminmax.v
index ebe9318e..95668cf8 100644
--- a/theories/ZArith/Zminmax.v
+++ b/theories/ZArith/Zminmax.v
@@ -5,27 +5,27 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zminmax.v 8034 2006-02-12 22:08:04Z herbelin $ i*)
+(*i $Id: Zminmax.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import Zmin Zmax.
 Require Import BinInt Zorder.
 
 Open Local Scope Z_scope.
 
-(** *** Lattice properties of min and max on Z *)
+(** Lattice properties of min and max on Z *)
 
 (** Absorption *)
 
 Lemma Zmin_max_absorption_r_r : forall n m, Zmax n (Zmin n m) = n.
 Proof.
-intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; 
-  reflexivity || apply Zle_antisym; trivial.
+  intros; apply Zmin_case_strong; intro; apply Zmax_case_strong; intro; 
+    reflexivity || apply Zle_antisym; trivial.
 Qed.
 
 Lemma Zmax_min_absorption_r_r : forall n m, Zmin n (Zmax n m) = n.
 Proof.
-intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; 
-  reflexivity || apply Zle_antisym; trivial.
+  intros; apply Zmax_case_strong; intro; apply Zmin_case_strong; intro; 
+    reflexivity || apply Zle_antisym; trivial.
 Qed.
 
 (** Distributivity *)
@@ -33,19 +33,19 @@ Qed.
 Lemma Zmax_min_distr_r : 
   forall n m p, Zmax n (Zmin m p) = Zmin (Zmax n m) (Zmax n p).
 Proof.
-intros.
-repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; 
-  reflexivity ||
-  apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
+  intros.
+  repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; 
+    reflexivity ||
+      apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
 Qed.
 
 Lemma Zmin_max_distr_r : 
   forall n m p, Zmin n (Zmax m p) = Zmax (Zmin n m) (Zmin n p).
 Proof.
-intros.
-repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; 
-  reflexivity ||
-  apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
+  intros.
+  repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros; 
+    reflexivity ||
+      apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
 Qed.
 
 (** Modularity *)
@@ -53,30 +53,24 @@ Qed.
 Lemma Zmax_min_modular_r :
   forall n m p, Zmax n (Zmin m (Zmax n p)) = Zmin (Zmax n m) (Zmax n p).
 Proof.
-intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
-  reflexivity ||
-  apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
+  intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
+    reflexivity ||
+      apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
 Qed.
 
 Lemma Zmin_max_modular_r :
   forall n m p, Zmin n (Zmax m (Zmin n p)) = Zmax (Zmin n m) (Zmin n p).
 Proof.
-intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
-  reflexivity ||
-  apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
+  intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
+    reflexivity ||
+      apply Zle_antisym; (assumption || eapply Zle_trans; eassumption).
 Qed.
 
 (** Disassociativity *)
 
 Lemma max_min_disassoc : forall n m p, Zmin n (Zmax m p) <= Zmax (Zmin n m) p.
 Proof.
-intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
-  apply Zle_refl || (assumption || eapply Zle_trans; eassumption).
+  intros; repeat apply Zmax_case_strong; repeat apply Zmin_case_strong; intros;
+    apply Zle_refl || (assumption || eapply Zle_trans; eassumption).
 Qed.
 
-
-
-
-
-
-
diff --git a/theories/ZArith/Zmisc.v b/theories/ZArith/Zmisc.v
index 8246e324..d01cada6 100644
--- a/theories/ZArith/Zmisc.v
+++ b/theories/ZArith/Zmisc.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zmisc.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zmisc.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import BinInt.
 Require Import Zcompare.
@@ -20,78 +20,78 @@ Open Local Scope Z_scope.
 (** [n]th iteration of the function [f] *)
 Fixpoint iter_nat (n:nat) (A:Set) (f:A -> A) (x:A) {struct n} : A :=
   match n with
-  | O => x
-  | S n' => f (iter_nat n' A f x)
+    | O => x
+    | S n' => f (iter_nat n' A f x)
   end.
 
 Fixpoint iter_pos (n:positive) (A:Set) (f:A -> A) (x:A) {struct n} : A :=
   match n with
-  | xH => f x
-  | xO n' => iter_pos n' A f (iter_pos n' A f x)
-  | xI n' => f (iter_pos n' A f (iter_pos n' A f x))
+    | 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) :=
   match n with
-  | Z0 => x
-  | Zpos p => iter_pos p A f x
-  | Zneg p => x
+    | Z0 => x
+    | Zpos p => iter_pos p A f x
+    | Zneg p => x
   end.
 
 Theorem iter_nat_plus :
- forall (n m:nat) (A:Set) (f:A -> A) (x:A),
-   iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x).
+  forall (n m:nat) (A:Set) (f:A -> A) (x:A),
+    iter_nat (n + m) A f x = iter_nat n A f (iter_nat m A f x).
 Proof.    
-simple induction n;
- [ simpl in |- *; auto with arith
- | intros; simpl in |- *; apply f_equal with (f := f); apply H ].  
+  simple induction n;
+    [ simpl in |- *; auto with arith
+      | intros; simpl in |- *; apply f_equal with (f := f); apply H ].  
 Qed.
 
 Theorem iter_nat_of_P :
- forall (p:positive) (A:Set) (f:A -> A) (x:A),
-   iter_pos p A f x = iter_nat (nat_of_P p) A f x.
+  forall (p:positive) (A:Set) (f:A -> A) (x:A),
+    iter_pos p A f x = iter_nat (nat_of_P p) A f x.
 Proof.    
-intro n; induction n as [p H| p H| ];
- [ intros; simpl in |- *; rewrite (H A f x);
-    rewrite (H A f (iter_nat (nat_of_P p) A f x)); 
-    rewrite (ZL6 p); symmetry  in |- *; apply f_equal with (f := f);
-    apply iter_nat_plus
- | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x);
-    rewrite (H A f (iter_nat (nat_of_P p) A f x)); 
-    rewrite (ZL6 p); symmetry  in |- *; apply iter_nat_plus
- | simpl in |- *; auto with arith ].
+  intro n; induction n as [p H| p H| ];
+    [ intros; simpl in |- *; rewrite (H A f x);
+      rewrite (H A f (iter_nat (nat_of_P p) A f x)); 
+	rewrite (ZL6 p); symmetry  in |- *; apply f_equal with (f := f);
+	  apply iter_nat_plus
+      | intros; unfold nat_of_P in |- *; simpl in |- *; rewrite (H A f x);
+	rewrite (H A f (iter_nat (nat_of_P p) A f x)); 
+	  rewrite (ZL6 p); symmetry  in |- *; apply iter_nat_plus
+      | simpl in |- *; auto with arith ].
 Qed.
 
 Theorem iter_pos_plus :
- forall (p q:positive) (A:Set) (f:A -> A) (x:A),
-   iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x).
+  forall (p q:positive) (A:Set) (f:A -> A) (x:A),
+    iter_pos (p + q) A f x = iter_pos p A f (iter_pos q A f x).
 Proof.    
-intros n m; intros.
-rewrite (iter_nat_of_P m A f x).
-rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)).
-rewrite (iter_nat_of_P (n + m) A f x).
-rewrite (nat_of_P_plus_morphism n m).
-apply iter_nat_plus.
+  intros n m; intros.
+  rewrite (iter_nat_of_P m A f x).
+  rewrite (iter_nat_of_P n A f (iter_nat (nat_of_P m) A f x)).
+  rewrite (iter_nat_of_P (n + m) A f x).
+  rewrite (nat_of_P_plus_morphism n m).
+  apply iter_nat_plus.
 Qed.
 
 (** Preservation of invariants : if [f : A->A] preserves the invariant [Inv], 
     then the iterates of [f] also preserve it. *)
 
 Theorem iter_nat_invariant :
- forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop),
-   (forall x:A, Inv x -> Inv (f x)) ->
-   forall x:A, Inv x -> Inv (iter_nat n A f x).
+  forall (n:nat) (A:Set) (f:A -> A) (Inv:A -> Prop),
+    (forall x:A, Inv x -> Inv (f x)) ->
+    forall x:A, Inv x -> Inv (iter_nat n A f x).
 Proof.    
-simple induction n; intros;
- [ trivial with arith
- | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H;
-    trivial with arith ].
+  simple induction n; intros;
+    [ trivial with arith
+      | simpl in |- *; apply H0 with (x := iter_nat n0 A f x); apply H;
+	trivial with arith ].
 Qed.
 
 Theorem iter_pos_invariant :
- forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop),
-   (forall x:A, Inv x -> Inv (f x)) ->
-   forall x:A, Inv x -> Inv (iter_pos p A f x).
+  forall (p:positive) (A:Set) (f:A -> A) (Inv:A -> Prop),
+    (forall x:A, Inv x -> Inv (f x)) ->
+    forall x:A, Inv x -> Inv (iter_pos p A f x).
 Proof.    
-intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith.
+  intros; rewrite iter_nat_of_P; apply iter_nat_invariant; trivial with arith.
 Qed.
diff --git a/theories/ZArith/Znat.v b/theories/ZArith/Znat.v
index 3e27878c..f0a3d47b 100644
--- a/theories/ZArith/Znat.v
+++ b/theories/ZArith/Znat.v
@@ -6,11 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Znat.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Znat.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
-Require Export Arith.
+Require Export Arith_base.
 Require Import BinPos.
 Require Import BinInt.
 Require Import Zcompare.
@@ -23,116 +23,116 @@ Open Local Scope Z_scope.
 
 Definition neq (x y:nat) := x <> y.
 
-(**********************************************************************)
+(************************************************)
 (** Properties of the injection from nat into Z *)
 
 Theorem inj_S : forall n:nat, Z_of_nat (S n) = Zsucc (Z_of_nat n).
 Proof.
-intro y; induction y as [| n H];
- [ unfold Zsucc in |- *; simpl in |- *; trivial with arith
- | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *;
-    rewrite Zpos_succ_morphism; trivial with arith ].
+  intro y; induction y as [| n H];
+    [ unfold Zsucc in |- *; simpl in |- *; trivial with arith
+      | change (Zpos (Psucc (P_of_succ_nat n)) = Zsucc (Z_of_nat (S n))) in |- *;
+	rewrite Zpos_succ_morphism; trivial with arith ].
 Qed.
  
 Theorem inj_plus : forall n m:nat, Z_of_nat (n + m) = Z_of_nat n + Z_of_nat m.
 Proof.
-intro x; induction x as [| n H]; intro y; destruct y as [| m];
- [ simpl in |- *; trivial with arith
- | simpl in |- *; trivial with arith
- | simpl in |- *; rewrite <- plus_n_O; trivial with arith
- | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *;
-    rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l;
-    trivial with arith ].
+  intro x; induction x as [| n H]; intro y; destruct y as [| m];
+    [ simpl in |- *; trivial with arith
+      | simpl in |- *; trivial with arith
+      | simpl in |- *; rewrite <- plus_n_O; trivial with arith
+      | change (Z_of_nat (S (n + S m)) = Z_of_nat (S n) + Z_of_nat (S m)) in |- *;
+	rewrite inj_S; rewrite H; do 2 rewrite inj_S; rewrite Zplus_succ_l;
+	  trivial with arith ].
 Qed.
- 
+
 Theorem inj_mult : forall n m:nat, Z_of_nat (n * m) = Z_of_nat n * Z_of_nat m.
 Proof.
-intro x; induction x as [| n H];
- [ simpl in |- *; trivial with arith
- | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H;
-    rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; 
-    trivial with arith ].
+  intro x; induction x as [| n H];
+    [ simpl in |- *; trivial with arith
+      | intro y; rewrite inj_S; rewrite <- Zmult_succ_l_reverse; rewrite <- H;
+	rewrite <- inj_plus; simpl in |- *; rewrite plus_comm; 
+	  trivial with arith ].
 Qed.
 
 Theorem inj_neq : forall n m:nat, neq n m -> Zne (Z_of_nat n) (Z_of_nat m).
 Proof.
-unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2;
- case x; case y; intros;
- [ auto with arith
- | discriminate H0
- | discriminate H0
- | simpl in H0; injection H0;
-    do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; 
-    intros E; rewrite E; auto with arith ].
+  unfold neq, Zne, not in |- *; intros x y H1 H2; apply H1; generalize H2;
+    case x; case y; intros;
+      [ auto with arith
+	| discriminate H0
+	| discriminate H0
+	| simpl in H0; injection H0;
+	  do 2 rewrite <- nat_of_P_o_P_of_succ_nat_eq_succ; 
+	    intros E; rewrite E; auto with arith ].
 Qed. 
 
 Theorem inj_le : forall n m:nat, (n <= m)%nat -> Z_of_nat n <= Z_of_nat m.
 Proof.
-intros x y; intros H; elim H;
- [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x));
-    intros H1 H2; rewrite H2; [ discriminate | trivial with arith ]
- | intros m H1 H2; apply Zle_trans with (Z_of_nat m);
-    [ assumption | rewrite inj_S; apply Zle_succ ] ].
+  intros x y; intros H; elim H;
+    [ unfold Zle in |- *; elim (Zcompare_Eq_iff_eq (Z_of_nat x) (Z_of_nat x));
+      intros H1 H2; rewrite H2; [ discriminate | trivial with arith ]
+      | intros m H1 H2; apply Zle_trans with (Z_of_nat m);
+	[ assumption | rewrite inj_S; apply Zle_succ ] ].
 Qed.
 
 Theorem inj_lt : forall n m:nat, (n < m)%nat -> Z_of_nat n < Z_of_nat m.
 Proof.
-intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le;
- exact H.
+  intros x y H; apply Zgt_lt; apply Zlt_succ_gt; rewrite <- inj_S; apply inj_le;
+    exact H.
 Qed.
 
 Theorem inj_gt : forall n m:nat, (n > m)%nat -> Z_of_nat n > Z_of_nat m.
 Proof.
-intros x y H; apply Zlt_gt; apply inj_lt; exact H.
+  intros x y H; apply Zlt_gt; apply inj_lt; exact H.
 Qed.
 
 Theorem inj_ge : forall n m:nat, (n >= m)%nat -> Z_of_nat n >= Z_of_nat m.
 Proof.
-intros x y H; apply Zle_ge; apply inj_le; apply H.
+  intros x y H; apply Zle_ge; apply inj_le; apply H.
 Qed.
 
 Theorem inj_eq : forall n m:nat, n = m -> Z_of_nat n = Z_of_nat m.
 Proof.
-intros x y H; rewrite H; trivial with arith.
+  intros x y H; rewrite H; trivial with arith.
 Qed.
 
 Theorem intro_Z :
- forall n:nat,  exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0.
+  forall n:nat,  exists y : Z, Z_of_nat n = y /\ 0 <= y * 1 + 0.
 Proof.
-intros x; exists (Z_of_nat x); split;
- [ trivial with arith
- | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r;
-    unfold Zle in |- *; elim x; intros; simpl in |- *; 
-    discriminate ].
+  intros x; exists (Z_of_nat x); split;
+    [ trivial with arith
+      | rewrite Zmult_comm; rewrite Zmult_1_l; rewrite Zplus_0_r;
+	unfold Zle in |- *; elim x; intros; simpl in |- *; 
+          discriminate ].
 Qed.
 
 Theorem inj_minus1 :
- forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m.
+  forall n m:nat, (m <= n)%nat -> Z_of_nat (n - m) = Z_of_nat n - Z_of_nat m.
 Proof.
-intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *;
- rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus;
- rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; 
- trivial with arith.
+  intros x y H; apply (Zplus_reg_l (Z_of_nat y)); unfold Zminus in |- *;
+    rewrite Zplus_permute; rewrite Zplus_opp_r; rewrite <- inj_plus;
+      rewrite <- (le_plus_minus y x H); rewrite Zplus_0_r; 
+        trivial with arith.
 Qed.
  
 Theorem inj_minus2 : forall n m:nat, (m > n)%nat -> Z_of_nat (n - m) = 0.
 Proof.
-intros x y H; rewrite not_le_minus_0;
- [ trivial with arith | apply gt_not_le; assumption ].
+  intros x y H; rewrite not_le_minus_0;
+    [ trivial with arith | apply gt_not_le; assumption ].
 Qed.
 
 Theorem Zpos_eq_Z_of_nat_o_nat_of_P :
- forall p:positive, Zpos p = Z_of_nat (nat_of_P p).
+  forall p:positive, Zpos p = Z_of_nat (nat_of_P p).
 Proof.
-intros x; elim x; simpl in |- *; auto.
-intros p H; rewrite ZL6.
-apply f_equal with (f := Zpos).
-apply nat_of_P_inj.
-rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *;
- simpl in |- *.
-rewrite ZL6; auto.
-intros p H; unfold nat_of_P in |- *; simpl in |- *.
-rewrite ZL6; simpl in |- *.
-rewrite inj_plus; repeat rewrite <- H.
-rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity.
+  intros x; elim x; simpl in |- *; auto.
+  intros p H; rewrite ZL6.
+  apply f_equal with (f := Zpos).
+  apply nat_of_P_inj.
+  rewrite nat_of_P_o_P_of_succ_nat_eq_succ; unfold nat_of_P in |- *;
+    simpl in |- *.
+  rewrite ZL6; auto.
+  intros p H; unfold nat_of_P in |- *; simpl in |- *.
+  rewrite ZL6; simpl in |- *.
+  rewrite inj_plus; repeat rewrite <- H.
+  rewrite Zpos_xO; simpl in |- *; rewrite Pplus_diag; reflexivity.
 Qed.
diff --git a/theories/ZArith/Znumtheory.v b/theories/ZArith/Znumtheory.v
index e722b679..d89ec052 100644
--- a/theories/ZArith/Znumtheory.v
+++ b/theories/ZArith/Znumtheory.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Znumtheory.v 8990 2006-06-26 13:57:44Z notin $ i*)
+(*i $Id: Znumtheory.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import ZArith_base.
 Require Import ZArithRing.
@@ -38,91 +38,91 @@ Notation "( a | b )" := (Zdivide a b) (at level 0) : Z_scope.
 
 Lemma Zdivide_refl : forall a:Z, (a | a).
 Proof.
-intros; apply Zdivide_intro with 1; ring.
+  intros; apply Zdivide_intro with 1; ring.
 Qed.
 
 Lemma Zone_divide : forall a:Z, (1 | a).
 Proof.
-intros; apply Zdivide_intro with a; ring.
+  intros; apply Zdivide_intro with a; ring.
 Qed.
 
 Lemma Zdivide_0 : forall a:Z, (a | 0).
 Proof.
-intros; apply Zdivide_intro with 0; ring.
+  intros; apply Zdivide_intro with 0; ring.
 Qed.
 
 Hint Resolve Zdivide_refl Zone_divide Zdivide_0: zarith.
 
 Lemma Zmult_divide_compat_l : forall a b c:Z, (a | b) -> (c * a | c * b).
 Proof.
-simple induction 1; intros; apply Zdivide_intro with q.
-rewrite H0; ring.
+  simple induction 1; intros; apply Zdivide_intro with q.
+  rewrite H0; ring.
 Qed.
 
 Lemma Zmult_divide_compat_r : forall a b c:Z, (a | b) -> (a * c | b * c).
 Proof.
-intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c).
-apply Zmult_divide_compat_l; trivial.
+  intros a b c; rewrite (Zmult_comm a c); rewrite (Zmult_comm b c).
+  apply Zmult_divide_compat_l; trivial.
 Qed.
 
 Hint Resolve Zmult_divide_compat_l Zmult_divide_compat_r: zarith.
 
 Lemma Zdivide_plus_r : forall a b c:Z, (a | b) -> (a | c) -> (a | b + c).
 Proof.
-simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
-apply Zdivide_intro with (q + q').
-rewrite Hq; rewrite Hq'; ring.
+  simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
+  apply Zdivide_intro with (q + q').
+  rewrite Hq; rewrite Hq'; ring.
 Qed.
 
 Lemma Zdivide_opp_r : forall a b:Z, (a | b) -> (a | - b).
 Proof.
-simple induction 1; intros; apply Zdivide_intro with (- q).
-rewrite H0; ring.
+  simple induction 1; intros; apply Zdivide_intro with (- q).
+  rewrite H0; ring.
 Qed.
 
 Lemma Zdivide_opp_r_rev : forall a b:Z, (a | - b) -> (a | b).
 Proof.
-intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring.
+  intros; replace b with (- - b). apply Zdivide_opp_r; trivial. ring.
 Qed.
 
 Lemma Zdivide_opp_l : forall a b:Z, (a | b) -> (- a | b).
 Proof.
-simple induction 1; intros; apply Zdivide_intro with (- q).
-rewrite H0; ring.
+  simple induction 1; intros; apply Zdivide_intro with (- q).
+  rewrite H0; ring.
 Qed.
 
 Lemma Zdivide_opp_l_rev : forall a b:Z, (- a | b) -> (a | b).
 Proof.
-intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring.
+  intros; replace a with (- - a). apply Zdivide_opp_l; trivial. ring.
 Qed.
 
 Lemma Zdivide_minus_l : forall a b c:Z, (a | b) -> (a | c) -> (a | b - c).
 Proof.
-simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
-apply Zdivide_intro with (q - q').
-rewrite Hq; rewrite Hq'; ring.
+  simple induction 1; intros q Hq; simple induction 1; intros q' Hq'.
+  apply Zdivide_intro with (q - q').
+  rewrite Hq; rewrite Hq'; ring.
 Qed.
 
 Lemma Zdivide_mult_l : forall a b c:Z, (a | b) -> (a | b * c).
 Proof.
-simple induction 1; intros q Hq; apply Zdivide_intro with (q * c).
-rewrite Hq; ring.
+  simple induction 1; intros q Hq; apply Zdivide_intro with (q * c).
+  rewrite Hq; ring.
 Qed.
 
 Lemma Zdivide_mult_r : forall a b c:Z, (a | c) -> (a | b * c).
 Proof.
-simple induction 1; intros q Hq; apply Zdivide_intro with (q * b).
-rewrite Hq; ring.
+  simple induction 1; intros q Hq; apply Zdivide_intro with (q * b).
+  rewrite Hq; ring.
 Qed.
 
 Lemma Zdivide_factor_r : forall a b:Z, (a | a * b).
 Proof.
-intros; apply Zdivide_intro with b; ring.
+  intros; apply Zdivide_intro with b; ring.
 Qed.
 
 Lemma Zdivide_factor_l : forall a b:Z, (a | b * a).
 Proof.
-intros; apply Zdivide_intro with b; ring.
+  intros; apply Zdivide_intro with b; ring.
 Qed.
 
 Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
@@ -133,7 +133,7 @@ Hint Resolve Zdivide_plus_r Zdivide_opp_r Zdivide_opp_r_rev Zdivide_opp_l
 
 Lemma Zmult_one : forall x y:Z, x >= 0 -> x * y = 1 -> x = 1.
 Proof.
-intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg].
+  intros x y H H0; destruct (Zmult_1_inversion_l _ _ H0) as [Hpos| Hneg].
   assumption.
   rewrite Hneg in H; simpl in H.
   contradiction (Zle_not_lt 0 (-1)).
@@ -145,11 +145,11 @@ Qed.
 
 Lemma Zdivide_1 : forall x:Z, (x | 1) -> x = 1 \/ x = -1.
 Proof.
-simple induction 1; intros.
-elim (Z_lt_ge_dec 0 x); [ left | right ].
-apply Zmult_one with q; auto with zarith; rewrite H0; ring.
-assert (- x = 1); auto with zarith.
-apply Zmult_one with (- q); auto with zarith; rewrite H0; ring.
+  simple induction 1; intros.
+  elim (Z_lt_ge_dec 0 x); [ left | right ].
+  apply Zmult_one with q; auto with zarith; rewrite H0; ring.
+  assert (- x = 1); auto with zarith.
+  apply Zmult_one with (- q); auto with zarith; rewrite H0; ring.
 Qed.
 
 (** If [a] divides [b] and [b] divides [a] then [a] is [b] or [-b]. *)
@@ -164,7 +164,7 @@ left; rewrite H0; rewrite e; ring.
 assert (Hqq0 : q0 * q = 1).
 apply Zmult_reg_l with a.
 assumption.
-ring.
+ring_simplify.
 pattern a at 2 in |- *; rewrite H2; ring.
 assert (q | 1).
 rewrite <- Hqq0; auto with zarith.
@@ -177,21 +177,21 @@ Qed.
 
 Lemma Zdivide_bounds : forall a b:Z, (a | b) -> b <> 0 -> Zabs a <= Zabs b.
 Proof.
-simple induction 1; intros.
-assert (Zabs b = Zabs q * Zabs a).
- subst; apply Zabs_Zmult.
-rewrite H2.
-assert (H3 := Zabs_pos q).
-assert (H4 := Zabs_pos a).
-assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith.
-apply Zmult_ge_compat; auto with zarith.
-elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ].
-assert (Zabs q = 0).
- omega.
-assert (q = 0).
- rewrite <- (Zabs_Zsgn q).
-rewrite H5; auto with zarith.
-subst q; omega.
+  simple induction 1; intros.
+  assert (Zabs b = Zabs q * Zabs a).
+  subst; apply Zabs_Zmult.
+  rewrite H2.
+  assert (H3 := Zabs_pos q).
+  assert (H4 := Zabs_pos a).
+  assert (Zabs q * Zabs a >= 1 * Zabs a); auto with zarith.
+  apply Zmult_ge_compat; auto with zarith.
+  elim (Z_lt_ge_dec (Zabs q) 1); [ intros | auto with zarith ].
+  assert (Zabs q = 0).
+  omega.
+  assert (q = 0).
+  rewrite <- (Zabs_Zsgn q).
+  rewrite H5; auto with zarith.
+  subst q; omega.
 Qed.
 
 (** * Greatest common divisor (gcd). *)
@@ -201,48 +201,48 @@ Qed.
      (We show later that the [gcd] is actually unique if we discard its sign.) *)
 
 Inductive Zis_gcd (a b d:Z) : Prop :=
-    Zis_gcd_intro :
-      (d | a) ->
-      (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d.
+  Zis_gcd_intro :
+  (d | a) ->
+  (d | b) -> (forall x:Z, (x | a) -> (x | b) -> (x | d)) -> Zis_gcd a b d.
 
 (** Trivial properties of [gcd] *)
 
 Lemma Zis_gcd_sym : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a d.
 Proof.
-simple induction 1; constructor; intuition.
+  simple induction 1; constructor; intuition.
 Qed.
 
 Lemma Zis_gcd_0 : forall a:Z, Zis_gcd a 0 a.
 Proof.
-constructor; auto with zarith.
+  constructor; auto with zarith.
 Qed.
 
 Lemma Zis_gcd_1 : forall a, Zis_gcd a 1 1.
 Proof.
-constructor; auto with zarith.
+  constructor; auto with zarith.
 Qed.
 
 Lemma Zis_gcd_refl : forall a, Zis_gcd a a a.
 Proof.
-constructor; auto with zarith.
+  constructor; auto with zarith.
 Qed.
 
 Lemma Zis_gcd_minus : forall a b d:Z, Zis_gcd a (- b) d -> Zis_gcd b a d.
 Proof.
-simple induction 1; constructor; intuition.
+  simple induction 1; constructor; intuition.
 Qed.
 
 Lemma Zis_gcd_opp : forall a b d:Z, Zis_gcd a b d -> Zis_gcd b a (- d).
 Proof.
-simple induction 1; constructor; intuition.
+  simple induction 1; constructor; intuition.
 Qed.
 
 Lemma Zis_gcd_0_abs : forall a:Z, Zis_gcd 0 a (Zabs a).
 Proof.
-intros a.
-apply Zabs_ind.
-intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto.
-intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto.
+  intros a.
+  apply Zabs_ind.
+  intros; apply Zis_gcd_sym; apply Zis_gcd_0; auto.
+  intros; apply Zis_gcd_opp; apply Zis_gcd_0; auto.
 Qed.
 
 Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith.
@@ -253,18 +253,18 @@ Hint Resolve Zis_gcd_sym Zis_gcd_0 Zis_gcd_minus Zis_gcd_opp: zarith.
     the following property. *)
 
 Lemma Zis_gcd_for_euclid :
- forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d.
+  forall a b d q:Z, Zis_gcd b (a - q * b) d -> Zis_gcd a b d.
 Proof.
-simple induction 1; constructor; intuition.
-replace a with (a - q * b + q * b). auto with zarith. ring.
+  simple induction 1; constructor; intuition.
+  replace a with (a - q * b + q * b). auto with zarith. ring.
 Qed.
 
 Lemma Zis_gcd_for_euclid2 :
- forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d.
+  forall b d q r:Z, Zis_gcd r b d -> Zis_gcd b (b * q + r) d.
 Proof.
-simple induction 1; constructor; intuition.
-apply H2; auto.
-replace r with (b * q + r - b * q). auto with zarith. ring.
+  simple induction 1; constructor; intuition.
+  apply H2; auto.
+  replace r with (b * q + r - b * q). auto with zarith. ring.
 Qed.
 
 (** We implement the extended version of Euclid's algorithm,
@@ -274,117 +274,117 @@ Qed.
 
 Section extended_euclid_algorithm.
 
-Variables a b : Z.
+  Variables 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)]. *)
+  (** 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 :=
+  Inductive Euclid : Set :=
     Euclid_intro :
-      forall u v d:Z, u * a + v * b = d -> Zis_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 :
- forall v3:Z,
-   0 <= v3 ->
-   forall u1 u2 u3 v1 v2:Z,
-     u1 * a + u2 * b = u3 ->
-     v1 * a + v2 * b = v3 ->
-     (forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
-Proof.
-intros v3 Hv3; generalize Hv3; pattern v3 in |- *.
-apply Zlt_0_rec.
-clear v3 Hv3; intros.
-elim (Z_zerop x); intro.
-apply Euclid_intro with (u := u1) (v := u2) (d := u3).
-assumption.
-apply H3.
-rewrite a0; auto with zarith.
-set (q := u3 / x) in *.
-assert (Hq : 0 <= u3 - q * x < x).
-replace (u3 - q * x) with (u3 mod x).
-apply Z_mod_lt; omega.
-assert (xpos : x > 0). omega.
-generalize (Z_div_mod_eq u3 x xpos). 
-unfold q in |- *. 
-intro eq; pattern u3 at 2 in |- *; rewrite eq; ring.
-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 H1; rewrite H2; trivial.
-ring.
-intros; apply H3.
-apply Zis_gcd_for_euclid with q; assumption.
-assumption.
-Qed.
-
-(** 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.
-Qed.
+    forall u v d:Z, u * a + v * b = d -> Zis_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 :
+    forall v3:Z,
+      0 <= v3 ->
+      forall u1 u2 u3 v1 v2:Z,
+	u1 * a + u2 * b = u3 ->
+	v1 * a + v2 * b = v3 ->
+	(forall d:Z, Zis_gcd u3 v3 d -> Zis_gcd a b d) -> Euclid.
+  Proof.
+    intros v3 Hv3; generalize Hv3; pattern v3 in |- *.
+    apply Zlt_0_rec.
+    clear v3 Hv3; intros.
+    elim (Z_zerop x); intro.
+    apply Euclid_intro with (u := u1) (v := u2) (d := u3).
+    assumption.
+    apply H3.
+    rewrite a0; auto with zarith.
+    set (q := u3 / x) in *.
+    assert (Hq : 0 <= u3 - q * x < x).
+    replace (u3 - q * x) with (u3 mod x).
+    apply Z_mod_lt; omega.
+    assert (xpos : x > 0). omega.
+    generalize (Z_div_mod_eq u3 x xpos). 
+    unfold q in |- *. 
+    intro eq; pattern u3 at 2 in |- *; rewrite eq; ring.
+    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 H1; rewrite H2; trivial.
+    ring.
+    intros; apply H3.
+    apply Zis_gcd_for_euclid with q; assumption.
+    assumption.
+  Qed.
+
+  (** 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.
+  Qed.
 
 End extended_euclid_algorithm.
 
 Theorem Zis_gcd_uniqueness_apart_sign :
- forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'.
+  forall a b d d':Z, Zis_gcd a b d -> Zis_gcd a b d' -> d = d' \/ d = - d'.
 Proof.
-simple induction 1.
-intros H1 H2 H3; simple induction 1; intros.
-generalize (H3 d' H4 H5); intro Hd'd.
-generalize (H6 d H1 H2); intro Hdd'.
-exact (Zdivide_antisym d d' Hdd' Hd'd).
+  simple induction 1.
+  intros H1 H2 H3; simple induction 1; intros.
+  generalize (H3 d' H4 H5); intro Hd'd.
+  generalize (H6 d H1 H2); intro Hdd'.
+  exact (Zdivide_antisym d d' Hdd' Hd'd).
 Qed.
 
 (** * Bezout's coefficients *)
 
 Inductive Bezout (a b d:Z) : Prop :=
-    Bezout_intro : forall u v:Z, u * a + v * b = d -> Bezout a b d.
+  Bezout_intro : forall 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 Zis_gcd_bezout : forall a b d:Z, Zis_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 (Zis_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.
+  intros a b d Hgcd.
+  elim (euclid a b); intros u v d0 e g.
+  generalize (Zis_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.
 Qed.
 
 (** gcd of [ca] and [cb] is [c gcd(a,b)]. *)
 
 Lemma Zis_gcd_mult :
- forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d).
-Proof.
-intros a b c d; simple induction 1; constructor; intuition.
-elim (Zis_gcd_bezout a b d H); intros.
-elim H3; intros.
-elim H4; intros.
-apply Zdivide_intro with (u * q + v * q0).
-rewrite <- H5.
-replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)).
-rewrite H6; rewrite H7; ring.
-ring.
+  forall a b c d:Z, Zis_gcd a b d -> Zis_gcd (c * a) (c * b) (c * d).
+Proof.
+  intros a b c d; simple induction 1; constructor; intuition.
+  elim (Zis_gcd_bezout a b d H); intros.
+  elim H3; intros.
+  elim H4; intros.
+  apply Zdivide_intro with (u * q + v * q0).
+  rewrite <- H5.
+  replace (c * (u * a + v * b)) with (u * (c * a) + v * (c * b)).
+  rewrite H6; rewrite H7; ring.
+  ring.
 Qed.
   
 
@@ -397,13 +397,13 @@ Definition rel_prime (a b:Z) : Prop := Zis_gcd a b 1.
 
 Lemma rel_prime_bezout : forall a b:Z, rel_prime a b -> Bezout a b 1.
 Proof.
-intros a b; exact (Zis_gcd_bezout a b 1).
+  intros a b; exact (Zis_gcd_bezout a b 1).
 Qed.
 
 Lemma bezout_rel_prime : forall a b:Z, Bezout a b 1 -> rel_prime a b.
 Proof.
-simple induction 1; constructor; auto with zarith.
-intros. rewrite <- H0; auto with zarith.
+  simple induction 1; constructor; auto with zarith.
+  intros. rewrite <- H0; auto with zarith.
 Qed.
 
 (** Gauss's theorem: if [a] divides [bc] and if [a] and [b] are
@@ -411,134 +411,134 @@ Qed.
 
 Theorem Gauss : forall 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 ].
+  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 ].
 Qed.
 
 (** If [a] is relatively prime to [b] and [c], then it is to [bc] *)
 
 Lemma rel_prime_mult :
- forall a b c:Z, rel_prime a b -> rel_prime a c -> rel_prime a (b * c).
+  forall 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.
+  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.
 Qed.
 
 Lemma rel_prime_cross_prod :
- forall 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_comm in H3.
-apply Zmult_reg_l with d; auto with zarith.
-intros; omega.
-apply Gauss with a.
-rewrite H3.
-auto with zarith.
-red in |- *; auto with zarith.
-apply Gauss with c.
-rewrite Zmult_comm.
-rewrite <- H3.
-auto with zarith.
-red in |- *; auto with zarith.
+  forall 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_comm in H3.
+  apply Zmult_reg_l with d; auto with zarith.
+  intros; omega.
+  apply Gauss with a.
+  rewrite H3.
+  auto with zarith.
+  red in |- *; auto with zarith.
+  apply Gauss with c.
+  rewrite Zmult_comm.
+  rewrite <- H3.
+  auto with zarith.
+  red in |- *; auto with zarith.
 Qed.
 
 (** After factorization by a gcd, the original numbers are relatively prime. *)
 
 Lemma Zis_gcd_rel_prime :
- forall a b g:Z,
-   b > 0 -> g >= 0 -> Zis_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 in |- *.
-destruct H1.
-destruct H1 as (a',H1).
-destruct H3 as (b',H3).
-replace (a/g) with a'; 
- [|rewrite H1; rewrite Z_div_mult; auto with zarith].
-replace (b/g) with b'; 
- [|rewrite H3; rewrite Z_div_mult; auto with zarith].
-constructor.
-exists a'; auto with zarith.
-exists b'; auto with zarith.
-intros x (xa,H5) (xb,H6).
-destruct (H4 (x*g)).
-exists xa; rewrite Zmult_assoc; rewrite <- H5; auto.
-exists xb; rewrite Zmult_assoc; rewrite <- H6; auto.
-replace g with (1*g) in H7; auto with zarith.
-do 2 rewrite Zmult_assoc in H7.
-generalize (Zmult_reg_r _ _ _ H2 H7); clear H7; intros.
-rewrite Zmult_1_r in H7.
-exists q; auto with zarith.
+  forall a b g:Z,
+    b > 0 -> g >= 0 -> Zis_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 in |- *.
+  destruct H1.
+  destruct H1 as (a',H1).
+  destruct H3 as (b',H3).
+  replace (a/g) with a'; 
+    [|rewrite H1; rewrite Z_div_mult; auto with zarith].
+  replace (b/g) with b'; 
+    [|rewrite H3; rewrite Z_div_mult; auto with zarith].
+  constructor.
+  exists a'; auto with zarith.
+  exists b'; auto with zarith.
+  intros x (xa,H5) (xb,H6).
+  destruct (H4 (x*g)).
+  exists xa; rewrite Zmult_assoc; rewrite <- H5; auto.
+  exists xb; rewrite Zmult_assoc; rewrite <- H6; auto.
+  replace g with (1*g) in H7; auto with zarith.
+  do 2 rewrite Zmult_assoc in H7.
+  generalize (Zmult_reg_r _ _ _ H2 H7); clear H7; intros.
+  rewrite Zmult_1_r in H7.
+  exists q; auto with zarith.
 Qed.
 
 (** * Primality *)
 
 Inductive prime (p:Z) : Prop :=
-    prime_intro :
-      1 < p -> (forall n:Z, 1 <= n < p -> rel_prime n p) -> prime p.
+  prime_intro :
+    1 < p -> (forall 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 :
- forall p:Z,
-   prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p.
-Proof.
-simple induction 1; intros.
-assert
- (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p).
-assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ].
-generalize H3. 
-pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *;
- apply Zabs_ind; intros; omega.
-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.
+  forall p:Z,
+    prime p -> forall a:Z, (a | p) -> a = -1 \/ a = 1 \/ a = p \/ a = - p.
+Proof.
+  simple induction 1; intros.
+  assert
+    (a = - p \/ - p < a < -1 \/ a = -1 \/ a = 0 \/ a = 1 \/ 1 < a < p \/ a = p).
+  assert (Zabs a <= Zabs p). apply Zdivide_bounds; [ assumption | omega ].
+  generalize H3. 
+  pattern (Zabs a) in |- *; apply Zabs_ind; pattern (Zabs p) in |- *;
+    apply Zabs_ind; intros; omega.
+  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.
 Qed.
 
 (** A prime number is relatively prime with any number it does not divide *)
 
 Lemma prime_rel_prime :
- forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a.
+  forall p:Z, prime p -> forall a:Z, ~ (p | a) -> rel_prime p a.
 Proof.
-simple 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.
+  simple 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.
 Qed.
 
 Hint Resolve prime_rel_prime: zarith.
@@ -546,46 +546,48 @@ Hint Resolve prime_rel_prime: zarith.
 (** [Zdivide] can be expressed using [Zmod]. *)
 
 Lemma Zmod_divide : forall a b:Z, b > 0 -> a mod b = 0 -> (b | a).
-intros a b H H0.
-apply Zdivide_intro with (a / b).
-pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H).
-rewrite H0; ring.
+Proof.
+  intros a b H H0.
+  apply Zdivide_intro with (a / b).
+  pattern a at 1 in |- *; rewrite (Z_div_mod_eq a b H).
+  rewrite H0; ring.
 Qed.
 
 Lemma Zdivide_mod : forall a b:Z, b > 0 -> (b | a) -> a mod b = 0.
-intros a b; simple destruct 2; intros; subst.
-change (q * b) with (0 + q * b) in |- *.
-rewrite Z_mod_plus; auto.
+Proof.
+  intros a b; simple destruct 2; intros; subst.
+  change (q * b) with (0 + q * b) in |- *.
+  rewrite Z_mod_plus; auto.
 Qed.
 
 (** [Zdivide] is hence decidable *)
 
 Lemma Zdivide_dec : forall a b:Z, {(a | b)} + {~ (a | b)}.
 Proof.
-intros a b; elim (Ztrichotomy_inf a 0).
-(* a<0 *)
-intros H; elim H; intros. 
-case (Z_eq_dec (b mod - a) 0).
-left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith.
-intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
-(* a=0 *)
-case (Z_eq_dec b 0); intro.
-left; subst; auto with zarith.
-right; subst; intro H0; inversion H0; omega.
-(* a>0 *)
-intro H; case (Z_eq_dec (b mod a) 0).
-left; apply Zmod_divide; auto with zarith.
-intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
+  intros a b; elim (Ztrichotomy_inf a 0).
+  (* a<0 *)
+  intros H; elim H; intros. 
+  case (Z_eq_dec (b mod - a) 0).
+  left; apply Zdivide_opp_l_rev; apply Zmod_divide; auto with zarith.
+  intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
+  (* a=0 *)
+  case (Z_eq_dec b 0); intro.
+  left; subst; auto with zarith.
+  right; subst; intro H0; inversion H0; omega.
+  (* a>0 *)
+  intro H; case (Z_eq_dec (b mod a) 0).
+  left; apply Zmod_divide; auto with zarith.
+  intro H1; right; intro; elim H1; apply Zdivide_mod; auto with zarith.
 Qed.
 
 (** If a prime [p] divides [ab] then it divides either [a] or [b] *)
 
 Lemma prime_mult :
- forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b).
+  forall p:Z, prime p -> forall a b:Z, (p | a * b) -> (p | a) \/ (p | b).
 Proof.
-intro p; simple induction 1; intros.
-case (Zdivide_dec p a); intuition.
-right; apply Gauss with a; auto with zarith.
+  intro p; simple induction 1; intros.
+  case (Zdivide_dec p a); intuition.
+  right; apply Gauss with a; auto with zarith.
 Qed.
 
 
@@ -606,53 +608,53 @@ Qed.
 Open Scope positive_scope.
 
 Fixpoint Pgcdn (n: nat) (a b : positive) { struct n } : positive := 
- match n with 
-  | O => 1
-  | S n => 
-     match a,b with 
-       | xH, _ => 1 
-       | _, xH => 1
-       | xO a, xO b => xO (Pgcdn n a b)
-       | a, xO b => Pgcdn n a b
-       | xO a, b => Pgcdn n a b
-       | xI a', xI b' => match Pcompare a' b' Eq with 
-           | Eq => a
-           | Lt => Pgcdn  n (b'-a') a
-           | Gt => Pgcdn n (a'-b') b
-         end
-     end
+  match n with 
+    | O => 1
+    | S n => 
+      match a,b with 
+	| xH, _ => 1 
+	| _, xH => 1
+	| xO a, xO b => xO (Pgcdn n a b)
+	| a, xO b => Pgcdn n a b
+	| xO a, b => Pgcdn n a b
+	| xI a', xI b' => match Pcompare a' b' Eq with 
+			    | Eq => a
+			    | Lt => Pgcdn  n (b'-a') a
+			    | Gt => Pgcdn n (a'-b') b
+			  end
+      end
   end.
 
 Fixpoint Pggcdn (n: nat) (a b : positive) { struct n } : (positive*(positive*positive)) := 
- match n with 
-  | O => (1,(a,b))
-  | S n => 
-     match a,b with 
-       | xH, b => (1,(1,b)) 
-       | a, xH => (1,(a,1))
-       | xO a, xO b => 
-             let (g,p) := Pggcdn n a b in 
-             (xO g,p)
-       | a, xO b => 
-             let (g,p) := Pggcdn n a b in 
-             let (aa,bb) := p in 
-             (g,(aa, xO bb))
-       | xO a, b => 
-             let (g,p) := Pggcdn n a b in 
-             let (aa,bb) := p in 
-             (g,(xO aa, bb))
-       | xI a', xI b' => match Pcompare a' b' Eq with 
-           | Eq => (a,(1,1))
-           | Lt => 
-                let (g,p) := Pggcdn n (b'-a') a in 
-                let (ba,aa) := p in 
-                (g,(aa, aa + xO ba))
-           | Gt => 
-                let (g,p) := Pggcdn n (a'-b') b in 
-                let (ab,bb) := p in 
-                (g,(bb+xO ab, bb))
-         end
-     end
+  match n with 
+    | O => (1,(a,b))
+    | S n => 
+      match a,b with 
+	| xH, b => (1,(1,b)) 
+	| a, xH => (1,(a,1))
+	| xO a, xO b => 
+          let (g,p) := Pggcdn n a b in 
+            (xO g,p)
+	| a, xO b => 
+          let (g,p) := Pggcdn n a b in 
+            let (aa,bb) := p in 
+              (g,(aa, xO bb))
+	| xO a, b => 
+          let (g,p) := Pggcdn n a b in 
+            let (aa,bb) := p in 
+              (g,(xO aa, bb))
+	| xI a', xI b' => match Pcompare a' b' Eq with 
+			    | Eq => (a,(1,1))
+			    | Lt => 
+			      let (g,p) := Pggcdn n (b'-a') a in 
+				let (ba,aa) := p in 
+				  (g,(aa, aa + xO ba))
+			    | Gt => 
+			      let (g,p) := Pggcdn n (a'-b') b in 
+				let (ab,bb) := p in 
+				  (g,(bb+xO ab, bb))
+			  end
+      end
   end.
 
 Definition Pgcd (a b: positive) := Pgcdn (Psize a + Psize b)%nat a b.
@@ -661,269 +663,269 @@ Definition Pggcd (a b: positive) := Pggcdn (Psize a + Psize b)%nat a b.
 Open Scope Z_scope.
 
 Definition Zgcd (a b : Z) : Z := match a,b with 
-  | Z0, _ => Zabs b 
-  | _, Z0 => Zabs a
-  | Zpos a, Zpos b => Zpos (Pgcd a b)
-  | Zpos a, Zneg b => Zpos (Pgcd a b)
-  | Zneg a, Zpos b => Zpos (Pgcd a b)
-  | Zneg a, Zneg b => Zpos (Pgcd a b)
-end.
+				   | Z0, _ => Zabs b 
+				   | _, Z0 => Zabs a
+				   | Zpos a, Zpos b => Zpos (Pgcd a b)
+				   | Zpos a, Zneg b => Zpos (Pgcd a b)
+				   | Zneg a, Zpos b => Zpos (Pgcd a b)
+				   | Zneg a, Zneg b => Zpos (Pgcd a b)
+				 end.
 
 Definition Zggcd (a b : Z) : Z*(Z*Z) := match a,b with 
-  | Z0, _ => (Zabs b,(0, Zsgn b)) 
-  | _, Z0 => (Zabs a,(Zsgn a, 0))
-  | Zpos a, Zpos b => 
-     let (g,p) := Pggcd a b in 
-     let (aa,bb) := p in 
-     (Zpos g, (Zpos aa, Zpos bb))
-  | Zpos a, Zneg b => 
-     let (g,p) := Pggcd a b in 
-     let (aa,bb) := p in 
-     (Zpos g, (Zpos aa, Zneg bb))
-  | Zneg a, Zpos b => 
-     let (g,p) := Pggcd a b in 
-     let (aa,bb) := p in 
-     (Zpos g, (Zneg aa, Zpos bb))
-  | Zneg a, Zneg b =>
-     let (g,p) := Pggcd a b in 
-     let (aa,bb) := p in 
-     (Zpos g, (Zneg aa, Zneg bb))
-end.
+					  | Z0, _ => (Zabs b,(0, Zsgn b)) 
+					  | _, Z0 => (Zabs a,(Zsgn a, 0))
+					  | Zpos a, Zpos b => 
+					    let (g,p) := Pggcd a b in 
+					      let (aa,bb) := p in 
+						(Zpos g, (Zpos aa, Zpos bb))
+					  | Zpos a, Zneg b => 
+					    let (g,p) := Pggcd a b in 
+					      let (aa,bb) := p in 
+						(Zpos g, (Zpos aa, Zneg bb))
+					  | Zneg a, Zpos b => 
+					    let (g,p) := Pggcd a b in 
+					      let (aa,bb) := p in 
+						(Zpos g, (Zneg aa, Zpos bb))
+					  | Zneg a, Zneg b =>
+					    let (g,p) := Pggcd a b in 
+					      let (aa,bb) := p in 
+						(Zpos g, (Zneg aa, Zneg bb))
+					end.
 
 Lemma Zgcd_is_pos : forall a b, 0 <= Zgcd a b.
 Proof.
-unfold Zgcd; destruct a; destruct b; auto with zarith.
+  unfold Zgcd; destruct a; destruct b; auto with zarith.
 Qed.
 
 Lemma Psize_monotone : forall p q, Pcompare p q Eq = Lt -> (Psize p <= Psize q)%nat.
 Proof.
-induction p; destruct q; simpl; auto with arith; intros; try discriminate.
-intros; generalize (Pcompare_Gt_Lt _ _ H); auto with arith.
-intros; destruct (Pcompare_Lt_Lt _ _ H); auto with arith; subst; auto.
+  induction p; destruct q; simpl; auto with arith; intros; try discriminate.
+  intros; generalize (Pcompare_Gt_Lt _ _ H); auto with arith.
+  intros; destruct (Pcompare_Lt_Lt _ _ H); auto with arith; subst; auto.
 Qed.
 
 Lemma Pminus_Zminus : forall a b, Pcompare a b Eq = Lt -> 
- Zpos (b-a) = Zpos b - Zpos a.
+  Zpos (b-a) = Zpos b - Zpos a.
 Proof.
-intros.
-repeat rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
-rewrite nat_of_P_minus_morphism.
-apply inj_minus1.
-apply lt_le_weak.
-apply nat_of_P_lt_Lt_compare_morphism; auto.
-rewrite ZC4; rewrite H; auto.
+  intros.
+  repeat rewrite Zpos_eq_Z_of_nat_o_nat_of_P.
+  rewrite nat_of_P_minus_morphism.
+  apply inj_minus1.
+  apply lt_le_weak.
+  apply nat_of_P_lt_Lt_compare_morphism; auto.
+  rewrite ZC4; rewrite H; auto.
 Qed.
 
 Lemma Zis_gcd_even_odd : forall a b g, Zis_gcd (Zpos a) (Zpos (xI b)) g -> 
- Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. 
-Proof.
-intros.
-destruct H.
-constructor; auto.
-destruct H as (e,H2); exists (2*e); auto with zarith.
-rewrite Zpos_xO; rewrite H2; ring.
-intros.
-apply H1; auto.
-rewrite Zpos_xO in H2.
-rewrite Zpos_xI in H3.
-apply Gauss with 2; auto.
-apply bezout_rel_prime.
-destruct H3 as (bb, H3).
-apply Bezout_intro with bb (-Zpos b).
-omega.
+  Zis_gcd (Zpos (xO a)) (Zpos (xI b)) g. 
+Proof.
+  intros.
+  destruct H.
+  constructor; auto.
+  destruct H as (e,H2); exists (2*e); auto with zarith.
+  rewrite Zpos_xO; rewrite H2; ring.
+  intros.
+  apply H1; auto.
+  rewrite Zpos_xO in H2.
+  rewrite Zpos_xI in H3.
+  apply Gauss with 2; auto.
+  apply bezout_rel_prime.
+  destruct H3 as (bb, H3).
+  apply Bezout_intro with bb (-Zpos b).
+  omega.
 Qed.
 
 Lemma Pgcdn_correct : forall n a b, (Psize a + Psize b<=n)%nat -> 
- Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)).
-Proof.
-intro n; pattern n; apply lt_wf_ind; clear n; intros.
-destruct n.
-simpl.
-destruct a; simpl in *; try inversion H0.
-destruct a.
-destruct b; simpl.
-case_eq (Pcompare a b Eq); intros.
-(* a = xI, b = xI, compare = Eq *)
-rewrite (Pcompare_Eq_eq _ _ H1); apply Zis_gcd_refl.
-(* a = xI, b = xI, compare = Lt *)
-apply Zis_gcd_sym.
-apply Zis_gcd_for_euclid with 1.
-apply Zis_gcd_sym.
-replace (Zpos (xI b) - 1 * Zpos (xI a)) with (Zpos(xO (b - a))).
-apply Zis_gcd_even_odd.
-apply H; auto.
-simpl in *.
-assert (Psize (b-a) <= Psize b)%nat.
- apply Psize_monotone.
- change (Zpos (b-a) < Zpos b).
- rewrite (Pminus_Zminus _ _ H1).
- assert (0 < Zpos a) by (compute; auto).
- omega.
-omega.  
-rewrite Zpos_xO; do 2 rewrite Zpos_xI.
-rewrite Pminus_Zminus; auto.
-omega.
-(* a = xI, b = xI, compare = Gt *)
-apply Zis_gcd_for_euclid with 1.
-replace (Zpos (xI a) - 1 * Zpos (xI b)) with (Zpos(xO (a - b))).
-apply Zis_gcd_sym.
-apply Zis_gcd_even_odd.
-apply H; auto.
-simpl in *.
-assert (Psize (a-b) <= Psize a)%nat.
- apply Psize_monotone.
- change (Zpos (a-b) < Zpos a).
- rewrite (Pminus_Zminus b a).
- assert (0 < Zpos b) by (compute; auto).
- omega.
- rewrite ZC4; rewrite H1; auto.
-omega.  
-rewrite Zpos_xO; do 2 rewrite Zpos_xI.
-rewrite Pminus_Zminus; auto.
-omega.
-rewrite ZC4; rewrite H1; auto.
-(* a = xI, b = xO *)
-apply Zis_gcd_sym.
-apply Zis_gcd_even_odd.
-apply Zis_gcd_sym.
-apply H; auto.
-simpl in *; omega.
-(* a = xI, b = xH *)
-apply Zis_gcd_1.
-destruct b; simpl.
-(* a = xO, b = xI *)
-apply Zis_gcd_even_odd.
-apply H; auto.
-simpl in *; omega.
-(* a = xO, b = xO *)
-rewrite (Zpos_xO a); rewrite (Zpos_xO b); rewrite (Zpos_xO (Pgcdn n a b)).
-apply Zis_gcd_mult.
-apply H; auto.
-simpl in *; omega.
-(* a = xO, b = xH *)
-apply Zis_gcd_1.
-(* a = xH *)
-simpl; apply Zis_gcd_sym; apply Zis_gcd_1.
+  Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcdn n a b)).
+Proof.
+  intro n; pattern n; apply lt_wf_ind; clear n; intros.
+  destruct n.
+  simpl.
+  destruct a; simpl in *; try inversion H0.
+  destruct a.
+  destruct b; simpl.
+  case_eq (Pcompare a b Eq); intros.
+  (* a = xI, b = xI, compare = Eq *)
+  rewrite (Pcompare_Eq_eq _ _ H1); apply Zis_gcd_refl.
+  (* a = xI, b = xI, compare = Lt *)
+  apply Zis_gcd_sym.
+  apply Zis_gcd_for_euclid with 1.
+  apply Zis_gcd_sym.
+  replace (Zpos (xI b) - 1 * Zpos (xI a)) with (Zpos(xO (b - a))).
+  apply Zis_gcd_even_odd.
+  apply H; auto.
+  simpl in *.
+  assert (Psize (b-a) <= Psize b)%nat.
+  apply Psize_monotone.
+  change (Zpos (b-a) < Zpos b).
+  rewrite (Pminus_Zminus _ _ H1).
+  assert (0 < Zpos a) by (compute; auto).
+  omega.
+  omega.  
+  rewrite Zpos_xO; do 2 rewrite Zpos_xI.
+  rewrite Pminus_Zminus; auto.
+  omega.
+  (* a = xI, b = xI, compare = Gt *)
+  apply Zis_gcd_for_euclid with 1.
+  replace (Zpos (xI a) - 1 * Zpos (xI b)) with (Zpos(xO (a - b))).
+  apply Zis_gcd_sym.
+  apply Zis_gcd_even_odd.
+  apply H; auto.
+  simpl in *.
+  assert (Psize (a-b) <= Psize a)%nat.
+  apply Psize_monotone.
+  change (Zpos (a-b) < Zpos a).
+  rewrite (Pminus_Zminus b a).
+  assert (0 < Zpos b) by (compute; auto).
+  omega.
+  rewrite ZC4; rewrite H1; auto.
+  omega.  
+  rewrite Zpos_xO; do 2 rewrite Zpos_xI.
+  rewrite Pminus_Zminus; auto.
+  omega.
+  rewrite ZC4; rewrite H1; auto.
+  (* a = xI, b = xO *)
+  apply Zis_gcd_sym.
+  apply Zis_gcd_even_odd.
+  apply Zis_gcd_sym.
+  apply H; auto.
+  simpl in *; omega.
+  (* a = xI, b = xH *)
+  apply Zis_gcd_1.
+  destruct b; simpl.
+  (* a = xO, b = xI *)
+  apply Zis_gcd_even_odd.
+  apply H; auto.
+  simpl in *; omega.
+  (* a = xO, b = xO *)
+  rewrite (Zpos_xO a); rewrite (Zpos_xO b); rewrite (Zpos_xO (Pgcdn n a b)).
+  apply Zis_gcd_mult.
+  apply H; auto.
+  simpl in *; omega.
+  (* a = xO, b = xH *)
+  apply Zis_gcd_1.
+  (* a = xH *)
+  simpl; apply Zis_gcd_sym; apply Zis_gcd_1.
 Qed.
 
 Lemma Pgcd_correct : forall a b, Zis_gcd (Zpos a) (Zpos b) (Zpos (Pgcd a b)).
 Proof.
-unfold Pgcd; intros.
-apply Pgcdn_correct; auto.
+  unfold Pgcd; intros.
+  apply Pgcdn_correct; auto.
 Qed.
 
 Lemma Zgcd_is_gcd : forall a b, Zis_gcd a b (Zgcd a b).
 Proof.
-destruct a.
-intros.
-simpl.
-apply Zis_gcd_0_abs.
-destruct b; simpl.
-apply Zis_gcd_0.
-apply Pgcd_correct.
-apply Zis_gcd_sym.
-apply Zis_gcd_minus; simpl.
-apply Pgcd_correct.
-destruct b; simpl.
-apply Zis_gcd_minus; simpl.
-apply Zis_gcd_sym.
-apply Zis_gcd_0.
-apply Zis_gcd_minus; simpl.
-apply Zis_gcd_sym.
-apply Pgcd_correct.
-apply Zis_gcd_sym.
-apply Zis_gcd_minus; simpl.
-apply Zis_gcd_minus; simpl.
-apply Zis_gcd_sym.
-apply Pgcd_correct.
+  destruct a.
+  intros.
+  simpl.
+  apply Zis_gcd_0_abs.
+  destruct b; simpl.
+  apply Zis_gcd_0.
+  apply Pgcd_correct.
+  apply Zis_gcd_sym.
+  apply Zis_gcd_minus; simpl.
+  apply Pgcd_correct.
+  destruct b; simpl.
+  apply Zis_gcd_minus; simpl.
+  apply Zis_gcd_sym.
+  apply Zis_gcd_0.
+  apply Zis_gcd_minus; simpl.
+  apply Zis_gcd_sym.
+  apply Pgcd_correct.
+  apply Zis_gcd_sym.
+  apply Zis_gcd_minus; simpl.
+  apply Zis_gcd_minus; simpl.
+  apply Zis_gcd_sym.
+  apply Pgcd_correct.
 Qed.
 
 
 Lemma Pggcdn_gcdn : forall n a b, 
- fst (Pggcdn n a b) = Pgcdn n a b.
+  fst (Pggcdn n a b) = Pgcdn n a b.
 Proof.
-induction n.
-simpl; auto.
-destruct a; destruct b; simpl; auto.
-destruct (Pcompare a b Eq); simpl; auto.
-rewrite <- IHn; destruct (Pggcdn n (b-a) (xI a)) as (g,(aa,bb)); simpl; auto.
-rewrite <- IHn; destruct (Pggcdn n (a-b) (xI b)) as (g,(aa,bb)); simpl; auto.
-rewrite <- IHn; destruct (Pggcdn n (xI a) b) as (g,(aa,bb)); simpl; auto.
-rewrite <- IHn; destruct (Pggcdn n a (xI b)) as (g,(aa,bb)); simpl; auto.
-rewrite <- IHn; destruct (Pggcdn n a b) as (g,(aa,bb)); simpl; auto.
+  induction n.
+  simpl; auto.
+  destruct a; destruct b; simpl; auto.
+  destruct (Pcompare a b Eq); simpl; auto.
+  rewrite <- IHn; destruct (Pggcdn n (b-a) (xI a)) as (g,(aa,bb)); simpl; auto.
+  rewrite <- IHn; destruct (Pggcdn n (a-b) (xI b)) as (g,(aa,bb)); simpl; auto.
+  rewrite <- IHn; destruct (Pggcdn n (xI a) b) as (g,(aa,bb)); simpl; auto.
+  rewrite <- IHn; destruct (Pggcdn n a (xI b)) as (g,(aa,bb)); simpl; auto.
+  rewrite <- IHn; destruct (Pggcdn n a b) as (g,(aa,bb)); simpl; auto.
 Qed.
 
 Lemma Pggcd_gcd : forall a b, fst (Pggcd a b) = Pgcd a b.
 Proof.
-intros; exact (Pggcdn_gcdn (Psize a+Psize b)%nat a b).
+  intros; exact (Pggcdn_gcdn (Psize a+Psize b)%nat a b).
 Qed.
 
 Lemma Zggcd_gcd : forall a b, fst (Zggcd a b) = Zgcd a b.
 Proof.
-destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; 
-destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto.
+  destruct a; destruct b; simpl; auto; rewrite <- Pggcd_gcd; 
+    destruct (Pggcd p p0) as (g,(aa,bb)); simpl; auto.
 Qed.
 
 Open Scope positive_scope.
 
 Lemma Pggcdn_correct_divisors : forall n a b, 
   let (g,p) := Pggcdn n a b in 
-  let (aa,bb):=p in 
-  (a=g*aa) /\ (b=g*bb).
-Proof.
-induction n.
-simpl; auto.
-destruct a; destruct b; simpl; auto.
-case_eq (Pcompare a b Eq); intros.
-(* Eq *)
-rewrite Pmult_comm; simpl; auto.
-rewrite (Pcompare_Eq_eq _ _ H); auto.
-(* Lt *)
-generalize (IHn (b-a) (xI a)); destruct (Pggcdn n (b-a) (xI a)) as (g,(ba,aa)); simpl.
-intros (H0,H1); split; auto.
-rewrite Pmult_plus_distr_l.
-rewrite Pmult_xO_permute_r.
-rewrite <- H1; rewrite <- H0.
-simpl; f_equal; symmetry.
-apply Pplus_minus; auto.
-rewrite ZC4; rewrite H; auto.
-(* Gt *)
-generalize (IHn (a-b) (xI b)); destruct (Pggcdn n (a-b) (xI b)) as (g,(ab,bb)); simpl.
-intros (H0,H1); split; auto.
-rewrite Pmult_plus_distr_l.
-rewrite Pmult_xO_permute_r.
-rewrite <- H1; rewrite <- H0.
-simpl; f_equal; symmetry.
-apply Pplus_minus; auto.
-(* Then... *) 
-generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl.
-intros (H0,H1); split; auto.
-rewrite Pmult_xO_permute_r; rewrite H1; auto.
-generalize (IHn a (xI b)); destruct (Pggcdn n a (xI b)) as (g,(ab,bb)); simpl.
-intros (H0,H1); split; auto.
-rewrite Pmult_xO_permute_r; rewrite H0; auto.
-generalize (IHn a b); destruct (Pggcdn n a b) as (g,(ab,bb)); simpl.
-intros (H0,H1); split; subst; auto.
+    let (aa,bb):=p in 
+      (a=g*aa) /\ (b=g*bb).
+Proof.
+  induction n.
+  simpl; auto.
+  destruct a; destruct b; simpl; auto.
+  case_eq (Pcompare a b Eq); intros.
+  (* Eq *)
+  rewrite Pmult_comm; simpl; auto.
+  rewrite (Pcompare_Eq_eq _ _ H); auto.
+  (* Lt *)
+  generalize (IHn (b-a) (xI a)); destruct (Pggcdn n (b-a) (xI a)) as (g,(ba,aa)); simpl.
+  intros (H0,H1); split; auto.
+  rewrite Pmult_plus_distr_l.
+  rewrite Pmult_xO_permute_r.
+  rewrite <- H1; rewrite <- H0.
+  simpl; f_equal; symmetry.
+  apply Pplus_minus; auto.
+  rewrite ZC4; rewrite H; auto.
+  (* Gt *)
+  generalize (IHn (a-b) (xI b)); destruct (Pggcdn n (a-b) (xI b)) as (g,(ab,bb)); simpl.
+  intros (H0,H1); split; auto.
+  rewrite Pmult_plus_distr_l.
+  rewrite Pmult_xO_permute_r.
+  rewrite <- H1; rewrite <- H0.
+  simpl; f_equal; symmetry.
+  apply Pplus_minus; auto.
+  (* Then... *) 
+  generalize (IHn (xI a) b); destruct (Pggcdn n (xI a) b) as (g,(ab,bb)); simpl.
+  intros (H0,H1); split; auto.
+  rewrite Pmult_xO_permute_r; rewrite H1; auto.
+  generalize (IHn a (xI b)); destruct (Pggcdn n a (xI b)) as (g,(ab,bb)); simpl.
+  intros (H0,H1); split; auto.
+  rewrite Pmult_xO_permute_r; rewrite H0; auto.
+  generalize (IHn a b); destruct (Pggcdn n a b) as (g,(ab,bb)); simpl.
+  intros (H0,H1); split; subst; auto.
 Qed.
 
 Lemma Pggcd_correct_divisors : forall a b, 
   let (g,p) := Pggcd a b in 
-  let (aa,bb):=p in 
-  (a=g*aa) /\ (b=g*bb).
+    let (aa,bb):=p in 
+      (a=g*aa) /\ (b=g*bb).
 Proof.
-intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b).
+  intros a b; exact (Pggcdn_correct_divisors (Psize a + Psize b)%nat a b).
 Qed.
 
 Open Scope Z_scope.
 
 Lemma Zggcd_correct_divisors : forall a b, 
   let (g,p) := Zggcd a b in 
-  let (aa,bb):=p in 
-  (a=g*aa) /\ (b=g*bb).
+    let (aa,bb):=p in 
+      (a=g*aa) /\ (b=g*bb).
 Proof.
-destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; 
-generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); 
-destruct 1; subst; auto.
+  destruct a; destruct b; simpl; auto; try solve [rewrite Pmult_comm; simpl; auto]; 
+    generalize (Pggcd_correct_divisors p p0); destruct (Pggcd p p0) as (g,(aa,bb)); 
+      destruct 1; subst; auto.
 Qed.
 
 Theorem Zgcd_spec : forall x y : Z, {z : Z | Zis_gcd x y z /\ 0 <= z}.
diff --git a/theories/ZArith/Zorder.v b/theories/ZArith/Zorder.v
index b81cc580..47490be6 100644
--- a/theories/ZArith/Zorder.v
+++ b/theories/ZArith/Zorder.v
@@ -5,13 +5,13 @@
 (*    //   *      This file is distributed under the terms of the       *)
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
-(*i $Id: Zorder.v 6983 2005-05-02 10:47:51Z herbelin $ i*)
+(*i $Id: Zorder.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Binary Integers (Pierre Crégut (CNET, Lannion, France) *)
 
 Require Import BinPos.
 Require Import BinInt.
-Require Import Arith.
+Require Import Arith_base.
 Require Import Decidable.
 Require Import Zcompare.
 
@@ -19,178 +19,180 @@ Open Local Scope Z_scope.
 
 Implicit Types x y z : Z.
 
-(**********************************************************************)
+(*********************************************************)
 (** Properties of the order relations on binary integers *)
 
-(** Trichotomy *)
+(** * Trichotomy *)
 
 Theorem Ztrichotomy_inf : forall n m:Z, {n < m} + {n = m} + {n > m}.
 Proof.
-unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)).
+  unfold Zgt, Zlt in |- *; intros m n; assert (H := refl_equal (m ?= n)).
   set (x := m ?= n) in H at 2 |- *.
   destruct x;
-   [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ];
-   reflexivity.
+    [ left; right; rewrite Zcompare_Eq_eq with (1 := H) | left; left | right ];
+    reflexivity.
 Qed.
 
 Theorem Ztrichotomy : forall n m:Z, n < m \/ n = m \/ n > m.
 Proof.
   intros m n; destruct (Ztrichotomy_inf m n) as [[Hlt| Heq]| Hgt];
-   [ left | right; left | right; right ]; assumption.
+    [ left | right; left | right; right ]; assumption.
 Qed.
 
 (**********************************************************************)
-(** Decidability of equality and order on Z *)
+(** * Decidability of equality and order on Z *)
 
 Theorem dec_eq : forall n m:Z, decidable (n = m).
 Proof.
-intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y);
- intros H1 H2; elim (Dcompare (x ?= y));
- [ tauto
- | intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4);
-    intros H5; discriminate H5 ].
+  intros x y; unfold decidable in |- *; elim (Zcompare_Eq_iff_eq x y);
+    intros H1 H2; elim (Dcompare (x ?= y));
+      [ tauto
+	| intros H3; right; unfold not in |- *; intros H4; elim H3; rewrite (H2 H4);
+	  intros H5; discriminate H5 ].
 Qed. 
 
 Theorem dec_Zne : forall n m:Z, decidable (Zne n m).
 Proof.
-intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y).
-intros H1 H2; elim (Dcompare (x ?= y));
- [ right; rewrite H1; auto
- | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq);
-    [ elim H; intros HR; rewrite HR; discriminate | auto ] ].
+  intros x y; unfold decidable, Zne in |- *; elim (Zcompare_Eq_iff_eq x y).
+  intros H1 H2; elim (Dcompare (x ?= y));
+    [ right; rewrite H1; auto
+      | left; unfold not in |- *; intro; absurd ((x ?= y) = Eq);
+	[ elim H; intros HR; rewrite HR; discriminate | auto ] ].
 Qed.
 
 Theorem dec_Zle : forall n m:Z, decidable (n <= m).
 Proof.
-intros x y; unfold decidable, Zle in |- *; elim (x ?= y);
- [ left; discriminate
- | left; discriminate
- | right; unfold not in |- *; intros H; apply H; trivial with arith ].
+  intros x y; unfold decidable, Zle in |- *; elim (x ?= y);
+    [ left; discriminate
+      | left; discriminate
+      | right; unfold not in |- *; intros H; apply H; trivial with arith ].
 Qed.
 
 Theorem dec_Zgt : forall n m:Z, decidable (n > m).
 Proof.
-intros x y; unfold decidable, Zgt in |- *; elim (x ?= y);
- [ right; discriminate | right; discriminate | auto with arith ].
+  intros x y; unfold decidable, Zgt in |- *; elim (x ?= y);
+    [ right; discriminate | right; discriminate | auto with arith ].
 Qed.
 
 Theorem dec_Zge : forall n m:Z, decidable (n >= m).
 Proof.
-intros x y; unfold decidable, Zge in |- *; elim (x ?= y);
- [ left; discriminate
- | right; unfold not in |- *; intros H; apply H; trivial with arith
- | left; discriminate ]. 
+  intros x y; unfold decidable, Zge in |- *; elim (x ?= y);
+    [ left; discriminate
+      | right; unfold not in |- *; intros H; apply H; trivial with arith
+      | left; discriminate ]. 
 Qed.
 
 Theorem dec_Zlt : forall n m:Z, decidable (n < m).
 Proof.
-intros x y; unfold decidable, Zlt in |- *; elim (x ?= y);
- [ right; discriminate | auto with arith | right; discriminate ].
+  intros x y; unfold decidable, Zlt in |- *; elim (x ?= y);
+    [ right; discriminate | auto with arith | right; discriminate ].
 Qed.
 
 Theorem not_Zeq : forall n m:Z, n <> m -> n < m \/ m < n.
 Proof.
-intros x y; elim (Dcompare (x ?= y));
- [ intros H1 H2; absurd (x = y);
-    [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ]
- | unfold Zlt in |- *; intros H; elim H; intros H1;
-    [ auto with arith
-    | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ].
+  intros x y; elim (Dcompare (x ?= y));
+    [ intros H1 H2; absurd (x = y);
+      [ assumption | elim (Zcompare_Eq_iff_eq x y); auto with arith ]
+      | unfold Zlt in |- *; intros H; elim H; intros H1;
+	[ auto with arith
+	  | right; elim (Zcompare_Gt_Lt_antisym x y); auto with arith ] ].
 Qed. 
 
-(** Relating strict and large orders *)
+(** * Relating strict and large orders *)
 
 Lemma Zgt_lt : forall n m:Z, n > m -> m < n.
 Proof.
-unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n);
- auto with arith.
+  unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym m n);
+    auto with arith.
 Qed.
 
 Lemma Zlt_gt : forall n m:Z, n < m -> m > n.
 Proof.
-unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m);
- auto with arith.
+  unfold Zgt, Zlt in |- *; intros m n H; elim (Zcompare_Gt_Lt_antisym n m);
+    auto with arith.
 Qed.
 
 Lemma Zge_le : forall n m:Z, n >= m -> m <= n.
 Proof.
-intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *;
- intros H1 H2; apply H1; apply Zgt_lt; assumption.
+  intros m n; change (~ m < n -> ~ n > m) in |- *; unfold not in |- *;
+    intros H1 H2; apply H1; apply Zgt_lt; assumption.
 Qed.
 
 Lemma Zle_ge : forall n m:Z, n <= m -> m >= n.
 Proof.
-intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *;
- intros H1 H2; apply H1; apply Zlt_gt; assumption.
+  intros m n; change (~ m > n -> ~ n < m) in |- *; unfold not in |- *;
+    intros H1 H2; apply H1; apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zle_not_gt : forall n m:Z, n <= m -> ~ n > m.
 Proof.
-trivial.
+  trivial.
 Qed.
 
 Lemma Zgt_not_le : forall n m:Z, n > m -> ~ n <= m.
 Proof.
-intros n m H1 H2; apply H2; assumption.
+  intros n m H1 H2; apply H2; assumption.
 Qed.
 
 Lemma Zle_not_lt : forall n m:Z, n <= m -> ~ m < n.
 Proof.
-intros n m H1 H2.
-assert (H3 := Zlt_gt _ _ H2).
-apply Zle_not_gt with n m; assumption.
+  intros n m H1 H2.
+  assert (H3 := Zlt_gt _ _ H2).
+  apply Zle_not_gt with n m; assumption.
 Qed.
 
 Lemma Zlt_not_le : forall n m:Z, n < m -> ~ m <= n.
 Proof.
-intros n m H1 H2.
-apply Zle_not_lt with m n; assumption.
+  intros n m H1 H2.
+  apply Zle_not_lt with m n; assumption.
 Qed.
 
 Lemma Znot_ge_lt : forall n m:Z, ~ n >= m -> n < m.
 Proof.
-unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not;
- [ exact (dec_Zlt x y) | assumption ].
+  unfold Zge, Zlt in |- *; intros x y H; apply dec_not_not;
+    [ exact (dec_Zlt x y) | assumption ].
 Qed.
- 
+
 Lemma Znot_lt_ge : forall n m:Z, ~ n < m -> n >= m.
 Proof.
-unfold Zlt, Zge in |- *; auto with arith.
+  unfold Zlt, Zge in |- *; auto with arith.
 Qed.
 
 Lemma Znot_gt_le : forall n m:Z, ~ n > m -> n <= m.
 Proof.
-trivial.
+  trivial.
 Qed.
 
 Lemma Znot_le_gt : forall n m:Z, ~ n <= m -> n > m.
 Proof.
-unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not;
- [ exact (dec_Zgt x y) | assumption ].
+  unfold Zle, Zgt in |- *; intros x y H; apply dec_not_not;
+    [ exact (dec_Zgt x y) | assumption ].
 Qed.
 
 Lemma Zge_iff_le : forall n m:Z, n >= m <-> m <= n.
 Proof.
-    intros x y; intros. split. intro. apply Zge_le. assumption.
-    intro. apply Zle_ge. assumption.
+  intros x y; intros. split. intro. apply Zge_le. assumption.
+  intro. apply Zle_ge. assumption.
 Qed.
 
 Lemma Zgt_iff_lt : forall n m:Z, n > m <-> m < n.
 Proof.
-    intros x y. split. intro. apply Zgt_lt. assumption.
-    intro. apply Zlt_gt. assumption.
+  intros x y. split. intro. apply Zgt_lt. assumption.
+  intro. apply Zlt_gt. assumption.
 Qed.
  
+(** * Equivalence and order properties *)
+
 (** Reflexivity *)
 
 Lemma Zle_refl : forall n:Z, n <= n.
 Proof.
-intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate.
+  intros n; unfold Zle in |- *; rewrite (Zcompare_refl n); discriminate.
 Qed. 
 
 Lemma Zeq_le : forall n m:Z, n = m -> n <= m.
 Proof.
-intros; rewrite H; apply Zle_refl.
+  intros; rewrite H; apply Zle_refl.
 Qed.
 
 Hint Resolve Zle_refl: zarith.
@@ -199,7 +201,7 @@ Hint Resolve Zle_refl: zarith.
 
 Lemma Zle_antisym : forall n m:Z, n <= m -> m <= n -> n = m.
 Proof.
-intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. 
+  intros n m H1 H2; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]]. 
   absurd (m > n); [ apply Zle_not_gt | apply Zlt_gt ]; assumption.
   assumption.
   absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption.
@@ -209,138 +211,143 @@ Qed.
 
 Lemma Zgt_asym : forall n m:Z, n > m -> ~ m > n.
 Proof.
-unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m);
- intros H1 H2; rewrite H1; [ discriminate | assumption ].
+  unfold Zgt in |- *; intros n m H; elim (Zcompare_Gt_Lt_antisym n m);
+    intros H1 H2; rewrite H1; [ discriminate | assumption ].
 Qed.
 
 Lemma Zlt_asym : forall 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_asym with m n; assumption.
+  intros n m H H1; assert (H2 : m > n). apply Zlt_gt; assumption.
+  assert (H3 : n > m). apply Zlt_gt; assumption.
+  apply Zgt_asym with m n; assumption.
 Qed.
 
 (** Irreflexivity *)
 
 Lemma Zgt_irrefl : forall n:Z, ~ n > n.
 Proof.
-intros n H; apply (Zgt_asym n n H H).
+  intros n H; apply (Zgt_asym n n H H).
 Qed.
 
 Lemma Zlt_irrefl : forall n:Z, ~ n < n.
 Proof.
-intros n H; apply (Zlt_asym n n H H).
+  intros n H; apply (Zlt_asym n n H H).
 Qed.
 
 Lemma Zlt_not_eq : forall n m:Z, n < m -> n <> m.
 Proof.
-unfold not in |- *; intros x y H H0.
-rewrite H0 in H.
-apply (Zlt_irrefl _ H).
+  unfold not in |- *; intros x y H H0.
+  rewrite H0 in H.
+  apply (Zlt_irrefl _ H).
 Qed.
 
 (** Large = strict or equal *)
 
 Lemma Zlt_le_weak : forall n m:Z, n < m -> n <= m.
 Proof.
-intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption.
+  intros n m Hlt; apply Znot_gt_le; apply Zgt_asym; apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zle_lt_or_eq : forall n m:Z, n <= m -> n < m \/ n = m.
 Proof.
-intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
- [ left; assumption
- | right; assumption
- | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ].
+  intros n m H; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
+    [ left; assumption
+      | right; assumption
+      | absurd (n > m); [ apply Zle_not_gt | idtac ]; assumption ].
 Qed.
 
 (** Dichotomy *)
 
 Lemma Zle_or_lt : forall n m:Z, n <= m \/ m < n.
 Proof.
-intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
- [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt);
-    apply Zgt_asym with m n; assumption
- | left; rewrite Heq; apply Zle_refl
- | right; apply Zgt_lt; assumption ].
+  intros n m; destruct (Ztrichotomy n m) as [Hlt| [Heq| Hgt]];
+    [ left; apply Znot_gt_le; intro Hgt; assert (Hgt' := Zlt_gt _ _ Hlt);
+      apply Zgt_asym with m n; assumption
+      | left; rewrite Heq; apply Zle_refl
+      | right; apply Zgt_lt; assumption ].
 Qed.
 
 (** Transitivity of strict orders *)
 
 Lemma Zgt_trans : forall n m p:Z, n > m -> m > p -> n > p.
 Proof.
-exact Zcompare_Gt_trans.
+  exact Zcompare_Gt_trans.
 Qed.
 
 Lemma Zlt_trans : forall 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.
+  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 : forall n m p:Z, m <= n -> m > p -> n > p.
 Proof.
-intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq];
- [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ]
- | rewrite <- Heq; assumption ].
+  intros n m p H1 H2; destruct (Zle_lt_or_eq m n H1) as [Hlt| Heq];
+    [ apply Zgt_trans with m; [ apply Zlt_gt; assumption | assumption ]
+      | rewrite <- Heq; assumption ].
 Qed.
 
 Lemma Zgt_le_trans : forall n m p:Z, n > m -> p <= m -> n > p.
 Proof.
-intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq];
- [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ]
- | rewrite Heq; assumption ].
+  intros n m p H1 H2; destruct (Zle_lt_or_eq p m H2) as [Hlt| Heq];
+    [ apply Zgt_trans with m; [ assumption | apply Zlt_gt; assumption ]
+      | rewrite Heq; assumption ].
 Qed.
 
 Lemma Zlt_le_trans : forall n m p:Z, n < m -> m <= p -> n < p.
-intros n m p H1 H2; apply Zgt_lt; apply Zle_gt_trans with (m := m);
- [ assumption | apply Zlt_gt; assumption ].
+  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 : forall 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 ].
+  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 : forall n m p:Z, n <= m -> m <= p -> n <= p.
 Proof.
-intros n m p H1 H2; apply Znot_gt_le.
-intro Hgt; apply Zle_not_gt with n m. assumption.
-exact (Zgt_le_trans n p m Hgt H2).
+  intros n m p H1 H2; apply Znot_gt_le.
+  intro Hgt; apply Zle_not_gt with n m. assumption.
+  exact (Zgt_le_trans n p m Hgt H2).
 Qed.
 
 Lemma Zge_trans : forall 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.
+  intros n m p H1 H2.
+  apply Zle_ge.
+  apply Zle_trans with m; apply Zge_le; trivial.
 Qed.
 
 Hint Resolve Zle_trans: zarith.
 
+
+(** * Compatibility of order and operations on Z *)
+
+(** ** Successor *)
+
 (** Compatibility of successor wrt to order *)
 
 Lemma Zsucc_le_compat : forall n m:Z, m <= n -> Zsucc m <= Zsucc n.
 Proof.
-unfold Zle, not in |- *; intros m n H1 H2; apply H1;
- rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1);
- exact H2.
+  unfold Zle, not in |- *; intros m n H1 H2; apply H1;
+    rewrite <- (Zcompare_plus_compat n m 1); do 2 rewrite (Zplus_comm 1);
+      exact H2.
 Qed.
 
 Lemma Zsucc_gt_compat : forall n m:Z, m > n -> Zsucc m > Zsucc n.
 Proof.
-unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat;
- auto with arith.
+  unfold Zgt in |- *; intros n m H; rewrite Zcompare_succ_compat;
+    auto with arith.
 Qed.
 
 Lemma Zsucc_lt_compat : forall n m:Z, n < m -> Zsucc n < Zsucc m.
 Proof.
-intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption.
+  intros n m H; apply Zgt_lt; apply Zsucc_gt_compat; apply Zlt_gt; assumption.
 Qed.
 
 Hint Resolve Zsucc_le_compat: zarith.
@@ -349,231 +356,119 @@ Hint Resolve Zsucc_le_compat: zarith.
 
 Lemma Zsucc_gt_reg : forall n m:Z, Zsucc m > Zsucc n -> m > n.
 Proof.
-unfold Zsucc, Zgt in |- *; intros n p;
- do 2 rewrite (fun m:Z => Zplus_comm m 1);
- rewrite (Zcompare_plus_compat p n 1); trivial with arith.
+  unfold Zsucc, Zgt in |- *; intros n p;
+    do 2 rewrite (fun m:Z => Zplus_comm m 1);
+      rewrite (Zcompare_plus_compat p n 1); trivial with arith.
 Qed.
 
 Lemma Zsucc_le_reg : forall n m:Z, Zsucc m <= Zsucc n -> m <= n.
 Proof.
-unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *;
- do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1);
- assumption.
+  unfold Zle, not in |- *; intros m n H1 H2; apply H1; unfold Zsucc in |- *;
+    do 2 rewrite <- (Zplus_comm 1); rewrite (Zcompare_plus_compat n m 1);
+      assumption.
 Qed.
 
 Lemma Zsucc_lt_reg : forall n m:Z, Zsucc n < Zsucc m -> n < m.
 Proof.
-intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption.
-Qed.
-
-(** Compatibility of addition wrt to order *)
-
-Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m.
-Proof.
-unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p);
- assumption.
-Qed.
-
-Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p.
-Proof.
-intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
- apply Zplus_gt_compat_l; trivial.
-Qed.
-
-Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m.
-Proof.
-intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
- rewrite <- (Zcompare_plus_compat n m p); assumption.
-Qed.
-
-Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p.
-Proof.
-intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c);
- exact (Zplus_le_compat_l a b c).
-Qed.
-
-Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m.
-Proof.
-unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
- trivial with arith.
-Qed.
-
-Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p.
-Proof.
-intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
- apply Zplus_lt_compat_l; trivial.
-Qed.
-
-Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q.
-Proof.
-intros a b c d H0 H1.
-apply Zlt_le_trans with (b + c).
-apply Zplus_lt_compat_r; trivial.
-apply Zplus_le_compat_l; trivial.
-Qed.
-
-Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q.
-Proof.
-intros a b c d H0 H1.
-apply Zle_lt_trans with (b + c).
-apply Zplus_le_compat_r; trivial.
-apply Zplus_lt_compat_l; trivial.
-Qed.
-
-Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q.
-Proof.
-intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q);
- [ apply Zplus_le_compat_l; assumption
- | apply Zplus_le_compat_r; assumption ].
+  intros n m H; apply Zgt_lt; apply Zsucc_gt_reg; apply Zlt_gt; assumption.
 Qed.
 
-
-Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q.
-intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption.
-Qed.
-
-
-(** Compatibility of addition wrt to being positive *)
-
-Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m.
-Proof.
-intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption.
-Qed.
-
-(** Simplification of addition wrt to order *)
-
-Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m.
-Proof.
-unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p);
- assumption.
-Qed.
-
-Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m.
-Proof.
-intros n m p H; apply Zplus_gt_reg_l with p.
-rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
-Qed.
-
-Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m.
-Proof.
-intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
- rewrite (Zcompare_plus_compat n m p); assumption.
-Qed.
- 
-Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m.
-Proof.
-intros n m p H; apply Zplus_le_reg_l with p.
-rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
-Qed.
-
-Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m.
-Proof.
-unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
- trivial with arith.
-Qed.
- 
-Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m.
-Proof.
-intros n m p H; apply Zplus_lt_reg_l with p.
-rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
-Qed.
- 
 (** Special base instances of order *)
 
 Lemma Zgt_succ : forall n:Z, Zsucc n > n.
 Proof.
-exact Zcompare_succ_Gt.
+  exact Zcompare_succ_Gt.
 Qed.
 
 Lemma Znot_le_succ : forall n:Z, ~ Zsucc n <= n.
 Proof.
-intros n; apply Zgt_not_le; apply Zgt_succ.
+  intros n; apply Zgt_not_le; apply Zgt_succ.
 Qed.
 
 Lemma Zlt_succ : forall n:Z, n < Zsucc n.
 Proof.
-intro n; apply Zgt_lt; apply Zgt_succ.
+  intro n; apply Zgt_lt; apply Zgt_succ.
 Qed.
 
 Lemma Zlt_pred : forall n:Z, Zpred n < n.
 Proof.
-intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ.
+  intros n; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; apply Zlt_succ.
 Qed.
 
 (** Relating strict and large order using successor or predecessor *)
 
 Lemma Zgt_le_succ : forall n m:Z, m > n -> Zsucc n <= m.
 Proof.
-unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n);
- intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; 
- apply H1;
- [ assumption
- | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ].
+  unfold Zgt, Zle in |- *; intros n p H; elim (Zcompare_Gt_not_Lt p n);
+    intros H1 H2; unfold not in |- *; intros H3; unfold not in H1; 
+      apply H1;
+	[ assumption
+	  | elim (Zcompare_Gt_Lt_antisym (n + 1) p); intros H4 H5; apply H4; exact H3 ].
 Qed.
 
 Lemma Zlt_gt_succ : forall n m:Z, n <= m -> Zsucc m > n.
 Proof.
-intros n p H; apply Zgt_le_trans with p.
+  intros n p H; apply Zgt_le_trans with p.
   apply Zgt_succ.
   assumption.
 Qed.
 
 Lemma Zle_lt_succ : forall n m:Z, n <= m -> n < Zsucc m.
 Proof.
-intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption.
+  intros n m H; apply Zgt_lt; apply Zlt_gt_succ; assumption.
 Qed.
 
 Lemma Zlt_le_succ : forall n m:Z, n < m -> Zsucc n <= m.
 Proof.
-intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption.
+  intros n p H; apply Zgt_le_succ; apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zgt_succ_le : forall n m:Z, Zsucc m > n -> n <= m.
 Proof.
-intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption.
+  intros n p H; apply Zsucc_le_reg; apply Zgt_le_succ; assumption.
 Qed.
 
 Lemma Zlt_succ_le : forall n m:Z, n < Zsucc m -> n <= m.
 Proof.
-intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption.
+  intros n m H; apply Zgt_succ_le; apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zlt_succ_gt : forall n m:Z, Zsucc n <= m -> m > n.
 Proof.
-intros n m H; apply Zle_gt_trans with (m := Zsucc n);
- [ assumption | apply Zgt_succ ].
+  intros n m H; apply Zle_gt_trans with (m := Zsucc n);
+    [ assumption | apply Zgt_succ ].
 Qed.
 
 (** Weakening order *)
 
 Lemma Zle_succ : forall n:Z, n <= Zsucc n.
 Proof.
-intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n);
- apply Zgt_succ.
+  intros n; apply Zgt_succ_le; apply Zgt_trans with (m := Zsucc n);
+    apply Zgt_succ.
 Qed.
 
 Hint Resolve Zle_succ: zarith.
 
 Lemma Zle_pred : forall n:Z, Zpred n <= n.
 Proof.
-intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ.
+  intros n; pattern n at 2 in |- *; rewrite Zsucc_pred; apply Zle_succ.
 Qed.
 
 Lemma Zlt_lt_succ : forall n m:Z, n < m -> n < Zsucc m.
-intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m);
- [ apply Zgt_succ | apply Zlt_gt; assumption ].
+  intros n m H; apply Zgt_lt; apply Zgt_trans with (m := m);
+    [ apply Zgt_succ | apply Zlt_gt; assumption ].
 Qed.
 
 Lemma Zle_le_succ : forall n m:Z, n <= m -> n <= Zsucc m.
 Proof.
-intros x y H.
-apply Zle_trans with y; trivial with zarith.
+  intros x y H.
+  apply Zle_trans with y; trivial with zarith.
 Qed.
 
 Lemma Zle_succ_le : forall n m:Z, Zsucc n <= m -> n <= m.
 Proof.
-intros n m H; apply Zle_trans with (m := Zsucc n);
- [ apply Zle_succ | assumption ].
+  intros n m H; apply Zle_trans with (m := Zsucc n);
+    [ apply Zle_succ | assumption ].
 Qed.
 
 Hint Resolve Zle_le_succ: zarith.
@@ -582,31 +477,32 @@ Hint Resolve Zle_le_succ: zarith.
 
 Lemma Zgt_succ_pred : forall n m:Z, m > Zsucc n -> Zpred m > n.
 Proof.
-unfold Zgt, Zsucc, Zpred in |- *; intros n p H;
- rewrite <- (fun x y => Zcompare_plus_compat x y 1); 
- rewrite (Zplus_comm p); rewrite Zplus_assoc;
- rewrite (fun x => Zplus_comm x n); simpl in |- *; 
- assumption.
+  unfold Zgt, Zsucc, Zpred in |- *; intros n p H;
+    rewrite <- (fun x y => Zcompare_plus_compat x y 1); 
+      rewrite (Zplus_comm p); rewrite Zplus_assoc;
+	rewrite (fun x => Zplus_comm x n); simpl in |- *; 
+	  assumption.
 Qed.
 
 Lemma Zlt_succ_pred : forall n m:Z, Zsucc n < m -> n < Zpred m.
 Proof.
-intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption.
+  intros n p H; apply Zsucc_lt_reg; rewrite <- Zsucc_pred; assumption.
 Qed.
 
 (** Relating strict order and large order on positive *)
 
 Lemma Zlt_0_le_0_pred : forall n:Z, 0 < n -> 0 <= Zpred n.
-intros x H.
-rewrite (Zsucc_pred x) in H.
-apply Zgt_succ_le.
-apply Zlt_gt.
-assumption.
+Proof.
+  intros x H.
+  rewrite (Zsucc_pred x) in H.
+  apply Zgt_succ_le.
+  apply Zlt_gt.
+  assumption.
 Qed.
 
-
 Lemma Zgt_0_le_0_pred : forall n:Z, n > 0 -> 0 <= Zpred n.
-intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption.
+Proof.
+  intros; apply Zlt_0_le_0_pred; apply Zgt_lt. assumption.
 Qed.
 
 
@@ -614,35 +510,39 @@ Qed.
 
 Lemma Zlt_0_1 : 0 < 1.
 Proof.
-change (0 < Zsucc 0) in |- *. apply Zlt_succ.
+  change (0 < Zsucc 0) in |- *. apply Zlt_succ.
 Qed.
 
 Lemma Zle_0_1 : 0 <= 1.
 Proof.
-change (0 <= Zsucc 0) in |- *. apply Zle_succ.
+  change (0 <= Zsucc 0) in |- *. apply Zle_succ.
 Qed.
 
 Lemma Zle_neg_pos : forall p q:positive, Zneg p <= Zpos q.
 Proof.
-intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate.
+  intros p; red in |- *; simpl in |- *; red in |- *; intros H; discriminate.
 Qed.
 
 Lemma Zgt_pos_0 : forall p:positive, Zpos p > 0.
-unfold Zgt in |- *; trivial.
+Proof.
+  unfold Zgt in |- *; trivial.
 Qed.
 
-  (* weaker but useful (in [Zpower] for instance) *)
+(* weaker but useful (in [Zpower] for instance) *)
 Lemma Zle_0_pos : forall p:positive, 0 <= Zpos p.
-intro; unfold Zle in |- *; discriminate.
+Proof.
+  intro; unfold Zle in |- *; discriminate.
 Qed.
 
 Lemma Zlt_neg_0 : forall p:positive, Zneg p < 0.
-unfold Zlt in |- *; trivial.
+Proof.
+  unfold Zlt in |- *; trivial.
 Qed.
 
 Lemma Zle_0_nat : forall n:nat, 0 <= Z_of_nat n.
-simple induction n; simpl in |- *; intros;
- [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ].
+Proof.
+  simple induction n; simpl in |- *; intros;
+    [ apply Zle_refl | unfold Zle in |- *; simpl in |- *; discriminate ].
 Qed.
 
 Hint Immediate Zeq_le: zarith.
@@ -651,178 +551,294 @@ Hint Immediate Zeq_le: zarith.
 
 Lemma Zge_trans_succ : forall n m p:Z, Zsucc n > m -> m > p -> n > p.
 Proof.
-intros n m p H1 H2; apply Zle_gt_trans with (m := m);
- [ apply Zgt_succ_le; assumption | assumption ].
+  intros n m p H1 H2; apply Zle_gt_trans with (m := m);
+    [ apply Zgt_succ_le; assumption | assumption ].
 Qed.
 
 (** Derived lemma *)
 
 Lemma Zgt_succ_gt_or_eq : forall n m:Z, Zsucc n > m -> n > m \/ m = n.
 Proof.
-intros n m H.
-assert (Hle : m <= n).
+  intros n m H.
+  assert (Hle : m <= n).
   apply Zgt_succ_le; assumption.
-destruct (Zle_lt_or_eq _ _ Hle) as [Hlt| Heq].
+  destruct (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 *)
+(** ** Addition *)
+(** Compatibility of addition wrt to order *)
+
+Lemma Zplus_gt_compat_l : forall n m p:Z, n > m -> p + n > p + m.
+Proof.
+  unfold Zgt in |- *; intros n m p H; rewrite (Zcompare_plus_compat n m p);
+    assumption.
+Qed.
+
+Lemma Zplus_gt_compat_r : forall n m p:Z, n > m -> n + p > m + p.
+Proof.
+  intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
+    apply Zplus_gt_compat_l; trivial.
+Qed.
+
+Lemma Zplus_le_compat_l : forall n m p:Z, n <= m -> p + n <= p + m.
+Proof.
+  intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
+    rewrite <- (Zcompare_plus_compat n m p); assumption.
+Qed.
+
+Lemma Zplus_le_compat_r : forall n m p:Z, n <= m -> n + p <= m + p.
+Proof.
+  intros a b c; do 2 rewrite (fun n:Z => Zplus_comm n c);
+    exact (Zplus_le_compat_l a b c).
+Qed.
+
+Lemma Zplus_lt_compat_l : forall n m p:Z, n < m -> p + n < p + m.
+Proof.
+  unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
+    trivial with arith.
+Qed.
 
+Lemma Zplus_lt_compat_r : forall n m p:Z, n < m -> n + p < m + p.
+Proof.
+  intros n m p H; rewrite (Zplus_comm n p); rewrite (Zplus_comm m p);
+    apply Zplus_lt_compat_l; trivial.
+Qed.
+
+Lemma Zplus_lt_le_compat : forall n m p q:Z, n < m -> p <= q -> n + p < m + q.
+Proof.
+  intros a b c d H0 H1.
+  apply Zlt_le_trans with (b + c).
+  apply Zplus_lt_compat_r; trivial.
+  apply Zplus_le_compat_l; trivial.
+Qed.
+
+Lemma Zplus_le_lt_compat : forall n m p q:Z, n <= m -> p < q -> n + p < m + q.
+Proof.
+  intros a b c d H0 H1.
+  apply Zle_lt_trans with (b + c).
+  apply Zplus_le_compat_r; trivial.
+  apply Zplus_lt_compat_l; trivial.
+Qed.
+
+Lemma Zplus_le_compat : forall n m p q:Z, n <= m -> p <= q -> n + p <= m + q.
+Proof.
+  intros n m p q; intros H1 H2; apply Zle_trans with (m := n + q);
+    [ apply Zplus_le_compat_l; assumption
+      | apply Zplus_le_compat_r; assumption ].
+Qed.
+
+
+Lemma Zplus_lt_compat : forall n m p q:Z, n < m -> p < q -> n + p < m + q.
+  intros; apply Zplus_le_lt_compat. apply Zlt_le_weak; assumption. assumption.
+Qed.
+
+
+(** Compatibility of addition wrt to being positive *)
+
+Lemma Zplus_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n + m.
+Proof.
+  intros x y H1 H2; rewrite <- (Zplus_0_l 0); apply Zplus_le_compat; assumption.
+Qed.
+
+(** Simplification of addition wrt to order *)
+
+Lemma Zplus_gt_reg_l : forall n m p:Z, p + n > p + m -> n > m.
+Proof.
+  unfold Zgt in |- *; intros n m p H; rewrite <- (Zcompare_plus_compat n m p);
+    assumption.
+Qed.
+
+Lemma Zplus_gt_reg_r : forall n m p:Z, n + p > m + p -> n > m.
+Proof.
+  intros n m p H; apply Zplus_gt_reg_l with p.
+  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+Qed.
+
+Lemma Zplus_le_reg_l : forall n m p:Z, p + n <= p + m -> n <= m.
+Proof.
+  intros n m p; unfold Zle, not in |- *; intros H1 H2; apply H1;
+    rewrite (Zcompare_plus_compat n m p); assumption.
+Qed.
+
+Lemma Zplus_le_reg_r : forall n m p:Z, n + p <= m + p -> n <= m.
+Proof.
+  intros n m p H; apply Zplus_le_reg_l with p.
+  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+Qed.
+
+Lemma Zplus_lt_reg_l : forall n m p:Z, p + n < p + m -> n < m.
+Proof.
+  unfold Zlt in |- *; intros n m p; rewrite Zcompare_plus_compat;
+    trivial with arith.
+Qed.
+
+Lemma Zplus_lt_reg_r : forall n m p:Z, n + p < m + p -> n < m.
+Proof.
+  intros n m p H; apply Zplus_lt_reg_l with p.
+  rewrite (Zplus_comm p n); rewrite (Zplus_comm p m); trivial.
+Qed.
+
+(** ** Multiplication *) 
+(** Compatibility of multiplication by a positive wrt to order *)
 
 Lemma Zmult_le_compat_r : forall n m p:Z, n <= m -> 0 <= p -> n * p <= m * p.
 Proof.
-intros a b c H H0; destruct c.
+  intros a b c H H0; destruct c.
   do 2 rewrite Zmult_0_r; assumption.
   rewrite (Zmult_comm a); rewrite (Zmult_comm b).
-    unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption.
+  unfold Zle in |- *; rewrite Zcompare_mult_compat; assumption.
   unfold Zle in H0; contradiction H0; reflexivity.
 Qed.
 
 Lemma Zmult_le_compat_l : forall n m p:Z, n <= m -> 0 <= p -> p * n <= p * m.
 Proof.
-intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
-apply Zmult_le_compat_r; trivial.
+  intros a b c H1 H2; rewrite (Zmult_comm c a); rewrite (Zmult_comm c b).
+  apply Zmult_le_compat_r; trivial.
 Qed.
 
 Lemma Zmult_lt_compat_r : forall n m p:Z, 0 < p -> n < m -> n * p < m * p.
 Proof.
-intros x y z H H0; destruct z.
+  intros x y z H H0; destruct z.
   contradiction (Zlt_irrefl 0).
   rewrite (Zmult_comm x); rewrite (Zmult_comm y).
-    unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption.
+  unfold Zlt in |- *; rewrite Zcompare_mult_compat; assumption.
   discriminate H.
 Qed.
 
 Lemma Zmult_gt_compat_r : forall n m p:Z, p > 0 -> n > m -> n * p > m * p.
 Proof.
-intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt;
- assumption.
+  intros x y z; intros; apply Zlt_gt; apply Zmult_lt_compat_r; apply Zgt_lt;
+    assumption.
 Qed.
 
 Lemma Zmult_gt_0_lt_compat_r :
- forall n m p:Z, p > 0 -> n < m -> n * p < m * p.
+  forall n m p:Z, p > 0 -> n < m -> n * p < m * p.
 Proof.
-intros x y z; intros; apply Zmult_lt_compat_r;
- [ apply Zgt_lt; assumption | assumption ].
+  intros x y z; intros; apply Zmult_lt_compat_r;
+    [ apply Zgt_lt; assumption | assumption ].
 Qed.
 
 Lemma Zmult_gt_0_le_compat_r :
- forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p.
+  forall n m p:Z, p > 0 -> n <= m -> n * p <= m * p.
 Proof.
-intros x y z Hz Hxy.
-elim (Zle_lt_or_eq x y Hxy).
-intros; apply Zlt_le_weak.
-apply Zmult_gt_0_lt_compat_r; trivial.
-intros; apply Zeq_le.
-rewrite H; trivial.
+  intros x y z Hz Hxy.
+  elim (Zle_lt_or_eq x y Hxy).
+  intros; apply Zlt_le_weak.
+  apply Zmult_gt_0_lt_compat_r; trivial.
+  intros; apply Zeq_le.
+  rewrite H; trivial.
 Qed.
 
 Lemma Zmult_lt_0_le_compat_r :
- forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p.
+  forall n m p:Z, 0 < p -> n <= m -> n * p <= m * p.
 Proof.
-intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt;
- assumption.
+  intros x y z; intros; apply Zmult_gt_0_le_compat_r; try apply Zlt_gt;
+    assumption.
 Qed.
 
 Lemma Zmult_gt_0_lt_compat_l :
- forall n m p:Z, p > 0 -> n < m -> p * n < p * m.
+  forall n m p:Z, p > 0 -> n < m -> p * n < p * m.
 Proof.
-intros x y z; intros.
-rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
- apply Zmult_gt_0_lt_compat_r; assumption.
+  intros x y z; intros.
+  rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+    apply Zmult_gt_0_lt_compat_r; assumption.
 Qed.
 
 Lemma Zmult_lt_compat_l : forall n m p:Z, 0 < p -> n < m -> p * n < p * m.
 Proof.
-intros x y z; intros.
-rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
- apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption.
+  intros x y z; intros.
+  rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+    apply Zmult_gt_0_lt_compat_r; try apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zmult_gt_compat_l : forall n m p:Z, p > 0 -> n > m -> p * n > p * m.
 Proof.
-intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
- apply Zmult_gt_compat_r; assumption.
+  intros x y z; intros; rewrite (Zmult_comm z x); rewrite (Zmult_comm z y);
+    apply Zmult_gt_compat_r; assumption.
 Qed.
 
 Lemma Zmult_ge_compat_r : forall n m p:Z, n >= m -> p >= 0 -> n * p >= m * p.
 Proof.
-intros a b c H1 H2; apply Zle_ge.
-apply Zmult_le_compat_r; apply Zge_le; trivial.
+  intros a b c H1 H2; apply Zle_ge.
+  apply Zmult_le_compat_r; apply Zge_le; trivial.
 Qed.
 
 Lemma Zmult_ge_compat_l : forall n m p:Z, n >= m -> p >= 0 -> p * n >= p * m.
 Proof.
-intros a b c H1 H2; apply Zle_ge.
-apply Zmult_le_compat_l; apply Zge_le; trivial.
+  intros a b c H1 H2; apply Zle_ge.
+  apply Zmult_le_compat_l; apply Zge_le; trivial.
 Qed.
 
 Lemma Zmult_ge_compat :
- forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
+  forall n m p q:Z, n >= p -> m >= q -> p >= 0 -> q >= 0 -> n * m >= p * q.
 Proof.
-intros a b c d H0 H1 H2 H3.
-apply Zge_trans with (a * d).
-apply Zmult_ge_compat_l; trivial.
-apply Zge_trans with c; trivial. 
-apply Zmult_ge_compat_r; trivial.
+  intros a b c d H0 H1 H2 H3.
+  apply Zge_trans with (a * d).
+  apply Zmult_ge_compat_l; trivial.
+  apply Zge_trans with c; trivial. 
+  apply Zmult_ge_compat_r; trivial.
 Qed.
 
 Lemma Zmult_le_compat :
- forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
+  forall n m p q:Z, n <= p -> m <= q -> 0 <= n -> 0 <= m -> n * m <= p * q.
 Proof.
-intros a b c d H0 H1 H2 H3.
-apply Zle_trans with (c * b).
-apply Zmult_le_compat_r; assumption.
-apply Zmult_le_compat_l.
-assumption.
-apply Zle_trans with a; assumption.
+  intros a b c d H0 H1 H2 H3.
+  apply Zle_trans with (c * b).
+  apply Zmult_le_compat_r; assumption.
+  apply Zmult_le_compat_l.
+  assumption.
+  apply Zle_trans with a; assumption.
 Qed.
 
 (** Simplification of multiplication by a positive wrt to being positive *)
 
 Lemma Zmult_gt_0_lt_reg_r : forall n m p:Z, p > 0 -> n * p < m * p -> n < m.
 Proof.
-intros x y z; intros; destruct z.
+  intros x y z; intros; destruct z.
   contradiction (Zgt_irrefl 0).
   rewrite (Zmult_comm x) in H0; rewrite (Zmult_comm y) in H0.
-    unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption.
+  unfold Zlt in H0; rewrite Zcompare_mult_compat in H0; assumption.
   discriminate H.
 Qed.
 
 Lemma Zmult_lt_reg_r : forall n m p:Z, 0 < p -> n * p < m * p -> n < m.
 Proof.
-intros a b c H0 H1.
-apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption.
+  intros a b c H0 H1.
+  apply Zmult_gt_0_lt_reg_r with c; try apply Zlt_gt; assumption.
 Qed.
 
 Lemma Zmult_le_reg_r : forall n m p:Z, p > 0 -> n * p <= m * p -> n <= m.
 Proof.
-intros x y z Hz Hxy.
-elim (Zle_lt_or_eq (x * z) (y * z) Hxy).
-intros; apply Zlt_le_weak.
-apply Zmult_gt_0_lt_reg_r with z; trivial.
-intros; apply Zeq_le.
-apply Zmult_reg_r with z.
+  intros x y z Hz Hxy.
+  elim (Zle_lt_or_eq (x * z) (y * z) Hxy).
+  intros; apply Zlt_le_weak.
+  apply Zmult_gt_0_lt_reg_r with z; trivial.
+  intros; apply Zeq_le.
+  apply Zmult_reg_r with z.
   intro. rewrite H0 in Hz. contradiction (Zgt_irrefl 0).
-assumption.
+  assumption.
 Qed.
 
 Lemma Zmult_lt_0_le_reg_r : forall n m p:Z, 0 < p -> n * p <= m * p -> n <= m.
-intros x y z; intros; apply Zmult_le_reg_r with z.
-try apply Zlt_gt; assumption.
-assumption.
+Proof.
+  intros x y z; intros; apply Zmult_le_reg_r with z.
+  try apply Zlt_gt; assumption.
+  assumption.
 Qed.
 
 
 Lemma Zmult_ge_reg_r : forall n m p:Z, p > 0 -> n * p >= m * p -> n >= m.
-intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial.
-apply Zge_le; trivial.
+Proof.
+  intros a b c H1 H2; apply Zle_ge; apply Zmult_le_reg_r with c; trivial.
+  apply Zge_le; trivial.
 Qed.
 
 Lemma Zmult_gt_reg_r : forall n m p:Z, p > 0 -> n * p > m * p -> n > m.
-intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial.
-apply Zgt_lt; trivial.
+Proof.
+  intros a b c H1 H2; apply Zlt_gt; apply Zmult_gt_0_lt_reg_r with c; trivial.
+  apply Zgt_lt; trivial.
 Qed.
 
 
@@ -830,154 +846,156 @@ Qed.
 
 Lemma Zmult_le_0_compat : forall n m:Z, 0 <= n -> 0 <= m -> 0 <= n * m.
 Proof.
-intros x y; case x.
-intros; rewrite Zmult_0_l; trivial.
-intros p H1; unfold Zle in |- *.
+  intros x y; case x.
+  intros; rewrite Zmult_0_l; trivial.
+  intros p H1; unfold Zle in |- *.
   pattern 0 at 2 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
   rewrite Zcompare_mult_compat; trivial.
-intros p H1 H2; absurd (0 > Zneg p); trivial.
-unfold Zgt in |- *; simpl in |- *; auto with zarith.
+  intros p H1 H2; absurd (0 > Zneg p); trivial.
+  unfold Zgt in |- *; simpl in |- *; auto with zarith.
 Qed.
 
 Lemma Zmult_gt_0_compat : forall n m:Z, n > 0 -> m > 0 -> n * m > 0.
 Proof.
-intros x y; case x.
-intros H; discriminate H.
-intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *;
- rewrite <- (Zmult_0_r (Zpos p)).
+  intros x y; case x.
+  intros H; discriminate H.
+  intros p H1; unfold Zgt in |- *; pattern 0 at 2 in |- *;
+    rewrite <- (Zmult_0_r (Zpos p)).
   rewrite Zcompare_mult_compat; trivial.
-intros p H; discriminate H.
+  intros p H; discriminate H.
 Qed.
 
 Lemma Zmult_lt_0_compat : forall n m:Z, 0 < n -> 0 < m -> 0 < n * m.
-intros a b apos bpos.
-apply Zgt_lt.
-apply Zmult_gt_0_compat; try apply Zlt_gt; assumption.
+Proof.
+  intros a b apos bpos.
+  apply Zgt_lt.
+  apply Zmult_gt_0_compat; try apply Zlt_gt; assumption.
 Qed.
 
-(* For compatibility *)
+(** For compatibility *)
 Notation Zmult_lt_O_compat := Zmult_lt_0_compat (only parsing).
 
 Lemma Zmult_gt_0_le_0_compat : forall n m:Z, n > 0 -> 0 <= m -> 0 <= m * n.
 Proof.
-intros x y H1 H2; apply Zmult_le_0_compat; trivial.
-apply Zlt_le_weak; apply Zgt_lt; trivial.
+  intros x y H1 H2; apply Zmult_le_0_compat; trivial.
+  apply Zlt_le_weak; apply Zgt_lt; trivial.
 Qed.
 
 (** Simplification of multiplication by a positive wrt to being positive *)
 
 Lemma Zmult_le_0_reg_r : forall n m:Z, n > 0 -> 0 <= m * n -> 0 <= m.
 Proof.
-intros x y; case x;
- [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
- | intros p H1; unfold Zle in |- *; rewrite Zmult_comm;
-    pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
-    rewrite Zcompare_mult_compat; auto with arith
- | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
+  intros x y; case x;
+    [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
+      | intros p H1; unfold Zle in |- *; rewrite Zmult_comm;
+	pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
+	  rewrite Zcompare_mult_compat; auto with arith
+      | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
 Qed.
 
 Lemma Zmult_gt_0_lt_0_reg_r : forall n m:Z, n > 0 -> 0 < m * n -> 0 < m.
 Proof.
-intros x y; case x;
- [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
- | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm;
-    pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
-    rewrite Zcompare_mult_compat; auto with arith
- | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
+  intros x y; case x;
+    [ simpl in |- *; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H
+      | intros p H1; unfold Zlt in |- *; rewrite Zmult_comm;
+	pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p));
+	  rewrite Zcompare_mult_compat; auto with arith
+      | intros p; unfold Zgt in |- *; simpl in |- *; intros H; discriminate H ].
 Qed.
 
 Lemma Zmult_lt_0_reg_r : forall n m:Z, 0 < n -> 0 < m * n -> 0 < m.
 Proof.
-intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt;
- assumption.
+  intros x y; intros; eapply Zmult_gt_0_lt_0_reg_r with x; try apply Zlt_gt;
+    assumption.
 Qed.
 
 Lemma Zmult_gt_0_reg_l : forall n m:Z, n > 0 -> n * m > 0 -> m > 0.
 Proof.
-intros x y; case x.
- intros H; discriminate H.
- intros p H1; unfold Zgt in |- *.
- pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
- rewrite Zcompare_mult_compat; trivial.
-intros p H; discriminate H.
+  intros x y; case x.
+  intros H; discriminate H.
+  intros p H1; unfold Zgt in |- *.
+  pattern 0 at 1 in |- *; rewrite <- (Zmult_0_r (Zpos p)).
+  rewrite Zcompare_mult_compat; trivial.
+  intros p H; discriminate H.
 Qed.
 
+(** ** Square *)
 (** Simplification of square wrt order *)
 
 Lemma Zgt_square_simpl :
- forall n m:Z, n >= 0 -> n * n > m * m -> n > m.
+  forall n m:Z, n >= 0 -> n * n > m * m -> n > m.
 Proof.
-intros n m H0 H1.
-case (dec_Zlt m n).
-intro; apply Zlt_gt; trivial.
-intros H2; cut (m >= n).
-intros H.
-elim Zgt_not_le with (1 := H1).
-apply Zge_le.
-apply Zmult_ge_compat; auto.
-apply Znot_lt_ge; trivial.
+  intros n m H0 H1.
+  case (dec_Zlt m n).
+  intro; apply Zlt_gt; trivial.
+  intros H2; cut (m >= n).
+  intros H.
+  elim Zgt_not_le with (1 := H1).
+  apply Zge_le.
+  apply Zmult_ge_compat; auto.
+  apply Znot_lt_ge; trivial.
 Qed.
 
 Lemma Zlt_square_simpl :
- forall n m:Z, 0 <= n -> m * m < n * n -> m < n.
+  forall n m:Z, 0 <= n -> m * m < n * n -> m < n.
 Proof.
-intros x y H0 H1.
-apply Zgt_lt.
-apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption.
+  intros x y H0 H1.
+  apply Zgt_lt.
+  apply Zgt_square_simpl; try apply Zle_ge; try apply Zlt_gt; assumption.
 Qed.
 
-(** Equivalence between inequalities *)
+(** * Equivalence between inequalities *)
 
 Lemma Zle_plus_swap : forall n m p:Z, n + p <= m <-> n <= m - p.
 Proof.
-    intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z).
-    rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H).
-    intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc.
-    apply Zplus_le_compat_r. assumption.
+  intros x y z; intros. split. intro. rewrite <- (Zplus_0_r x). rewrite <- (Zplus_opp_r z).
+  rewrite Zplus_assoc. exact (Zplus_le_compat_r _ _ _ H).
+  intro. rewrite <- (Zplus_0_r y). rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc.
+  apply Zplus_le_compat_r. assumption.
 Qed.
 
 Lemma Zlt_plus_swap : forall n m p:Z, n + p < m <-> n < m - p.
 Proof.
-    intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x).
-    rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm.
-    assumption.
-    intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z).
-    rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption.
+  intros x y z; intros. split. intro. unfold Zminus in |- *. rewrite Zplus_comm. rewrite <- (Zplus_0_l x).
+  rewrite <- (Zplus_opp_l z). rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm.
+  assumption.
+  intro. rewrite Zplus_comm. rewrite <- (Zplus_0_l y). rewrite <- (Zplus_opp_r z).
+  rewrite Zplus_assoc_reverse. apply Zplus_lt_compat_l. rewrite Zplus_comm. assumption.
 Qed.
 
 Lemma Zeq_plus_swap : forall n m p:Z, n + p = m <-> n = m - p.
 Proof.
-intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry  in |- *. rewrite Zplus_comm. 
+  intros x y z; intros. split. intro. apply Zplus_minus_eq. symmetry  in |- *. rewrite Zplus_comm. 
   assumption.
-intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. 
+  intro. rewrite H. unfold Zminus in |- *. rewrite Zplus_assoc_reverse. 
   rewrite Zplus_opp_l. apply Zplus_0_r.
 Qed.
 
 Lemma Zlt_minus_simpl_swap : forall n m:Z, 0 < m -> n - m < n.
 Proof.
-intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus;
- pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); 
- rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; 
- assumption.
+  intros n m H; apply Zplus_lt_reg_l with (p := m); rewrite Zplus_minus;
+    pattern n at 1 in |- *; rewrite <- (Zplus_0_r n); 
+      rewrite (Zplus_comm m n); apply Zplus_lt_compat_l; 
+	assumption.
 Qed.
 
 Lemma Zlt_0_minus_lt : forall n m:Z, 0 < n - m -> m < n.
 Proof.
-intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l;
- rewrite Zplus_comm; exact H.
+  intros n m H; apply Zplus_lt_reg_l with (p := - m); rewrite Zplus_opp_l;
+    rewrite Zplus_comm; exact H.
 Qed.
 
 Lemma Zle_0_minus_le : forall n m:Z, 0 <= n - m -> m <= n.
 Proof.
-intros n m H; apply Zplus_le_reg_l with (p := - m); rewrite Zplus_opp_l;
- rewrite Zplus_comm; exact H.
+  intros n m H; apply Zplus_le_reg_l with (p := - m); rewrite Zplus_opp_l;
+    rewrite Zplus_comm; exact H.
 Qed.
 
 Lemma Zle_minus_le_0 : forall n m:Z, m <= n -> 0 <= n - m.
 Proof.
-intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); 
-rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. 
+  intros n m H; unfold Zminus; apply Zplus_le_reg_r with (p := m); 
+    rewrite <- Zplus_assoc; rewrite Zplus_opp_l; rewrite Zplus_0_r; exact H. 
 Qed.
 
-(* For compatibility *)
+(** For compatibility *)
 Notation Zlt_O_minus_lt := Zlt_0_minus_lt (only parsing).
diff --git a/theories/ZArith/Zpower.v b/theories/ZArith/Zpower.v
index 70a2bd45..446f663c 100644
--- a/theories/ZArith/Zpower.v
+++ b/theories/ZArith/Zpower.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: Zpower.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: Zpower.v 9245 2006-10-17 12:53:34Z notin $ i*)
 
 Require Import ZArith_base.
 Require Import Omega.
@@ -15,81 +15,84 @@ Open Local Scope Z_scope.
 
 Section section1.
 
+(** * Definition of powers over [Z]*)
+
 (** [Zpower_nat z n] is the n-th power of [z] when [n] is an unary
     integer (type [nat]) and [z] a signed integer (type [Z]) *) 
 
-Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun x:Z => z * x) 1.
-
-(** [Zpower_nat_is_exp] says [Zpower_nat] is a morphism for
-    [plus : nat->nat] and [Zmult : Z->Z] *)
-
-Lemma Zpower_nat_is_exp :
- forall (n m:nat) (z:Z),
-   Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m.
-
-intros; elim n;
- [ simpl in |- *; elim (Zpower_nat z m); auto with zarith
- | unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H;
-    apply Zmult_assoc ].
-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 (fun 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 :
- forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p).
-
-intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *;
- apply iter_nat_of_P.
-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 :
- forall (n m:positive) (z:Z),
-   Zpower_pos z (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 (n + m)).
-rewrite (nat_of_P_plus_morphism n m).
-apply Zpower_nat_is_exp.
-Qed.
-
-Definition Zpower (x y:Z) :=
-  match y with
-  | Zpos p => Zpower_pos x p
-  | Z0 => 1
-  | Zneg p => 0
-  end.
-
-Infix "^" := Zpower : Z_scope.
-
-Hint Immediate Zpower_nat_is_exp: zarith.
-Hint Immediate Zpower_pos_is_exp: zarith.
-Hint Unfold Zpower_pos: zarith.
-Hint Unfold Zpower_nat: zarith.
-
-Lemma Zpower_exp :
- forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m.
-destruct n; destruct m; auto with zarith.
-simpl in |- *; intros; apply Zred_factor0.
-simpl in |- *; auto with zarith.
-intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
-intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
-Qed.
+  Definition Zpower_nat (z:Z) (n:nat) := iter_nat n Z (fun 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 :
+    forall (n m:nat) (z:Z),
+      Zpower_nat z (n + m) = Zpower_nat z n * Zpower_nat z m.
+  Proof.
+    intros; elim n;
+      [ simpl in |- *; elim (Zpower_nat z m); auto with zarith
+	| unfold Zpower_nat in |- *; intros; simpl in |- *; rewrite H;
+	  apply Zmult_assoc ].
+  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 (fun 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 :
+    forall (z:Z) (p:positive), Zpower_pos z p = Zpower_nat z (nat_of_P p).
+  Proof.
+    intros; unfold Zpower_pos in |- *; unfold Zpower_nat in |- *;
+      apply iter_nat_of_P.
+  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 :
+    forall (n m:positive) (z:Z),
+      Zpower_pos z (n + m) = Zpower_pos z n * Zpower_pos z m.
+  Proof.
+    intros.
+    rewrite (Zpower_pos_nat z n).
+    rewrite (Zpower_pos_nat z m).
+    rewrite (Zpower_pos_nat z (n + m)).
+    rewrite (nat_of_P_plus_morphism n m).
+    apply Zpower_nat_is_exp.
+  Qed.
+
+  Definition Zpower (x y:Z) :=
+    match y with
+      | Zpos p => Zpower_pos x p
+      | Z0 => 1
+      | Zneg p => 0
+    end.
+
+  Infix "^" := Zpower : Z_scope.
+
+  Hint Immediate Zpower_nat_is_exp: zarith.
+  Hint Immediate Zpower_pos_is_exp: zarith.
+  Hint Unfold Zpower_pos: zarith.
+  Hint Unfold Zpower_nat: zarith.
+
+  Lemma Zpower_exp :
+    forall x n m:Z, n >= 0 -> m >= 0 -> x ^ (n + m) = x ^ n * x ^ m.
+  Proof.
+    destruct n; destruct m; auto with zarith.
+    simpl in |- *; intros; apply Zred_factor0.
+    simpl in |- *; auto with zarith.
+    intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
+    intros; compute in H0; absurd (Datatypes.Lt = Datatypes.Lt); auto with zarith.
+  Qed.
 
 End section1.
 
-(* Exporting notation "^" *)
+(** Exporting notation "^" *)
 
 Infix "^" := Zpower : Z_scope.
 
@@ -100,273 +103,283 @@ Hint 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 z:positive) := iter_pos n positive xO z. 
-Definition shift (n:Z) (z:positive) :=
-  match n with
-  | Z0 => z
-  | Zpos p => iter_pos p positive xO z
-  | Zneg p => z
-  end.
-
-Definition two_power_nat (n:nat) := Zpos (shift_nat n 1).
-Definition two_power_pos (x:positive) := Zpos (shift_pos x 1).
-
-Lemma two_power_nat_S :
- forall n:nat, two_power_nat (S n) = 2 * two_power_nat n.
-intro; simpl in |- *; apply refl_equal.
-Qed.
-
-Lemma shift_nat_plus :
- forall (n m:nat) (x:positive),
-   shift_nat (n + m) x = shift_nat n (shift_nat m x).
-
-intros; unfold shift_nat in |- *; apply iter_nat_plus.
-Qed.
-
-Theorem shift_nat_correct :
- forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x.
-
-unfold shift_nat in |- *; simple induction n;
- [ simpl in |- *; trivial with zarith
- | intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0);
-    [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity
-    | auto with zarith ] ].
-Qed.
-
-Theorem two_power_nat_correct :
- forall n:nat, two_power_nat n = Zpower_nat 2 n.
-
-intro n.
-unfold two_power_nat in |- *.
-rewrite (shift_nat_correct n).
-omega.
-Qed.
+  (** * 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 z:positive) := iter_pos n positive xO z. 
+  Definition shift (n:Z) (z:positive) :=
+    match n with
+      | Z0 => z
+      | Zpos p => iter_pos p positive xO z
+      | Zneg p => z
+    end.
+
+  Definition two_power_nat (n:nat) := Zpos (shift_nat n 1).
+  Definition two_power_pos (x:positive) := Zpos (shift_pos x 1).
+
+  Lemma two_power_nat_S :
+    forall n:nat, two_power_nat (S n) = 2 * two_power_nat n.
+  Proof.
+    intro; simpl in |- *; apply refl_equal.
+  Qed.
+
+  Lemma shift_nat_plus :
+    forall (n m:nat) (x:positive),
+      shift_nat (n + m) x = shift_nat n (shift_nat m x).
+  Proof.
+    intros; unfold shift_nat in |- *; apply iter_nat_plus.
+  Qed.
+
+  Theorem shift_nat_correct :
+    forall (n:nat) (x:positive), Zpos (shift_nat n x) = Zpower_nat 2 n * Zpos x.
+  Proof.
+    unfold shift_nat in |- *; simple induction n;
+      [ simpl in |- *; trivial with zarith
+	| intros; replace (Zpower_nat 2 (S n0)) with (2 * Zpower_nat 2 n0);
+	  [ rewrite <- Zmult_assoc; rewrite <- (H x); simpl in |- *; reflexivity
+	    | auto with zarith ] ].
+  Qed.
+
+  Theorem two_power_nat_correct :
+    forall n:nat, two_power_nat n = Zpower_nat 2 n.
+  Proof.
+    intro n.
+    unfold two_power_nat in |- *.
+    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 :
+    forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x.
+  Proof.
+    unfold shift_pos in |- *.
+    unfold shift_nat in |- *.
+    intros; apply iter_nat_of_P.
+  Qed.
+
+  Lemma two_power_pos_nat :
+    forall p:positive, two_power_pos p = two_power_nat (nat_of_P p).
+  Proof.
+    intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *.
+    apply f_equal with (f := Zpos).
+    apply shift_pos_nat.
+  Qed.
+
+  (** Then we deduce that [two_power_pos] is also correct *)
+
+  Theorem shift_pos_correct :
+    forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x.
+  Proof.
+    intros.
+    rewrite (shift_pos_nat p x).
+    rewrite (Zpower_pos_nat 2 p).
+    apply shift_nat_correct.
+  Qed.
+
+  Theorem two_power_pos_correct :
+    forall x:positive, two_power_pos x = Zpower_pos 2 x.
+  Proof.
+    intro.
+    rewrite two_power_pos_nat.
+    rewrite Zpower_pos_nat.
+    apply two_power_nat_correct.
+  Qed.
+
+  (** Some consequences *)
+
+  Theorem two_power_pos_is_exp :
+    forall x y:positive,
+      two_power_pos (x + y) = two_power_pos x * two_power_pos y.
+  Proof.
+    intros.
+    rewrite (two_power_pos_correct (x + y)).
+    rewrite (two_power_pos_correct x).
+    rewrite (two_power_pos_correct y).
+    apply Zpower_pos_is_exp.
+  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. *)
   
-(** Second we show that [two_power_pos] and [two_power_nat] are the same *)
-Lemma shift_pos_nat :
- forall p x:positive, shift_pos p x = shift_nat (nat_of_P p) x.
-
-unfold shift_pos in |- *.
-unfold shift_nat in |- *.
-intros; apply iter_nat_of_P.
-Qed.
-
-Lemma two_power_pos_nat :
- forall p:positive, two_power_pos p = two_power_nat (nat_of_P p).
-
-intro; unfold two_power_pos in |- *; unfold two_power_nat in |- *.
-apply f_equal with (f := Zpos).
-apply shift_pos_nat.
-Qed.
-
-(** Then we deduce that [two_power_pos] is also correct *)
-
-Theorem shift_pos_correct :
- forall p x:positive, Zpos (shift_pos p x) = Zpower_pos 2 p * Zpos x.
-
-intros.
-rewrite (shift_pos_nat p x).
-rewrite (Zpower_pos_nat 2 p).
-apply shift_nat_correct.
-Qed.
-
-Theorem two_power_pos_correct :
- forall 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 :
- forall x y:positive,
-   two_power_pos (x + y) = two_power_pos x * two_power_pos y.
-intros.
-rewrite (two_power_pos_correct (x + y)).
-rewrite (two_power_pos_correct x).
-rewrite (two_power_pos_correct y).
-apply Zpower_pos_is_exp.
-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) :=
-  match x with
-  | Z0 => 1
-  | Zpos y => two_power_pos y
-  | Zneg y => 0
-  end.
-
-Theorem two_p_is_exp :
- forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y.
-simple induction x;
- [ simple induction y; simpl in |- *; auto with zarith
- | simple induction y;
-    [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1);
-       rewrite (Zmult_1_l (two_power_pos p)); auto with zarith
-    | unfold Zplus in |- *; unfold two_p in |- *; intros;
-       apply two_power_pos_is_exp
-    | intros; unfold Zle in H0; unfold Zcompare in H0;
-       absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ]
- | simple induction y;
-    [ simpl in |- *; auto with zarith
-    | intros; unfold Zle in H; unfold Zcompare in H;
-       absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith
-    | intros; unfold Zle in H; unfold Zcompare in H;
-       absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ].
-Qed.
-
-Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0.
-simple induction x; intros;
- [ simpl in |- *; omega
- | simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0
- | absurd (0 <= Zneg p);
-    [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *;
-       do 2 unfold not in |- *; auto with zarith
-    | assumption ] ].
-Qed.
-
-Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x.
-intros; unfold Zsucc in |- *. 
-rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)).
-apply Zmult_comm.
-Qed.
-
-Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x.
-intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x);
- [ simpl in |- *; unfold Zlt in |- *; auto with zarith
- | intros; elim (Zle_lt_or_eq 0 x0 H0);
-    [ intros;
-       replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0)));
-       [ rewrite (two_p_S (Zpred x0));
-          [ rewrite (two_p_S x0); [ omega | assumption ]
-          | apply Zorder.Zlt_0_le_0_pred; assumption ]
-       | rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0);
-          trivial with zarith ]
-    | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *;
-       auto with zarith ]
- | assumption ].
-Qed. 
-
-Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y.
-intros; omega. Qed. 
-
-End Powers_of_2.
+  Definition two_p (x:Z) :=
+    match x with
+      | Z0 => 1
+      | Zpos y => two_power_pos y
+      | Zneg y => 0
+    end.
+
+  Theorem two_p_is_exp :
+    forall x y:Z, 0 <= x -> 0 <= y -> two_p (x + y) = two_p x * two_p y.
+  Proof.
+    simple induction x;
+      [ simple induction y; simpl in |- *; auto with zarith
+	| simple induction y;
+	  [ unfold two_p in |- *; rewrite (Zmult_comm (two_power_pos p) 1);
+	    rewrite (Zmult_1_l (two_power_pos p)); auto with zarith
+	    | unfold Zplus in |- *; unfold two_p in |- *; intros;
+	      apply two_power_pos_is_exp
+	    | intros; unfold Zle in H0; unfold Zcompare in H0;
+	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ]
+	| simple induction y;
+	  [ simpl in |- *; auto with zarith
+	    | intros; unfold Zle in H; unfold Zcompare in H;
+	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith
+	    | intros; unfold Zle in H; unfold Zcompare in H;
+	      absurd (Datatypes.Gt = Datatypes.Gt); trivial with zarith ] ].
+  Qed.
+
+  Lemma two_p_gt_ZERO : forall x:Z, 0 <= x -> two_p x > 0.
+  Proof.
+    simple induction x; intros;
+      [ simpl in |- *; omega
+	| simpl in |- *; unfold two_power_pos in |- *; apply Zorder.Zgt_pos_0
+	| absurd (0 <= Zneg p);
+	  [ simpl in |- *; unfold Zle in |- *; unfold Zcompare in |- *;
+	    do 2 unfold not in |- *; auto with zarith
+	    | assumption ] ].
+  Qed.
+
+  Lemma two_p_S : forall x:Z, 0 <= x -> two_p (Zsucc x) = 2 * two_p x.
+  Proof.
+    intros; unfold Zsucc in |- *. 
+    rewrite (two_p_is_exp x 1 H (Zorder.Zle_0_pos 1)).
+    apply Zmult_comm.
+  Qed.
+
+  Lemma two_p_pred : forall x:Z, 0 <= x -> two_p (Zpred x) < two_p x.
+  Proof.
+    intros; apply natlike_ind with (P := fun x:Z => two_p (Zpred x) < two_p x);
+      [ simpl in |- *; unfold Zlt in |- *; auto with zarith
+	| intros; elim (Zle_lt_or_eq 0 x0 H0);
+	  [ intros;
+	    replace (two_p (Zpred (Zsucc x0))) with (two_p (Zsucc (Zpred x0)));
+	      [ rewrite (two_p_S (Zpred x0));
+		[ rewrite (two_p_S x0); [ omega | assumption ]
+		  | apply Zorder.Zlt_0_le_0_pred; assumption ]
+		| rewrite <- (Zsucc_pred x0); rewrite <- (Zpred_succ x0);
+		  trivial with zarith ]
+	    | intro Hx0; rewrite <- Hx0; simpl in |- *; unfold Zlt in |- *;
+	      auto with zarith ]
+	| assumption ].
+  Qed. 
+
+  Lemma Zlt_lt_double : forall x y:Z, 0 <= x < y -> x < 2 * y.
+    intros; omega. Qed. 
+
+  End Powers_of_2.
 
 Hint Resolve two_p_gt_ZERO: zarith.
 Hint 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
-  (match q with
-   | Z0 => (0, r)
-   | Zpos xH => (0, d + r)
-   | Zpos (xI n) => (Zpos n, d + r)
-   | Zpos (xO n) => (Zpos n, r)
-   | Zneg xH => (-1, d + r)
-   | Zneg (xI n) => (Zneg n - 1, d + r)
-   | Zneg (xO n) => (Zneg n, r)
-   end, 2 * d).
-
-Definition Zdiv_rest (x:Z) (p:positive) :=
-  let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr.
-
-Lemma Zdiv_rest_correct1 :
- forall (x:Z) (p:positive),
-   let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p.
-
-intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1));
- rewrite (two_power_pos_nat p); elim (nat_of_P p); 
- simpl in |- *;
- [ trivial with zarith
- | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *;
-    elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); 
-    destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z);
-    assumption ]. 
-Qed.
-
-Lemma Zdiv_rest_correct2 :
- forall (x:Z) (p:positive),
-   let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in
-   let (q, r) := qr in x = q * d + r /\ 0 <= r < d.
-
-intros;
- apply iter_pos_invariant with
-  (f := Zdiv_rest_aux)
-  (Inv := fun qrd:Z * Z * Z =>
-            let (qr, d) := qrd in
+  (** * 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
+	(match q with
+	   | Z0 => (0, r)
+	   | Zpos xH => (0, d + r)
+	   | Zpos (xI n) => (Zpos n, d + r)
+	   | Zpos (xO n) => (Zpos n, r)
+	   | Zneg xH => (-1, d + r)
+	   | Zneg (xI n) => (Zneg n - 1, d + r)
+	   | Zneg (xO n) => (Zneg n, r)
+	 end, 2 * d).
+
+  Definition Zdiv_rest (x:Z) (p:positive) :=
+    let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in qr.
+
+  Lemma Zdiv_rest_correct1 :
+    forall (x:Z) (p:positive),
+      let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in d = two_power_pos p.
+  Proof.
+    intros x p; rewrite (iter_nat_of_P p _ Zdiv_rest_aux (x, 0, 1));
+      rewrite (two_power_pos_nat p); elim (nat_of_P p); 
+	simpl in |- *;
+	  [ trivial with zarith
+	    | intro n; rewrite (two_power_nat_S n); unfold Zdiv_rest_aux at 2 in |- *;
+	      elim (iter_nat n (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)); 
+		destruct a; intros; apply f_equal with (f := fun z:Z => 2 * z);
+		  assumption ]. 
+  Qed.
+
+  Lemma Zdiv_rest_correct2 :
+    forall (x:Z) (p:positive),
+      let (qr, d) := iter_pos p _ Zdiv_rest_aux (x, 0, 1) in
+	let (q, r) := qr in x = q * d + r /\ 0 <= r < d.
+  Proof.
+    intros;
+      apply iter_pos_invariant with
+	(f := Zdiv_rest_aux)
+	(Inv := fun qrd:Z * Z * Z =>
+          let (qr, d) := qrd in
             let (q, r) := qr in x = q * d + r /\ 0 <= r < d);
- [ intro x0; elim x0; intro y0; elim y0; intros q r d;
-    unfold Zdiv_rest_aux in |- *; elim q;
-    [ omega
-    | destruct p0;
-       [ rewrite BinInt.Zpos_xI; intro; elim H; intros; split;
-          [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l;
-             rewrite Zmult_1_l; rewrite Zmult_assoc;
-             rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal
-          | omega ]
-       | rewrite BinInt.Zpos_xO; intro; elim H; intros; split;
-          [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2);
-             apply refl_equal
-          | omega ]
-       | omega ]
-    | destruct p0;
-       [ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros;
-          split;
-          [ rewrite H0; rewrite Zplus_assoc;
-             apply f_equal with (f := fun z:Z => z + r);
-             do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc;
-             rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc;
-             apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); 
-             omega
-          | omega ]
-       | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros;
-          split;
-          [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2);
-             apply refl_equal
-          | omega ]
-       | omega ] ]
- | omega ].
-Qed.
-
-Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set :=
+	[ intro x0; elim x0; intro y0; elim y0; intros q r d;
+	  unfold Zdiv_rest_aux in |- *; elim q;
+	    [ omega
+	      | destruct p0;
+		[ rewrite BinInt.Zpos_xI; intro; elim H; intros; split;
+		  [ rewrite H0; rewrite Zplus_assoc; rewrite Zmult_plus_distr_l;
+		    rewrite Zmult_1_l; rewrite Zmult_assoc;
+		      rewrite (Zmult_comm (Zpos p0) 2); apply refl_equal
+		    | omega ]
+		  | rewrite BinInt.Zpos_xO; intro; elim H; intros; split;
+		    [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zpos p0) 2);
+		      apply refl_equal
+		      | omega ]
+		  | omega ]
+	      | destruct p0;
+		[ rewrite BinInt.Zneg_xI; unfold Zminus in |- *; intro; elim H; intros;
+		  split;
+		    [ rewrite H0; rewrite Zplus_assoc;
+		      apply f_equal with (f := fun z:Z => z + r);
+			do 2 rewrite Zmult_plus_distr_l; rewrite Zmult_assoc;
+			  rewrite (Zmult_comm (Zneg p0) 2); rewrite <- Zplus_assoc;
+			    apply f_equal with (f := fun z:Z => 2 * Zneg p0 * d + z); 
+			      omega
+		      | omega ]
+		  | rewrite BinInt.Zneg_xO; unfold Zminus in |- *; intro; elim H; intros;
+		    split;
+		      [ rewrite H0; rewrite Zmult_assoc; rewrite (Zmult_comm (Zneg p0) 2);
+			apply refl_equal
+			| omega ]
+		  | omega ] ]
+	  | omega ].
+  Qed.
+
+  Inductive Zdiv_rest_proofs (x:Z) (p:positive) : Set :=
     Zdiv_rest_proof :
-      forall q r:Z,
-        x = q * two_power_pos p + r ->
-        0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p.
-
-Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p.
-intros x p.
-generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
-elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)).
-simple induction a.
-intros.
-elim H; intros H1 H2; clear H.
-rewrite H0 in H1; rewrite H0 in H2; elim H2; intros;
- apply Zdiv_rest_proof with (q := a0) (r := b); assumption.
-Qed.
+    forall q r:Z,
+      x = q * two_power_pos p + r ->
+      0 <= r -> r < two_power_pos p -> Zdiv_rest_proofs x p.
+
+  Lemma Zdiv_rest_correct : forall (x:Z) (p:positive), Zdiv_rest_proofs x p.
+  Proof.
+    intros x p.
+    generalize (Zdiv_rest_correct1 x p); generalize (Zdiv_rest_correct2 x p).
+    elim (iter_pos p (Z * Z * Z) Zdiv_rest_aux (x, 0, 1)).
+    simple induction a.
+    intros.
+    elim H; intros H1 H2; clear H.
+    rewrite H0 in H1; rewrite H0 in H2; elim H2; intros;
+      apply Zdiv_rest_proof with (q := a0) (r := b); assumption.
+  Qed.
 
 End power_div_with_rest.
\ No newline at end of file
diff --git a/theories/ZArith/Zsqrt.v b/theories/ZArith/Zsqrt.v
index cf4acb5f..9893bed3 100644
--- a/theories/ZArith/Zsqrt.v
+++ b/theories/ZArith/Zsqrt.v
@@ -6,11 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zsqrt.v 6199 2004-10-11 11:39:18Z herbelin $ *)
+(* $Id: Zsqrt.v 9245 2006-10-17 12:53:34Z notin $ *)
 
+Require Import ZArithRing.
 Require Import Omega.
 Require Export ZArith_base.
-Require Export ZArithRing.
 Open Local Scope Z_scope.
 
 (**********************************************************************)
@@ -20,73 +20,73 @@ Open Local Scope Z_scope.
     `2*(POS ...)+1`, but only when ... is not made only with xO, XI, or xH. *)
 Ltac compute_POS :=
   match goal with
-  |  |- context [(Zpos (xI ?X1))] =>
+    |  |- context [(Zpos (xI ?X1))] =>
       match constr:X1 with
-      | context [1%positive] => fail 1
-      | _ => rewrite (BinInt.Zpos_xI X1)
+	| context [1%positive] => fail 1
+	| _ => rewrite (BinInt.Zpos_xI X1)
       end
-  |  |- context [(Zpos (xO ?X1))] =>
+    |  |- context [(Zpos (xO ?X1))] =>
       match constr:X1 with
-      | context [1%positive] => fail 1
-      | _ => rewrite (BinInt.Zpos_xO X1)
+	| context [1%positive] => fail 1
+	| _ => rewrite (BinInt.Zpos_xO X1)
       end
   end.
 
 Inductive sqrt_data (n:Z) : Set :=
-    c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n.
+  c_sqrt : forall s r:Z, n = s * s + r -> 0 <= r <= 2 * s -> sqrt_data n.
 
 Definition sqrtrempos : forall p:positive, sqrt_data (Zpos p).
-refine
- (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) :=
-    match p return sqrt_data (Zpos p) with
-    | xH => c_sqrt 1 1 0 _ _
-    | xO xH => c_sqrt 2 1 1 _ _
-    | xI xH => c_sqrt 3 1 2 _ _
-    | xO (xO p') =>
-        match sqrtrempos p' with
-        | c_sqrt s' r' Heq Hint =>
-            match Z_le_gt_dec (4 * s' + 1) (4 * r') with
-            | left Hle =>
-                c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1)
+  refine
+    (fix sqrtrempos (p:positive) : sqrt_data (Zpos p) :=
+      match p return sqrt_data (Zpos p) with
+	| xH => c_sqrt 1 1 0 _ _
+	| xO xH => c_sqrt 2 1 1 _ _
+	| xI xH => c_sqrt 3 1 2 _ _
+	| xO (xO p') =>
+          match sqrtrempos p' with
+            | c_sqrt s' r' Heq Hint =>
+              match Z_le_gt_dec (4 * s' + 1) (4 * r') with
+		| left Hle =>
+                  c_sqrt (Zpos (xO (xO p'))) (2 * s' + 1)
                   (4 * r' - (4 * s' + 1)) _ _
-            | right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _
-            end
-        end
-    | xO (xI p') =>
-        match sqrtrempos p' with
-        | c_sqrt s' r' Heq Hint =>
-            match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with
-            | left Hle =>
-                c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1)
+		| right Hgt => c_sqrt (Zpos (xO (xO p'))) (2 * s') (4 * r') _ _
+              end
+          end
+	| xO (xI p') =>
+          match sqrtrempos p' with
+            | c_sqrt s' r' Heq Hint =>
+              match Z_le_gt_dec (4 * s' + 1) (4 * r' + 2) with
+		| left Hle =>
+                  c_sqrt (Zpos (xO (xI p'))) (2 * s' + 1)
                   (4 * r' + 2 - (4 * s' + 1)) _ _
-            | right Hgt =>
-                c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _
-            end
-        end
-    | xI (xO p') =>
-        match sqrtrempos p' with
-        | c_sqrt s' r' Heq Hint =>
-            match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with
-            | left Hle =>
-                c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1)
+		| right Hgt =>
+                  c_sqrt (Zpos (xO (xI p'))) (2 * s') (4 * r' + 2) _ _
+              end
+          end
+	| xI (xO p') =>
+          match sqrtrempos p' with
+            | c_sqrt s' r' Heq Hint =>
+              match Z_le_gt_dec (4 * s' + 1) (4 * r' + 1) with
+		| left Hle =>
+                  c_sqrt (Zpos (xI (xO p'))) (2 * s' + 1)
                   (4 * r' + 1 - (4 * s' + 1)) _ _
-            | right Hgt =>
-                c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _
-            end
-        end
-    | xI (xI p') =>
-        match sqrtrempos p' with
-        | c_sqrt s' r' Heq Hint =>
-            match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with
-            | left Hle =>
-                c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1)
+		| right Hgt =>
+                  c_sqrt (Zpos (xI (xO p'))) (2 * s') (4 * r' + 1) _ _
+              end
+          end
+	| xI (xI p') =>
+          match sqrtrempos p' with
+            | c_sqrt s' r' Heq Hint =>
+              match Z_le_gt_dec (4 * s' + 1) (4 * r' + 3) with
+		| left Hle =>
+                  c_sqrt (Zpos (xI (xI p'))) (2 * s' + 1)
                   (4 * r' + 3 - (4 * s' + 1)) _ _
             | right Hgt =>
                 c_sqrt (Zpos (xI (xI p'))) (2 * s') (4 * r' + 3) _ _
             end
         end
     end); clear sqrtrempos; repeat compute_POS;
- try (try rewrite Heq; ring; fail); try omega.
+ try (try rewrite Heq; ring); try omega.
 Defined.
 
 (** Define with integer input, but with a strong (readable) specification. *)
@@ -94,70 +94,71 @@ Definition Zsqrt :
   forall x:Z,
     0 <= x ->
     {s : Z &  {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}.
-refine
- (fun x =>
-    match
-      x
-      return
+  refine
+    (fun x =>
+      match
+	x
+	return
         0 <= x ->
         {s : Z &  {r : Z | x = s * s + r /\ s * s <= x < (s + 1) * (s + 1)}}
-    with
-    | Zpos p =>
-        fun h =>
-          match sqrtrempos p with
-          | c_sqrt s r Heq Hint =>
-              existS
+	with
+	| Zpos p =>
+          fun h =>
+            match sqrtrempos p with
+              | c_sqrt s r Heq Hint =>
+		existS
                 (fun s:Z =>
-                   {r : Z |
-                   Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)})
+                  {r : Z |
+                    Zpos p = s * s + r /\ s * s <= Zpos p < (s + 1) * (s + 1)})
                 s
                 (exist
-                   (fun r:Z =>
-                      Zpos p = s * s + r /\
-                      s * s <= Zpos p < (s + 1) * (s + 1)) r _)
-          end
-    | Zneg p =>
-        fun h =>
-          False_rec
+                  (fun r:Z =>
+                    Zpos p = s * s + r /\
+                    s * s <= Zpos p < (s + 1) * (s + 1)) r _)
+            end
+	| Zneg p =>
+          fun h =>
+            False_rec
             {s : Z & 
-            {r : Z |
-            Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}}
+              {r : Z |
+		Zneg p = s * s + r /\ s * s <= Zneg p < (s + 1) * (s + 1)}}
             (h (refl_equal Datatypes.Gt))
-    | Z0 =>
-        fun h =>
-          existS
+	| Z0 =>
+          fun h =>
+            existS
             (fun s:Z =>
-               {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0
+              {r : Z | 0 = s * s + r /\ s * s <= 0 < (s + 1) * (s + 1)}) 0
             (exist
                (fun 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 ].
+split; [ omega | rewrite Heq; ring_simplify ((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 (x:Z) : Z :=
   match x with
-  | Zpos p =>
+    | Zpos p =>
       match Zsqrt (Zpos p) (Zorder.Zle_0_pos p) with
-      | existS s _ => s
+	| existS s _ => s
       end
-  | Zneg p => 0
-  | Z0 => 0
+    | Zneg p => 0
+    | Z0 => 0
   end.
 
 (** A basic theorem about Zsqrt_plain *)
 Theorem Zsqrt_interval :
- forall n:Z,
-   0 <= n ->
-   Zsqrt_plain n * Zsqrt_plain n <= n <
-   (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1).
-intros x; case x.
-unfold Zsqrt_plain in |- *; omega.
-intros p; unfold Zsqrt_plain in |- *;
- case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)).
-intros s [r [Heq Hint]] Hle; assumption.
-intros p Hle; elim Hle; auto.
+  forall n:Z,
+    0 <= n ->
+    Zsqrt_plain n * Zsqrt_plain n <= n <
+    (Zsqrt_plain n + 1) * (Zsqrt_plain n + 1).
+Proof.
+  intros x; case x.
+  unfold Zsqrt_plain in |- *; omega.
+  intros p; unfold Zsqrt_plain in |- *;
+    case (Zsqrt (Zpos p) (Zorder.Zle_0_pos p)).
+  intros s [r [Heq Hint]] Hle; assumption.
+  intros p Hle; elim Hle; auto.
 Qed.
 
diff --git a/theories/ZArith/Zwf.v b/theories/ZArith/Zwf.v
index 4ff663fb..bd617204 100644
--- a/theories/ZArith/Zwf.v
+++ b/theories/ZArith/Zwf.v
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: Zwf.v 5920 2004-07-16 20:01:26Z herbelin $ *)
+(* $Id: Zwf.v 9245 2006-10-17 12:53:34Z notin $ *)
 
 Require Import ZArith_base.
 Require Export Wf_nat.
@@ -26,35 +26,35 @@ Definition Zwf (c x y:Z) := c <= y /\ x < y.
 
 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|] *)
-
-Let f (z:Z) := Zabs_nat (z - c).
-
-Lemma Zwf_well_founded : well_founded (Zwf c).
-red in |- *; intros.
-assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a).
-clear a; simple induction n; intros.
-(** n= 0 *)
-case H; intros.
-case (lt_n_O (f a)); auto.
-apply Acc_intro; unfold Zwf in |- *; intros.
-assert False; omega || contradiction.
-(** inductive case *)
-case H0; clear H0; intro; auto.
-apply Acc_intro; intros.
-apply H.
-unfold Zwf in H1.
-case (Zle_or_lt c y); intro; auto with zarith.
-left.
-red in H0.
-apply lt_le_trans with (f a); auto with arith.
-unfold f in |- *.
-apply Zabs.Zabs_nat_lt; omega.
-apply (H (S (f a))); auto.
-Qed.
+  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|] *)
+
+  Let f (z:Z) := Zabs_nat (z - c).
+
+  Lemma Zwf_well_founded : well_founded (Zwf c).
+    red in |- *; intros.
+    assert (forall (n:nat) (a:Z), (f a < n)%nat \/ a < c -> Acc (Zwf c) a).
+    clear a; simple induction n; intros.
+  (** n= 0 *)
+    case H; intros.
+    case (lt_n_O (f a)); auto.
+    apply Acc_intro; unfold Zwf in |- *; intros.
+    assert False; omega || contradiction.
+  (** inductive case *)
+    case H0; clear H0; intro; auto.
+    apply Acc_intro; intros.
+    apply H.
+    unfold Zwf in H1.
+    case (Zle_or_lt c y); intro; auto with zarith.
+    left.
+    red in H0.
+    apply lt_le_trans with (f a); auto with arith.
+    unfold f in |- *.
+    apply Zabs.Zabs_nat_lt; omega.
+    apply (H (S (f a))); auto.
+  Qed.
 
 End wf_proof.
 
@@ -72,25 +72,25 @@ Definition Zwf_up (c x y:Z) := y < x <= c.
 
 Section wf_proof_up.
 
-Variable c : Z.
+  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|] *)
+  (** The proof of well-foundness is classic: we do the proof by induction
+      on a measure in nat, which is here [|c-x|] *)
 
-Let f (z:Z) := Zabs_nat (c - z).
+  Let f (z:Z) := Zabs_nat (c - z).
 
-Lemma Zwf_up_well_founded : well_founded (Zwf_up c).
-Proof.
-apply well_founded_lt_compat with (f := f).
-unfold Zwf_up, f in |- *.
-intros.
-apply Zabs.Zabs_nat_lt.
-unfold Zminus in |- *. split.
-apply Zle_left; intuition.
-apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp;
- intuition.
-Qed.
+  Lemma Zwf_up_well_founded : well_founded (Zwf_up c).
+  Proof.
+    apply well_founded_lt_compat with (f := f).
+    unfold Zwf_up, f in |- *.
+    intros.
+    apply Zabs.Zabs_nat_lt.
+    unfold Zminus in |- *. split.
+    apply Zle_left; intuition.
+    apply Zplus_lt_compat_l; unfold Zlt in |- *; rewrite <- Zcompare_opp;
+      intuition.
+  Qed.
 
 End wf_proof_up.
 
-Hint Resolve Zwf_up_well_founded: datatypes v62.
\ No newline at end of file
+Hint Resolve Zwf_up_well_founded: datatypes v62.
diff --git a/theories/ZArith/auxiliary.v b/theories/ZArith/auxiliary.v
index 28cbd1e4..726fb45a 100644
--- a/theories/ZArith/auxiliary.v
+++ b/theories/ZArith/auxiliary.v
@@ -6,11 +6,11 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: auxiliary.v 5920 2004-07-16 20:01:26Z herbelin $ i*)
+(*i $Id: auxiliary.v 9302 2006-10-27 21:21:17Z barras $ i*)
 
 (** Binary Integers (Pierre Crégut, CNET, Lannion, France) *)
 
-Require Export Arith.
+Require Export Arith_base.
 Require Import BinInt.
 Require Import Zorder.
 Require Import Decidable.
@@ -19,132 +19,134 @@ Require Export Compare_dec.
 
 Open Local Scope Z_scope.
 
-(**********************************************************************)
-(** Moving terms from one side to the other of an inequality *)
+(***************************************************************)
+(** * Moving terms from one side to the other of an inequality *)
 
 Theorem Zne_left : forall n m:Z, Zne n m -> Zne (n + - m) 0.
 Proof.
-intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1;
- apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; 
- rewrite Zplus_comm; trivial with arith.
+  intros x y; unfold Zne in |- *; unfold not in |- *; intros H1 H2; apply H1;
+    apply Zplus_reg_l with (- y); rewrite Zplus_opp_l; 
+      rewrite Zplus_comm; trivial with arith.
 Qed.
 
 Theorem Zegal_left : forall n m:Z, n = m -> n + - m = 0.
 Proof.
-intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute;
- rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption.
+  intros x y H; apply (Zplus_reg_l y); rewrite Zplus_permute;
+    rewrite Zplus_opp_r; do 2 rewrite Zplus_0_r; assumption.
 Qed.
 
 Theorem Zle_left : forall n m:Z, n <= m -> 0 <= m + - n.
 Proof.
-intros x y H; replace 0 with (x + - x).
-apply Zplus_le_compat_r; trivial.
-apply Zplus_opp_r.
+  intros x y H; replace 0 with (x + - x).
+  apply Zplus_le_compat_r; trivial.
+  apply Zplus_opp_r.
 Qed.
 
 Theorem Zle_left_rev : forall n m:Z, 0 <= m + - n -> n <= m.
 Proof.
-intros x y H; apply Zplus_le_reg_r with (- x).
-rewrite Zplus_opp_r; trivial.
+  intros x y H; apply Zplus_le_reg_r with (- x).
+  rewrite Zplus_opp_r; trivial.
 Qed.
 
 Theorem Zlt_left_rev : forall n m:Z, 0 < m + - n -> n < m.
 Proof.
-intros x y H; apply Zplus_lt_reg_r with (- x).
-rewrite Zplus_opp_r; trivial.
+  intros x y H; apply Zplus_lt_reg_r with (- x).
+  rewrite Zplus_opp_r; trivial.
 Qed.
 
 Theorem Zlt_left : forall n m:Z, n < m -> 0 <= m + -1 + - n.
 Proof.
-intros x y H; apply Zle_left; apply Zsucc_le_reg;
- change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred;
- apply Zlt_le_succ; assumption.
+  intros x y H; apply Zle_left; apply Zsucc_le_reg;
+    change (Zsucc x <= Zsucc (Zpred y)) in |- *; rewrite <- Zsucc_pred;
+      apply Zlt_le_succ; assumption.
 Qed.
 
 Theorem Zlt_left_lt : forall n m:Z, n < m -> 0 < m + - n.
 Proof.
-intros x y H; replace 0 with (x + - x).
-apply Zplus_lt_compat_r; trivial.
-apply Zplus_opp_r.
+  intros x y H; replace 0 with (x + - x).
+  apply Zplus_lt_compat_r; trivial.
+  apply Zplus_opp_r.
 Qed.
 
 Theorem Zge_left : forall n m:Z, n >= m -> 0 <= n + - m.
 Proof.
-intros x y H; apply Zle_left; apply Zge_le; assumption.
+  intros x y H; apply Zle_left; apply Zge_le; assumption.
 Qed.
 
 Theorem Zgt_left : forall n m:Z, n > m -> 0 <= n + -1 + - m.
 Proof.
-intros x y H; apply Zlt_left; apply Zgt_lt; assumption.
+  intros x y H; apply Zlt_left; apply Zgt_lt; assumption.
 Qed.
 
 Theorem Zgt_left_gt : forall n m:Z, n > m -> n + - m > 0.
 Proof.
-intros x y H; replace 0 with (y + - y).
-apply Zplus_gt_compat_r; trivial.
-apply Zplus_opp_r.
+  intros x y H; replace 0 with (y + - y).
+  apply Zplus_gt_compat_r; trivial.
+  apply Zplus_opp_r.
 Qed.
 
 Theorem Zgt_left_rev : forall n m:Z, n + - m > 0 -> n > m.
 Proof.
-intros x y H; apply Zplus_gt_reg_r with (- y).
-rewrite Zplus_opp_r; trivial.
+  intros x y H; apply Zplus_gt_reg_r with (- y).
+  rewrite Zplus_opp_r; trivial.
 Qed.
 
 (**********************************************************************)
-(** Factorization lemmas *)
+(** * Factorization lemmas *)
 
 Theorem Zred_factor0 : forall n:Z, n = n * 1.
-intro x; rewrite (Zmult_1_r x); reflexivity.
+  intro x; rewrite (Zmult_1_r x); reflexivity.
 Qed.
 
 Theorem Zred_factor1 : forall n:Z, n + n = n * 2.
 Proof.
-exact Zplus_diag_eq_mult_2.
+  exact Zplus_diag_eq_mult_2.
 Qed.
 
 Theorem Zred_factor2 : forall n m:Z, n + n * m = n * (1 + m).
-
-intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x);
- rewrite <- Zmult_plus_distr_r; trivial with arith.
+Proof.
+  intros x y; pattern x at 1 in |- *; rewrite <- (Zmult_1_r x);
+    rewrite <- Zmult_plus_distr_r; trivial with arith.
 Qed.
 
 Theorem Zred_factor3 : forall n m:Z, n * m + n = n * (1 + m).
-
-intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x);
- rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm; 
- trivial with arith.
+Proof.
+  intros x y; pattern x at 2 in |- *; rewrite <- (Zmult_1_r x);
+    rewrite <- Zmult_plus_distr_r; rewrite Zplus_comm; 
+      trivial with arith.
 Qed.
+
 Theorem Zred_factor4 : forall n m p:Z, n * m + n * p = n * (m + p).
-intros x y z; symmetry  in |- *; apply Zmult_plus_distr_r.
+Proof.
+  intros x y z; symmetry  in |- *; apply Zmult_plus_distr_r.
 Qed.
 
 Theorem Zred_factor5 : forall n m:Z, n * 0 + m = m.
-
-intros x y; rewrite <- Zmult_0_r_reverse; auto with arith.
+Proof.
+  intros x y; rewrite <- Zmult_0_r_reverse; auto with arith.
 Qed.
 
 Theorem Zred_factor6 : forall n:Z, n = n + 0.
-
-intro; rewrite Zplus_0_r; trivial with arith.
+Proof.
+  intro; rewrite Zplus_0_r; trivial with arith.
 Qed.
 
 Theorem Zle_mult_approx :
- forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p.
-
-intros x y z H1 H2 H3; apply Zle_trans with (m := y * x);
- [ apply Zmult_gt_0_le_0_compat; assumption
- | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r;
-    apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; 
-    assumption ].
+  forall n m p:Z, n > 0 -> p > 0 -> 0 <= m -> 0 <= m * n + p.
+Proof.
+  intros x y z H1 H2 H3; apply Zle_trans with (m := y * x);
+    [ apply Zmult_gt_0_le_0_compat; assumption
+      | pattern (y * x) at 1 in |- *; rewrite <- Zplus_0_r;
+	apply Zplus_le_compat_l; apply Zlt_le_weak; apply Zgt_lt; 
+	  assumption ].
 Qed.
 
 Theorem Zmult_le_approx :
- forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
-
-intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x;
- [ assumption
- | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse;
-    apply Zplus_lt_compat_l; apply Zgt_lt; assumption ].
-
+  forall n m p:Z, n > 0 -> n > p -> 0 <= m * n + p -> 0 <= m.
+Proof.
+  intros x y z H1 H2 H3; apply Zlt_succ_le; apply Zmult_gt_0_lt_0_reg_r with x;
+    [ assumption
+      | apply Zle_lt_trans with (1 := H3); rewrite <- Zmult_succ_l_reverse;
+	apply Zplus_lt_compat_l; apply Zgt_lt; assumption ].
 Qed.
+
diff --git a/tools/coqdep.ml b/tools/coqdep.ml
index 6597c3f6..3647152a 100644
--- a/tools/coqdep.ml
+++ b/tools/coqdep.ml
@@ -6,18 +6,12 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqdep.ml 8923 2006-06-08 16:39:58Z herbelin $ *)
+(* $Id: coqdep.ml 9276 2006-10-25 13:00:22Z barras $ *)
 
 open Printf
 open Coqdep_lexer
 open Unix
 
-let (/) = Filename.concat
-
-let file_concat l =
-  if l=[] then "<empty>" else
-    List.fold_left (/) (List.hd l) (List.tl l)
-
 let stderr = Pervasives.stderr
 let stdout = Pervasives.stdout
 
@@ -28,12 +22,23 @@ let option_D = ref false
 let option_w = ref false
 let option_i = ref false
 let option_sort = ref false
+let option_slash = ref false
 
 let suffixe = ref ".vo"
 let suffixe_spec = ref ".vi"
 
 type dir = string option
 
+(* filename for printing *)
+let (//) s1 s2 =
+  if !option_slash then s1^"/"^s2 else Filename.concat s1 s2
+
+let (/) = Filename.concat
+
+let file_concat l =
+  if l=[] then "<empty>" else
+    List.fold_left (//) (List.hd l) (List.tl l)
+
 (* Files specified on the command line *)
 let mlAccu  = ref ([] : (string * string * dir) list) 
 and mliAccu = ref ([] : (string * string * dir) list) 
@@ -148,7 +153,7 @@ let cut_prefix p s =
   if ls >= lp && String.sub s 0 lp = p then String.sub s lp (ls - lp) else s
 
 let canonize f = match Sys.os_type with
-  | "Win32" -> cut_prefix ".\\" f
+  | "Win32" when not !option_slash -> cut_prefix ".\\" f
   | _ -> cut_prefix "./" f
 
 let sort () = 
@@ -517,6 +522,7 @@ let coqdep () =
       | "-coqlib" :: [] -> usage ()
       | "-suffix" :: (s :: ll) -> suffixe := s ; suffixe_spec := s; parse ll
       | "-suffix" :: [] -> usage ()
+      | "-slash" :: ll -> option_slash := true; parse ll
       | f :: ll -> treat None f; parse ll
       | [] -> ()
   in
diff --git a/tools/coqdoc/coqdoc.sty b/tools/coqdoc/coqdoc.sty
index 597152f5..2c07b9fc 100644
--- a/tools/coqdoc/coqdoc.sty
+++ b/tools/coqdoc/coqdoc.sty
@@ -50,7 +50,7 @@
 %HEVEA\newcommand{\coqdocindent}[1]{\hspace{#1}\hspace{#1}}
 
 % macro for typesetting the title of a module implementation
-\newcommand{\coqdocmodule}[1]{\section*{Module #1}\markboth{Module #1}{}
+\newcommand{\coqdocmodule}[1]{\chapter{Module #1}\markboth{Module #1}{}
 }
 
 %HEVEA\newcommand{\lnot}{\coqwkw{not}}
diff --git a/tools/coqdoc/index.mll b/tools/coqdoc/index.mll
index 9b5716ff..5b281b8b 100644
--- a/tools/coqdoc/index.mll
+++ b/tools/coqdoc/index.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: index.mll 8863 2006-05-26 10:33:21Z notin $ i*)
+(*i $Id: index.mll 9204 2006-10-04 13:05:58Z notin $ i*)
 
 {
 
@@ -364,6 +364,7 @@ and end_ident = parse
 and module_ident = parse
   | space+
       { module_ident lexbuf }
+  | '"' { string lexbuf; module_ident lexbuf }
   | ident space* ":="
       { () }
   | ident
diff --git a/tools/coqdoc/output.ml b/tools/coqdoc/output.ml
index e6a0a72b..84e03d92 100644
--- a/tools/coqdoc/output.ml
+++ b/tools/coqdoc/output.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: output.ml 8863 2006-05-26 10:33:21Z notin $ i*)
+(*i $Id: output.ml 9245 2006-10-17 12:53:34Z notin $ i*)
 
 open Cdglobals
 open Index
@@ -118,7 +118,7 @@ module Latex = struct
 
   let header () =
     if !header_trailer then begin
-      printf "\\documentclass[12pt]{article}\n";
+      printf "\\documentclass[12pt]{report}\n";
       if !inputenc != "" then printf "\\usepackage[%s]{inputenc}\n" !inputenc;
       printf "\\usepackage[T1]{fontenc}\n";
       printf "\\usepackage{fullpage}\n";
diff --git a/tools/coqdoc/pretty.mll b/tools/coqdoc/pretty.mll
index 5c6c7952..bdb58f86 100644
--- a/tools/coqdoc/pretty.mll
+++ b/tools/coqdoc/pretty.mll
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: pretty.mll 8861 2006-05-24 15:52:15Z notin $ i*)
+(*i $Id: pretty.mll 9204 2006-10-04 13:05:58Z notin $ i*)
 
 (*s Utility functions for the scanners *)
 
@@ -398,19 +398,22 @@ and coq = parse
       { () }
   | gallina_kw_to_hide
       { let s = lexeme lexbuf in
-	  if !light && section_or_end s then begin 
-	    let eol = skip_to_dot lexbuf in
-	      if eol then coq_bol lexbuf else coq lexbuf 
-	  end else begin
-	    ident s (lexeme_start lexbuf); 
-	    let eol=body lexbuf in 
-	      if eol then coq_bol lexbuf else coq lexbuf
-	  end }
+	  if !light && section_or_end s then 
+	    begin 
+	      let eol = skip_to_dot lexbuf in
+		if eol then coq_bol lexbuf else coq lexbuf 
+	    end 
+	  else 
+	    begin
+	      ident s (lexeme_start lexbuf); 
+	      let eol=body lexbuf in 
+		if eol then coq_bol lexbuf else coq lexbuf
+	    end }
   | gallina_kw
       { let s = lexeme lexbuf in 
 	  ident s (lexeme_start lexbuf); 
-	  let eol = body lexbuf in
-	    if eol then coq_bol lexbuf else coq lexbuf }
+	let eol = body lexbuf in
+	  if eol then coq_bol lexbuf else coq lexbuf }
   | space+ { char ' '; coq lexbuf }
   | eof 
       { () }
diff --git a/toplevel/cerrors.ml b/toplevel/cerrors.ml
index ab9c4c63..f6c5c3af 100644
--- a/toplevel/cerrors.ml
+++ b/toplevel/cerrors.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: cerrors.ml 8003 2006-02-07 22:11:50Z herbelin $ *)
+(* $Id: cerrors.ml 9306 2006-10-28 18:28:19Z herbelin $ *)
 
 open Pp
 open Util
@@ -28,19 +28,21 @@ let guill s = "\""^s^"\""
 let where s =
   if !Options.debug then  (str"in " ++ str s ++ str":" ++ spc ()) else (mt ())
 
+let anomaly_string () = str "Anomaly: "
+
 let report () = (str "." ++ spc () ++ str "Please report.")
 
 (* assumption : explain_sys_exn does NOT end with a 'FNL anymore! *)
 
-let rec explain_exn_default = function
+let rec explain_exn_default_aux anomaly_string report_fn = function
   | Stream.Failure -> 
-      hov 0 (str "Anomaly: uncaught Stream.Failure.")
+      hov 0 (anomaly_string () ++ str "uncaught Stream.Failure.")
   | Stream.Error txt -> 
       hov 0 (str "Syntax error: " ++ str txt)
   | Token.Error txt -> 
       hov 0 (str "Syntax error: " ++ str txt)
   | Sys_error msg -> 
-      hov 0 (str "Anomaly: uncaught exception Sys_error " ++ str (guill msg) ++ report ())
+      hov 0 (anomaly_string () ++ str "uncaught exception Sys_error " ++ str (guill msg) ++ report_fn ())
   | UserError(s,pps) -> 
       hov 1 (str "User error: " ++ where s ++ pps)
   | Out_of_memory -> 
@@ -48,26 +50,26 @@ let rec explain_exn_default = function
   | Stack_overflow -> 
       hov 0 (str "Stack overflow")
   | Anomaly (s,pps) -> 
-      hov 1 (str "Anomaly: " ++ where s ++ pps ++ report ())
+      hov 1 (anomaly_string () ++ where s ++ pps ++ report_fn ())
   | Match_failure(filename,pos1,pos2) ->
-      hov 1 (str "Anomaly: Match failure in file " ++ str (guill filename) ++ 
+      hov 1 (anomaly_string () ++ str "Match failure in file " ++ str (guill filename) ++ 
       if Sys.ocaml_version = "3.06" then
 		   (str " from character " ++ int pos1 ++ 
                     str " to " ++ int pos2)
 		 else
 		   (str " at line " ++ int pos1 ++
 		    str " character " ++ int pos2)
-	           ++ report ())
+	           ++ report_fn ())
   | Not_found -> 
-      hov 0 (str "Anomaly: uncaught exception Not_found" ++ report ())
+      hov 0 (anomaly_string () ++ str "uncaught exception Not_found" ++ report_fn ())
   | Failure s -> 
-      hov 0 (str "Anomaly: uncaught exception Failure " ++ str (guill s) ++ report ())
+      hov 0 (anomaly_string () ++ str "uncaught exception Failure " ++ str (guill s) ++ report_fn ())
   | Invalid_argument s -> 
-      hov 0 (str "Anomaly: uncaught exception Invalid_argument " ++ str (guill s) ++ report ())
+      hov 0 (anomaly_string () ++ str "uncaught exception Invalid_argument " ++ str (guill s) ++ report_fn ())
   | Sys.Break -> 
-      hov 0 (fnl () ++ str "User Interrupt.")
+      hov 0 (fnl () ++ str "User interrupt.")
   | Univ.UniverseInconsistency -> 
-      hov 0 (str "Error: Universe Inconsistency.")
+      hov 0 (str "Error: Universe inconsistency.")
   | TypeError(ctx,te) -> 
       hov 0 (str "Error:" ++ spc () ++ Himsg.explain_type_error ctx te)
   | PretypeError(ctx,te) ->
@@ -97,7 +99,7 @@ let rec explain_exn_default = function
   | Stdpp.Exc_located (loc,exc) ->
       hov 0 ((if loc = dummy_loc then (mt ())
                else (str"At location " ++ print_loc loc ++ str":" ++ fnl ()))
-               ++ explain_exn_default exc)
+               ++ explain_exn_default_aux anomaly_string report_fn exc)
   | Lexer.Error Illegal_character -> 
       hov 0 (str "Syntax error: Illegal character.")
   | Lexer.Error Unterminated_comment -> 
@@ -109,7 +111,7 @@ let rec explain_exn_default = function
   | Lexer.Error (Bad_token s) -> 
       hov 0 (str "Syntax error: Bad token" ++ spc () ++ str s ++ str ".")
   | Assert_failure (s,b,e) ->
-      hov 0 (str "Anomaly: assert failure" ++ spc () ++
+      hov 0 (anomaly_string () ++ str "assert failure" ++ spc () ++
 	       (if s <> "" then 
 		 if Sys.ocaml_version = "3.06" then
 		   (str ("(file \"" ^ s ^ "\", characters ") ++ 
@@ -120,16 +122,22 @@ let rec explain_exn_default = function
 		    int (e+6) ++ str ")")
 	       else
 		 (mt ())) ++
-	       report ())
+	       report_fn ())
   | reraise ->
-      hov 0 (str "Anomaly: Uncaught exception " ++ 
-	       str (Printexc.to_string reraise) ++ report ())
+      hov 0 (anomaly_string () ++ str "Uncaught exception " ++ 
+	       str (Printexc.to_string reraise) ++ report_fn ())
+
+let explain_exn_default =
+    explain_exn_default_aux (fun () -> str "Anomaly: ") report
 
 let raise_if_debug e =
   if !Options.debug then raise e
 
 let _ = Tactic_debug.explain_logic_error := explain_exn_default
 
+let _ = Tactic_debug.explain_logic_error_no_anomaly :=
+          explain_exn_default_aux (fun () -> mt()) (fun () -> mt())
+
 let explain_exn_function = ref explain_exn_default
 
 let explain_exn e = !explain_exn_function e
diff --git a/toplevel/command.ml b/toplevel/command.ml
index 56a32f04..d751f70c 100644
--- a/toplevel/command.ml
+++ b/toplevel/command.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: command.ml 8875 2006-05-29 19:59:11Z msozeau $ *)
+(* $Id: command.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Pp
 open Util
@@ -32,11 +32,15 @@ open Proof_type
 open Tacmach
 open Safe_typing
 open Nametab
+open Impargs
 open Typeops
+open Reductionops
 open Indtypes
 open Vernacexpr
 open Decl_kinds
 open Pretyping
+open Evarutil
+open Evarconv
 open Notation
 
 let mkLambdaCit = List.fold_right (fun (x,a) b -> mkLambdaC(x,a,b))
@@ -56,11 +60,6 @@ let rec generalize_constr_expr c = function
       List.fold_right (fun x b -> mkProdC([x],t,b)) idl
         (generalize_constr_expr c bl)
 
-let rec length_of_raw_binders = function
-  | [] -> 0
-  | LocalRawDef _::bl -> 1 + length_of_raw_binders bl
-  | LocalRawAssum (idl,_)::bl -> List.length idl + length_of_raw_binders bl
-
 let rec under_binders env f n c =
   if n = 0 then f env Evd.empty c else
     match kind_of_term c with
@@ -78,12 +77,12 @@ let rec destSubCast c = match kind_of_term c with
   | Cast (b,_, u) -> (b,u)
   | _ -> assert false
 
-let rec adjust_conclusion a cs = function
-  | CProdN (loc,bl,c) -> CProdN (loc,bl,adjust_conclusion a cs c)
-  | CLetIn (loc,b,t,c) -> CLetIn (loc,b,t,adjust_conclusion a cs c)
+let rec complete_conclusion a cs = function
+  | CProdN (loc,bl,c) -> CProdN (loc,bl,complete_conclusion a cs c)
+  | CLetIn (loc,b,t,c) -> CLetIn (loc,b,t,complete_conclusion a cs c)
   | CHole loc ->
-      let (nar,name,params) = a in
-      if nar <> 0 then
+      let (has_no_args,name,params) = a in
+      if not has_no_args then
 	user_err_loc (loc,"",
 	  str "Cannot infer the non constant arguments of the conclusion of "
 	  ++ pr_id cs);
@@ -106,7 +105,7 @@ let constant_entry_of_com (bl,com,comtypopt,opacity,boxed) =
 	let b = abstract_constr_expr com bl in
 	let j = interp_constr_judgment sigma env b in
 	{ const_entry_body = j.uj_val;
-	  const_entry_type = Some (refresh_universes j.uj_type);
+	  const_entry_type = None;
           const_entry_opaque = opacity;
 	  const_entry_boxed = boxed }
     | Some comtyp ->
@@ -125,7 +124,7 @@ let red_constant_entry bl ce = function
       let body = ce.const_entry_body in
       { ce with const_entry_body = 
 	under_binders (Global.env()) (fst (reduction_of_red_expr red))
-	  (length_of_raw_binders bl)
+	  (local_binders_length bl)
 	  body }
 
 let declare_global_definition ident ce local =
@@ -226,7 +225,8 @@ let declare_one_elimination ind =
   if List.mem InType kelim then
     let elim = make_elim (new_sort_in_family InType) in
     let cte = declare (mindstr^(Indrec.elimination_suffix InType)) elim None in
-    let c = mkConst cte and t = constant_type (Global.env()) cte in
+    let c = mkConst cte in
+    let t = type_of_constant (Global.env()) cte in
     List.iter (fun (sort,suff) -> 
       let (t',c') = 
 	Indrec.instantiate_type_indrec_scheme (new_sort_in_family sort)
@@ -248,371 +248,380 @@ let declare_eliminations sp =
       declare_one_elimination (sp,i)
     done
 
-(* 3b| Mutual Inductive definitions *)
-
-let minductive_message = function 
+(* 3b| Mutual inductive definitions *)
+
+let compute_interning_datas env l nal typl =
+  let mk_interning_data na typ =
+    let idl, impl =
+      if is_implicit_args() then
+	let impl = compute_implicits env typ in
+	let sub_impl,_ = list_chop (List.length l) impl in
+	let sub_impl' = List.filter is_status_implicit sub_impl in
+	(List.map name_of_implicit sub_impl', impl)
+      else 
+	([],[]) in
+    (na, (idl, impl, compute_arguments_scope typ)) in
+  (l, List.map2 mk_interning_data nal typl)
+
+let declare_interning_data (_,impls) (df,c,scope) =
+  silently (Metasyntax.add_notation_interpretation df impls c) scope
+
+let push_named_types env idl tl =
+  List.fold_left2 (fun env id t -> Environ.push_named (id,None,t) env)
+    env idl tl
+
+let push_types env idl tl =
+  List.fold_left2 (fun env id t -> Environ.push_rel (Name id,None,t) env)
+    env idl tl
+
+type inductive_expr = {
+  ind_name : identifier;
+  ind_arity : constr_expr;
+  ind_lc : (identifier * constr_expr) list
+}
+
+let minductive_message = function
   | []  -> error "no inductive definition"
   | [x] -> (pr_id x ++ str " is defined")
   | l   -> hov 0  (prlist_with_sep pr_coma pr_id l ++
 		     spc () ++ str "are defined")
 
-let recursive_message v =
-  match Array.length v with
-    | 0 -> error "no recursive definition"
-    | 1 -> (Printer.pr_global v.(0) ++ str " is recursively defined")
-    | _ -> hov 0 (prvect_with_sep pr_coma Printer.pr_global v ++
-		    spc () ++ str "are recursively defined")
-
-let corecursive_message v =
-  match Array.length v with
-    | 0 -> error "no corecursive definition"
-    | 1 -> (Printer.pr_global v.(0) ++ str " is corecursively defined")
-    | _ -> hov 0 (prvect_with_sep pr_coma Printer.pr_global v ++
-                    spc () ++ str "are corecursively defined")
+let check_all_names_different indl =
+  let get_names ind = ind.ind_name::List.map fst ind.ind_lc in
+  if not (list_distinct (List.flatten (List.map get_names indl))) then
+    error "Two inductive objects have the same name"
+
+let mk_mltype_data isevars env assums arity indname =
+  let is_ml_type = is_sort env (Evd.evars_of !isevars) arity in
+  (is_ml_type,indname,assums)
+
+let prepare_param = function
+  | (na,None,t) -> out_name na, LocalAssum t 
+  | (na,Some b,_) -> out_name na, LocalDef b
+
+let interp_ind_arity isevars env ind =
+  interp_type_evars isevars env ind.ind_arity
+
+let interp_cstrs isevars env impls mldata arity ind =
+  let cnames,ctyps = List.split ind.ind_lc in
+  (* Complete conclusions of constructor types if given in ML-style syntax *)
+  let ctyps' = List.map2 (complete_conclusion mldata) cnames ctyps in
+  (* Interpret the constructor types *)
+  let ctyps'' = List.map (interp_type_evars isevars env ~impls) ctyps' in
+  (cnames, ctyps'')
+
+let interp_mutual paramsl indl notations finite = 
+  check_all_names_different indl;
+  let env0 = Global.env() in
+  let isevars = ref (Evd.create_evar_defs Evd.empty) in
+  let env_params, ctx_params = interp_context_evars isevars env0 paramsl in
+  let indnames = List.map (fun ind -> ind.ind_name) indl in
 
-let interp_mutual lparams lnamearconstrs finite = 
-  let allnames = 
-    List.fold_left (fun acc (id,_,_,l) -> id::(List.map fst l)@acc)
-      [] lnamearconstrs in
-  if not (list_distinct allnames) then
-    error "Two inductive objects have the same name";
-  let sigma = Evd.empty and env0 = Global.env() in
-  let env_params, params = interp_context sigma env0 lparams in
-
-  (* Builds the params of the inductive entry *)
-  let params' =
-    List.map (fun (na,b,t) ->
-		let id = match na with
-		  | Name id -> id
-		  | Anonymous -> anomaly "Unnamed inductive variable" in 
-		match b with
-		  | None -> (id, LocalAssum t)
-		  | Some b -> (id, LocalDef b)) params
-  in
-  let paramassums = 
-    List.fold_right (fun d l -> match d with
-	(id,LocalAssum _) -> id::l | (_,LocalDef _) -> l) params' [] in
-  let nparamassums = List.length paramassums in
-  let (ind_env,ind_impls,arityl) =
-    List.fold_left
-      (fun (env, ind_impls, arl) (recname, _, arityc, _) ->
-         let arity = interp_type sigma env_params arityc in
-	 let fullarity = it_mkProd_or_LetIn arity params in
-	 let env' = Termops.push_rel_assum (Name recname,fullarity) env in
-	 let argsc = compute_arguments_scope fullarity in
-	 let ind_impls' = 
-	   if Impargs.is_implicit_args() then
-	     let impl = Impargs.compute_implicits env_params fullarity in
-	     let paramimpl,_ = list_chop nparamassums impl in
-	     let l = List.fold_right
-	       (fun imp l -> if Impargs.is_status_implicit imp then
-		 Impargs.name_of_implicit imp::l else l) paramimpl [] in
-	     (recname,(l,impl,argsc))::ind_impls
-	   else
-	     (recname,([],[],argsc))::ind_impls in
-	 (env', ind_impls', (arity::arl)))
-      (env0, [], []) lnamearconstrs
-  in
   (* Names of parameters as arguments of the inductive type (defs removed) *)
-  let lparargs = 
-    List.flatten
-      (List.map (function (id,LocalAssum _) -> [id] | _ -> []) params') in
-  let notations = 
-    List.fold_right (fun (_,ntnopt,_,_) l -> option_cons ntnopt l) 
-      lnamearconstrs [] in
-  let fs = States.freeze() in
-  (* Declare the notations for the inductive types pushed in local context*)
-  try
-  List.iter (fun (df,c,scope) ->
-    silently (Metasyntax.add_notation_interpretation df ind_impls c) scope)
-    notations;
-  let ind_env_params = push_rel_context params ind_env in
-
-  let mispecvec = 
-    List.map2
-      (fun ar (name,_,_,lname_constr) ->
-	 let constrnames, bodies = List.split lname_constr in
-         (* Compute the conclusions of constructor types *)
-	 (* for inductive given in ML syntax *)
-	 let nar = 
-	   List.length (fst (Reductionops.splay_arity env_params Evd.empty ar))
-	 in
-	 let bodies =
-	   List.map2 (adjust_conclusion (nar,name,lparargs))
-	     constrnames bodies
-	 in
-
-         (* Interpret the constructor types *)
-         let constrs =
-	   List.map 
-	     (interp_type sigma ind_env_params ~impls:(paramassums,ind_impls))
-	     bodies
-	 in
-
-         (* Build the inductive entry *)
-	 { mind_entry_typename = name;
-	   mind_entry_arity = ar;
-	   mind_entry_consnames = constrnames;
-	   mind_entry_lc = constrs })
-      (List.rev arityl) lnamearconstrs
-  in
-  States.unfreeze fs;
-  notations, { mind_entry_params = params';
-	       mind_entry_record = false; 
-	       mind_entry_finite = finite; 
-	       mind_entry_inds = mispecvec }
-  with e -> States.unfreeze fs; raise e
+  let assums = List.filter(fun (_,b,_) -> b=None) ctx_params in
+  let params = List.map (fun (na,_,_) -> out_name na) assums in
+
+  (* Interpret the arities *)
+  let arities = List.map (interp_ind_arity isevars env_params) indl in
+  let fullarities = List.map (fun c -> it_mkProd_or_LetIn c ctx_params) arities in
+  let env_ar = push_types env0 indnames fullarities in
+  let env_ar_params = push_rel_context ctx_params env_ar in
+
+  (* Compute interpretation metadatas *)
+  let impls = compute_interning_datas env0 params indnames fullarities in
+  let mldatas = List.map2 (mk_mltype_data isevars env_params params) arities indnames in
+
+  let constructors =
+    States.with_heavy_rollback (fun () -> 
+     (* Temporary declaration of notations and scopes *)
+     List.iter (declare_interning_data impls) notations;
+     (* Interpret the constructor types *)
+     list_map3 (interp_cstrs isevars env_ar_params impls) mldatas arities indl)
+     () in
+
+  (* Instantiate evars and check all are resolved *)
+  let isevars,_ = consider_remaining_unif_problems env_params !isevars in
+  let sigma = Evd.evars_of isevars in
+  let constructors = List.map (fun (idl,cl) -> (idl,List.map (nf_evar sigma) cl)) constructors in
+  let ctx_params = Sign.map_rel_context (nf_evar sigma) ctx_params in
+  let arities = List.map (nf_evar sigma) arities in
+  List.iter (check_evars env_params Evd.empty isevars) arities;
+  Sign.iter_rel_context (check_evars env0 Evd.empty isevars) ctx_params;
+  List.iter (fun (_,ctyps) ->
+    List.iter (check_evars env_ar_params Evd.empty isevars) ctyps)
+    constructors;
+  
+  (* Build the inductive entries *)
+  let entries = list_map3 (fun ind arity (cnames,ctypes) -> {
+    mind_entry_typename = ind.ind_name;
+    mind_entry_arity = arity;
+    mind_entry_consnames = cnames;
+    mind_entry_lc = ctypes
+  }) indl arities constructors in
+
+  (* Build the mutual inductive entry *)
+  { mind_entry_params = List.map prepare_param ctx_params;
+    mind_entry_record = false; 
+    mind_entry_finite = finite; 
+    mind_entry_inds = entries }
+
+let eq_constr_expr c1 c2 =
+  try let _ = Constrextern.check_same_type c1 c2 in true with _ -> false
+
+(* Very syntactical equality *)
+let eq_local_binder d1 d2 = match d1,d2 with
+  | LocalRawAssum (nal1,c1), LocalRawAssum (nal2,c2) ->
+      List.length nal1 = List.length nal2 &&
+      List.for_all2 (fun (_,na1) (_,na2) -> na1 = na2) nal1 nal2 &&
+      eq_constr_expr c1 c2
+  | LocalRawDef ((_,id1),c1), LocalRawDef ((_,id2),c2) ->
+      id1 = id2 && eq_constr_expr c1 c2
+  | _ ->
+      false
+
+let eq_local_binders bl1 bl2 =
+  List.length bl1 = List.length bl2 && List.for_all2 eq_local_binder bl1 bl2
+
+let extract_coercions indl =
+  let mkqid (_,((_,id),_)) = make_short_qualid id in
+  let extract lc = List.filter (fun (iscoe,_) -> iscoe) lc in
+  List.map mkqid (List.flatten(List.map (fun (_,_,_,lc) -> extract lc) indl))
+
+let extract_params indl =
+  let paramsl = List.map (fun (_,params,_,_) -> params) indl in
+  match paramsl with
+  | [] -> anomaly "empty list of inductive types"
+  | params::paramsl ->
+      if not (List.for_all (eq_local_binders params) paramsl) then error 
+	"Parameters should be syntactically the same for each inductive type";
+      params
+
+let prepare_inductive ntnl indl =
+  let indl =
+    List.map (fun ((_,indname),_,ar,lc) -> { 
+      ind_name = indname;
+      ind_arity = ar;
+      ind_lc = List.map (fun (_,((_,id),t)) -> (id,t)) lc
+    }) indl in
+  List.fold_right option_cons ntnl [], indl
 
 let declare_mutual_with_eliminations isrecord mie =
-  let lrecnames =
-    List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in
+  let names = List.map (fun e -> e.mind_entry_typename) mie.mind_entry_inds in
   let (_,kn) = declare_mind isrecord mie in
-  if_verbose ppnl (minductive_message lrecnames);
+  if_verbose ppnl (minductive_message names);
   declare_eliminations kn;
   kn
 
-(* Very syntactical equality *)
-let eq_la d1 d2 = match d1,d2 with
-  | LocalRawAssum (nal,ast), LocalRawAssum (nal',ast') ->
-      (List.length nal = List.length nal') &&
-      List.for_all2 (fun (_,na) (_,na') -> na = na') nal nal'
-      & (try let _ = Constrextern.check_same_type ast ast' in true with _ -> false)
-  | LocalRawDef ((_,id),ast), LocalRawDef ((_,id'),ast') ->
-      id=id' & (try let _ = Constrextern.check_same_type ast ast' in true with _ -> false)
-  | _ -> false
-
-let extract_coe lc =
-  List.fold_right
-    (fun (addcoe,((_,(id:identifier)),t)) (l1,l2) ->
-      ((if addcoe then id::l1 else l1), (id,t)::l2)) lc ([],[])
-
-let extract_coe_la_lc = function
-  | []            -> anomaly "Vernacentries: empty list of inductive types"
-  | ((_,id),ntn,la,ar,lc)::rest ->
-      let rec check = function 
-	| []             -> [],[]
-  	| ((_,id),ntn,la',ar,lc)::rest ->
-            if (List.length la = List.length la') && 
-               (List.for_all2 eq_la la la')
-	    then
-	      let mcoes, mspec = check rest in
-	      let coes, lc' = extract_coe lc in
-	      (coes::mcoes,(id,ntn,ar,lc')::mspec)
-	    else 
-	      error ("Parameters should be syntactically the same "^
-		     "for each inductive type")
-      in
-      let mcoes, mspec = check rest in
-      let coes, lc' = extract_coe lc in
-      (coes,la,(id,ntn,ar,lc'):: mspec)
-
-let build_mutual lind finite =
-  let ((coes:identifier list),lparams,lnamearconstructs) = extract_coe_la_lc lind in
-  let notations,mie = interp_mutual lparams lnamearconstructs finite in
-  let _ = declare_mutual_with_eliminations false mie in
-  (* Declare the notations now bound to the inductive types *)
-  List.iter (fun (df,c,scope) ->
-    Metasyntax.add_notation_interpretation df [] c scope) notations;
-  List.iter
-    (fun id -> 
-      Class.try_add_new_coercion (locate (make_short_qualid id)) Global) coes
-
-(* try to find non recursive definitions *)
-
-let list_chop_hd i l = match list_chop i l with
-  | (l1,x::l2) -> (l1,x,l2)
-  | _ -> assert false
+let build_mutual l finite =
+  let indl,ntnl = List.split l in
+  let paramsl = extract_params indl in
+  let coes = extract_coercions indl in
+  let notations,indl = prepare_inductive ntnl indl in
+  let mie = interp_mutual paramsl indl notations finite in
+  (* Declare the mutual inductive block with its eliminations *)
+  ignore (declare_mutual_with_eliminations false mie);
+  (* Declare the possible notations of inductive types *)
+  List.iter (declare_interning_data ([],[])) notations;
+  (* Declare the coercions *)
+  List.iter (fun qid -> Class.try_add_new_coercion (locate qid) Global) coes
+
+(* 3c| Fixpoints and co-fixpoints *)
+
+let recursive_message = function
+  | [] -> anomaly "no recursive definition"
+  | [id] -> pr_id id ++ str " is recursively defined"
+  | l -> hov 0 (prlist_with_sep pr_coma pr_id l ++
+		    spc () ++ str "are recursively defined")
 
-let collect_non_rec env = 
-  let rec searchrec lnonrec lnamerec ldefrec larrec nrec = 
-    try
-      let i = 
-        list_try_find_i
-          (fun i f ->
-             if List.for_all (fun def -> not (occur_var env f def)) ldefrec
-             then i else failwith "try_find_i")
-          0 lnamerec 
-      in
-      let (lf1,f,lf2) = list_chop_hd i lnamerec in
-      let (ldef1,def,ldef2) = list_chop_hd i ldefrec in
-      let (lar1,ar,lar2) = list_chop_hd i larrec in
-      let newlnv = 
-	try 
-	  match list_chop i nrec with 
-            | (lnv1,_::lnv2) -> (lnv1@lnv2)
-	    | _ -> [] (* nrec=[] for cofixpoints *)
-        with Failure "list_chop" -> []
-      in 
-      searchrec ((f,def,ar)::lnonrec) 
-	(lf1@lf2) (ldef1@ldef2) (lar1@lar2) newlnv
-    with Failure "try_find_i" -> 
-      (List.rev lnonrec,
-       (Array.of_list lnamerec, Array.of_list ldefrec,
-        Array.of_list larrec, Array.of_list nrec))
-  in 
-  searchrec [] 
+let corecursive_message = function
+  | [] -> error "no corecursive definition"
+  | [id] -> pr_id id ++ str " is corecursively defined"
+  | l -> hov 0 (prlist_with_sep pr_coma pr_id l ++
+                    spc () ++ str "are corecursively defined")
 
-let build_recursive (lnameargsardef:(fixpoint_expr *decl_notation) list)
-                                                                   boxed =
-  let lrecnames = List.map (fun ((f,_,_,_,_),_) -> f) lnameargsardef 
-  and sigma = Evd.empty
-  and env0 = Global.env()
-  and nv = Array.of_list (List.map (fun ((_,n,_,_,_),_) -> n) lnameargsardef)
-  and bl = Array.of_list (List.map (fun ((_,_,bl,_,_),_) -> bl) lnameargsardef) 
-  in 
-  (* Build the recursive context and notations for the recursive types *)
-  let (rec_sign,rec_impls,arityl) = 
-    List.fold_left 
-      (fun (env,impls,arl) ((recname,_,bl,arityc,_),_) -> 
-        let arityc = generalize_constr_expr arityc bl in
-        let arity = interp_type sigma env0 arityc in
-	let impl = 
-	  if Impargs.is_implicit_args()
-	  then Impargs.compute_implicits env0 arity
-	  else [] in
-	let impls' =(recname,([],impl,compute_arguments_scope arity))::impls in
-        (Environ.push_named (recname,None,arity) env, impls', arity::arl))
-      (env0,[],[]) lnameargsardef in
-  let arityl = List.rev arityl in
-  let notations = 
-    List.fold_right (fun (_,ntnopt) l -> option_cons ntnopt l) 
-      lnameargsardef [] in
-
-  let recdef =
-
-    (* Declare local notations *)
-    let fs = States.freeze() in
-    let def = 
-      try
-	List.iter (fun (df,c,scope) ->
-	 silently
-	  (Metasyntax.add_notation_interpretation df rec_impls c) scope)
-	  notations;
-	List.map2
-	  (fun ((_,_,bl,_,def),_) arity ->
-            let def = abstract_constr_expr def bl in
-            interp_casted_constr sigma rec_sign ~impls:([],rec_impls)
-              def arity)
-          lnameargsardef arityl
-      with e ->
-	States.unfreeze fs; raise e in
-    States.unfreeze fs; def 
-  in
+let recursive_message isfix = 
+  if isfix=Fixpoint then recursive_message else corecursive_message
 
-  let (lnonrec,(namerec,defrec,arrec,nvrec)) = 
-    collect_non_rec env0 lrecnames recdef arityl (Array.to_list nv) in
-  let recvec = 
-    Array.map (subst_vars (List.rev (Array.to_list namerec))) defrec in
-  let recdecls = (Array.map (fun id -> Name id) namerec, arrec, recvec) in
-  let nvrec = Array.mapi 
-    (fun i (n,_) -> match n with 
-       | Some n -> n 
-       | None -> 
-	   (* Recursive argument was not given by the user : 
-	      We check that there is only one inductive argument *)
-	   let ctx = snd (interp_context sigma env0 bl.(i)) in 
-	   let isIndApp t = isInd (fst (decompose_app (strip_head_cast t))) in 
-	   (* This could be more precise (e.g. do some delta) *)
-	   let lb = List.rev_map (fun (_,_,t) -> isIndApp t) ctx in
-	   try (list_unique_index true lb) - 1
-	   with Not_found -> 
-	     error "the recursive argument needs to be specified")
-    nvrec
-  in  
-  let rec declare i fi =
-    let ce = 
-      { const_entry_body = mkFix ((nvrec,i),recdecls); (* ignore rec order *)
-        const_entry_type = Some arrec.(i);
-        const_entry_opaque = false;
-        const_entry_boxed = boxed} in
-    let kn = declare_constant fi (DefinitionEntry ce,IsDefinition Fixpoint)
-    in (ConstRef kn)
-  in 
-  (* declare the recursive definitions *)
-  let lrefrec = Array.mapi declare namerec in
-  if_verbose ppnl (recursive_message lrefrec);
-  (* The others are declared as normal definitions *)
-  let var_subst id = (id, global_reference id) in
-  let _ = 
-    List.fold_left
-      (fun subst (f,def,t) ->
-	 let ce = { const_entry_body = replace_vars subst def;
-		    const_entry_type = Some t;
-                    const_entry_opaque = false;
-		    const_entry_boxed = boxed } in
-	 let _ =
-	   declare_constant f (DefinitionEntry ce,IsDefinition Definition)
-	 in
-      	 warning ((string_of_id f)^" is non-recursively defined");
-      	 (var_subst f) :: subst)
-      (List.map var_subst (Array.to_list namerec))
-      lnonrec 
-  in
-  List.iter (fun (df,c,scope) ->
-    Metasyntax.add_notation_interpretation df [] c scope) notations
+(* An (unoptimized) function that maps preorders to partial orders...
 
-let build_corecursive lnameardef boxed = 
-  let lrecnames = List.map (fun (f,_,_,_) -> f) lnameardef
-  and sigma = Evd.empty
-  and env0 = Global.env() in
-  let fs = States.freeze() in
-  let (rec_sign,arityl) = 
-    try 
-      List.fold_left 
-        (fun (env,arl) (recname,bl,arityc,_) -> 
-           let arityc = generalize_constr_expr arityc bl in
-           let arity = interp_type Evd.empty env0 arityc in
-           let _ = declare_variable recname
-	     (Lib.cwd(),SectionLocalAssum arity,IsAssumption Definitional) in
-           (Environ.push_named (recname,None,arity) env, (arity::arl)))
-        (env0,[]) lnameardef
-    with e -> 
-      States.unfreeze fs; raise e in 
-  let arityl = List.rev arityl in
-  let recdef =
-    try 
-      List.map (fun (_,bl,arityc,def) ->
-        let arityc = generalize_constr_expr arityc bl in
-        let def = abstract_constr_expr def bl in
-	let arity = interp_constr sigma rec_sign arityc in
-        interp_casted_constr sigma rec_sign def arity)
-        lnameardef
-    with e -> 
-      States.unfreeze fs; raise e 
+   Input:  a list of associations (x,[y1;...;yn]), all yi distincts
+           and different of x, meaning x<=y1, ..., x<=yn
+
+   Output: a list of associations (x,Inr [y1;...;yn]), collecting all
+           distincts yi greater than x, _or_, (x, Inl y) meaning that
+           x is in the same class as y (in which case, x occurs
+           nowhere else in the association map)
+
+   partial_order : ('a * 'a list) list -> ('a * ('a,'a list) union) list
+*)
+
+let rec partial_order = function
+  | [] -> []
+  | (x,xge)::rest ->
+    let rec browse res xge' = function
+    | [] ->
+	let res = List.map (function
+	  | (z, Inr zge) when List.mem x zge -> (z, Inr (list_union zge xge'))
+	  | r -> r) res in
+	(x,Inr xge')::res
+    | y::xge -> 
+      let rec link y = 
+	try match List.assoc y res with
+	| Inl z -> link z
+	| Inr yge -> 
+	  if List.mem x yge then
+	    let res = List.remove_assoc y res in
+	    let res = List.map (function
+	      | (z, Inl t) ->
+		  if t = y then (z, Inl x) else (z, Inl t)
+	      | (z, Inr zge) ->
+		  if List.mem y zge then
+		    (z, Inr (list_add_set x (list_remove y zge)))
+		  else
+		    (z, Inr zge)) res in
+	    browse ((y,Inl x)::res) xge' (list_union xge (list_remove x yge))
+	  else
+	    browse res (list_add_set y (list_union xge' yge)) xge
+	with Not_found -> browse res (list_add_set y xge') xge
+      in link y
+    in browse (partial_order rest) [] xge 
+
+let non_full_mutual_message x xge y yge kind rest =
+  let reason = 
+    if List.mem x yge then 
+      string_of_id y^" depends on "^string_of_id x^" but not conversely"
+    else if List.mem y xge then 
+      string_of_id x^" depends on "^string_of_id y^" but not conversely"
+    else
+      string_of_id y^" and "^string_of_id x^" are not mutually dependent" in
+  let e = if rest <> [] then "e.g.: "^reason else reason in
+  let k = if kind=Fixpoint then "fixpoint" else "cofixpoint" in
+  let w =
+    if kind=Fixpoint then "Well-foundedness check may fail unexpectedly.\n"
+    else "" in
+  "Not a fully mutually defined "^k^"\n("^e^").\n"^w
+
+let check_mutuality env kind fixl =
+  let names = List.map fst fixl in
+  let preorder =
+    List.map (fun (id,def) -> 
+      (id, List.filter (fun id' -> id<>id' & occur_var env id' def) names))
+      fixl in
+  let po = partial_order preorder in
+  match List.filter (function (_,Inr _) -> true | _ -> false) po with
+    | (x,Inr xge)::(y,Inr yge)::rest ->
+	if_verbose warning (non_full_mutual_message x xge y yge kind rest)
+    | _ -> ()
+
+type fixpoint_kind =
+  | IsFixpoint of (int option * recursion_order_expr) list
+  | IsCoFixpoint
+
+type fixpoint_expr = {
+  fix_name : identifier;
+  fix_binders : local_binder list;
+  fix_body : constr_expr;
+  fix_type : constr_expr
+}
+
+let interp_fix_type isevars env fix =
+  interp_type_evars isevars env 
+    (generalize_constr_expr fix.fix_type fix.fix_binders)
+
+let interp_fix_body isevars env impls fix fixtype =
+  interp_casted_constr_evars isevars env ~impls
+    (abstract_constr_expr fix.fix_body fix.fix_binders) fixtype
+
+let declare_fix boxed kind f def t =
+  let ce = {
+    const_entry_body = def;
+    const_entry_type = Some t;
+    const_entry_opaque = false;
+    const_entry_boxed = boxed
+  } in
+  let kn = declare_constant f (DefinitionEntry ce,IsDefinition kind) in
+  ConstRef kn
+
+let prepare_recursive_declaration fixnames fixtypes fixdefs =
+  let defs = List.map (subst_vars (List.rev fixnames)) fixdefs in
+  let names = List.map (fun id -> Name id) fixnames in
+  (Array.of_list names, Array.of_list fixtypes, Array.of_list defs)
+
+let compute_guardness_evidence (n,_) fixl fixtype =
+  match n with 
+  | Some n -> n 
+  | None -> 
+      (* Recursive argument was not given by the user : 
+	 We check that there is only one inductive argument *)
+      let m = local_binders_length fixl.fix_binders in
+      let ctx = fst (Sign.decompose_prod_n_assum m fixtype) in
+      let isIndApp t = isInd (fst (decompose_app (strip_head_cast t))) in 
+      (* This could be more precise (e.g. do some delta) *)
+      let lb = List.rev_map (fun (_,_,t) -> isIndApp t) ctx in
+      try (list_unique_index true lb) - 1
+      with Not_found -> error "the recursive argument needs to be specified"
+
+let interp_recursive fixkind l boxed =
+  let env = Global.env() in
+  let fixl, ntnl = List.split l in
+  let kind = if fixkind <> IsCoFixpoint then Fixpoint else CoFixpoint in
+  let fixnames = List.map (fun fix -> fix.fix_name) fixl in
+
+  (* Interp arities allowing for unresolved types *)
+  let isevars = ref (Evd.create_evar_defs Evd.empty) in
+  let fixtypes = List.map (interp_fix_type isevars env) fixl in
+  let env_rec = push_named_types env fixnames fixtypes in
+
+  (* Get interpretation metadatas *)
+  let impls = compute_interning_datas env [] fixnames fixtypes in
+  let notations = List.fold_right option_cons ntnl [] in
+
+  (* Interp bodies with rollback because temp use of notations/implicit *)
+  let fixdefs = 
+    States.with_heavy_rollback (fun () -> 
+      List.iter (declare_interning_data impls) notations;
+      List.map2 (interp_fix_body isevars env_rec impls) fixl fixtypes)
+      () in
+
+  (* Instantiate evars and check all are resolved *)
+  let isevars,_ = consider_remaining_unif_problems env_rec !isevars in
+  let fixdefs = List.map (nf_evar (Evd.evars_of isevars)) fixdefs in
+  let fixtypes = List.map (nf_evar (Evd.evars_of isevars)) fixtypes in
+  List.iter (check_evars env_rec Evd.empty isevars) fixdefs;
+  check_mutuality env kind (List.combine fixnames fixdefs);
+
+  (* Build the fix declaration block *)
+  let fixdecls = prepare_recursive_declaration fixnames fixtypes fixdefs in
+  let fixdecls = 
+    match fixkind with
+    | IsFixpoint wfl ->
+	let fixwf = list_map3 compute_guardness_evidence wfl fixl fixtypes in
+	list_map_i (fun i _ -> mkFix ((Array.of_list fixwf,i),fixdecls)) 0 l
+    | IsCoFixpoint ->
+	list_map_i (fun i _ -> mkCoFix (i,fixdecls)) 0 l
   in
-  States.unfreeze fs;
-  let (lnonrec,(namerec,defrec,arrec,_)) = 
-    collect_non_rec env0 lrecnames recdef arityl [] in
-  let recvec = 
-    Array.map (subst_vars (List.rev (Array.to_list namerec))) defrec in
-  let recdecls = (Array.map (fun id -> Name id) namerec, arrec, recvec) in
-  let rec declare i fi =
-    let ce = 
-      { const_entry_body = mkCoFix (i, recdecls);
-        const_entry_type = Some (arrec.(i));
-        const_entry_opaque = false;
-        const_entry_boxed = boxed } 
-    in
-    let kn = declare_constant fi (DefinitionEntry ce,IsDefinition CoFixpoint)
-    in (ConstRef kn)
-  in 
-  let lrefrec = Array.mapi declare namerec in
-  if_verbose ppnl (corecursive_message lrefrec);
-  let var_subst id = (id, global_reference id) in
-  let _ = 
-    List.fold_left
-      (fun subst (f,def,t) ->
-	 let ce = { const_entry_body = replace_vars subst def;
-		    const_entry_type = Some t;
-                    const_entry_opaque = false;
-		    const_entry_boxed = boxed } in
-	 let _ = 
-	   declare_constant f (DefinitionEntry ce,IsDefinition Definition) in
-      	 warning ((string_of_id f)^" is non-recursively defined");
-      	 (var_subst f) :: subst)
-      (List.map var_subst (Array.to_list namerec))
-      lnonrec 
-  in ()
+
+  (* Declare the recursive definitions *)
+  ignore (list_map3 (declare_fix boxed kind) fixnames fixdecls fixtypes);
+  if_verbose ppnl (recursive_message kind fixnames);
+
+  (* Declare notations *)
+  List.iter (declare_interning_data ([],[])) notations
+
+let build_recursive l b =
+  let g = List.map (fun ((_,wf,_,_,_),_) -> wf) l in
+  let fixl = List.map (fun ((id,_,bl,typ,def),ntn) -> 
+    ({fix_name = id; fix_binders = bl; fix_body = def; fix_type = typ},ntn))
+    l in
+  interp_recursive (IsFixpoint g) fixl b
+
+let build_corecursive l b =
+  let fixl = List.map (fun ((id,bl,typ,def),ntn) -> 
+    ({fix_name = id; fix_binders = bl; fix_body = def; fix_type = typ},ntn))
+    l in
+  interp_recursive IsCoFixpoint fixl b
+
+(* 3d| Schemes *)
 
 let build_scheme lnamedepindsort = 
   let lrecnames = List.map (fun ((_,f),_,_,_) -> f) lnamedepindsort
@@ -637,8 +646,10 @@ let build_scheme lnamedepindsort =
     let kn = declare_constant fi (DefinitionEntry ce, IsDefinition Scheme) in
     ConstRef kn :: lrecref
   in 
-  let lrecref = List.fold_right2 declare listdecl lrecnames [] in
-  if_verbose ppnl (recursive_message (Array.of_list lrecref))
+  let _ = List.fold_right2 declare listdecl lrecnames [] in
+  if_verbose ppnl (recursive_message Fixpoint lrecnames)
+
+(* 4| Goal declaration *)
 
 let start_proof id kind c hook =
   let sign = Global.named_context () in
diff --git a/toplevel/command.mli b/toplevel/command.mli
index c93f69be..6f9a55c3 100644
--- a/toplevel/command.mli
+++ b/toplevel/command.mli
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: command.mli 7682 2005-12-21 15:06:11Z herbelin $ i*)
+(*i $Id: command.mli 9110 2006-09-01 12:30:52Z herbelin $ i*)
 
 (*i*)
 open Util
@@ -39,14 +39,14 @@ val syntax_definition : identifier -> constr_expr -> bool -> bool -> unit
 val declare_assumption : identifier located list ->
   coercion_flag -> assumption_kind -> local_binder list -> constr_expr -> unit
 
-val build_mutual : inductive_expr list -> bool -> unit
+val build_mutual : (inductive_expr * decl_notation) list -> bool -> unit
 
 val declare_mutual_with_eliminations :
   bool -> Entries.mutual_inductive_entry -> mutual_inductive
 
 val build_recursive : (fixpoint_expr * decl_notation) list -> bool -> unit
 
-val build_corecursive : cofixpoint_expr list -> bool -> unit
+val build_corecursive : (cofixpoint_expr * decl_notation) list -> bool -> unit
 
 val build_scheme : (identifier located * bool * reference * rawsort) list -> unit
 
diff --git a/toplevel/coqtop.ml b/toplevel/coqtop.ml
index 6d65ccc2..3374b0ee 100644
--- a/toplevel/coqtop.ml
+++ b/toplevel/coqtop.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: coqtop.ml 8932 2006-06-09 09:29:03Z notin $ *)
+(* $Id: coqtop.ml 9191 2006-09-29 15:45:42Z courtieu $ *)
 
 open Pp
 open Util
@@ -21,18 +21,16 @@ open Coqinit
 
 let get_version_date () =
   try
-    let ch = open_in (Coq_config.coqtop^"/make.result") in
-    let l = input_line ch in
-    let i = String.index l ' ' in
-    let j = String.index_from l (i+1) ' ' in
-    "checked out on "^(String.sub l (i+1) (j-i-1))
-  with _ -> Coq_config.date
+    let ch = open_in (Coq_config.coqlib^"/revision") in
+    let ver = input_line ch in
+    let rev = input_line ch in
+      (ver,rev)
+  with _ -> (Coq_config.version,Coq_config.date)
 
 let print_header () =
-  Printf.printf "Welcome to Coq %s (%s)\n" 
-    Coq_config.version 
-    (get_version_date ());
-  flush stdout
+  let (ver,rev) = (get_version_date ()) in
+    Printf.printf "Welcome to Coq %s (%s)\n" ver rev;
+    flush stdout
 
 let memory_stat = ref false
 
@@ -249,6 +247,8 @@ let parse_args is_ide =
 
     | "-vm" :: rem -> use_vm := true; parse rem
     | "-emacs" :: rem -> Options.print_emacs := true; Pp.make_pp_emacs(); parse rem
+    | "-emacs-U" :: rem -> Options.print_emacs := true; 
+	Options.print_emacs_safechar := true; Pp.make_pp_emacs(); parse rem
 	  
     | "-where" :: _ -> print_endline (getenv_else "COQLIB" Coq_config.coqlib); exit 0
 
diff --git a/toplevel/discharge.ml b/toplevel/discharge.ml
index c011ba52..63a6ad07 100644
--- a/toplevel/discharge.ml
+++ b/toplevel/discharge.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: discharge.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: discharge.ml 9310 2006-10-28 19:35:09Z herbelin $ *)
 
 open Names
 open Util
@@ -73,7 +73,7 @@ let process_inductive sechyps modlist mib =
   let inds = 
     array_map_to_list
       (fun mip ->
-	 let arity = expmod_constr modlist (Termops.refresh_universes (Inductive.type_of_inductive (mib,mip))) in
+	 let arity = expmod_constr modlist (Termops.refresh_universes (Inductive.type_of_inductive (Global.env()) (mib,mip))) in
 	 let lc = Array.map (expmod_constr modlist) mip.mind_user_lc in
 	 (mip.mind_typename,
 	  arity,
diff --git a/toplevel/himsg.ml b/toplevel/himsg.ml
index 73aaef30..b8e9eeda 100644
--- a/toplevel/himsg.ml
+++ b/toplevel/himsg.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: himsg.ml 8845 2006-05-23 07:41:58Z herbelin $ *)
+(* $Id: himsg.ml 9217 2006-10-05 17:31:23Z notin $ *)
 
 open Pp
 open Util
@@ -385,6 +385,14 @@ let explain_cannot_unify m n =
   str"Impossible to unify" ++ brk(1,1)  ++ pm ++ spc ()  ++
   str"with" ++ brk(1,1)  ++ pn
 
+let explain_cannot_unify_local env m n subn =
+  let pm = pr_lconstr m in 
+  let pn = pr_lconstr n in
+  let psubn = pr_lconstr_env env subn in
+    str"Impossible to unify" ++ brk(1,1)  ++ pm ++ spc ()  ++
+      str"with" ++ brk(1,1)  ++ pn ++ spc() ++ str"as" ++ brk(1,1) ++ 
+      psubn ++ str" contains local variables"
+
 let explain_refiner_cannot_generalize ty =
   str "Cannot find a well-typed generalisation of the goal with type : " ++ 
   pr_lconstr ty
@@ -455,6 +463,7 @@ let explain_pretype_error ctx err =
   | NotProduct c ->
       explain_not_product ctx c
   | CannotUnify (m,n) -> explain_cannot_unify m n
+  | CannotUnifyLocal (e,m,n,sn) -> explain_cannot_unify_local e m n sn
   | CannotGeneralize ty -> explain_refiner_cannot_generalize ty
   | NoOccurrenceFound c -> explain_no_occurrence_found c
   | CannotUnifyBindingType (m,n) -> explain_cannot_unify_binding_type m n
diff --git a/toplevel/metasyntax.ml b/toplevel/metasyntax.ml
index 92ce6e36..3dcb1f58 100644
--- a/toplevel/metasyntax.ml
+++ b/toplevel/metasyntax.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: metasyntax.ml 7822 2006-01-08 17:14:56Z herbelin $ *)
+(* $Id: metasyntax.ml 9333 2006-11-02 13:59:14Z barras $ *)
 
 open Pp
 open Util
@@ -50,7 +50,7 @@ let make_terminal_status = function
 let rec make_tags lev = function
   | VTerm s :: l -> make_tags lev l
   | VNonTerm (loc, nt, po) :: l ->
-      let (etyp, _) = Egrammar.interp_entry_name lev "tactic" nt in
+      let (etyp, _) = Egrammar.interp_entry_name lev nt in
       etyp :: make_tags lev l
   | [] -> []
 
@@ -112,6 +112,8 @@ let print_grammar univ = function
   | "tactic" -> 
       msgnl (str "Entry tactic_expr is");
       Gram.Entry.print Pcoq.Tactic.tactic_expr;
+      msgnl (str "Entry binder_tactic is");
+      Gram.Entry.print Pcoq.Tactic.binder_tactic;
       msgnl (str "Entry simple_tactic is");
       Gram.Entry.print Pcoq.Tactic.simple_tactic;
   | "vernac" -> 
@@ -399,6 +401,10 @@ let is_operator s =
    s.[0] = '-' or s.[0] = '/' or s.[0] = '<' or s.[0] = '>' or
    s.[0] = '@' or s.[0] = '\\' or s.[0] = '&' or s.[0] = '~')
 
+let is_prod_ident = function
+  | Terminal s when is_letter s.[0] or s.[0] = '_' -> true
+  | _ -> false
+
 let rec is_non_terminal = function
   | NonTerminal _ | SProdList _ -> true
   | _ -> false
@@ -437,10 +443,11 @@ let make_hunks etyps symbols from =
 	  else 
 	    UnpTerminal s :: add_break 1 (make NoBreak prods)
 	else if is_ident_tail s.[String.length s - 1] then
+	  let sep = if is_prod_ident (List.hd prods) then "" else " " in
 	  if ws = CanBreak then
-	    add_break 1 (UnpTerminal (s^" ") :: make CanBreak prods)
+	    add_break 1 (UnpTerminal (s^sep) :: make CanBreak prods)
 	  else
-	    UnpTerminal (s^" ") :: make CanBreak prods
+	    UnpTerminal (s^sep) :: make CanBreak prods
 	else if ws = CanBreak then
 	  add_break 1 (UnpTerminal (s^" ") :: make CanBreak prods)
 	else
diff --git a/toplevel/record.ml b/toplevel/record.ml
index 9eeeb51e..bf0271d9 100644
--- a/toplevel/record.ml
+++ b/toplevel/record.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: record.ml 8875 2006-05-29 19:59:11Z msozeau $ *)
+(* $Id: record.ml 9082 2006-08-24 17:03:28Z herbelin $ *)
 
 open Pp
 open Util
@@ -192,7 +192,6 @@ let declare_projections indsp coers fields =
    list telling if the corresponding fields must me declared as coercion *)
 let definition_structure ((is_coe,(_,idstruc)),ps,cfs,idbuild,s) =
   let coers,fs = List.split cfs in
-  let nparams = local_binders_length ps in
   let extract_name acc = function
       Vernacexpr.AssumExpr((_,Name id),_) -> id::acc
     | Vernacexpr.DefExpr ((_,Name id),_,_) -> id::acc
@@ -219,4 +218,4 @@ let definition_structure ((is_coe,(_,idstruc)),ps,cfs,idbuild,s) =
   let kinds,sp_projs = declare_projections rsp coers fields in
   let build = ConstructRef (rsp,1) in (* This is construct path of idbuild *)
   if is_coe then Class.try_add_new_coercion build Global;
-  Recordops.declare_structure(rsp,idbuild,nparams,List.rev kinds,List.rev sp_projs)
+  Recordops.declare_structure(rsp,idbuild,List.rev kinds,List.rev sp_projs)
diff --git a/toplevel/toplevel.ml b/toplevel/toplevel.ml
index 95c1b7d9..439e9254 100644
--- a/toplevel/toplevel.ml
+++ b/toplevel/toplevel.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: toplevel.ml 8748 2006-04-27 16:01:26Z courtieu $ *)
+(* $Id: toplevel.ml 9252 2006-10-20 14:22:41Z herbelin $ *)
 
 open Pp
 open Util
@@ -48,11 +48,19 @@ let resynch_buffer ibuf =
     | _ -> ()
 
 
-(* Read a char in an input channel, displaying a prompt at every
-   beginning of line. *)
+(* emacs special character for prompt end (fast) detection. Prefer
+   (Char.chr 6) since it does not interfere with utf8. For
+    compatibility we let (Char.chr 249) as default for a while. *)
+
+let emacs_prompt_startstring() = 
+  if !Options.print_emacs_safechar then "<prompt>" else ""
 
-let emacs_prompt_endstring = String.make 1 (Char.chr 249)
+let emacs_prompt_endstring() = 
+  if !Options.print_emacs_safechar then "</prompt>"
+  else String.make 1 (Char.chr 249)
 
+(* Read a char in an input channel, displaying a prompt at every
+   beginning of line. *)
 let prompt_char ic ibuf count =
   let bol = match ibuf.bols with
     | ll::_ -> ibuf.len == ll
@@ -128,6 +136,7 @@ let print_highlight_location ib loc =
                       str sn ++ str dn) in 
 	  (l1 ++ li ++ ln)
   in 
+  let loc = make_loc (bp,ep) in
   (str"Toplevel input, characters " ++ Cerrors.print_loc loc ++ fnl () ++
      highlight_lines ++ fnl ())
 
@@ -214,14 +223,16 @@ let make_emacs_prompt() =
       (fun acc x -> acc ^ (if acc <> "" then "|" else "") ^ Names.string_of_id x)
       "" pending in
   let proof_info = if dpth >= 0 then string_of_int dpth else "0" in
-  statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < " ^ emacs_prompt_endstring
+  statnum ^ " |" ^ pendingprompt ^ "| " ^ proof_info ^ " < " ^ (emacs_prompt_endstring())
 
 (* A buffer to store the current command read on stdin. It is
  * initialized when a vernac command is immediately followed by "\n",
  * or after a Drop. *)
 let top_buffer =
   let pr() = 
-    make_prompt() ^ Printer.emacs_str (make_emacs_prompt())
+    Printer.emacs_str (emacs_prompt_startstring()) 
+    ^ make_prompt() 
+    ^ Printer.emacs_str (make_emacs_prompt())
   in
   { prompt = pr;
     str = "";
@@ -232,7 +243,10 @@ let top_buffer =
 
 let set_prompt prompt =
   top_buffer.prompt
-  <- (fun () -> (prompt ())^(Printer.emacs_str (String.make 1 (Char.chr 249))))
+  <- (fun () -> 
+    Printer.emacs_str (emacs_prompt_startstring())
+    ^ prompt ()
+    ^ Printer.emacs_str (emacs_prompt_endstring()))
 
 (* Removes and prints the location of the error. The following exceptions
    need not be located. *)
diff --git a/toplevel/vernac.ml b/toplevel/vernac.ml
index afe72f0f..710b814d 100644
--- a/toplevel/vernac.ml
+++ b/toplevel/vernac.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(* $Id: vernac.ml 8924 2006-06-08 17:49:01Z notin $ *)
+(* $Id: vernac.ml 9133 2006-09-12 14:52:07Z notin $ *)
 
 (* Parsing of vernacular. *)
 
@@ -162,12 +162,12 @@ let rec vernac_com interpfun (loc,com) =
     | v -> if not !just_parsing then interpfun v
 
   in 
-  try
-    if do_translate () then pr_new_syntax loc (Some com);
-    interp com
-  with e -> 
-    Format.set_formatter_out_channel stdout;
-    raise (DuringCommandInterp (loc, e))
+    try
+      if do_translate () then pr_new_syntax loc (Some com);
+      interp com
+    with e -> 
+      Format.set_formatter_out_channel stdout;
+      raise (DuringCommandInterp (loc, e))
 
 and vernac interpfun input =
   vernac_com interpfun (parse_phrase input)
diff --git a/toplevel/vernacentries.ml b/toplevel/vernacentries.ml
index d384541f..35d202d9 100644
--- a/toplevel/vernacentries.ml
+++ b/toplevel/vernacentries.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: vernacentries.ml 9017 2006-07-05 17:27:34Z herbelin $ i*)
+(*i $Id: vernacentries.ml 9304 2006-10-28 09:58:16Z herbelin $ i*)
 
 (* Concrete syntax of the mathematical vernacular MV V2.6 *)
 
@@ -20,6 +20,7 @@ open Term
 open Pfedit
 open Tacmach
 open Proof_trees
+open Decl_mode
 open Constrintern
 open Prettyp
 open Printer
@@ -93,7 +94,10 @@ let show_script () =
   let pts = get_pftreestate () in
   let pf = proof_of_pftreestate pts
   and evc = evc_of_pftreestate pts in
-  msgnl (print_treescript true evc (Global.named_context()) pf)
+  msgnl (print_treescript true evc pf)
+
+let show_thesis () =
+     msgnl (anomaly "TODO" )
 
 let show_top_evars () =
   let pfts = get_pftreestate () in 
@@ -111,39 +115,19 @@ let print_subgoals () = if_verbose (fun () -> msg (pr_open_subgoals ())) ()
 
   (* Simulate the Intro(s) tactic *)
 
-let fresh_id_of_name avoid gl = function
-    Anonymous -> Tactics.fresh_id avoid (id_of_string "H") gl
-  | Name id   -> Tactics.fresh_id avoid id gl
-
-let rec do_renum avoid gl = function
-    [] -> mt ()
-  | [n] -> pr_id (fresh_id_of_name avoid gl n)
-  | n :: l ->
-      let id = fresh_id_of_name avoid gl n in
-      pr_id id ++ spc () ++ do_renum (id :: avoid) gl l
-
-(* Transforms a product term (x1:T1)..(xn:Tn)T into the pair
-   ([(xn,Tn);...;(x1,T1)],T), where T is not a product nor a letin *)
-let decompose_prod_letins = 
-  let rec prodec_rec l c = match kind_of_term c with
-    | Prod (x,t,c) -> prodec_rec ((x,t)::l) c
-    | LetIn (x,b,t,c) -> prodec_rec ((x,t)::l) c
-    | Cast (c,_,_)   -> prodec_rec l c
-    | _              -> l,c
-  in 
-  prodec_rec []
-
 let show_intro all =
   let pf = get_pftreestate() in
   let gl = nth_goal_of_pftreestate 1 pf in
-  let l,_= decompose_prod_letins (strip_outer_cast (pf_concl gl)) in
-  let nl = List.rev_map fst l in
-  if all then msgnl (hov 0 (do_renum [] gl nl))
-  else try 
-    let n = List.hd nl in
-    msgnl (pr_id (fresh_id_of_name [] gl n))
-  with Failure "hd" -> message "" 
-
+  let l,_= Sign.decompose_prod_assum (strip_outer_cast (pf_concl gl)) in
+  if all 
+  then 
+    let lid = Tactics.find_intro_names l gl in 
+    msgnl (hov 0 (prlist_with_sep  spc pr_id lid))
+  else  
+    try  
+      let n = list_last l in
+      msgnl (pr_id (List.hd (Tactics.find_intro_names [n] gl)))
+    with Failure "list_last" -> message ""
 
 let id_of_name = function 
   | Names.Anonymous -> id_of_string "x" 
@@ -508,15 +492,14 @@ let vernac_end_section = Lib.close_section
 
 let vernac_end_segment id =
   check_no_pending_proofs ();
-  let o = 
-    try Lib.what_is_opened ()
-    with Not_found -> error "There is nothing to end." in
-  match o with
-    | _,Lib.OpenedModule (export,_,_) -> vernac_end_module export id
-    | _,Lib.OpenedModtype _ -> vernac_end_modtype id
-    | _,Lib.OpenedSection _ -> vernac_end_section id
-    | _ -> anomaly "No more opened things"
-      
+  let o = try Lib.what_is_opened () with 
+      Not_found -> error "There is nothing to end." in
+    match o with
+      | _,Lib.OpenedModule (export,_,_) -> vernac_end_module export id
+      | _,Lib.OpenedModtype _ -> vernac_end_modtype id
+      | _,Lib.OpenedSection _ -> vernac_end_section id
+      | _ -> anomaly "No more opened things"
+
 let vernac_require import _ qidl =
   let qidl = List.map qualid_of_reference qidl in
   Library.require_library qidl import
@@ -553,6 +536,7 @@ let vernac_identity_coercion stre id qids qidt =
 let vernac_solve n tcom b =
   if not (refining ()) then
     error "Unknown command of the non proof-editing mode";
+  Decl_mode.check_not_proof_mode "Unknown proof instruction";
   begin
     if b then 
       solve_nth n (Tacinterp.hide_interp tcom (get_end_tac ()))
@@ -563,7 +547,7 @@ let vernac_solve n tcom b =
   if subtree_solved () then begin
     Options.if_verbose msgnl (str "Subgoal proved");
     make_focus 0;
-    reset_top_of_tree ()
+    reset_top_of_script ()
   end;
   print_subgoals();
   if !pcoq <> None then (out_some !pcoq).solve n
@@ -580,8 +564,35 @@ let vernac_set_end_tac tac =
   if not (refining ()) then
     error "Unknown command of the non proof-editing mode";
   if tac <> (Tacexpr.TacId []) then set_end_tac (Tacinterp.interp tac) else ()
-      (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*)
-	
+    (* TO DO verifier s'il faut pas mettre exist s | TacId s ici*)
+
+(***********************)
+(* Proof Language Mode *)
+
+let vernac_decl_proof () = 
+  check_not_proof_mode "Already in Proof Mode";
+  if tree_solved () then 
+    error "Nothing left to prove here."
+  else
+    begin
+      Decl_proof_instr.go_to_proof_mode ();
+      print_subgoals ()
+    end
+
+let vernac_return () = 
+  match get_current_mode () with
+      Mode_tactic ->
+	Decl_proof_instr.return_from_tactic_mode ();
+	print_subgoals ()
+    | Mode_proof -> 
+	error "\"return\" is only used after \"escape\"."
+    | Mode_none -> 
+	error "There is no proof to end." 
+
+let vernac_proof_instr instr = 
+  Decl_proof_instr.proof_instr instr;
+  print_subgoals ()
+
 (*****************************)
 (* Auxiliary file management *)
 
@@ -789,6 +800,14 @@ let _ =
       optread=Pp_control.get_margin;
       optwrite=Pp_control.set_margin }
 
+let _ =
+  declare_bool_option
+    { optsync=true;
+      optkey=SecondaryTable("Printing","Universes");
+      optname="the printing of universes";
+      optread=(fun () -> !Constrextern.print_universes);
+      optwrite=(fun b -> Constrextern.print_universes:=b) }
+
 let vernac_debug b =
   set_debug (if b then Tactic_debug.DebugOn 0 else Tactic_debug.DebugOff)
 
@@ -1009,18 +1028,21 @@ let vernac_backtrack snum pnum naborts =
   for i = 1 to naborts do vernac_abort None done;
   undo_todepth pnum;
   vernac_backto snum;
+  Pp.flush_all();
   (* there may be no proof in progress, even if no abort *)
   (try print_subgoals () with UserError _ -> ())
   
 
-  (* Est-ce normal que "Focus" ne semble pas se comporter comme "Focus 1" ? *)
-let vernac_focus = function
-  | None -> traverse_nth_goal 1; print_subgoals ()
-  | Some n -> traverse_nth_goal n; print_subgoals ()
-
+let vernac_focus gln =
+  check_not_proof_mode "No focussing or Unfocussing in Proof Mode.";
+  match gln with 
+    | None -> traverse_nth_goal 1; print_subgoals ()
+    | Some n -> traverse_nth_goal n; print_subgoals ()
+	
   (* Reset the focus to the top of the tree *)
 let vernac_unfocus () =
-  make_focus 0; reset_top_of_tree (); print_subgoals ()
+  check_not_proof_mode "No focussing or Unfocussing in Proof Mode.";
+  make_focus 0; reset_top_of_script (); print_subgoals ()
 
 let vernac_go = function
   | GoTo n -> Pfedit.traverse n;show_node()
@@ -1039,7 +1061,7 @@ let apply_subproof f occ =
   f evc (Global.named_context()) pf
 
 let explain_proof occ =
-  msg (apply_subproof (print_treescript true) occ)
+  msg (apply_subproof (fun evd _ -> print_treescript true evd) occ)
 
 let explain_tree occ =
   msg (apply_subproof print_proof occ)
@@ -1063,9 +1085,11 @@ let vernac_show = function
       msgnl (prlist_with_sep pr_spc pr_id (Pfedit.get_all_proof_names()))
   | ShowIntros all -> show_intro all
   | ShowMatch id -> show_match id
+  | ShowThesis -> show_thesis ()
   | ExplainProof occ -> explain_proof occ
   | ExplainTree occ -> explain_tree occ
 
+
 let vernac_check_guard () =
   let pts = get_pftreestate () in
   let pf = proof_of_pftreestate pts in
@@ -1130,6 +1154,14 @@ let interp c = match c with
   | VernacSolve (n,tac,b) -> vernac_solve n tac b
   | VernacSolveExistential (n,c) -> vernac_solve_existential n c
 
+  (* MMode *)
+
+  | VernacDeclProof -> vernac_decl_proof ()
+  | VernacReturn -> vernac_return ()
+  | VernacProofInstr stp -> vernac_proof_instr stp 
+
+  (* /MMode *)
+
   (* Auxiliary file and library management *)
   | VernacRequireFrom (exp,spec,f) -> vernac_require_from exp spec f
   | VernacAddLoadPath (isrec,s,alias) -> vernac_add_loadpath isrec s alias
diff --git a/toplevel/vernacexpr.ml b/toplevel/vernacexpr.ml
index 972d7ed9..9d514622 100644
--- a/toplevel/vernacexpr.ml
+++ b/toplevel/vernacexpr.ml
@@ -6,7 +6,7 @@
 (*         *       GNU Lesser General Public License Version 2.1        *)
 (************************************************************************)
 
-(*i $Id: vernacexpr.ml 9017 2006-07-05 17:27:34Z herbelin $ i*)
+(*i $Id: vernacexpr.ml 9154 2006-09-20 17:18:18Z corbinea $ i*)
 
 open Util
 open Names
@@ -99,6 +99,7 @@ type showable =
   | ShowProofNames
   | ShowIntros of bool
   | ShowMatch of lident
+  | ShowThesis
   | ExplainProof of int list
   | ExplainTree of int list
 
@@ -146,8 +147,7 @@ type simple_binder = lident list  * constr_expr
 type 'a with_coercion = coercion_flag * 'a
 type constructor_expr = (lident * constr_expr) with_coercion
 type inductive_expr =
-     lident * decl_notation * local_binder list * constr_expr
-    * constructor_expr list
+     lident * local_binder list * constr_expr * constructor_expr list
 type definition_expr =
   | ProveBody of local_binder list * constr_expr
   | DefineBody of local_binder list * raw_red_expr option * constr_expr
@@ -195,9 +195,9 @@ type vernac_expr =
   | VernacEndProof of proof_end
   | VernacExactProof of constr_expr
   | VernacAssumption of assumption_kind * simple_binder with_coercion list
-  | VernacInductive of inductive_flag * inductive_expr list
+  | VernacInductive of inductive_flag * (inductive_expr * decl_notation) list
   | VernacFixpoint of (fixpoint_expr * decl_notation) list * bool
-  | VernacCoFixpoint of cofixpoint_expr list * bool
+  | VernacCoFixpoint of (cofixpoint_expr * decl_notation) list * bool
   | VernacScheme of (lident * bool * lreference * sort_expr) list
 
   (* Gallina extensions *)
@@ -223,9 +223,17 @@ type vernac_expr =
       module_binder list * module_type_ast option
 
   (* Solving *)
+
   | VernacSolve of int * raw_tactic_expr * bool
   | VernacSolveExistential of int * constr_expr
 
+  (* Proof Mode *)
+
+  | VernacDeclProof
+  | VernacReturn
+  | VernacProofInstr of Decl_expr.raw_proof_instr
+
+
   (* Auxiliary file and library management *)
   | VernacRequireFrom of export_flag option * specif_flag option * lstring
   | VernacAddLoadPath of rec_flag * lstring * dir_path option